-;;; ssl.el,v --- ssl functions for emacsen without them builtin
+;;; ssl.el,v --- ssl functions for Emacsen without them builtin
+;; Author: William M. Perry <wmperry@cs.indiana.edu>
;; Keywords: comm
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Copyright (c) 1995, 1996 by William M. Perry <wmperry@cs.indiana.edu>
-;;; 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.
;;;
;;;
;;; 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., 51 Franklin Street, Fifth Floor,
-;;; Boston, MA 02110-1301, USA.
+;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;;; Boston, MA 02111-1307, USA.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(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)
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'.
: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"
(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))
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)
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))
projects / elisp / gnus.git- / commitdiff