X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=contrib%2Fssl.el;fp=contrib%2Fssl.el;h=df198ba3e1d26f821f879f9d891292dd213f8989;hb=60b6cdd89175586e7d5b5d270f84e727a485202f;hp=5aa9d2f26df8f845a15bb58aa9f6437508a096fb;hpb=d44e180be8963b473e313f2176b0d41b06929d40;p=elisp%2Fgnus.git- diff --git a/contrib/ssl.el b/contrib/ssl.el index 5aa9d2f..df198ba 100644 --- a/contrib/ssl.el +++ b/contrib/ssl.el @@ -1,9 +1,10 @@ -;;; ssl.el,v --- ssl functions for emacsen without them builtin +;;; ssl.el,v --- ssl functions for Emacsen without them builtin +;; Author: William M. Perry ;; Keywords: comm ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Copyright (c) 1995, 1996 by William M. Perry -;;; Copyright (c) 1996 - 1999 Free Software Foundation, Inc. +;;; Copyright (c) 1996, 97, 98, 99, 2001 Free Software Foundation, Inc. ;;; ;;; This file is part of GNU Emacs. ;;; @@ -25,25 +26,14 @@ (eval-when-compile (require 'cl)) (require 'base64) - -(eval-and-compile - (condition-case () - (require 'custom) - (error nil)) - (if (and (featurep 'custom) (fboundp 'custom-declare-variable)) - nil ;; We've got what we needed - ;; We have the old custom-library, hack around it! - (defmacro defgroup (&rest args) - nil) - (defmacro defcustom (var value doc &rest args) - (` (defvar (, var) (, value) (, doc)))))) +(require 'url) ; for `url-configuration-directory' (defgroup ssl nil "Support for `Secure Sockets Layer' encryption." :group 'comm) (defcustom ssl-certificate-directory "~/.w3/certs/" - "*Directory to store CA certificates in" + "*Directory in which to store CA certificates." :group 'ssl :type 'directory) @@ -63,7 +53,7 @@ Run with one argument, the directory name." The certificate is piped to it. Maybe a way of passing a file should be implemented" :group 'ssl - :type 'list) + :type '(repeat string)) (defcustom ssl-certificate-directory-style 'ssleay "*Style of cert database to use, the only valid value right now is `ssleay'. @@ -102,6 +92,19 @@ to." :group 'ssl :type 'list) +(defcustom ssl-view-certificate-program-name ssl-program-name + "*The program to run to provide a human-readable view of a certificate." + :group 'ssl + :type 'string) + +(defcustom ssl-view-certificate-program-arguments + '("x509" "-text" "-inform" "DER") + "*Arguments that should be passed to the certificate viewing program. +The certificate is piped to it. +Maybe a way of passing a file should be implemented." + :group 'ssl + :type 'list) + (defun ssl-certificate-information (der) "Return an assoc list of information about a certificate in DER format." (let ((certificate (concat "-----BEGIN CERTIFICATE-----\n" @@ -112,18 +115,19 @@ to." (set-buffer (get-buffer-create " *openssl*")) (erase-buffer) (insert certificate) - (setq exit-code (condition-case () - (call-process-region (point-min) (point-max) - ssl-program-name - t (list (current-buffer) nil) t - "x509" - "-subject" ; Print the subject DN - "-issuer" ; Print the issuer DN - "-dates" ; Both before and after dates - "-serial" ; print out serial number - "-noout" ; Don't spit out the certificate - ) - (error -1))) + (setq exit-code + (condition-case () + (call-process-region (point-min) (point-max) + ssl-program-name + t (list (current-buffer) nil) t + "x509" + "-subject" ; Print the subject DN + "-issuer" ; Print the issuer DN + "-dates" ; Both before and after dates + "-serial" ; print out serial number + "-noout" ; Don't spit out the certificate + ) + (error -1))) (if (/= exit-code 0) nil (let ((vals nil)) @@ -133,17 +137,17 @@ to." vals))))) (defun ssl-accept-ca-certificate () - "Ask if the user is willing to accept a new CA certificate. The buffer-name -should be the intended name of the certificate, and the buffer should probably -be in DER encoding" + "Ask if the user is willing to accept a new CA certificate. +The buffer name should be the intended name of the certificate, and +the buffer should probably be in DER encoding" ;; TODO, check if it is really new or if we already know it (let* ((process-connection-type nil) (tmpbuf (generate-new-buffer "X509 CA Certificate Information")) (response (save-excursion - (and (eq 0 + (and (eq 0 (apply 'call-process-region - (point-min) (point-max) - ssl-view-certificate-program-name + (point-min) (point-max) + ssl-view-certificate-program-name nil tmpbuf t ssl-view-certificate-program-arguments)) (switch-to-buffer tmpbuf) @@ -171,27 +175,43 @@ be in DER encoding" nil nil nil (expand-file-name ssl-certificate-directory)))))))) +(defvar ssl-exec-wrapper nil) + +(defun ssl-get-command () + (if (memq system-type '(ms-dos ms-windows axp-vms vax-vms)) + ;; Nothing to do on DOS, Windows, or VMS! + (cons ssl-program-name ssl-program-arguments) + (if (not ssl-exec-wrapper) + (let ((script + (expand-file-name "exec_ssl_quietly" url-configuration-directory))) + (if (not (file-executable-p script)) + ;; Need to create our handy-dandy utility script to shut OpenSSL + ;; up completely. + (progn + (write-region "#!/bin/sh\n\nexec \"$@\" 2> /dev/null\n" nil + script nil 5) + (set-file-modes script 493))) ; (rwxr-xr-x) + (setq ssl-exec-wrapper script))) + (cons ssl-exec-wrapper (cons ssl-program-name ssl-program-arguments)))) + (defun open-ssl-stream (name buffer host service) "Open a SSL connection for a service to a host. Returns a subprocess-object to represent the connection. Input and output work as for subprocesses; `delete-process' closes it. Args are NAME BUFFER HOST SERVICE. NAME is name for process. It is modified if necessary to make it unique. -BUFFER is the buffer (or buffer-name) to associate with the process. - Process output goes at end of that buffer, unless you specify - an output stream or filter function to handle the output. - BUFFER may be also nil, meaning that this process is not associated - with any buffer +BUFFER is the buffer (or buffer name) to associate with the process. +Process output goes at end of that buffer, unless you specify +an output stream or filter function to handle the output. +BUFFER may be also nil, meaning that this process is not associated +with any buffer. Third arg is name of the host to connect to, or its IP address. Fourth arg SERVICE is name of the service desired, or an integer specifying a port number to connect to." (if (integerp service) (setq service (int-to-string service))) (let* ((process-connection-type nil) (port service) - (proc (eval - (` - (start-process name buffer ssl-program-name - (,@ ssl-program-arguments)))))) + (proc (eval `(start-process name buffer ,@(ssl-get-command))))) (process-kill-without-query proc) proc))