Revision: miles@gnu.org--gnu-2004/gnus--devo--0--patch-99
[gnus] / lisp / mml-smime.el
index 8c4c709..3313d6a 100644 (file)
@@ -1,10 +1,10 @@
 ;;; mml-smime.el --- S/MIME support for MML
-;; Copyright (c) 2000, 2001 Free Software Foundation, Inc.
+;; Copyright (c) 2000, 2001, 2003 Free Software Foundation, Inc.
 
 ;; Author: Simon Josefsson <simon@josefsson.org>
 ;; Keywords: Gnus, MIME, S/MIME, MML
 
-;; This file is part of GNU Emacs.
+;; 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
 
 ;;; Code:
 
+(eval-when-compile (require 'cl))
+
 (require 'smime)
 (require 'mm-decode)
+(autoload 'message-narrow-to-headers "message")
+(autoload 'message-fetch-field "message")
 
 (defun mml-smime-sign (cont)
   (when (null smime-keys)
     (customize-variable 'smime-keys)
     (error "No S/MIME keys configured, use customize to add your key"))
-  (smime-sign-buffer (cdr (assq 'keyfile cont))))
+  (smime-sign-buffer (cdr (assq 'keyfile cont)))
+  (goto-char (point-min))
+  (while (search-forward "\r\n" nil t)
+    (replace-match "\n" t t))
+  (goto-char (point-max)))
 
 (defun mml-smime-encrypt (cont)
   (let (certnames certfiles tmp file tmpfiles)
@@ -44,7 +52,8 @@
       (if (not (and (not (file-exists-p tmp))
                    (get-buffer tmp)))
          (push tmp certfiles)
-       (setq file (make-temp-name mm-tmp-directory))
+       (setq file (mm-make-temp-file (expand-file-name "mml." 
+                                                       mm-tmp-directory)))
        (with-current-buffer tmp
          (write-region (point-min) (point-max) file))
        (push file certfiles)
@@ -56,7 +65,8 @@
          t)
       (while (setq tmp (pop tmpfiles))
        (delete-file tmp))
-      nil)))
+      nil))
+  (goto-char (point-max)))
 
 (defun mml-smime-sign-query ()
   ;; query information (what certificate) from user when MML tag is
   ;; todo: try dns/ldap automatically first, before prompting user
   (let (certs done)
     (while (not done)
-      (ecase (read (gnus-completing-read "dns" "Fetch certificate from"
-                                        '(("dns") ("file")) nil t))
+      (ecase (read (gnus-completing-read-with-default
+                   "dns" "Fetch certificate from"
+                   '(("dns") ("file")) nil t))
        (dns (setq certs (append certs
                                 (mml-smime-get-dns-cert))))
        (file (setq certs (append certs
 
 (defun mml-smime-verify (handle ctl)
   (with-temp-buffer
-    (insert-buffer (mm-handle-multipart-original-buffer ctl))
+    (insert-buffer-substring (mm-handle-multipart-original-buffer ctl))
     (goto-char (point-min))
     (insert (format "Content-Type: %s; " (mm-handle-media-type ctl)))
     (insert (format "protocol=\"%s\"; "
 
 (provide 'mml-smime)
 
+;;; arch-tag: f1bf94d4-f2cd-4c6f-b059-ad69492817e2
 ;;; mml-smime.el ends here