Mercurial > hg > xemacs-beta
diff lisp/w3/url-pgp.el @ 102:a145efe76779 r20-1b3
Import from CVS: tag r20-1b3
author | cvs |
---|---|
date | Mon, 13 Aug 2007 09:15:49 +0200 |
parents | 441bb1e64a06 |
children |
line wrap: on
line diff
--- a/lisp/w3/url-pgp.el Mon Aug 13 09:15:13 2007 +0200 +++ b/lisp/w3/url-pgp.el Mon Aug 13 09:15:49 2007 +0200 @@ -1,175 +0,0 @@ -;;; url-pgp.el --- PGP encapsulation of HTTP -;; Author: wmperry -;; Created: 1997/01/10 00:13:05 -;; Version: 1.3 -;; Keywords: comm, data, processes - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (c) 1993-1996 by William M. Perry (wmperry@cs.indiana.edu) -;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc. -;;; -;;; This file is not part of GNU Emacs, but the same permissions apply. -;;; -;;; GNU Emacs is free software; you can redistribute it and/or modify -;;; it under the terms of the GNU General Public License as published by -;;; the Free Software Foundation; either version 2, or (at your option) -;;; any later version. -;;; -;;; GNU Emacs is distributed in the hope that it will be useful, -;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;; GNU General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with GNU Emacs; see the file COPYING. If not, write to the -;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;;; Boston, MA 02111-1307, USA. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(require 'url-vars) -(require 'url-parse) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; UUencoding -;;; ---------- -;;; These functions are needed for the (RI)PEM encoding. PGP can -;;; handle binary data, but (RI)PEM requires that it be uuencoded -;;; first, or it will barf severely. How rude. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun url-uuencode-buffer (&optional buff) - "UUencode buffer BUFF, with a default of the current buffer." - (setq buff (or buff (current-buffer))) - (save-excursion - (set-buffer buff) - (url-lazy-message "UUencoding...") - (call-process-region (point-min) (point-max) - url-uuencode-program t t nil "url-temp-file") - (url-lazy-message "UUencoding... done."))) - -(defun url-uudecode-buffer (&optional buff) - "UUdecode buffer BUFF, with a default of the current buffer." - (setq buff (or buff (current-buffer))) - (let ((newname (url-generate-unique-filename))) - (save-excursion - (set-buffer buff) - (goto-char (point-min)) - (re-search-forward "^begin [0-9][0-9][0-9] \\(.*\\)$" nil t) - (replace-match (concat "begin 600 " newname)) - (url-lazy-message "UUdecoding...") - (call-process-region (point-min) (point-max) url-uudecode-program) - (url-lazy-message "UUdecoding...") - (erase-buffer) - (insert-file-contents-literally newname) - (url-lazy-message "UUdecoding... done.") - (condition-case () - (delete-file newname) - (error nil))))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Decoding PGP/PEM responses -;;; -------------------------- -;;; A PGP/PEM encrypted/signed response contains all the real headers, -;;; so this is just a quick decrypt-then-reparse hack. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun url-decode-pgp/pem (arg) - "Decode a pgp/pem response from an HTTP/1.0 server. -This expects the decoded message to contain all the necessary HTTP/1.0 headers -to correctly act on the decoded message (new content-type, etc)." - (mc-decrypt-message) - (url-parse-mime-headers)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; PGP/PEM Encryption -;;; ------------------ -;;; This implements the highly secure PGP/PEM encrypted requests, as -;;; specified by NCSA and CERN. -;;; -;;; The complete online spec of this scheme was done by Tony Sanders -;;; <sanders@bsdi.com>, and can be seen at -;;; http://www.bsdi.com/HTTP:TNG/ripem-http.txt -;;; -;;; This section of code makes use of the EXCELLENT mailcrypt.el -;;; package by Jin S Choi (jsc@mit.edu) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun url-public-key-exists (entity scheme) - "Return t iff a key for ENTITY exists using public key system SCHEME. -ENTITY is the username/hostname combination we are checking for. -SCHEME is a symbol representing what public key encryption program to use. - Currently only 'pgp (Pretty Good Privacy) and 'pem (RIPEM) are - recognized." - (let (retval) - (save-excursion - (cond - ((eq 'pgp scheme) ; PGP encryption - (set-buffer (get-buffer-create " *keytmp*")) - (erase-buffer) - (call-process mc-pgp-path nil t nil "+batchmode" "-kxaf" entity) - (goto-char (point-min)) - (setq retval (search-forward mc-pgp-key-begin-line nil t))) - ((eq 'pem scheme) ; PEM encryption - (set-buffer (find-file-noselect mc-ripem-pubkeyfile)) - (goto-char (point-min)) - (setq retval (search-forward entity nil t))) - (t - (url-warn 'security - (format - "Bad value for SCHEME in url-public-key-exists %s" - scheme)))) - (kill-buffer (current-buffer))) - retval)) - -(defun url-get-server-keys (entity &optional scheme) - "Make sure the key for ENTITY exists using SCHEME. -ENTITY is the username/hostname combination to get the info for. - This should be a string you could pass to 'finger'. -SCHEME is a symbol representing what public key encryption program to use. - Currently only 'pgp (Pretty Good Privacy) and 'pem (RIPEM) are - recognized." - (or scheme (setq scheme mc-default-scheme)) - (save-excursion - (cond - ((url-public-key-exists entity scheme) nil) - (t - (string-match "\\([^@]+\\)@\\(.*\\)" entity) - (let ((url-working-buffer " *url-get-keys*")) - (url-retrieve (format "gopher://%s:79/0%s/w" (url-match entity 1) - (url-match entity 2))) - (mc-snarf-keys) - (kill-buffer url-working-buffer)))))) - -(defun url-fetch-with-pgp (url recipient type) - "Retrieve a document with public-key authentication. - URL is the url to request from the server. -RECIPIENT is the server's entity name (usually webmaster@host) - TYPE is a symbol representing what public key encryption program to use. - Currently only 'pgp (Pretty Good Privacy) and 'pem (RIPEM) are - recognized." - (or noninteractive (require 'mailcrypt)) - (let ((request (url-create-mime-request url "PGP-Redirect")) - (url-request-data nil) - (url-request-extra-headers nil)) - (save-excursion - (url-get-server-keys recipient type) - (set-buffer (get-buffer-create " *url-encryption*")) - (erase-buffer) - (insert "\n\n" mail-header-separator "\n" request) - (mc-encrypt-message recipient type) - (goto-char (point-min)) - (if (re-search-forward (concat "\n" mail-header-separator "\n") nil t) - (delete-region (point-min) (point))) - (setq url-request-data (buffer-string) - url-request-extra-headers - (list (cons "Authorized" (format "%s entity=\"%s\"" - (cond - ((eq type 'pgp) "PGP") - ((eq type 'pem) "PEM")) - url-pgp/pem-entity)) - (cons "Content-type" (format "application/x-www-%s-reply" - (cond - ((eq type 'pgp) "pgp") - ((eq type 'pem) "pem"))))))) - (kill-buffer " *url-encryption*") - (url-retrieve (url-expand-file-name "/") t))) - -(provide 'url-pgp)