which included commits to RCS files with non-trunk default branches.
cup-page
admin
oort
+pgg
+smilies
like
(setq load-path (cons (expand-file-name "~/gnus-5.6.53/lisp") load-path))
+ (require 'gnus-load)
in your .emacs file, or wherever you keep such things.
;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003
;; Free Software Foundation, Inc.
-;; Author: Wes Hardaker <hardaker@ece.ucdavis.edu>
+;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news xpm annotation glyph faces
;; This file is part of GNU Emacs.
;; domain/dom/subdomain/unknown/face.gif
;; Groups: comp.lang.lisp
;; news/comp/lang/lisp/unknown/face.gif
-
+;;
+;; Original implementation by Wes Hardaker <hardaker@ece.ucdavis.edu>.
+;;
;;; Code:
(require 'gnus)
(insert glyph)
(gnus-add-wash-type category)
(gnus-add-image category (car glyph))
- (gnus-put-image (car glyph) (cdr glyph))))
+ (gnus-put-image (car glyph) (cdr glyph) category)))
(defun gnus-picon-create-glyph (file)
(or (cdr (assoc file gnus-picon-glyph-alist))
(mail-header-parse-addresses
;; mail-header-parse-addresses does not work (reliably) on
;; decoded headers.
- (mail-encode-encoded-word-string
- (or (mail-fetch-field header) ""))))
+ (or
+ (ignore-errors
+ (mail-encode-encoded-word-string
+ (or (mail-fetch-field header) "")))
+ (mail-fetch-field header))))
spec file point cache)
(dolist (address addresses)
(setq address (car address))
;;; Commands:
+;; #### NOTE: the test for buffer-read-only is the same as in
+;; article-display-[x-]face. See the comment up there.
+
;;;###autoload
(defun gnus-treat-from-picon ()
"Display picons in the From header.
If picons are already displayed, remove them."
(interactive)
- (gnus-with-article-buffer
- (if (memq 'from-picon gnus-article-wash-types)
- (gnus-delete-images 'from-picon)
- (gnus-picon-transform-address "from" 'from-picon))))
+ (let ((wash-picon-p buffer-read-only))
+ (gnus-with-article-buffer
+ (if (and wash-picon-p (memq 'from-picon gnus-article-wash-types))
+ (gnus-delete-images 'from-picon)
+ (gnus-picon-transform-address "from" 'from-picon)))
+ ))
;;;###autoload
(defun gnus-treat-mail-picon ()
"Display picons in the Cc and To headers.
If picons are already displayed, remove them."
(interactive)
- (gnus-with-article-buffer
- (if (memq 'mail-picon gnus-article-wash-types)
- (gnus-delete-images 'mail-picon)
- (gnus-picon-transform-address "cc" 'mail-picon)
- (gnus-picon-transform-address "to" 'mail-picon))))
+ (let ((wash-picon-p buffer-read-only))
+ (gnus-with-article-buffer
+ (if (and wash-picon-p (memq 'mail-picon gnus-article-wash-types))
+ (gnus-delete-images 'mail-picon)
+ (gnus-picon-transform-address "cc" 'mail-picon)
+ (gnus-picon-transform-address "to" 'mail-picon)))
+ ))
;;;###autoload
(defun gnus-treat-newsgroups-picon ()
"Display picons in the Newsgroups and Followup-To headers.
If picons are already displayed, remove them."
(interactive)
- (gnus-with-article-buffer
- (if (memq 'newsgroups-picon gnus-article-wash-types)
- (gnus-delete-images 'newsgroups-picon)
- (gnus-picon-transform-newsgroups "newsgroups")
- (gnus-picon-transform-newsgroups "followup-to"))))
+ (let ((wash-picon-p buffer-read-only))
+ (gnus-with-article-buffer
+ (if (and wash-picon-p (memq 'newsgroups-picon gnus-article-wash-types))
+ (gnus-delete-images 'newsgroups-picon)
+ (gnus-picon-transform-newsgroups "newsgroups")
+ (gnus-picon-transform-newsgroups "followup-to")))
+ ))
(provide 'gnus-picon)
;; o Don't use `read' at all (important places already fixed)
;; o Accept list of articles instead of message set string in most
;; imap-message-* functions.
+;; o Send strings as literal if they contain, e.g., ".
;;
;; Revision history:
;;
:type '(repeat string))
(defcustom imap-process-connection-type nil
- "*Value for `process-connection-type' to use for Kerberos4 and GSSAPI."
+ "*Value for `process-connection-type' to use for Kerberos4, GSSAPI and SSL.
+The `process-connection-type' variable control type of device
+used to communicate with subprocesses. Values are nil to use a
+pipe, or t or `pty' to use a pty. The value has no effect if the
+system has no ptys or if all ptys are busy: then a pipe is used
+in any case. The value takes effect when a IMAP server is
+opened, changing it after that has no effect.."
:group 'imap
:type 'boolean)
(while (and (memq (process-status process) '(open run))
(set-buffer buffer) ;; XXX "blue moon" nntp.el bug
(goto-char (point-min))
+ ;; Athena IMTEST can output SSL verify errors
+ (or (while (looking-at "^verify error:num=")
+ (forward-line))
+ t)
+ (or (while (looking-at "^TLS connection established")
+ (forward-line))
+ t)
;; cyrus 1.6.x (13? < x <= 22) queries capabilities
(or (while (looking-at "^C:")
(forward-line))
(coding-system-for-read imap-coding-system-for-read)
(coding-system-for-write imap-coding-system-for-write)
(process (starttls-open-stream name buffer server port))
- done)
+ done tls-info)
(message "imap: Connecting with STARTTLS...")
(when process
(while (and (memq (process-status process) '(open run))
(set-buffer buffer) ;; XXX "blue moon" nntp.el bug
- (goto-char (point-min))
+ (goto-char (point-max))
+ (forward-line -1)
(not (imap-parse-greeting)))
(accept-process-output process 1)
(sit-for 1))
+ (imap-send-command "STARTTLS")
+ (while (and (memq (process-status process) '(open run))
+ (set-buffer buffer) ;; XXX "blue moon" nntp.el bug
+ (goto-char (point-max))
+ (forward-line -1)
+ (not (re-search-forward "[0-9]+ OK.*\r?\n" nil t)))
+ (accept-process-output process 1)
+ (sit-for 1))
(and imap-log
(with-current-buffer (get-buffer-create imap-log-buffer)
(buffer-disable-undo)
(goto-char (point-max))
(insert-buffer-substring buffer)))
- (let ((imap-process process))
- (unwind-protect
- (progn
- (set-process-filter imap-process 'imap-arrival-filter)
- (when (and (eq imap-stream 'starttls)
- (imap-ok-p (imap-send-command-wait "STARTTLS")))
- (starttls-negotiate imap-process)))
- (set-process-filter imap-process nil)))
- (when (memq (process-status process) '(open run))
+ (when (and (setq tls-info (starttls-negotiate process))
+ (memq (process-status process) '(open run)))
(setq done process)))
- (if done
- (progn
- (message "imap: Connecting with STARTTLS...done")
- done)
- (message "imap: Connecting with STARTTLS...failed")
- nil)))
+ (if (stringp tls-info)
+ (message "imap: STARTTLS info: %s" tls-info))
+ (message "imap: Connecting with STARTTLS...%s" (if done "done" "failed"))
+ done))
;; Server functions; authenticator stuff:
(setq imap-password passwd)))
(message "Login failed...")
(setq passwd nil)
+ (setq imap-password nil)
(sit-for 1))))
;; (quit (with-current-buffer buffer
;; (setq user nil
ret)))
(defun imap-gssapi-auth-p (buffer)
- (and (imap-capability 'AUTH=GSSAPI buffer)
- (eq imap-stream 'gssapi)))
+ (eq imap-stream 'gssapi))
(defun imap-gssapi-auth (buffer)
(message "imap: Authenticating using GSSAPI...%s"
(imap-send-command-wait (list "STATUS \""
(imap-utf7-encode mailbox)
"\" "
- (format "%s"
- (if (listp items)
- items
- (list items))))))
+ (upcase
+ (format "%s"
+ (if (listp items)
+ items
+ (list items)))))))
(if (listp items)
(mapcar (lambda (item)
(imap-mailbox-get item mailbox))
(truncate (* (- imap-read-timeout
(truncate imap-read-timeout))
1000)))))
+ ;; A process can die _before_ we have processed everything it
+ ;; has to say. Moreover, this can happen in between the call to
+ ;; accept-process-output and the call to process-status in an
+ ;; iteration of the loop above.
+ (when (and (null imap-continuation)
+ (< imap-reached-tag tag))
+ (accept-process-output imap-process 0 0))
(when imap-have-messaged
(message ""))
(and (memq (process-status imap-process) '(open run))
(defun imap-arrival-filter (proc string)
"IMAP process filter."
- (with-current-buffer (process-buffer proc)
- (goto-char (point-max))
- (insert string)
- (and imap-log
- (with-current-buffer (get-buffer-create imap-log-buffer)
- (imap-disable-multibyte)
- (buffer-disable-undo)
- (goto-char (point-max))
- (insert string)))
- (let (end)
- (goto-char (point-min))
- (while (setq end (imap-find-next-line))
- (save-restriction
- (narrow-to-region (point-min) end)
- (delete-backward-char (length imap-server-eol))
- (goto-char (point-min))
- (unwind-protect
- (cond ((eq imap-state 'initial)
- (imap-parse-greeting))
- ((or (eq imap-state 'auth)
- (eq imap-state 'nonauth)
- (eq imap-state 'selected)
- (eq imap-state 'examine))
- (imap-parse-response))
- (t
- (message "Unknown state %s in arrival filter"
- imap-state)))
- (delete-region (point-min) (point-max))))))))
+ ;; Sometimes, we are called even though the process has died.
+ ;; Better abstain from doing stuff in that case.
+ (when (buffer-name (process-buffer proc))
+ (with-current-buffer (process-buffer proc)
+ (goto-char (point-max))
+ (insert string)
+ (and imap-log
+ (with-current-buffer (get-buffer-create imap-log-buffer)
+ (imap-disable-multibyte)
+ (buffer-disable-undo)
+ (goto-char (point-max))
+ (insert string)))
+ (let (end)
+ (goto-char (point-min))
+ (while (setq end (imap-find-next-line))
+ (save-restriction
+ (narrow-to-region (point-min) end)
+ (delete-backward-char (length imap-server-eol))
+ (goto-char (point-min))
+ (unwind-protect
+ (cond ((eq imap-state 'initial)
+ (imap-parse-greeting))
+ ((or (eq imap-state 'auth)
+ (eq imap-state 'nonauth)
+ (eq imap-state 'selected)
+ (eq imap-state 'examine))
+ (imap-parse-response))
+ (t
+ (message "Unknown state %s in arrival filter"
+ imap-state)))
+ (delete-region (point-min) (point-max)))))))))
\f
;; Imap parser.
(:authentication password))
(maildir
(:path (or (getenv "MAILDIR") "~/Maildir/"))
- (:subdirs ("new" "cur"))
+ (:subdirs ("cur" "new"))
(:function))
(imap
(:server (getenv "MAILHOST"))
(:mailbox "INBOX")
(:predicate "UNSEEN UNDELETED")
(:fetchflag "\\Deleted")
+ (:prescript)
+ (:prescript-delay)
+ (:postscript)
(:dontexpunge))
(webmail
(:subtype hotmail)
(set-file-modes to mail-source-default-file-modes))
(if (and (or (not (buffer-modified-p errors))
(zerop (buffer-size errors)))
- (zerop result))
+ (and (numberp result)
+ (zerop result)))
;; No output => movemail won.
t
(set-buffer errors)
(delete-file from)))
(defun mail-source-fetch-with-program (program)
- (zerop (call-process shell-file-name nil nil nil
- shell-command-switch program)))
+ (eq 0 (call-process shell-file-name nil nil nil
+ shell-command-switch program)))
(defun mail-source-run-script (script spec &optional delay)
(when script
(defun mail-source-fetch-imap (source callback)
"Fetcher for imap sources."
(mail-source-bind (imap source)
- (let* ((from (format "%s:%s:%s" server user port))
- (found 0)
- (buffer-name " *imap source*")
- (buf (get-buffer-create (generate-new-buffer-name buffer-name)))
- (mail-source-string (format "imap:%s:%s" server mailbox))
- (imap-shell-program (or (list program) imap-shell-program))
- remove)
- (if (and (imap-open server port stream authentication buffer-name)
+ (mail-source-run-script
+ prescript (format-spec-make ?p password ?t mail-source-crash-box
+ ?s server ?P port ?u user)
+ prescript-delay)
+ (let ((from (format "%s:%s:%s" server user port))
+ (found 0)
+ (buf (generate-new-buffer " *imap source*"))
+ (mail-source-string (format "imap:%s:%s" server mailbox))
+ (imap-shell-program (or (list program) imap-shell-program))
+ remove)
+ (if (and (imap-open server port stream authentication buf)
(imap-authenticate
user (or (cdr (assoc from mail-source-password-cache))
password) buf)
(mm-disable-multibyte)
;; remember password
(with-current-buffer buf
- (when (or imap-password
- (assoc from mail-source-password-cache))
+ (when (and imap-password
+ (not (assoc from mail-source-password-cache)))
(push (cons from imap-password) mail-source-password-cache)))
;; if predicate is nil, use all uids
(dolist (uid (imap-search (or predicate "1:*") buf))
(nnheader-ms-strip-cr))
(incf found (mail-source-callback callback server))
(when (and remove fetchflag)
+ (setq remove (nreverse remove))
(imap-message-flags-add
(imap-range-to-message-set (gnus-compress-sequence remove))
fetchflag nil buf))
(setq mail-source-password-cache
(delq (assoc from mail-source-password-cache)
mail-source-password-cache))
- (error (imap-error-text buf)))
+ (error "IMAP error: %s" (imap-error-text buf)))
(kill-buffer buf)
+ (mail-source-run-script
+ postscript
+ (format-spec-make ?p password ?t mail-source-crash-box
+ ?s server ?P port ?u user))
found)))
(eval-and-compile
(require 'gnus-start)
(require 'gnus-int)
+(eval-when-compile (require 'cl))
+
(nnoo-declare nnimap)
(defconst nnimap-version "nnimap 1.0")
(port (if nnimap-server-port
(int-to-string nnimap-server-port)
"imap"))
- (alist (gnus-netrc-machine list (or nnimap-server-address
- nnimap-address server)
- port "imap"))
+ (alist (or (gnus-netrc-machine list server port "imap")
+ (gnus-netrc-machine list
+ (or nnimap-server-address
+ nnimap-address)
+ port "imap")))
(user (gnus-netrc-get alist "login"))
(passwd (gnus-netrc-get alist "password")))
(if (imap-authenticate user passwd nnimap-server-buffer)
nnimap-split-download-body-default
nnimap-split-download-body)
(and (nnimap-request-article article)
- (mail-narrow-to-head))
+ (with-current-buffer nntp-server-buffer (mail-narrow-to-head)))
(nnimap-request-head article))
;; copy article to right group(s)
(setq removeorig nil)
(let (msgid)
(and (setq msgid
(nnmail-fetch-field "message-id"))
- (nnmail-cache-insert msgid to-group)))))
+ (nnmail-cache-insert msgid
+ to-group
+ (nnmail-fetch-field "subject"))))))
;; Add the group-art list to the history list.
(push (list (cons to-group 0)) nnmail-split-history))
(t
(nnimap-before-find-minmax-bugworkaround)
(dolist (pattern (nnimap-pattern-to-list-arguments
nnimap-list-pattern))
- (dolist (mbx (imap-mailbox-lsub "*" (car pattern) nil
+ (dolist (mbx (imap-mailbox-lsub (cdr pattern) (car pattern) nil
nnimap-server-buffer))
(or (catch 'found
(dolist (mailbox (imap-mailbox-get 'list-flags mbx
(replace-match "\r\n"))
(when nnmail-cache-accepted-message-ids
(nnmail-cache-insert (nnmail-fetch-field "message-id")
- group)))
+ group
+ (nnmail-fetch-field "subject"))))
(when (and last nnmail-cache-accepted-message-ids)
(nnmail-cache-close))
;; this 'or' is for Cyrus server bug
:group 'pgg
:type 'string)
-(defcustom pgg-default-keyserver-address "wwwkeys.pgp.net"
+(defcustom pgg-default-keyserver-address "subkeys.pgp.net"
"Host name of keyserver."
:group 'pgg
:type 'string)
:group 'pgg
:type 'boolean)
-(defcustom pgg-encrypt-for-me nil
+(defcustom pgg-encrypt-for-me t
"If t, encrypt all outgoing messages with user's public key."
:group 'pgg
:type 'boolean)
;;; Code:
-(eval-when-compile (require 'pgg))
+(eval-when-compile
+ (require 'cl) ; for gpg macros
+ (require 'pgg))
(defgroup pgg-gpg ()
"GnuPG interface"
:group 'pgg)
-(defcustom pgg-gpg-program "gpg"
+(defcustom pgg-gpg-program "gpg"
"The GnuPG executable."
:group 'pgg-gpg
:type 'string)
(defcustom pgg-gpg-extra-args nil
"Extra arguments for every GnuPG invocation."
:group 'pgg-gpg
- :type '(choice
- (const :tag "None" nil)
- (string :tag "Arguments")))
+ :type '(repeat (string :tag "Argument")))
+
+(defcustom pgg-gpg-recipient-argument "--recipient"
+ "GnuPG option to specify recipient."
+ :group 'pgg-gpg
+ :type '(choice (const :tag "New `--recipient' option" "--recipient")
+ (const :tag "Old `--remote-user' option" "--remote-user")))
(defvar pgg-gpg-user-id nil
"GnuPG ID of your default identity.")
(defun pgg-gpg-process-region (start end passphrase program args)
- (let* ((output-file-name
- (expand-file-name (make-temp-name "pgg-output")
- pgg-temporary-file-directory))
+ (let* ((output-file-name (pgg-make-temp-file "pgg-output"))
(args
`("--status-fd" "2"
,@(if passphrase '("--passphrase-fd" "0"))
+ "--yes" ; overwrite
"--output" ,output-file-name
,@pgg-gpg-extra-args ,@args))
(output-buffer pgg-output-buffer)
(unwind-protect
(progn
(set-default-file-modes 448)
- (let* ((coding-system-for-write 'binary)
- (input (buffer-substring-no-properties start end)))
- (with-temp-buffer
- (when passphrase
- (insert passphrase "\n"))
- (insert input)
- (setq exit-status
- (apply #'call-process-region (point-min) (point-max) program
- nil errors-buffer nil args))))
+ (let ((coding-system-for-write 'binary)
+ (input (buffer-substring-no-properties start end))
+ (default-enable-multibyte-characters nil))
+ (with-temp-buffer
+ (when passphrase
+ (insert passphrase "\n"))
+ (insert input)
+ (setq exit-status
+ (apply #'call-process-region (point-min) (point-max) program
+ nil errors-buffer nil args))))
(with-current-buffer (get-buffer-create output-buffer)
(buffer-disable-undo)
(erase-buffer)
(set-buffer errors-buffer)
(if (not (equal exit-status 0))
(insert (format "\n%s exited abnormally: '%s'\n"
- program exit-status)))))
+ program exit-status)))))
(if (file-exists-p output-file-name)
(delete-file output-file-name))
(set-default-file-modes orig-mode))))
-(defun pgg-gpg-possibly-cache-passphrase (passphrase)
+(defun pgg-gpg-possibly-cache-passphrase (passphrase &optional key)
(if (and pgg-cache-passphrase
(progn
(goto-char (point-min))
(re-search-forward "^\\[GNUPG:] GOOD_PASSPHRASE\\>" nil t)))
(pgg-add-passphrase-cache
- (progn
- (goto-char (point-min))
- (if (re-search-forward
- "^\\[GNUPG:] NEED_PASSPHRASE \\w+ ?\\w*" nil t)
- (substring (match-string 0) -8)))
+ (or key
+ (progn
+ (goto-char (point-min))
+ (if (re-search-forward
+ "^\\[GNUPG:] NEED_PASSPHRASE \\w+ ?\\w*" nil t)
+ (substring (match-string 0) -8))))
passphrase)))
+(defvar pgg-gpg-all-secret-keys 'unknown)
+
+(defun pgg-gpg-lookup-all-secret-keys ()
+ "Return all secret keys present in secret key ring."
+ (when (eq pgg-gpg-all-secret-keys 'unknown)
+ (setq pgg-gpg-all-secret-keys '())
+ (let ((args (list "--with-colons" "--no-greeting" "--batch"
+ "--list-secret-keys")))
+ (with-temp-buffer
+ (apply #'call-process pgg-gpg-program nil t nil args)
+ (goto-char (point-min))
+ (while (re-search-forward "^\\(sec\\|pub\\):" nil t)
+ (push (substring
+ (nth 3 (split-string
+ (buffer-substring (match-end 0)
+ (progn (end-of-line) (point)))
+ ":")) 8)
+ pgg-gpg-all-secret-keys)))))
+ pgg-gpg-all-secret-keys)
+
(defun pgg-gpg-lookup-key (string &optional type)
"Search keys associated with STRING."
(let ((args (list "--with-colons" "--no-greeting" "--batch"
(when sign
(pgg-read-passphrase
(format "GnuPG passphrase for %s: " pgg-gpg-user-id)
- (pgg-gpg-lookup-key pgg-gpg-user-id 'encrypt))))
+ pgg-gpg-user-id)))
(args
(append
(list "--batch" "--armor" "--always-trust" "--encrypt")
(if recipients
(apply #'nconc
(mapcar (lambda (rcpt)
- (list "--remote-user" rcpt))
+ (list pgg-gpg-recipient-argument rcpt))
(append recipients
(if pgg-encrypt-for-me
(list pgg-gpg-user-id)))))))))
(pgg-gpg-process-region start end passphrase pgg-gpg-program args))
(when sign
(with-current-buffer pgg-errors-buffer
+ ;; Possibly cache passphrase under, e.g. "jas", for future sign.
+ (pgg-gpg-possibly-cache-passphrase passphrase pgg-gpg-user-id)
+ ;; Possibly cache passphrase under, e.g. B565716F, for future decrypt.
(pgg-gpg-possibly-cache-passphrase passphrase)))
(pgg-process-when-success)))
(defun pgg-gpg-decrypt-region (start end)
"Decrypt the current region between START and END."
- (let* ((pgg-gpg-user-id (or pgg-gpg-user-id pgg-default-user-id))
+ (let* ((current-buffer (current-buffer))
+ (message-keys (with-temp-buffer
+ (insert-buffer-substring current-buffer)
+ (pgg-decode-armor-region (point-min) (point-max))))
+ (secret-keys (pgg-gpg-lookup-all-secret-keys))
+ (key (pgg-gpg-select-matching-key message-keys secret-keys))
+ (pgg-gpg-user-id (or key pgg-gpg-user-id pgg-default-user-id))
(passphrase
(pgg-read-passphrase
(format "GnuPG passphrase for %s: " pgg-gpg-user-id)
- (pgg-gpg-lookup-key pgg-gpg-user-id 'encrypt)))
+ pgg-gpg-user-id))
(args '("--batch" "--decrypt")))
(pgg-gpg-process-region start end passphrase pgg-gpg-program args)
(with-current-buffer pgg-errors-buffer
- (pgg-gpg-possibly-cache-passphrase passphrase)
+ (pgg-gpg-possibly-cache-passphrase passphrase pgg-gpg-user-id)
(goto-char (point-min))
(re-search-forward "^\\[GNUPG:] DECRYPTION_OKAY\\>" nil t))))
+(defun pgg-gpg-select-matching-key (message-keys secret-keys)
+ "Choose a key from MESSAGE-KEYS that matches one of the keys in SECRET-KEYS."
+ (loop for message-key in message-keys
+ for message-key-id = (and (equal (car message-key) 1)
+ (cdr (assq 'key-identifier message-key)))
+ for key = (and message-key-id (pgg-lookup-key message-key-id 'encrypt))
+ when (and key (member key secret-keys)) return key))
+
(defun pgg-gpg-sign-region (start end &optional cleartext)
"Make detached signature from text between START and END."
(let* ((pgg-gpg-user-id (or pgg-gpg-user-id pgg-default-user-id))
(passphrase
(pgg-read-passphrase
(format "GnuPG passphrase for %s: " pgg-gpg-user-id)
- (pgg-gpg-lookup-key pgg-gpg-user-id 'sign)))
+ pgg-gpg-user-id))
(args
(list (if cleartext "--clearsign" "--detach-sign")
"--armor" "--batch" "--verbose"
(pgg-as-lbt start end 'CRLF
(pgg-gpg-process-region start end passphrase pgg-gpg-program args))
(with-current-buffer pgg-errors-buffer
+ ;; Possibly cache passphrase under, e.g. "jas", for future sign.
+ (pgg-gpg-possibly-cache-passphrase passphrase pgg-gpg-user-id)
+ ;; Possibly cache passphrase under, e.g. B565716F, for future decrypt.
(pgg-gpg-possibly-cache-passphrase passphrase))
(pgg-process-when-success)))
'((1 . RSA) (2 . RSA-E) (3 . RSA-S) (16 . ELG-E) (17 . DSA) (20 . ELG))
"Alist of the assigned number to the public key algorithm."
:group 'pgg-parse
- :type '(repeat
+ :type '(repeat
(cons (sexp :tag "Number") (sexp :tag "Type"))))
(defcustom pgg-parse-symmetric-key-algorithm-alist
'((1 . IDEA) (2 . 3DES) (4 . CAST5) (5 . SAFER-SK128))
"Alist of the assigned number to the simmetric key algorithm."
:group 'pgg-parse
- :type '(repeat
+ :type '(repeat
(cons (sexp :tag "Number") (sexp :tag "Type"))))
(defcustom pgg-parse-hash-algorithm-alist
'((1 . MD5) (2 . SHA1) (3 . RIPEMD160) (5 . MD2))
"Alist of the assigned number to the cryptographic hash algorithm."
:group 'pgg-parse
- :type '(repeat
+ :type '(repeat
(cons (sexp :tag "Number") (sexp :tag "Type"))))
(defcustom pgg-parse-compression-algorithm-alist
(2 . ZLIB))
"Alist of the assigned number to the compression algorithm."
:group 'pgg-parse
- :type '(repeat
+ :type '(repeat
(cons (sexp :tag "Number") (sexp :tag "Type"))))
(defcustom pgg-parse-signature-type-alist
(64 . "Timestamp signature."))
"Alist of the assigned number to the signature type."
:group 'pgg-parse
- :type '(repeat
+ :type '(repeat
(cons (sexp :tag "Number") (sexp :tag "Type"))))
(defcustom pgg-ignore-packet-checksum t; XXX
(list (pgg-byte-after (+ (cdr length-type) (point)))
(1- (car length-type))
(1+ (cdr length-type)))))
-
+
(defun pgg-parse-signature-subpacket (ptag)
(case (car ptag)
(2 ;signature creation time
(cons 'trust-level (pgg-read-byte)))
(6 ;regular expression
(cons 'regular-expression
- (pgg-read-body-string ptag)))
+ (pgg-read-body-string ptag)))
(7 ;revocable
(cons 'revocability (pgg-read-byte)))
(9 ;key expiration time
;; 10 = placeholder for backward compatibility
(11 ;preferred symmetric algorithms
(cons 'preferred-symmetric-key-algorithm
- (cdr (assq (pgg-read-byte)
- pgg-parse-symmetric-key-algorithm-alist))))
+ (cdr (assq (pgg-read-byte)
+ pgg-parse-symmetric-key-algorithm-alist))))
(12 ;revocation key
)
(16 ;issuer key ID
(cons 'key-identifier
- (pgg-format-key-identifier (pgg-read-body-string ptag))))
+ (pgg-format-key-identifier (pgg-read-body-string ptag))))
(20 ;notation data
(pgg-skip-bytes 4)
(cons 'notation
(nth 1 value-bytes)))))))
(21 ;preferred hash algorithms
(cons 'preferred-hash-algorithm
- (cdr (assq (pgg-read-byte)
- pgg-parse-hash-algorithm-alist))))
+ (cdr (assq (pgg-read-byte)
+ pgg-parse-hash-algorithm-alist))))
(22 ;preferred compression algorithms
(cons 'preferred-compression-algorithm
- (cdr (assq (pgg-read-byte)
- pgg-parse-compression-algorithm-alist))))
+ (cdr (assq (pgg-read-byte)
+ pgg-parse-compression-algorithm-alist))))
(23 ;key server preferences
(cons 'key-server-preferences
(pgg-read-body ptag)))
(when (>= 10000 (setq n (pgg-read-bytes 2)
n (logior (lsh (car n) 8)
(nth 1 n))))
- (save-restriction
+ (save-restriction
(narrow-to-region (point)(+ n (point)))
(nconc result
(mapcar (function cdr) ;remove packet types
(cdr (assq (cdr field)
pgg-parse-public-key-algorithm-alist)))
result))
-
+
(defun pgg-decode-packets ()
- (let* ((marker
- (set-marker (make-marker)
- (and (re-search-forward "^=")
- (match-beginning 0))))
- (checksum (buffer-substring (point) (+ 4 (point)))))
- (delete-region marker (point-max))
- (base64-decode-region (point-min) marker)
- (when (fboundp 'pgg-parse-crc24-string)
- (or pgg-ignore-packet-checksum
- (string-equal
- (base64-encode-string (pgg-parse-crc24-string
- (buffer-string)))
- checksum)
- (error "PGP packet checksum does not match")))))
+ (if (re-search-forward "^=\\([A-Za-z0-9+/]\\{4\\}\\)$" nil t)
+ (let ((p (match-beginning 0))
+ (checksum (match-string 1)))
+ (delete-region p (point-max))
+ (if (ignore-errors (base64-decode-region (point-min) p))
+ (or (not (fboundp 'pgg-parse-crc24-string))
+ pgg-ignore-packet-checksum
+ (string-equal (base64-encode-string (pgg-parse-crc24-string
+ (buffer-string)))
+ checksum)
+ (progn
+ (message "PGP packet checksum does not match")
+ nil))
+ (message "PGP packet contain invalid base64")
+ nil))
+ (message "PGP packet checksum not found")
+ nil))
(defun pgg-decode-armor-region (start end)
(save-restriction
(delete-region (point-min)
(and (search-forward "\n\n")
(match-end 0)))
- (pgg-decode-packets)
- (goto-char (point-min))
- (pgg-parse-packets)))
+ (when (pgg-decode-packets)
+ (goto-char (point-min))
+ (pgg-parse-packets))))
(defun pgg-parse-armor (string)
(with-temp-buffer
;;; Code:
-(eval-when-compile (require 'pgg))
+(eval-when-compile
+ (require 'cl) ; for pgg macros
+ (require 'pgg))
(defgroup pgg-pgp ()
"PGP 2.* and 6.* interface"
"PGP ID of your default identity.")
(defun pgg-pgp-process-region (start end passphrase program args)
- (let* ((errors-file-name
- (expand-file-name (make-temp-name "pgg-errors")
- pgg-temporary-file-directory))
+ (let* ((errors-file-name (pgg-make-temp-file "pgg-errors"))
(args
(append args
pgg-pgp-extra-args
(defun pgg-pgp-verify-region (start end &optional signature)
"Verify region between START and END as the detached signature SIGNATURE."
- (let* ((basename (expand-file-name "pgg" temporary-file-directory))
- (orig-file (make-temp-name basename))
+ (let* ((orig-file (pgg-make-temp-file "pgg"))
(args '("+verbose=1" "+batchmode" "+language=us"))
(orig-mode (default-file-modes)))
(unwind-protect
(defun pgg-pgp-snarf-keys-region (start end)
"Add all public keys in region between START and END to the keyring."
(let* ((pgg-pgp-user-id (or pgg-pgp-user-id pgg-default-user-id))
- (basename (expand-file-name "pgg" temporary-file-directory))
- (key-file (make-temp-name basename))
+ (key-file (pgg-make-temp-file "pgg"))
(args
(list "+verbose=1" "+batchmode" "+language=us" "-kaf"
key-file)))
;;; Code:
-(eval-when-compile (require 'pgg))
+(eval-when-compile
+ (require 'cl) ; for pgg macros
+ (require 'pgg))
(defgroup pgg-pgp5 ()
"PGP 5.* interface"
"PGP 5.* ID of your default identity.")
(defun pgg-pgp5-process-region (start end passphrase program args)
- (let* ((errors-file-name
- (expand-file-name (make-temp-name "pgg-errors")
- pgg-temporary-file-directory))
+ (let* ((errors-file-name (pgg-make-temp-file "pgg-errors"))
(args
(append args
pgg-pgp5-extra-args
(defun pgg-pgp5-verify-region (start end &optional signature)
"Verify region between START and END as the detached signature SIGNATURE."
- (let* ((basename (expand-file-name "pgg" pgg-temporary-file-directory))
- (orig-file (make-temp-name basename))
- (args '("+verbose=1" "+batchmode=1" "+language=us"))
- (orig-mode (default-file-modes)))
+ (let ((orig-file (pgg-make-temp-file "pgg"))
+ (args '("+verbose=1" "+batchmode=1" "+language=us"))
+ (orig-mode (default-file-modes)))
(unwind-protect
(progn
(set-default-file-modes 448)
(defun pgg-pgp5-snarf-keys-region (start end)
"Add all public keys in region between START and END to the keyring."
(let* ((pgg-pgp5-user-id (or pgg-pgp5-user-id pgg-default-user-id))
- (basename (expand-file-name "pgg" pgg-temporary-file-directory))
- (key-file (make-temp-name basename))
+ (key-file (pgg-make-temp-file "pgg"))
(args
(list "+verbose=1" "+batchmode=1" "+language=us" "-a"
key-file)))
(require 'w3)
(require 'url)))
-;; Fixme: Avoid this and use mm-make-temp-file (especially for
-;; something sensitive like pgp).
-(defvar pgg-temporary-file-directory
- (cond ((fboundp 'temp-directory) (temp-directory))
- ((boundp 'temporary-file-directory) temporary-file-directory)
- ("/tmp/")))
-
;;; @ utility functions
;;;
(symbol-value (intern-soft key pgg-passphrase-cache)))
(read-passwd prompt)))
+(eval-when-compile
+ (defvar itimer-process)
+ (defvar itimer-timer)
+ (autoload 'delete-itimer "itimer")
+ (autoload 'itimer-driver-start "itimer")
+ (autoload 'itimer-value "itimer")
+ (autoload 'set-itimer-function "itimer")
+ (autoload 'set-itimer-function-arguments "itimer")
+ (autoload 'set-itimer-restart "itimer")
+ (autoload 'start-itimer "itimer"))
+
+(eval-and-compile
+ (defalias
+ 'pgg-run-at-time
+ (if (featurep 'xemacs)
+ (if (condition-case nil
+ (progn
+ (unless (or itimer-process itimer-timer)
+ (itimer-driver-start))
+ ;; Check whether there is a bug to which the difference of
+ ;; the present time and the time when the itimer driver was
+ ;; woken up is subtracted from the initial itimer value.
+ (let* ((inhibit-quit t)
+ (ctime (current-time))
+ (itimer-timer-last-wakeup
+ (prog1
+ ctime
+ (setcar ctime (1- (car ctime)))))
+ (itimer-list nil)
+ (itimer (start-itimer "pgg-run-at-time" 'ignore 5)))
+ (sleep-for 0.1) ;; Accept the timeout interrupt.
+ (prog1
+ (> (itimer-value itimer) 0)
+ (delete-itimer itimer))))
+ (error nil))
+ (lambda (time repeat function &rest args)
+ "Emulating function run as `run-at-time'.
+TIME should be nil meaning now, or a number of seconds from now.
+Return an itimer object which can be used in either `delete-itimer'
+or `cancel-timer'."
+ (apply #'start-itimer "pgg-run-at-time"
+ function (if time (max time 1e-9) 1e-9)
+ repeat nil t args))
+ (lambda (time repeat function &rest args)
+ "Emulating function run as `run-at-time' in the right way.
+TIME should be nil meaning now, or a number of seconds from now.
+Return an itimer object which can be used in either `delete-itimer'
+or `cancel-timer'."
+ (let ((itimers (list nil)))
+ (setcar
+ itimers
+ (apply #'start-itimer "pgg-run-at-time"
+ (lambda (itimers repeat function &rest args)
+ (let ((itimer (car itimers)))
+ (if repeat
+ (progn
+ (set-itimer-function
+ itimer
+ (lambda (itimer repeat function &rest args)
+ (set-itimer-restart itimer repeat)
+ (set-itimer-function itimer function)
+ (set-itimer-function-arguments itimer args)
+ (apply function args)))
+ (set-itimer-function-arguments
+ itimer
+ (append (list itimer repeat function) args)))
+ (set-itimer-function
+ itimer
+ (lambda (itimer function &rest args)
+ (delete-itimer itimer)
+ (apply function args)))
+ (set-itimer-function-arguments
+ itimer
+ (append (list itimer function) args)))))
+ 1e-9 (if time (max time 1e-9) 1e-9)
+ nil t itimers repeat function args)))))
+ 'run-at-time)))
+
(defun pgg-add-passphrase-cache (key passphrase)
(setq key (pgg-truncate-key-identifier key))
(set (intern key pgg-passphrase-cache)
passphrase)
- (run-at-time pgg-passphrase-cache-expiry nil
- #'pgg-remove-passphrase-cache
- key))
+ (pgg-run-at-time pgg-passphrase-cache-expiry nil
+ #'pgg-remove-passphrase-cache
+ key))
(defun pgg-remove-passphrase-cache (key)
(let ((passphrase (symbol-value (intern-soft key pgg-passphrase-cache))))
`(with-current-buffer pgg-output-buffer
(if (zerop (buffer-size)) nil ,@body t)))
+(defalias 'pgg-make-temp-file
+ (if (fboundp 'make-temp-file)
+ 'make-temp-file
+ (lambda (prefix &optional dir-flag)
+ (let ((file (expand-file-name
+ (make-temp-name prefix)
+ (if (fboundp 'temp-directory)
+ (temp-directory)
+ temporary-file-directory))))
+ (if dir-flag
+ (make-directory file))
+ file))))
+
;;; @ interface functions
;;;
"Decrypt the current region between START and END."
(interactive "r")
(let* ((buf (current-buffer))
- (packet (cdr (assq 1 (with-temp-buffer
- (insert-buffer-substring buf)
- (pgg-decode-armor-region
- (point-min) (point-max))))))
- (key (cdr (assq 'key-identifier packet)))
- (pgg-default-user-id
- (if key
- (concat "0x" (pgg-truncate-key-identifier key))
- pgg-default-user-id))
(status
(pgg-save-coding-system start end
(pgg-invoke "decrypt-region" (or pgg-scheme pgg-default-scheme)
@end example
@noindent
- Make sure that you don't have any gnus related stuff
+ Make sure that you don't have any Gnus related stuff
before this line, on MS Windows use something like
"C:/path/to/lisp" (yes, "/").
(eval-after-load "mail-source"
'(add-to-list 'mail-sources '(pop :server "pop.YourProvider.net"
:user "yourUserName"
- :password "yourPassword"))
+ :password "yourPassword")))
@end example
@noindent
* [5.9]:: Sometimes I accidentally hit r instead of f in newsgroups.
Can Gnus warn me, when I'm replying by mail in newsgroups?
* [5.10]:: How to tell Gnus not to generate a sender header?
-* [5.11]:: I want gnus to locally store copies of my send mail and news,
+* [5.11]:: I want Gnus to locally store copies of my send mail and news,
how to do it?
* [5.12]:: People tell me my Message-IDs are not correct,
why aren't they and how to fix it?
@noindent
Then typing your alias (followed by a space or punctuation
character) on a To: or Cc: line in the message buffer will
- cause gnus to insert the full address for you. See the
+ cause Gnus to insert the full address for you. See the
node "Mail Aliases" in Message (not Gnus) manual for
details.
%% include file for the Gnus refcard and booklet
\def\progver{5.10}\def\refver{5.10-1} % program and refcard versions
-\def\date{May, 2003}
+\def\date{Oct, 2003}
\def\author{Gnus Bugfixing Girls + Boys $<$bugs@gnus.org$>$}
%%
G V & Make a new empty {\bf virtual} group. (nnvirtual)\\
G w & Create ephemeral group based on web-search. [Prefix: make solid group
instead]\\
+ G R & Make an {\bf RSS} group.\\
G DEL & {\bf Delete} group [Prefix: delete all articles as well].\\
G x & Expunge all deleted articles in an nnimap mailbox.\\
G l & Edit ACL (Access Control {\bf List}) for an nnimap mailbox.\\
Y c & Insert all cached articles into the summary-buffer.\\
%
M-C-e & {\bf Edit} the group-parameters.\\
- M-C-g & Customize the group-parameters.\\
+ M-C-a & Customize the group-parameters.\\
%
% article handling
%
K $\mid$ & Pipe the MIME part to an external command.\\
K b & Make all the MIME parts have buttons in front of them.\\
K m & Try to repair {\bf multipart-headers}.\\
- K C & View the MIME part using a differenct {\bf charset}.\\
+ K C & View the MIME part using a different {\bf charset}.\\
X m & Save all parts matching a MIME type to a directory. [p/p]\\
M-t & Toggle the buttonized display of the article buffer.\\
W M w & Decode RFC2047-encoded words in the article headers.\\
\end{keys}
The four letters stand for:\\*
\quad \B{A}ction: I)ncrease, L)ower;\\*
- \quad \B{p}art: a)utor (from), s)ubject, x)refs (cross-posting), d)ate, l)ines,
+ \quad \B{p}art: a)uthor (from), s)ubject, x)refs (cross-posting), d)ate, l)ines,
message-i)d, t)references (parent), f)ollowup, b)ody, h)ead (all headers);\\*
\quad \B{m}atch type:\\*
\qquad string: s)ubstring, e)xact, r)egexp, f)uzzy,\\*
Z P & Exit and go to the {\bf previous} group.\\
%
Z G & (M-g) Check for new articles in this group ({\bf get}).\\
- Z R & Exit this group, and then enter it again ({\bf reenter}).
+ Z R & (C-x C-s) Exit this group, and then enter it again ({\bf reenter}).
[Prefix: select all articles, read and unread.]\\
Z s & Update and save the dribble buffer. [Prefix: save .newsrc* as well]\\
\end{keys}
C-c C-f C-d & Move to \textbf{Distribution:}.\\
C-c C-f C-m & Move to \textbf{Mail-Followup-To:}.\\
C-c C-f C-o & Move to \textbf{From:}.\\
- C-c C-f C-a & Insert a resonable \textbf{Mail-Followup-To:} for
+ C-c C-f C-a & Insert a reasonable \textbf{Mail-Followup-To:} for
an unsubscribed list. [Prefix: include addresses in \textbf{Cc:}]\\
C-c C-f TAB & (C-c C-u) Move to \textbf{Importance:}.\\
C-c M-n & Insert \textbf{Disposition-Notification-To:}
C-c C-m m & Insert \textbf{multi}-part.\\
C-c C-m q & \textbf{Quote} region.\\
C-c C-m c s & Encrypt message using \textbf{S/MIME}.\\
- C-c C-m c o & Encrypt message usging PGP.\\
+ C-c C-m c o & Encrypt message using PGP.\\
C-c C-m c p & Encrypt message using \textbf{PGP/MIME}.\\
C-c C-m s s & Sign message using \textbf{S/MIME}.\\
C-c C-m s o & Sign message using PGP.\\
and that you are familiar with its basic functions.
By default, PGG uses GnuPG, but Pretty Good Privacy version 2 or version
-5 are also supported. If you are new to such a system, I recomend that
+5 are also supported. If you are new to such a system, I recommend that
you should look over the GNU Privacy Handbook (GPH) which is available
at @uref{http://www.gnupg.org/gph/}.
select cipher algorithm from 3DES, CAST5, BLOWFISH, and so on, but on
the other hand the version 2 of PGP only supports IDEA.
-By default, if the variable @var{pgg-scheme} is not set, PGG searches the
+By default, if the variable @code{pgg-scheme} is not set, PGG searches the
registered scheme for an implementation of the requested service
associated with the named algorithm. If there are no match, PGG uses
-@var{pgg-default-scheme}. In other words, there are two options to
+@code{pgg-default-scheme}. In other words, there are two options to
control which command is used to process the incoming PGP armors. One
is for encrypting and signing, the other is for decrypting and
verifying.
@section Caching passphrase
PGG provides a simple passphrase caching mechanism. If you want to
-arrange the interaction, set the variable @var{pgg-read-passphrase}.
+arrange the interaction, set the variable @code{pgg-read-passphrase}.
@defvar pgg-cache-passphrase
If non-@code{nil}, store passphrases. The default value of this
singleton object wrapped with the luna object system.
Since PGG was designed for accessing and developing PGP functionality,
-the architecture had to be designed not just for interoperablity but
+the architecture had to be designed not just for interoperability but
also for extensiblity. In this chapter we explore the architecture
while finding out how to write the PGG backend.
The following code is snipped out of @file{pgg-gpg.el}. Once an
instance of @code{pgg-gpg} scheme is initialized, it's stored to the
-variable @var{pgg-scheme-gpg-instance} and will be reused from now on.
+variable @code{pgg-scheme-gpg-instance} and will be reused from now on.
@lisp
(defvar pgg-scheme-gpg-instance nil)
Verify the current region between @var{start} and @var{end}. If the
optional third argument @var{signature} is non-@code{nil}, it is treated
as the detached signature of the current region. If the signature is
-successflly verified, it returns @code{t}, otherwise @code{nil}.
+successfully verified, it returns @code{t}, otherwise @code{nil}.
@end deffn
@deffn Method pgg-scheme-insert-key scheme
\SortSummary
\subsection*{Score (Value) Commands}
\Scoring
- \subsection*{Extract Series (Uudecode etc)}
- \ExtractSeries
\subsection*{Output Articles}
\OutputArticles
+ \subsection*{Extract Series (Uudecode etc)}
+ \ExtractSeries
\subsection*{MIME operations from the Summary-Buffer}
\MIMESummary
%
\subsection*{Post, Followup, Reply, Forward, Cancel}
\PostReplyetc
- \subsection*{Message-Composition}
- \MsgCompositionGeneral
+ \newpage
+ \subsection*{Message Composition}
+ \MsgCompositionGeneral
\subsubsection*{Jumping in message-buffer}
\MsgCompositionMovementArticle
\subsubsection*{Attachments/MML}
projects / elisp / gnus.git- / commitdiff