projects
/
gnus
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Revision: emacs@sv.gnu.org/gnus--devo--0--patch-54
[gnus]
/
lisp
/
mml-smime.el
diff --git
a/lisp/mml-smime.el
b/lisp/mml-smime.el
index
5b54966
..
9d9d941
100644
(file)
--- a/
lisp/mml-smime.el
+++ b/
lisp/mml-smime.el
@@
-1,5
+1,7
@@
;;; mml-smime.el --- S/MIME support for MML
;;; mml-smime.el --- S/MIME support for MML
-;; Copyright (c) 2000, 2001, 2003, 2005 Free Software Foundation, Inc.
+
+;; Copyright (C) 2000, 2001, 2002, 2003, 2004,
+;; 2005, 2006 Free Software Foundation, Inc.
;; Author: Simon Josefsson <simon@josefsson.org>
;; Keywords: Gnus, MIME, S/MIME, MML
;; Author: Simon Josefsson <simon@josefsson.org>
;; Keywords: Gnus, MIME, S/MIME, MML
@@
-18,8
+20,8
@@
;; 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., 5
9 Temple Place - Suite 330
,
-;; Boston, MA 0211
1-1307
, USA.
+;; Free Software Foundation, Inc., 5
1 Franklin Street, Fifth Floor
,
+;; Boston, MA 0211
0-1301
, USA.
;;; Commentary:
;;; Commentary:
@@
-52,7
+54,7
@@
(if (not (and (not (file-exists-p tmp))
(get-buffer tmp)))
(push tmp certfiles)
(if (not (and (not (file-exists-p tmp))
(get-buffer tmp)))
(push tmp certfiles)
- (setq file (mm-make-temp-file (expand-file-name "mml."
+ (setq file (mm-make-temp-file (expand-file-name "mml."
mm-tmp-directory)))
(with-current-buffer tmp
(write-region (point-min) (point-max) file))
mm-tmp-directory)))
(with-current-buffer tmp
(write-region (point-min) (point-max) file))
@@
-77,7
+79,10
@@
(list 'keyfile
(if (= (length smime-keys) 1)
(cadar smime-keys)
(list 'keyfile
(if (= (length smime-keys) 1)
(cadar smime-keys)
- (or (let ((from (cadr (funcall gnus-extract-address-components
+ (or (let ((from (cadr (funcall (if (boundp
+ 'gnus-extract-address-components)
+ gnus-extract-address-components
+ 'mail-extract-address-components)
(or (save-excursion
(save-restriction
(message-narrow-to-headers)
(or (save-excursion
(save-restriction
(message-narrow-to-headers)
@@
-103,7
+108,10
@@
(while (not result)
(setq who (read-from-minibuffer
(format "%sLookup certificate for: " (or bad ""))
(while (not result)
(setq who (read-from-minibuffer
(format "%sLookup certificate for: " (or bad ""))
- (cadr (funcall gnus-extract-address-components
+ (cadr (funcall (if (boundp
+ 'gnus-extract-address-components)
+ gnus-extract-address-components
+ 'mail-extract-address-components)
(or (save-excursion
(save-restriction
(message-narrow-to-headers)
(or (save-excursion
(save-restriction
(message-narrow-to-headers)
@@
-115,7
+123,7
@@
(quit))
result))
(quit))
result))
-(defun mml-smime-get-
dns-ldap
()
+(defun mml-smime-get-
ldap-cert
()
;; todo: deal with comma separated multiple recipients
(let (result who bad cert)
(condition-case ()
;; todo: deal with comma separated multiple recipients
(let (result who bad cert)
(condition-case ()
@@
-135,17
+143,16
@@
result))
(defun mml-smime-encrypt-query ()
result))
(defun mml-smime-encrypt-query ()
- ;; todo: add ldap support (xemacs ldap api?)
;; todo: try dns/ldap automatically first, before prompting user
(let (certs done)
(while (not done)
(ecase (read (gnus-completing-read-with-default
;; todo: try dns/ldap automatically first, before prompting user
(let (certs done)
(while (not done)
(ecase (read (gnus-completing-read-with-default
- "
dns
" "Fetch certificate from"
+ "
ldap
" "Fetch certificate from"
'(("dns") ("ldap") ("file")) nil t))
(dns (setq certs (append certs
(mml-smime-get-dns-cert))))
(ldap (setq certs (append certs
'(("dns") ("ldap") ("file")) nil t))
(dns (setq certs (append certs
(mml-smime-get-dns-cert))))
(ldap (setq certs (append certs
-
(mml-smime-get-dns-ldap
))))
+
(mml-smime-get-ldap-cert
))))
(file (setq certs (append certs
(mml-smime-get-file-cert)))))
(setq done (not (y-or-n-p "Add more recipients? "))))
(file (setq certs (append certs
(mml-smime-get-file-cert)))))
(setq done (not (y-or-n-p "Add more recipients? "))))