"PGP verification of current region." t)
(autoload 'pgg-snarf-keys-region "pgg"
"Snarf PGP public keys in current region." t)
-(autoload 'smime-decrypt-region "smime"
+(autoload 'smime-decrypt-buffer "smime"
"S/MIME decryption of current region.")
-(autoload 'smime-verify-region "smime"
- "S/MIME verification of current region.")
-(defvar smime-output-buffer)
-(defvar smime-errors-buffer)
-
+(autoload 'smime-verify-buffer "smime"
+ "Verify integrity of S/MIME message in BUFFER.")
+(autoload 'smime-noverify-buffer "smime"
+ "Verify integrity of S/MIME message in BUFFER.")
+(autoload 'smime-pkcs7-region "smime"
+ "Convert S/MIME message into a PKCS7 message.")
+(autoload 'smime-pkcs7-certificates-region "smime"
+ "Extract any certificates enclosed in PKCS7 message.")
+(autoload 'smime-pkcs7-email-region "smime"
+ "Get email addresses contained in certificate.")
+(defvar smime-details-buffer)
+(defvar smime-CA-file)
+(defvar smime-CA-directory)
;;; @ Internal method for multipart/signed
;;;
;;; @ Internal method for application/pkcs7-signature
;;;
-;;; It is based on RFC 2633 (S/MIME version 3).
+;;; It is based on the S/MIME user interface in Gnus.
(defun mime-verify-application/pkcs7-signature (entity situation)
"Internal method to check S/MIME signature."
- (let* ((entity-node-id (mime-entity-node-id entity))
- (mother (mime-entity-parent entity))
- (knum (car entity-node-id))
- (onum (if (> knum 0)
- (1- knum)
- (1+ knum)))
- (orig-entity (nth onum (mime-entity-children mother)))
- (basename (expand-file-name "tm" temporary-file-directory))
- (sig-file (concat (make-temp-name basename) ".asc"))
- status)
- (save-excursion
- (mime-show-echo-buffer)
- (set-buffer mime-echo-buffer-name)
- (set-window-start
- (get-buffer-window mime-echo-buffer-name)
- (point-max)))
- (mime-write-entity entity sig-file)
- (unwind-protect
- (with-temp-buffer
- (mime-insert-entity orig-entity)
- (goto-char (point-min))
- (while (progn (end-of-line) (not (eobp)))
- (insert "\r")
- (forward-line 1))
- (setq status (smime-verify-region (point-min)(point-max)
- sig-file))
- (save-excursion
+ (with-temp-buffer
+ (mime-insert-entity (mime-find-root-entity entity))
+ (let ((good-signature (smime-noverify-buffer))
+ (good-certificate
+ (and (or smime-CA-file smime-CA-directory)
+ (smime-verify-buffer))))
+ (if (not good-signature)
+ ;; we couldn't verify message, fail with openssl output as message
+ (save-excursion
+ (mime-show-echo-buffer)
(set-buffer mime-echo-buffer-name)
- (insert-buffer-substring (if status smime-output-buffer
- smime-errors-buffer))))
- (delete-file sig-file))))
+ (set-window-start
+ (get-buffer-window mime-echo-buffer-name)
+ (point-max))
+ (insert-buffer-substring smime-details-buffer))
+ ;; verify mail addresses in mail against those in certificate
+ (when (and (smime-pkcs7-region (point-min)(point-max))
+ (smime-pkcs7-certificates-region (point-min)(point-max)))
+ (if (not (member
+ (downcase
+ (nth 1 (std11-extract-address-components
+ (mime-entity-fetch-field
+ (mime-find-root-entity entity) "From"))))
+ (mime-smime-pkcs7-email-buffer (current-buffer))))
+ (message "Sender address forged")
+ (if good-certificate
+ (message "Ok (sender authenticated)")
+ (message "Integrity OK (sender unknown)"))))))))
+
+(defun mime-smime-pkcs7-email-buffer (buffer)
+ (with-temp-buffer
+ (insert-buffer-substring buffer)
+ (goto-char (point-min))
+ (let (addresses)
+ (while (re-search-forward "-----END CERTIFICATE-----" nil t)
+ (if (smime-pkcs7-email-region (point-min)(point))
+ (setq addresses (append (split-string
+ (buffer-substring (point-min)(point))
+ "[\n\r]+")
+ addresses)))
+ (delete-region (point-min)(point)))
+ (mapcar #'downcase addresses))))
;;; @ Internal method for application/pkcs7-mime
buffer-read-only)
(erase-buffer)
(mime-insert-entity entity)
- (smime-decrypt-region (point-min)(point-max))
- (delete-region (point-min)(point-max))
- (insert-buffer smime-output-buffer))
+ (smime-decrypt-buffer))
(setq major-mode 'mime-show-message-mode)
(save-window-excursion
(mime-view-buffer nil preview-buffer mother
+++ /dev/null
-;;; smime.el --- S/MIME interface.
-
-;; Copyright (C) 1999,2000 Free Software Foundation, Inc.
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1999/12/08
-;; Keywords: S/MIME, OpenSSL
-
-;; This file is part of SEMI (Secure Emacs MIME Interface).
-
-;; This program 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.
-
-;; This program 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.
-
-
-;;; Commentary:
-
-;; This module is based on
-
-;; [SMIMEV3] RFC 2633: "S/MIME Version 3 Message Specification"
-;; by Crocker, D., Flanigan, B., Hoffman, P., Housley, R.,
-;; Pawling, J. and Schaad, J. (1999/06)
-
-;; [SMIMEV2] RFC 2311: "S/MIME Version 2 Message Specification"
-;; by Dusse, S., Hoffman, P., Ramsdell, B., Lundblade, L.
-;; and L. Repka. (1998/03)
-
-;;; Code:
-
-(require 'path-util)
-(require 'mel)
-;; binary-funcall, binary-write-decoded-region, binary-insert-encoded-file
-(eval-when-compile (require 'static))
-
-(defgroup smime ()
- "S/MIME interface"
- :group 'mime)
-
-(defcustom smime-program "smime"
- "The S/MIME executable."
- :group 'smime
- :type 'string)
-
-(defcustom smime-shell-file-name "/bin/sh"
- "File name to load inferior shells from. Bourne shell or its equivalent
-\(not tcsh) is needed for \"2>\"."
- :group 'smime
- :type 'string)
-
-(defcustom smime-shell-command-switch "-c"
- "Switch used to have the shell execute its command line argument."
- :group 'smime
- :type 'string)
-
-(defcustom smime-x509-program
- (let ((file (exec-installed-p "openssl")))
- (and file (list file "x509" "-noout")))
- "External program for x509 parser."
- :group 'smime
- :type 'string)
-
-(defcustom smime-cache-passphrase t
- "Cache passphrase."
- :group 'smime
- :type 'boolean)
-
-(defcustom smime-certificate-directory "~/.w3/certs"
- "Certificate directory."
- :group 'smime
- :type 'directory)
-
-(defcustom smime-public-key-file nil
- "Public key file."
- :group 'smime
- :type 'boolean)
-
-(defcustom smime-private-key-file nil
- "Private key file."
- :group 'smime
- :type 'boolean)
-
-(defvar smime-errors-buffer " *S/MIME errors*")
-(defvar smime-output-buffer " *S/MIME output*")
-
-;;; @ utility functions
-;;;
-(put 'smime-process-when-success 'lisp-indent-function 0)
-
-(defmacro smime-process-when-success (&rest body)
- `(with-current-buffer smime-output-buffer
- (if (zerop (buffer-size)) nil ,@body t)))
-
-(defvar smime-passphrase-cache-expiry 16)
-(defvar smime-passphrase-cache (make-vector 7 0))
-
-(defvar smime-read-passphrase nil)
-(defun smime-read-passphrase (prompt &optional key)
- (if (not smime-read-passphrase)
- (if (functionp 'read-passwd)
- (setq smime-read-passphrase 'read-passwd)
- (if (load "passwd" t)
- (setq smime-read-passphrase 'read-passwd)
- (autoload 'ange-ftp-read-passwd "ange-ftp")
- (setq smime-read-passphrase 'ange-ftp-read-passwd))))
- (or (and smime-cache-passphrase
- (symbol-value (intern-soft key smime-passphrase-cache)))
- (funcall smime-read-passphrase prompt)))
-
-(defun smime-add-passphrase-cache (key passphrase)
- (set (intern key smime-passphrase-cache)
- passphrase)
- (run-at-time smime-passphrase-cache-expiry nil
- #'smime-remove-passphrase-cache
- key))
-
-(defun smime-remove-passphrase-cache (key)
- (let ((passphrase (symbol-value (intern-soft key smime-passphrase-cache))))
- (when passphrase
- (fillarray passphrase ?_)
- (unintern key smime-passphrase-cache))))
-
-(defsubst smime-parse-attribute (string)
- (delq nil (mapcar
- (lambda (attr)
- (if (string-match "=" attr)
- (cons (intern (substring attr 0 (match-beginning 0)))
- (substring attr (match-end 0)))
- nil))
- (split-string string "/"))))
-
-(defsubst smime-query-signer (start end)
- (smime-process-region start end smime-program (list "-qs"))
- (with-current-buffer smime-output-buffer
- (if (zerop (buffer-size)) nil
- (goto-char (point-min))
- (when (re-search-forward "^/" nil t)
- (smime-parse-attribute
- (buffer-substring (point) (progn (end-of-line)(point)))))
- )))
-
-(defsubst smime-x509-hash (cert-file)
- (with-current-buffer (get-buffer-create smime-output-buffer)
- (buffer-disable-undo)
- (erase-buffer)
- (apply #'call-process (car smime-x509-program) nil t nil
- (append (cdr smime-x509-program)
- (list "-hash" "-in" cert-file)))
- (if (zerop (buffer-size)) nil
- (buffer-substring (point-min) (1- (point-max))))))
-
-(defsubst smime-x509-subject (cert-file)
- (with-current-buffer (get-buffer-create smime-output-buffer)
- (buffer-disable-undo)
- (erase-buffer)
- (apply #'call-process (car smime-x509-program) nil t nil
- (append (cdr smime-x509-program)
- (list "-subject" "-in" cert-file)))
- (if (zerop (buffer-size)) nil
- (goto-char (point-min))
- (when (re-search-forward "^subject=" nil t)
- (smime-parse-attribute
- (buffer-substring (point)(progn (end-of-line)(point))))))))
-
-(defsubst smime-find-certificate (attr)
- (let ((files
- (and (file-directory-p smime-certificate-directory)
- (delq nil (mapcar (lambda (file)
- (if (file-directory-p file) nil
- file))
- (directory-files
- smime-certificate-directory
- 'full))))))
- (catch 'found
- (while files
- (if (or (string-equal
- (cdr (assq 'CN (smime-x509-subject (car files))))
- (cdr (assq 'CN attr)))
- (string-equal
- (cdr (assq 'Email (smime-x509-subject (car files))))
- (cdr (assq 'Email attr))))
- (throw 'found (car files)))
- (pop files)))))
-
-(defun smime-process-region (start end program args)
- (let* ((errors-file-name
- (concat temporary-file-directory
- (make-temp-name "smime-errors")))
- (args (append args (list (concat "2>" errors-file-name))))
- (shell-file-name smime-shell-file-name)
- (shell-command-switch smime-shell-command-switch)
- (process-connection-type nil)
- process status exit-status)
- (with-current-buffer (get-buffer-create smime-output-buffer)
- (buffer-disable-undo)
- (erase-buffer))
- (setq process
- (apply #'binary-funcall #'start-process-shell-command
- "*S/MIME*" smime-output-buffer
- program args))
- (set-process-sentinel process 'ignore)
- (process-send-region process start end)
- (process-send-eof process)
- (while (eq 'run (process-status process))
- (accept-process-output process 5))
- (setq status (process-status process)
- exit-status (process-exit-status process))
- (delete-process process)
- (with-current-buffer smime-output-buffer
- (goto-char (point-min))
- (while (re-search-forward "\r$" (point-max) t)
- (replace-match ""))
-
- (if (memq status '(stop signal))
- (error "%s exited abnormally: '%s'" program exit-status))
- (if (= 127 exit-status)
- (error "%s could not be found" program))
-
- (set-buffer (get-buffer-create smime-errors-buffer))
- (buffer-disable-undo)
- (erase-buffer)
- (insert-file-contents errors-file-name)
- (delete-file errors-file-name)
-
- (if (and process (eq 'run (process-status process)))
- (interrupt-process process))
- )
- ))
-
-;;; @ interface functions
-;;;
-
-;;;###autoload
-(defun smime-encrypt-region (start end)
- "Encrypt the current region between START and END."
- (let* ((key-file
- (or smime-private-key-file
- (expand-file-name (read-file-name "Public key file: "))))
- (args (list "-e" key-file)))
- (smime-process-region start end smime-program args)
- (smime-process-when-success
- (goto-char (point-min))
- (delete-region (point-min) (progn
- (re-search-forward "^$" nil t)
- (1+ (point)))))))
-
-;;;###autoload
-(defun smime-decrypt-region (start end)
- "Decrypt the current region between START and END."
- (let* ((key-file
- (or smime-private-key-file
- (expand-file-name (read-file-name "Private key file: "))))
- (hash (smime-x509-hash key-file))
- (passphrase (smime-read-passphrase
- (format "S/MIME passphrase for %s: " hash)
- hash))
- (args (list "-d" key-file passphrase)))
- (smime-process-region start end smime-program args)
- (smime-process-when-success
- (when smime-cache-passphrase
- (smime-add-passphrase-cache hash passphrase)))))
-
-;;;###autoload
-(defun smime-sign-region (start end &optional cleartext)
- "Make the signature from text between START and END.
-If the optional 3rd argument CLEARTEXT is non-nil, it does not create
-a detached signature."
- (let* ((key-file
- (or smime-private-key-file
- (expand-file-name (read-file-name "Private key file: "))))
- (hash (smime-x509-hash key-file))
- (passphrase (smime-read-passphrase
- (format "S/MIME passphrase for %s: " hash)
- hash))
- (args (list "-ds" key-file passphrase)))
- (smime-process-region start end smime-program args)
- (smime-process-when-success
- (goto-char (point-min))
- (delete-region (point-min) (progn
- (re-search-forward "^$" nil t)
- (1+ (point))))
- (when smime-cache-passphrase
- (smime-add-passphrase-cache hash passphrase)))))
-
-;;;###autoload
-(defun smime-verify-region (start end signature)
- "Verify the current region between START and END.
-If the optional 3rd argument SIGNATURE is non-nil, it is treated as
-the detached signature of the current region."
- (let* ((basename (expand-file-name "smime" temporary-file-directory))
- (orig-file (make-temp-name basename))
- (orig-mode (default-file-modes)))
- (unwind-protect
- (progn
- (set-default-file-modes 448)
- (binary-write-decoded-region start end orig-file))
- (set-default-file-modes orig-mode))
- (with-temp-buffer
- (binary-insert-encoded-file signature)
- (goto-char (point-max))
- (binary-insert-encoded-file
- (or (smime-find-certificate
- (smime-query-signer (point-min)(point-max)))
- (expand-file-name
- (read-file-name "Certificate file: "))))
- (smime-process-region (point-min)(point-max) smime-program
- (list "-dv" orig-file)))
- (smime-process-when-success nil)))
-
-(provide 'smime)
-
-;;; smime.el ends here
projects / elisp / semi.git / commitdiff