Fixed the last commit.

diff --git a/lisp/mm-view.el b/lisp/mm-view.el
index f524905..5268582 100644 (file)
--- a/lisp/mm-view.el
+++ b/lisp/mm-view.el
@@ -30,7 +30,6 @@
 (require 'mailcap)
 (require 'mm-bodies)
 (require 'mm-decode)
 (require 'mailcap)
 (require 'mm-bodies)
 (require 'mm-decode)

-(require 'smime)

 
 (eval-and-compile
   (autoload 'gnus-article-prepare-display "gnus-art")
 
 (eval-and-compile
   (autoload 'gnus-article-prepare-display "gnus-art")

diff --git a/lisp/mml-sec.el b/lisp/mml-sec.el
index 835b8bb..cac0a9f 100644 (file)
--- a/lisp/mml-sec.el
+++ b/lisp/mml-sec.el
@@ -26,6 +26,7 @@
 
 ;;; Code:
 
 
 ;;; Code:
 

+(require 'mml-smime)

 (eval-when-compile (require 'cl))
 (require 'password)
 (autoload 'mml2015-sign "mml2015")
 (eval-when-compile (require 'cl))
 (require 'password)
 (autoload 'mml2015-sign "mml2015")


@@ -34,12 +35,6 @@
 (autoload 'mml1991-encrypt "mml1991")
 (autoload 'message-goto-body "message")
 (autoload 'mml-insert-tag "mml")
 (autoload 'mml1991-encrypt "mml1991")
 (autoload 'message-goto-body "message")
 (autoload 'mml-insert-tag "mml")

-(autoload 'mml-smime-sign "mml-smime")
-(autoload 'mml-smime-encrypt "mml-smime")
-(autoload 'mml-smime-sign-query "mml-smime")
-(autoload 'mml-smime-encrypt-query "mml-smime")
-(autoload 'mml-smime-verify "mml-smime")
-(autoload 'mml-smime-verify-test "mml-smime")

 
 (defvar mml-sign-alist
   '(("smime"     mml-smime-sign-buffer     mml-smime-sign-query)
 
 (defvar mml-sign-alist
   '(("smime"     mml-smime-sign-buffer     mml-smime-sign-query)

diff --git a/lisp/mml-smime.el b/lisp/mml-smime.el
index 2ef6d51..9d9d941 100644 (file)
--- a/lisp/mml-smime.el
+++ b/lisp/mml-smime.el
@@ -31,82 +31,10 @@
 
 (require 'smime)
 (require 'mm-decode)
 
 (require 'smime)
 (require 'mm-decode)

-(require 'mml-sec)

 (autoload 'message-narrow-to-headers "message")
 (autoload 'message-fetch-field "message")
 
 (autoload 'message-narrow-to-headers "message")
 (autoload 'message-fetch-field "message")
 

-(defvar mml-smime-use 'openssl)
-
-(defvar mml-smime-function-alist
-  '((openssl mml-smime-openssl-sign
-            mml-smime-openssl-encrypt
-            mml-smime-openssl-sign-query
-            mml-smime-openssl-encrypt-query
-            mml-smime-openssl-verify
-            mml-smime-openssl-verify-test)
-    (epg mml-smime-epg-sign
-        mml-smime-epg-encrypt
-        nil
-        nil
-        mml-smime-epg-verify
-        mml-smime-epg-verify-test)))
-
-(defcustom mml-smime-verbose mml-secure-verbose
-  "If non-nil, ask the user about the current operation more verbosely."
-  :group 'mime-security
-  :type 'boolean)
-
-(defcustom mml-smime-cache-passphrase mml-secure-cache-passphrase
-  "If t, cache passphrase."
-  :group 'mime-security
-  :type 'boolean)
-
-(defcustom mml-smime-passphrase-cache-expiry mml-secure-passphrase-cache-expiry
-  "How many seconds the passphrase is cached.
-Whether the passphrase is cached at all is controlled by
-`mml-smime-cache-passphrase'."
-  :group 'mime-security
-  :type 'integer)
-
-(defcustom mml-smime-signers nil
-  "A list of your own key ID which will be used to sign a message."
-  :group 'mime-security
-  :type '(repeat (string :tag "Key ID")))
-

 (defun mml-smime-sign (cont)
 (defun mml-smime-sign (cont)

-  (let ((func (nth 1 (assq mml-smime-use mml-smime-function-alist))))
-    (if func
-       (funcall func cont)
-      (error "Cannot find sign function"))))
-
-(defun mml-smime-encrypt (cont)
-  (let ((func (nth 2 (assq mml-smime-use mml-smime-function-alist))))
-    (if func
-       (funcall func cont)
-      (error "Cannot find encrypt function"))))
-
-(defun mml-smime-sign-query ()
-  (let ((func (nth 3 (assq mml-smime-use mml-smime-function-alist))))
-    (if func
-       (funcall func))))
-
-(defun mml-smime-encrypt-query ()
-  (let ((func (nth 4 (assq mml-smime-use mml-smime-function-alist))))
-    (if func
-       (funcall func))))
-
-(defun mml-smime-verify (handle ctl)
-  (let ((func (nth 5 (assq mml-smime-use mml-smime-function-alist))))
-    (if func
-       (funcall func handle ctl)
-      handle)))
-
-(defun mml-smime-verify-test (handle ctl)
-  (let ((func (nth 6 (assq mml-smime-use mml-smime-function-alist))))
-    (if func
-       (funcall func handle ctl))))
-
-(defun mml-smime-openssl-sign (cont)

   (when (null smime-keys)
     (customize-variable 'smime-keys)
     (error "No S/MIME keys configured, use customize to add your key"))
   (when (null smime-keys)
     (customize-variable 'smime-keys)
     (error "No S/MIME keys configured, use customize to add your key"))


@@ -116,7 +44,7 @@ Whether the passphrase is cached at all is controlled by
     (replace-match "\n" t t))
   (goto-char (point-max)))
 
     (replace-match "\n" t t))
   (goto-char (point-max)))
 

-(defun mml-smime-openssl-encrypt (cont)
+(defun mml-smime-encrypt (cont)

   (let (certnames certfiles tmp file tmpfiles)
     ;; xxx tmp files are always an security issue
     (while (setq tmp (pop cont))
   (let (certnames certfiles tmp file tmpfiles)
     ;; xxx tmp files are always an security issue
     (while (setq tmp (pop cont))


@@ -142,7 +70,7 @@ Whether the passphrase is cached at all is controlled by
       nil))
   (goto-char (point-max)))
 
       nil))
   (goto-char (point-max)))
 

-(defun mml-smime-openssl-sign-query ()
+(defun mml-smime-sign-query ()

   ;; query information (what certificate) from user when MML tag is
   ;; added, for use later by the signing process
   (when (null smime-keys)
   ;; query information (what certificate) from user when MML tag is
   ;; added, for use later by the signing process
   (when (null smime-keys)


@@ -214,7 +142,7 @@ Whether the passphrase is cached at all is controlled by
       (quit))
     result))
 
       (quit))
     result))
 

-(defun mml-smime-openssl-encrypt-query ()
+(defun mml-smime-encrypt-query ()

   ;; todo: try dns/ldap automatically first, before prompting user
   (let (certs done)
     (while (not done)
   ;; todo: try dns/ldap automatically first, before prompting user
   (let (certs done)
     (while (not done)


@@ -230,7 +158,7 @@ Whether the passphrase is cached at all is controlled by
       (setq done (not (y-or-n-p "Add more recipients? "))))
     certs))
 
       (setq done (not (y-or-n-p "Add more recipients? "))))
     certs))
 

-(defun mml-smime-openssl-verify (handle ctl)
+(defun mml-smime-verify (handle ctl)

   (with-temp-buffer
     (insert-buffer-substring (mm-handle-multipart-original-buffer ctl))
     (goto-char (point-min))
   (with-temp-buffer
     (insert-buffer-substring (mm-handle-multipart-original-buffer ctl))
     (goto-char (point-min))


@@ -295,212 +223,9 @@ Whether the passphrase is cached at all is controlled by
                 (buffer-string) "\n")))))
   handle)
 
                 (buffer-string) "\n")))))
   handle)
 

-(defun mml-smime-openssl-verify-test (handle ctl)
+(defun mml-smime-verify-test (handle ctl)

   smime-openssl-program)
 
   smime-openssl-program)
 

-(eval-and-compile
-  (autoload 'epg-make-context "epg"))
-
-(eval-when-compile
-  (defvar epg-user-id-alist)
-  (defvar epg-digest-algorithm-alist)
-  (defvar inhibit-redisplay)
-  (autoload 'epg-context-set-armor "epg")
-  (autoload 'epg-context-set-textmode "epg")
-  (autoload 'epg-context-set-signers "epg")
-  (autoload 'epg-context-result-for "epg")
-  (autoload 'epg-new-signature-digest-algorithm "epg")
-  (autoload 'epg-verify-result-to-string "epg")
-  (autoload 'epg-list-keys "epg")
-  (autoload 'epg-decrypt-string "epg")
-  (autoload 'epg-verify-string "epg")
-  (autoload 'epg-sign-string "epg")
-  (autoload 'epg-encrypt-string "epg")
-  (autoload 'epg-passphrase-callback-function "epg")
-  (autoload 'epg-context-set-passphrase-callback "epg")
-  (autoload 'epg-configuration "epg-config")
-  (autoload 'epg-expand-group "epg-config")
-  (autoload 'epa-select-keys "epa"))
-
-(eval-when-compile
-  (defvar password-cache-expiry)
-  (autoload 'password-read "password")
-  (autoload 'password-cache-add "password")
-  (autoload 'password-cache-remove "password"))
-
-(defvar mml-smime-epg-secret-key-id-list nil)
-
-(defun mml-smime-epg-passphrase-callback (context key-id ignore)
-  (if (eq key-id 'SYM)
-      (epg-passphrase-callback-function context key-id nil)
-    (let* (entry
-          (passphrase
-           (password-read
-            (if (eq key-id 'PIN)
-                "Passphrase for PIN: "
-              (if (setq entry (assoc key-id epg-user-id-alist))
-                  (format "Passphrase for %s %s: " key-id (cdr entry))
-                (format "Passphrase for %s: " key-id)))
-            (if (eq key-id 'PIN)
-                "PIN"
-              key-id))))
-      (when passphrase
-       (let ((password-cache-expiry mml-smime-passphrase-cache-expiry))
-         (password-cache-add key-id passphrase))
-       (setq mml-smime-epg-secret-key-id-list
-             (cons key-id mml-smime-epg-secret-key-id-list))
-       (copy-sequence passphrase)))))
-
-(defun mml-smime-epg-sign (cont)
-  (let* ((inhibit-redisplay t)
-        (context (epg-make-context 'CMS))
-        (boundary (mml-compute-boundary cont))
-        (signers
-         (or (message-options-get 'mml-smime-epg-signers)
-             (message-options-set
-             'mml-smime-epg-signers
-             (if mml-smime-verbose
-                 (epa-select-keys context "\
-Select keys for signing.
-If no one is selected, default secret key is used.  "
-                                  mml-smime-signers t)
-               (if mml-smime-signers
-                   (mapcar (lambda (name)
-                             (car (epg-list-keys context name t)))
-                           mml-smime-signers))))))
-       signature micalg)
-    (epg-context-set-signers context signers)
-    (if mml-smime-cache-passphrase
-       (epg-context-set-passphrase-callback
-        context
-        #'mml-smime-epg-passphrase-callback))
-    (condition-case error
-       (setq signature (epg-sign-string context (buffer-string) t)
-             mml-smime-epg-secret-key-id-list nil)
-      (error
-       (while mml-smime-epg-secret-key-id-list
-        (password-cache-remove (car mml-smime-epg-secret-key-id-list))
-        (setq mml-smime-epg-secret-key-id-list
-              (cdr mml-smime-epg-secret-key-id-list)))
-       (signal (car error) (cdr error))))
-    (if (epg-context-result-for context 'sign)
-       (setq micalg (epg-new-signature-digest-algorithm
-                     (car (epg-context-result-for context 'sign)))))
-    (goto-char (point-min))
-    (insert (format "Content-Type: multipart/signed; boundary=\"%s\";\n"
-                   boundary))
-    (if micalg
-       (insert (format "\tmicalg=%s; "
-                       (downcase
-                        (cdr (assq micalg
-                                   epg-digest-algorithm-alist))))))
-    (insert "protocol=\"application/pkcs7-signature\"\n")
-    (insert (format "\n--%s\n" boundary))
-    (goto-char (point-max))
-    (insert (format "\n--%s\n" boundary))
-    (insert "Content-Type: application/pkcs7-signature; name=smime.p7s
-Content-Transfer-Encoding: base64
-Content-Disposition: attachment; filename=smime.p7s
-
-")
-    (insert (base64-encode-string signature) "\n")
-    (goto-char (point-max))
-    (insert (format "--%s--\n" boundary))
-    (goto-char (point-max))))
-
-(defun mml-smime-epg-encrypt (cont)
-  (let ((inhibit-redisplay t)
-       (context (epg-make-context 'CMS))
-       (config (epg-configuration))
-       (recipients (message-options-get 'mml-smime-epg-recipients))
-       cipher signers
-       (boundary (mml-compute-boundary cont)))
-    (unless recipients
-      (setq recipients
-           (apply #'nconc
-                  (mapcar
-                   (lambda (recipient)
-                     (or (epg-expand-group config recipient)
-                         (list recipient)))
-                   (split-string
-                    (or (message-options-get 'message-recipients)
-                        (message-options-set 'message-recipients
-                                             (read-string "Recipients: ")))
-                    "[ \f\t\n\r\v,]+"))))
-      (if mml-smime-verbose
-         (setq recipients
-               (epa-select-keys context "\
-Select recipients for encryption.
-If no one is selected, symmetric encryption will be performed.  "
-                                recipients))
-       (setq recipients
-             (delq nil (mapcar (lambda (name)
-                                 (car (epg-list-keys context name)))
-                               recipients))))
-      (message-options-set 'mml-smime-epg-recipients recipients))
-    (if mml-smime-cache-passphrase
-       (epg-context-set-passphrase-callback
-        context
-        #'mml-smime-epg-passphrase-callback))
-    (condition-case error
-       (setq cipher
-             (epg-encrypt-string context (buffer-string) recipients)
-             mml-smime-epg-secret-key-id-list nil)
-      (error
-       (while mml-smime-epg-secret-key-id-list
-        (password-cache-remove (car mml-smime-epg-secret-key-id-list))
-        (setq mml-smime-epg-secret-key-id-list
-              (cdr mml-smime-epg-secret-key-id-list)))
-       (signal (car error) (cdr error))))
-    (delete-region (point-min) (point-max))
-    (goto-char (point-min))
-    (insert "\
-Content-Type: application/pkcs7-mime;
- smime-type=enveloped-data;
- name=smime.p7m
-Content-Transfer-Encoding: base64
-Content-Disposition: attachment; filename=smime.p7m
-
-")
-    (insert (base64-encode-string cipher))
-    (goto-char (point-max))))
-
-(defun mml-smime-epg-verify (handle ctl)
-  (catch 'error
-    (let ((inhibit-redisplay t)
-         context plain signature-file part signature)
-      (when (or (null (setq part (mm-find-raw-part-by-type
-                                 ctl (or (mm-handle-multipart-ctl-parameter
-                                          ctl 'protocol)
-                                         "application/pkcs7-signature")
-                                 t)))
-               (null (setq signature (mm-find-part-by-type
-                                      (cdr handle)
-                                      "application/pkcs7-signature"
-                                      nil t))))
-       (mm-set-handle-multipart-parameter
-        mm-security-handle 'gnus-info "Corrupted")
-       (throw 'error handle))
-      (setq context (epg-make-context 'CMS))
-      (condition-case error
-         (setq plain (epg-verify-string context (mm-get-part signature) part))
-       (error
-        (mm-set-handle-multipart-parameter
-         mm-security-handle 'gnus-info "Failed")
-        (if (eq (car error) 'quit)
-            (mm-set-handle-multipart-parameter
-             mm-security-handle 'gnus-details "Quit.")
-          (mm-set-handle-multipart-parameter
-           mm-security-handle 'gnus-details (format "%S" error)))
-        (throw 'error handle)))
-      (mm-set-handle-multipart-parameter
-       mm-security-handle 'gnus-info
-       (epg-verify-result-to-string (epg-context-result-for context 'verify)))
-      handle)))
-
-(defun mml-smime-epg-verify-test (handle ctl)
-  t)
-

 (provide 'mml-smime)
 
 ;;; arch-tag: f1bf94d4-f2cd-4c6f-b059-ad69492817e2
 (provide 'mml-smime)
 
 ;;; arch-tag: f1bf94d4-f2cd-4c6f-b059-ad69492817e2