Insert picons after doing the header highlightling.

[gnus] / contrib / ssl.el

diff --git a/contrib/ssl.el b/contrib/ssl.el
index e69363e..3c87529 100644 (file)
--- a/contrib/ssl.el
+++ b/contrib/ssl.el
@@ -1,15 +1,17 @@
-;;; ssl.el --- 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>
+;; $Revision: 1.5 $

 ;; Keywords: comm
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Copyright (c) 1995, 1996 by 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.
 ;;;
 ;;; 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
 ;;;
 ;;; This file is part of GNU Emacs.
 ;;;
 ;;; 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)
+;;; the Free Software Foundation; either version 3, or (at your option)

 ;;; any later version.
 ;;;
 ;;; GNU Emacs is distributed in the hope that it will be useful,
 ;;; any later version.
 ;;;
 ;;; GNU Emacs is distributed in the hope that it will be useful,


@@ -19,31 +21,20 @@
 ;;;
 ;;; 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
 ;;;
 ;;; 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-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/"
 
 (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)
 
   :group 'ssl
   :type 'directory)
 


@@ -63,7 +54,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
 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'.
 
 (defcustom ssl-certificate-directory-style 'ssleay
   "*Style of cert database to use, the only valid value right now is `ssleay'.


@@ -102,6 +93,19 @@ to."
   :group 'ssl
   :type 'list)
 
   :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"
 (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 +116,19 @@ to."
       (set-buffer (get-buffer-create " *openssl*"))
       (erase-buffer)
       (insert certificate)
       (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))
       (if (/= exit-code 0)
          nil
        (let ((vals nil))


@@ -133,17 +138,17 @@ to."
          vals)))))
   
 (defun ssl-accept-ca-certificate ()
          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
   ;; 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
                              (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 tmpbuf t
                                     ssl-view-certificate-program-arguments))
                          (switch-to-buffer tmpbuf)


@@ -171,30 +176,44 @@ be in DER encoding"
                         nil nil nil
                         (expand-file-name ssl-certificate-directory))))))))
 
                         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.
 (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)
 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))
 
 (provide 'ssl)
     (process-kill-without-query proc)
     proc))
 
 (provide 'ssl)

-
-;;; arch-tag: 659fae92-1c67-4055-939f-32153c2f5114