which included commits to RCS files with non-trunk default branches.
gnus-mdrtn.el
on-loginfo
+request-assign.future
Gnus is a rewrite of GNUS 4.1, written by Masanobu Umeda. The rewrite
was done by moi, yours truly, your humble servant, Lars Magne
Ingebrigtsen. If you have a WWW browser, you can investigate to your
-heart's delight at <URL:http://www.ifi.uio.no/~larsi/larsi.html>.
+heart's delight at <URL:http://www.gnus.org/> and
+<URL:http://quimby.gnus.org/lmi/>.
;; Copyright (C) 1995 Free Software Foundation, Inc.
version
*.elc
gnus-load.el
+old
;;; gnus-mlspl.el --- a group params-based mail splitting mechanism
-;; Copyright (C) 1998, 1999, 2000, 2001
+;; Copyright (C) 1998, 1999, 2000, 2001, 2002
;; Free Software Foundation, Inc.
;; Author: Alexandre Oliva <oliva@lsd.ic.unicamp.br>
;; Keywords: news, mail
-;; 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 file is part of GNU Emacs.
-;; 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.
+;; GNU Emacs 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.
+
+;; GNU Emacs 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 this program; see the file COPYING. If not, write to
uses are as simple as the name of a default mail group, but more
elaborate fancy splits may also be useful to split mail that doesn't
match any of the group-specified splitting rules. See
-gnus-group-split-fancy for details."
+`gnus-group-split-fancy' for details."
(interactive "P")
(setq nnmail-split-methods 'nnmail-split-fancy)
(when catch-all
;;;###autoload
(defun gnus-group-split ()
"Uses information from group parameters in order to split mail.
-See gnus-group-split-fancy for more information.
+See `gnus-group-split-fancy' for more information.
gnus-group-split is a valid value for nnmail-split-methods."
(let (nnmail-split-fancy)
\(: gnus-group-split-fancy GROUPS NO-CROSSPOST CATCH-ALL\)
GROUPS may be a regular expression or a list of group names, that will
-be used to select candidate groups. If it is ommited or nil, all
+be used to select candidate groups. If it is omitted or nil, all
existing groups are considered.
-if NO-CROSSPOST is ommitted or nil, a & split will be returned,
+if NO-CROSSPOST is omitted or nil, a & split will be returned,
otherwise, a | split, that does not allow crossposting, will be
returned.
nnml:mail.others:
\((split-spec . catch-all))
-Calling (gnus-group-split-fancy nil nil \"mail.misc\") returns:
+Calling (gnus-group-split-fancy nil nil \"mail.others\") returns:
\(| (& (any \"\\\\(bar@femail\\\\.com\\\\|.*@femail\\\\.com\\\\)\"
\"mail.bar\")
(defvar imap-continuation nil
"Non-nil indicates that the server emitted a continuation request.
-The actually value is really the text on the continuation line.")
+The actual value is really the text on the continuation line.")
(defvar imap-callbacks nil
"List of response tags and callbacks, on the form `(number . function)'.
nil)
(defun imap-shell-open (name buffer server port)
- (let ((cmds imap-shell-program)
+ (let ((cmds (if (listp imap-shell-program) imap-shell-program
+ (list imap-shell-program)))
cmd done)
(while (and (not done) (setq cmd (pop cmds)))
(message "imap: Opening IMAP connection with `%s'..." cmd)
(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))
(defun imap-interactive-login (buffer loginfunc)
"Login to server in BUFFER.
LOGINFUNC is passed a username and a password, it should return t if
-it where sucessful authenticating itself to the server, nil otherwise.
+it where successful authenticating itself to the server, nil otherwise.
Returns t if login was successful, nil otherwise."
(with-current-buffer buffer
(make-local-variable 'imap-username)
available authenticators. If nil, it choices the best stream the
server is capable of.
BUFFER can be a buffer or a name of a buffer, which is created if
-necessery. If nil, the buffer name is generated."
+necessary. If nil, the buffer name is generated."
(setq buffer (or buffer (format " *imap* %s:%d" server (or port 0))))
(with-current-buffer (get-buffer-create buffer)
(if (imap-opened buffer)
((search-forward "UIDNEXT \\([0-9]+\\)" nil t)
(imap-mailbox-put 'uidnext (match-string 1)))
((search-forward "UNSEEN " nil t)
- (imap-mailbox-put 'unseen (read (current-buffer))))
+ (imap-mailbox-put 'first-unseen (read (current-buffer))))
((looking-at "UIDVALIDITY \\([0-9]+\\)")
(imap-mailbox-put 'uidvalidity (match-string 1)))
((search-forward "READ-ONLY" nil t)
(defun imap-parse-status ()
(let ((mailbox (imap-parse-mailbox)))
- (when (and mailbox (search-forward "(" nil t))
- (while (not (eq (char-after) ?\)))
- (let ((token (read (current-buffer))))
- (cond ((eq token 'MESSAGES)
+ (if (eq (char-after) ? )
+ (forward-char))
+ (when (and mailbox (eq (char-after) ?\())
+ (while (and (not (eq (char-after) ?\)))
+ (or (forward-char) t)
+ (looking-at "\\([A-Za-z]+\\) "))
+ (let ((token (match-string 1)))
+ (goto-char (match-end 0))
+ (cond ((string= token "MESSAGES")
(imap-mailbox-put 'messages (read (current-buffer)) mailbox))
- ((eq token 'RECENT)
+ ((string= token "RECENT")
(imap-mailbox-put 'recent (read (current-buffer)) mailbox))
- ((eq token 'UIDNEXT)
- (and (looking-at " \\([0-9]+\\)")
- (imap-mailbox-put 'uidnext (match-string 1) mailbox)
- (goto-char (match-end 1))))
- ((eq token 'UIDVALIDITY)
- (and (looking-at " \\([0-9]+\\)")
- (imap-mailbox-put 'uidvalidity (match-string 1) mailbox)
- (goto-char (match-end 1))))
- ((eq token 'UNSEEN)
+ ((string= token "UIDNEXT")
+ (and (looking-at "[0-9]+")
+ (imap-mailbox-put 'uidnext (match-string 0) mailbox)
+ (goto-char (match-end 0))))
+ ((string= token "UIDVALIDITY")
+ (and (looking-at "[0-9]+")
+ (imap-mailbox-put 'uidvalidity (match-string 0) mailbox)
+ (goto-char (match-end 0))))
+ ((string= token "UNSEEN")
(imap-mailbox-put 'unseen (read (current-buffer)) mailbox))
(t
(message "Unknown status data %s in mailbox %s ignored"
- token mailbox))))))))
+ token mailbox)
+ (read (current-buffer)))))))))
;; acl_data ::= "ACL" SPACE mailbox *(SPACE identifier SPACE
;; rights)
This variable is a list of mail source specifiers.
See Info node `(gnus)Mail Source Specifiers'."
:group 'mail-source
+ :link '(custom-manual "(gnus)Mail Source Specifiers")
:type `(repeat
(choice :format "%[Value Menu%] %v"
:value (file)
(function :tag "Predicate"))
(group :inline t
(const :format "" :value :prescript)
- (string :tag "Prescript"))
+ (choice :tag "Prescript"
+ :value nil
+ (string :format "%v")
+ (function :format "%v")))
(group :inline t
(const :format "" :value :postscript)
- (string :tag "Postscript"))
+ (choice :tag "Postscript"
+ :value nil
+ (string :format "%v")
+ (function :format "%v")))
(group :inline t
(const :format "" :value :plugged)
(boolean :tag "Plugged"))))
(string :tag "Program"))
(group :inline t
(const :format "" :value :prescript)
- (string :tag "Prescript"))
+ (choice :tag "Prescript"
+ :value nil
+ (string :format "%v")
+ (function :format "%v")))
(group :inline t
(const :format "" :value :postscript)
- (string :tag "Postscript"))
+ (choice :tag "Postscript"
+ :value nil
+ (string :format "%v")
+ (function :format "%v")))
(group :inline t
(const :format "" :value :function)
(function :tag "Function"))
(error
(unless (yes-or-no-p
(format "Mail source %s error (%s). Continue? "
- source
+ (if (memq ':password source)
+ (let ((s (copy-sequence source)))
+ (setcar (cdr (memq ':password s))
+ "********")
+ s)
+ source)
(cadr err)))
(error "Cannot get new mail"))
0)))))))))
(defun mail-source-run-script (script spec &optional delay)
(when script
- (if (and (symbolp script) (fboundp script))
+ (if (functionp script)
(funcall script)
(mail-source-call-script
(format-spec script spec))))
mail-source-password-cache)))
result)))
+(defun mail-source-touch-pop ()
+ "Open and close a POP connection shortly.
+POP server should be defined in `mail-source-primary-source' (which is
+preferred) or `mail-sources'. You may use it for the POP-before-SMTP
+authentication. To do that, you need to set the option
+`message-send-mail-function' to `message-smtpmail-send-it' and put the
+following line in .gnus file:
+
+\(add-hook 'message-send-mail-hook 'mail-source-touch-pop)
+"
+ (let ((sources (if mail-source-primary-source
+ (list mail-source-primary-source)
+ mail-sources)))
+ (while sources
+ (if (eq 'pop (car (car sources)))
+ (mail-source-check-pop (car sources)))
+ (setq sources (cdr sources)))))
+
(defun mail-source-new-mail-p ()
"Handler for `display-time' to indicate when new mail is available."
;; Flash (ie. ring the visible bell) if mail is available.
;;; nnimap.el --- imap backend for Gnus
-;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 1999, 2000, 2001, 2002 Free Software Foundation, Inc.
;; Author: Simon Josefsson <jas@pdc.kth.se>
;; Jim Radford <radford@robby.caltech.edu>
;; o Split up big fetches (1,* header especially) in smaller chunks
;; o What do I do with gnus-newsgroup-*?
;; o Tell Gnus about new groups (how can we tell?)
-;; o Respooling (fix Gnus?) (unnecessery?)
+;; o Respooling (fix Gnus?) (unnecessary?)
;; o Add support for the following: (if applicable)
;; request-list-newsgroups, request-regenerate
;; list-active-group,
(functionp value))
(defcustom nnimap-split-rule nil
- "Mail will be split according to theese rules.
+ "Mail will be split according to these rules.
Mail is read from mailbox(es) specified in `nnimap-split-inbox'.
\(setq nnimap-split-rule '((\"INBOX.gnus-imap\" \"From:.*gnus-imap\")
(\"INBOX.junk\" \"Subject:.*buy\")))
-As you can see, `nnimap-split-rule' is a list of lists, where the first
-element in each \"rule\" is the name of the IMAP mailbox, and the
-second is a regexp that nnimap will try to match on the header to find
-a fit.
+As you can see, `nnimap-split-rule' is a list of lists, where the
+first element in each \"rule\" is the name of the IMAP mailbox (or the
+symbol `junk' if you want to remove the mail), and the second is a
+regexp that nnimap will try to match on the header to find a fit.
The second element can also be a function. In that case, it will be
called narrowed to the headers with the first element of the rule as
If this is 'imap-mailbox-lsub, then use a server-side subscription list to
restrict visible folders.")
+(defcustom nnimap-debug nil
+ "If non-nil, random debug spews are placed in *nnimap-debug* buffer."
+ :group 'nnimap
+ :type 'boolean)
+
;; Internal variables:
+(defvar nnimap-debug-buffer "*nnimap-debug*")
(defvar nnimap-mailbox-info (gnus-make-hashtable 997))
-(defvar nnimap-debug nil
- "Name of buffer to record debugging info.
-For example: (setq nnimap-debug \"*nnimap-debug*\")")
(defvar nnimap-current-move-server nil)
(defvar nnimap-current-move-group nil)
(defvar nnimap-current-move-article nil)
(defvar nnimap-progress-chars '(?| ?/ ?- ?\\))
(defvar nnimap-progress-how-often 20)
(defvar nnimap-counter)
-(defvar nnimap-callback-callback-function nil
- "Gnus callback the nnimap asynchronous callback should call.")
-(defvar nnimap-callback-buffer nil
- "Which buffer the asynchronous article prefetch callback should work in.")
(defvar nnimap-server-buffer-alist nil) ;; Map server name to buffers.
(defvar nnimap-current-server nil) ;; Current server
(defvar nnimap-server-buffer nil) ;; Current servers' buffer
(imap-mailbox-unselect nnimap-server-buffer))))
(defun nnimap-find-minmax-uid (group &optional examine)
- "Find lowest and highest active article nummber in GROUP.
+ "Find lowest and highest active article number in GROUP.
If EXAMINE is non-nil the group is selected read-only."
(with-current-buffer nnimap-server-buffer
(when (or (string= group (imap-current-mailbox))
(with-temp-buffer
(buffer-disable-undo)
(insert headers)
- (nnheader-ms-strip-cr)
- (nnheader-fold-continuation-lines)
- (subst-char-in-region (point-min) (point-max) ?\t ? )
- (let ((head (nnheader-parse-head 'naked)))
+ (let ((head (nnheader-parse-naked-head)))
(mail-header-set-number head uid)
(mail-header-set-chars head chars)
(mail-header-set-lines head lines)
(with-current-buffer (get-buffer-create nnimap-server-buffer)
(nnoo-change-server 'nnimap server defs))
(or (and nnimap-server-buffer
- (imap-opened nnimap-server-buffer))
+ (imap-opened nnimap-server-buffer)
+ (if (with-current-buffer nnimap-server-buffer
+ (memq imap-state '(auth select examine)))
+ t
+ (imap-close nnimap-server-buffer)
+ (nnimap-open-connection server)))
(nnimap-open-connection server))))
(deffoo nnimap-server-opened (&optional server)
'identity)
(or string "")))
-(defun nnimap-callback ()
- (remove-hook 'imap-fetch-data-hook 'nnimap-callback)
- (with-current-buffer nnimap-callback-buffer
- (insert
- (with-current-buffer nnimap-server-buffer
- (nnimap-demule
- (if (imap-capability 'IMAP4rev1)
- ;; xxx don't just use car? alist doesn't contain
- ;; anything else now, but it might...
- (nth 2 (car (imap-message-get (imap-current-message) 'BODYDETAIL)))
- (imap-message-get (imap-current-message) 'RFC822)))))
- (nnheader-ms-strip-cr)
- (funcall nnimap-callback-callback-function t)))
+(defun nnimap-make-callback (article gnus-callback buffer)
+ "Return a callback function."
+ `(lambda ()
+ (nnimap-callback ,article ,gnus-callback ,buffer)))
+
+(defun nnimap-callback (article gnus-callback buffer)
+ (when (eq article (imap-current-message))
+ (remove-hook 'imap-fetch-data-hook
+ (nnimap-make-callback article gnus-callback buffer))
+ (with-current-buffer buffer
+ (insert
+ (with-current-buffer nnimap-server-buffer
+ (nnimap-demule
+ (if (imap-capability 'IMAP4rev1)
+ ;; xxx don't just use car? alist doesn't contain
+ ;; anything else now, but it might...
+ (nth 2 (car (imap-message-get article 'BODYDETAIL)))
+ (imap-message-get article 'RFC822)))))
+ (nnheader-ms-strip-cr)
+ (funcall gnus-callback t))))
(defun nnimap-request-article-part (article part prop &optional
group server to-buffer detail)
nnimap-server-buffer))
article)))
(when article
- (gnus-message 10 "nnimap: Fetching (part of) article %d..." article)
+ (gnus-message 10 "nnimap: Fetching (part of) article %d from %s..."
+ article (or group imap-current-mailbox
+ gnus-newsgroup-name))
(if (not nnheader-callback-function)
(with-current-buffer (or to-buffer nntp-server-buffer)
(erase-buffer)
(nth 2 (car data))
data))))
(nnheader-ms-strip-cr)
- (gnus-message 10 "nnimap: Fetching (part of) article %d...done"
- article)
+ (gnus-message
+ 10 "nnimap: Fetching (part of) article %d from %s...done"
+ article (or group imap-current-mailbox gnus-newsgroup-name))
(if (bobp)
- (nnheader-report 'nnimap "No such article: %s"
+ (nnheader-report 'nnimap "No such article %d in %s: %s"
+ article (or group imap-current-mailbox
+ gnus-newsgroup-name)
(imap-error-text nnimap-server-buffer))
(cons group article)))
- (add-hook 'imap-fetch-data-hook 'nnimap-callback)
- (setq nnimap-callback-callback-function nnheader-callback-function
- nnimap-callback-buffer nntp-server-buffer)
+ (add-hook 'imap-fetch-data-hook
+ (nnimap-make-callback article
+ nnheader-callback-function
+ nntp-server-buffer))
(imap-fetch-asynch article part nil nnimap-server-buffer)
(cons group article))))))
(nnheader-report 'nnimap "Group %s selected" group)
t)))))
+(defun nnimap-update-unseen (group &optional server)
+ "Update the unseen count in `nnimap-mailbox-info'."
+ (gnus-sethash
+ (gnus-group-prefixed-name group server)
+ (let ((old (gnus-gethash-safe (gnus-group-prefixed-name group server)
+ nnimap-mailbox-info)))
+ (list (nth 0 old) (nth 1 old)
+ (imap-mailbox-status group 'unseen nnimap-server-buffer)
+ (nth 3 old)))
+ nnimap-mailbox-info))
+
(defun nnimap-close-group (group &optional server)
(with-current-buffer nnimap-server-buffer
(when (and (imap-opened)
(nnimap-possibly-change-group group server))
+ (nnimap-update-unseen group server)
(case nnimap-expunge-on-close
(always (progn
(imap-mailbox-expunge nnimap-close-asynchronous)
(if (null nnimap-retrieve-groups-asynchronous)
(setq slowgroups groups)
(dolist (group groups)
- (gnus-message 7 "nnimap: Checking mailbox %s" group)
- (add-to-list (if (gnus-gethash-safe (concat server group)
- nnimap-mailbox-info)
+ (gnus-message 9 "nnimap: Quickly checking mailbox %s" group)
+ (add-to-list (if (gnus-gethash-safe
+ (gnus-group-prefixed-name group server)
+ nnimap-mailbox-info)
'asyncgroups
'slowgroups)
(list group (imap-mailbox-status-asynch
- group 'uidnext nnimap-server-buffer))))
+ group '(uidvalidity uidnext unseen)
+ nnimap-server-buffer))))
(dolist (asyncgroup asyncgroups)
(let ((group (nth 0 asyncgroup))
(tag (nth 1 asyncgroup))
new old)
(when (imap-ok-p (imap-wait-for-tag tag nnimap-server-buffer))
- (if (nnimap-string-lessp-numerical
- (car (gnus-gethash
- (concat server group) nnimap-mailbox-info))
- (imap-mailbox-get 'uidnext group nnimap-server-buffer))
+ (if (or (not (string=
+ (nth 0 (gnus-gethash (gnus-group-prefixed-name
+ group server)
+ nnimap-mailbox-info))
+ (imap-mailbox-get 'uidvalidity group
+ nnimap-server-buffer)))
+ (not (string=
+ (nth 1 (gnus-gethash (gnus-group-prefixed-name
+ group server)
+ nnimap-mailbox-info))
+ (imap-mailbox-get 'uidnext group
+ nnimap-server-buffer))))
(push (list group) slowgroups)
- (insert (cdr (gnus-gethash (concat server group)
- nnimap-mailbox-info))))))))
+ (insert (nth 3 (gnus-gethash (gnus-group-prefixed-name
+ group server)
+ nnimap-mailbox-info))))))))
(dolist (group slowgroups)
(if nnimap-retrieve-groups-asynchronous
(setq group (car group)))
- (gnus-message 7 "nnimap: Rechecking mailbox %s" group)
+ (gnus-message 7 "nnimap: Mailbox %s modified" group)
(imap-mailbox-put 'uidnext nil group nnimap-server-buffer)
(or (member "\\NoSelect" (imap-mailbox-get 'list-flags group
nnimap-server-buffer))
(insert str)
(when nnimap-retrieve-groups-asynchronous
(gnus-sethash
- (concat server group)
- (cons (or (imap-mailbox-get
+ (gnus-group-prefixed-name group server)
+ (list (or (imap-mailbox-get
+ 'uidvalidity group nnimap-server-buffer)
+ (imap-mailbox-status
+ group 'uidvalidity nnimap-server-buffer))
+ (or (imap-mailbox-get
'uidnext group nnimap-server-buffer)
(imap-mailbox-status
group 'uidnext nnimap-server-buffer))
+ (or (imap-mailbox-get
+ 'unseen group nnimap-server-buffer)
+ (imap-mailbox-status
+ group 'unseen nnimap-server-buffer))
str)
nnimap-mailbox-info)))))))
(gnus-message 5 "nnimap: Checking mailboxes...done")
(when nnmail-cache-accepted-message-ids
(with-current-buffer nntp-server-buffer
(let (msgid)
- (and (setq msgid
+ (and (setq msgid
(nnmail-fetch-field "message-id"))
(nnmail-cache-insert msgid to-group)))))
;; Add the group-art list to the history list.
(defun nnimap-expiry-target (arts group server)
(unless (eq nnmail-expiry-target 'delete)
(with-temp-buffer
- (dolist (art (gnus-uncompress-sequence arts))
- (nnimap-request-article art group server (current-buffer))
+ (dolist (art arts)
+ (nnimap-request-article art group server (current-buffer))
;; hints for optimization in `nnimap-request-accept-article'
(let ((nnimap-current-move-article art)
(nnimap-current-move-group group)
(let ((artseq (gnus-compress-sequence articles)))
(when (and artseq (nnimap-possibly-change-group group server))
(with-current-buffer nnimap-server-buffer
- (if force
- (progn
- (nnimap-expiry-target artseq group server)
- (when (imap-message-flags-add (imap-range-to-message-set artseq)
- "\\Deleted")
- (setq articles nil)))
- (let ((days (or (and nnmail-expiry-wait-function
- (funcall nnmail-expiry-wait-function group))
- nnmail-expiry-wait)))
- (cond ((eq days 'immediate)
- (nnimap-expiry-target artseq group server)
- (when (imap-message-flags-add
- (imap-range-to-message-set artseq) "\\Deleted")
- (setq articles nil)))
- ((numberp days)
- (let ((oldarts (imap-search
- (format nnimap-expunge-search-string
- (imap-range-to-message-set artseq)
- (nnimap-date-days-ago days))))
- (imap-fetch-data-hook
- '(nnimap-request-expire-articles-progress)))
+ (let ((days (or (and nnmail-expiry-wait-function
+ (funcall nnmail-expiry-wait-function group))
+ nnmail-expiry-wait)))
+ (cond ((or force (eq days 'immediate))
+ (let ((oldarts (imap-search
+ (concat "UID "
+ (imap-range-to-message-set artseq)))))
+ (when oldarts
+ (nnimap-expiry-target oldarts group server)
+ (when (imap-message-flags-add
+ (imap-range-to-message-set
+ (gnus-compress-sequence oldarts)) "\\Deleted")
+ (setq articles (gnus-set-difference
+ articles oldarts))))))
+ ((numberp days)
+ (let ((oldarts (imap-search
+ (format nnimap-expunge-search-string
+ (imap-range-to-message-set artseq)
+ (nnimap-date-days-ago days))))
+ (imap-fetch-data-hook
+ '(nnimap-request-expire-articles-progress)))
+ (when oldarts
(nnimap-expiry-target oldarts group server)
- (and oldarts
- (imap-message-flags-add
- (imap-range-to-message-set
- (gnus-compress-sequence oldarts))
- "\\Deleted")
- (setq articles (gnus-set-difference
- articles oldarts)))))))))))
+ (when (imap-message-flags-add
+ (imap-range-to-message-set
+ (gnus-compress-sequence oldarts)) "\\Deleted")
+ (setq articles (gnus-set-difference
+ articles oldarts)))))))))))
;; return articles not deleted
articles)
(when nnimap-debug
(require 'trace)
- (buffer-disable-undo (get-buffer-create nnimap-debug))
- (mapcar (lambda (f) (trace-function-background f nnimap-debug))
+ (buffer-disable-undo (get-buffer-create nnimap-debug-buffer))
+ (mapcar (lambda (f) (trace-function-background f nnimap-debug-buffer))
'(
nnimap-possibly-change-server
nnimap-verify-uidvalidity
(setq subject (concat "Re: " (substring subject (match-end 0)))))
(setq subject (mm-url-decode-entities-string subject))
(search-forward "<BR>")
- (if (looking-at
- "by[ \t\n]+<a[^>]+>\\([^<]+\\)</a>[ \t\n]*(\\(<[^>]+>\\)*\\([^<>)]+\\))")
- (progn
- (goto-char (- (match-end 0) 5))
- (setq from (concat
- (mm-url-decode-entities-string (match-string 1))
- " <" (match-string 3) ">")))
- (setq from "")
- (when (looking-at "by \\([^<>]*\\) on ")
- (goto-char (- (match-end 0) 5))
- (setq from (mm-url-decode-entities-string (match-string 1)))))
- (search-forward " on ")
+ (cond
+ ((looking-at
+ "by[ \t\n]+<a[^>]+>\\([^<]+\\)</a>[ \t\n]*(\\(<[^>]+>\\)*\\([^<>)]+\\))")
+ (goto-char (- (match-end 0) 5))
+ (setq from (concat
+ (mm-url-decode-entities-string (match-string 1))
+ " <" (match-string 3) ">")))
+ ((looking-at "by[ \t\n]+<a[^>]+>\\([^<(]+\\) (\\([0-9]+\\))</a>")
+ (goto-char (- (match-end 0) 5))
+ (setq from (concat
+ (mm-url-decode-entities-string (match-string 1))
+ " <" (match-string 2) ">")))
+ ((looking-at "by \\([^<>]*\\)[\t\n\r ]+on ")
+ (goto-char (- (match-end 0) 5))
+ (setq from (mm-url-decode-entities-string (match-string 1))))
+ (t
+ (setq from "")))
+ (search-forward "on ")
(setq date
(nnslashdot-date-to-date
(buffer-substring (point) (progn (skip-chars-forward "^()<>\n\r") (point)))))
(set-buffer nntp-server-buffer)
(erase-buffer)
(dolist (elem nnslashdot-groups)
- (insert (prin1-to-string (car elem))
- " " (number-to-string (cadr elem)) " 1 y\n"))))
+ (when (numberp (cadr elem))
+ (insert (prin1-to-string (car elem))
+ " " (number-to-string (cadr elem)) " 1 y\n")))))
(defun nnslashdot-lose (why)
(error "Slashdot HTML has changed; please get a new version of nnslashdot"))
(provide 'nnslashdot)
;;; nnslashdot.el ends here
+
--- /dev/null
+;;; pgg-def.el --- functions/macros for defining PGG functions
+
+;; Copyright (C) 1999 Free Software Foundation, Inc.
+
+;; Author: Daiki Ueno <ueno@unixuser.org>
+;; Created: 1999/11/02
+;; Keywords: PGP, OpenPGP, GnuPG
+
+;; 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.
+
+;;; Code:
+
+(require 'custom)
+
+(defgroup pgg ()
+ "Glue for the various PGP implementations."
+ :group 'mime)
+
+(defcustom pgg-default-scheme 'gpg
+ "Default PGP scheme."
+ :group 'pgg
+ :type '(choice (const :tag "GnuPG" gpg)
+ (const :tag "PGP 5" pgp5)
+ (const :tag "PGP" pgp)))
+
+(defcustom pgg-default-user-id (user-login-name)
+ "User ID of your default identity."
+ :group 'pgg
+ :type 'string)
+
+(defcustom pgg-default-keyserver-address "wwwkeys.pgp.net"
+ "Host name of keyserver."
+ :group 'pgg
+ :type 'string)
+
+(defcustom pgg-query-keyserver nil
+ "Whether PGG queries keyservers for missing keys when verifying messages."
+ :group 'pgg
+ :type 'boolean)
+
+(defcustom pgg-encrypt-for-me nil
+ "If t, encrypt all outgoing messages with user's public key."
+ :group 'pgg
+ :type 'boolean)
+
+(defcustom pgg-cache-passphrase t
+ "If t, cache passphrase."
+ :group 'pgg
+ :type 'boolean)
+
+(defcustom pgg-passphrase-cache-expiry 16
+ "How many seconds the passphrase is cached.
+Whether the passphrase is cached at all is controlled by
+`pgg-cache-passphrase'."
+ :group 'pgg
+ :type 'integer)
+
+(defvar pgg-messages-coding-system nil
+ "Coding system used when reading from a PGP external process.")
+
+(defvar pgg-status-buffer " *PGG status*")
+(defvar pgg-errors-buffer " *PGG errors*")
+(defvar pgg-output-buffer " *PGG output*")
+
+(defvar pgg-echo-buffer "*PGG-echo*")
+
+(defvar pgg-scheme nil
+ "Current scheme of PGP implementation.")
+
+(defmacro pgg-truncate-key-identifier (key)
+ `(if (> (length ,key) 8) (substring ,key 8) ,key))
+
+(provide 'pgg-def)
+
+;;; pgg-def.el ends here
--- /dev/null
+;;; pgg-gpg.el --- GnuPG support for PGG.
+
+;; Copyright (C) 1999,2000 Free Software Foundation, Inc.
+
+;; Author: Daiki Ueno <ueno@unixuser.org>
+;; Created: 1999/10/28
+;; Keywords: PGP, OpenPGP, GnuPG
+
+;; 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.
+
+;;; Code:
+
+(eval-when-compile (require 'pgg))
+
+(defgroup pgg-gpg ()
+ "GnuPG interface"
+ :group 'pgg)
+
+(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")))
+
+(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))
+ (args
+ `("--status-fd" "2"
+ ,@(if passphrase '("--passphrase-fd" "0"))
+ "--output" ,output-file-name
+ ,@pgg-gpg-extra-args ,@args))
+ (output-buffer pgg-output-buffer)
+ (errors-buffer pgg-errors-buffer)
+ (orig-mode (default-file-modes))
+ (process-connection-type nil)
+ process status exit-status)
+ (with-current-buffer (get-buffer-create errors-buffer)
+ (buffer-disable-undo)
+ (erase-buffer))
+ (unwind-protect
+ (progn
+ (set-default-file-modes 448)
+ (let ((coding-system-for-write 'binary))
+ (setq process
+ (apply #'start-process "*GnuPG*" errors-buffer
+ program args)))
+ (set-process-sentinel process #'ignore)
+ (when passphrase
+ (process-send-string process (concat passphrase "\n")))
+ (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 (get-buffer-create output-buffer)
+ (buffer-disable-undo)
+ (erase-buffer)
+ (if (file-exists-p output-file-name)
+ (let ((coding-system-for-read 'raw-text-dos))
+ (insert-file-contents output-file-name)))
+ (set-buffer errors-buffer)
+ (if (memq status '(stop signal))
+ (error "%s exited abnormally: '%s'" program exit-status))
+ (if (= 127 exit-status)
+ (error "%s could not be found" program))))
+ (if (and process (eq 'run (process-status process)))
+ (interrupt-process process))
+ (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)
+ (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)))
+ passphrase)))
+
+(defun pgg-gpg-lookup-key (string &optional type)
+ "Search keys associated with STRING."
+ (let ((args (list "--with-colons" "--no-greeting" "--batch"
+ (if type "--list-secret-keys" "--list-keys")
+ string)))
+ (with-temp-buffer
+ (apply #'call-process pgg-gpg-program nil t nil args)
+ (goto-char (point-min))
+ (if (re-search-forward "^\\(sec\\|pub\\):" nil t)
+ (substring
+ (nth 3 (split-string
+ (buffer-substring (match-end 0)
+ (progn (end-of-line)(point)))
+ ":")) 8)))))
+
+(defun pgg-gpg-encrypt-region (start end recipients &optional sign)
+ "Encrypt the current region between START and END.
+If optional argument SIGN is non-nil, do a combined sign and encrypt."
+ (let* ((pgg-gpg-user-id (or pgg-gpg-user-id pgg-default-user-id))
+ (passphrase
+ (when sign
+ (pgg-read-passphrase
+ (format "GnuPG passphrase for %s: " pgg-gpg-user-id)
+ (pgg-gpg-lookup-key pgg-gpg-user-id 'encrypt))))
+ (args
+ (append
+ (list "--batch" "--armor" "--always-trust" "--encrypt")
+ (if sign (list "--sign" "--local-user" pgg-gpg-user-id))
+ (if recipients
+ (apply #'nconc
+ (mapcar (lambda (rcpt)
+ (list "--remote-user" rcpt))
+ (append recipients
+ (if pgg-encrypt-for-me
+ (list pgg-gpg-user-id)))))))))
+ (pgg-as-lbt start end 'CRLF
+ (pgg-gpg-process-region start end passphrase pgg-gpg-program args))
+ (when sign
+ (with-current-buffer pgg-errors-buffer
+ (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))
+ (passphrase
+ (pgg-read-passphrase
+ (format "GnuPG passphrase for %s: " pgg-gpg-user-id)
+ (pgg-gpg-lookup-key pgg-gpg-user-id 'encrypt)))
+ (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)
+ (goto-char (point-min))
+ (re-search-forward "^\\[GNUPG:] DECRYPTION_OKAY\\>" nil t))))
+
+(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)))
+ (args
+ (list (if cleartext "--clearsign" "--detach-sign")
+ "--armor" "--batch" "--verbose"
+ "--local-user" pgg-gpg-user-id))
+ (inhibit-read-only t)
+ buffer-read-only)
+ (pgg-as-lbt start end 'CRLF
+ (pgg-gpg-process-region start end passphrase pgg-gpg-program args))
+ (with-current-buffer pgg-errors-buffer
+ (pgg-gpg-possibly-cache-passphrase passphrase))
+ (pgg-process-when-success)))
+
+(defun pgg-gpg-verify-region (start end &optional signature)
+ "Verify region between START and END as the detached signature SIGNATURE."
+ (let ((args '("--batch" "--verify")))
+ (when (stringp signature)
+ (setq args (append args (list signature))))
+ (setq args (append args '("-")))
+ (pgg-gpg-process-region start end nil pgg-gpg-program args)
+ (with-current-buffer pgg-errors-buffer
+ (goto-char (point-min))
+ (while (re-search-forward "^gpg: \\(.*\\)\n" nil t)
+ (with-current-buffer pgg-output-buffer
+ (insert-buffer-substring pgg-errors-buffer
+ (match-beginning 1) (match-end 0)))
+ (delete-region (match-beginning 0) (match-end 0)))
+ (goto-char (point-min))
+ (re-search-forward "^\\[GNUPG:] GOODSIG\\>" nil t))))
+
+(defun pgg-gpg-insert-key ()
+ "Insert public key at point."
+ (let* ((pgg-gpg-user-id (or pgg-gpg-user-id pgg-default-user-id))
+ (args (list "--batch" "--export" "--armor"
+ pgg-gpg-user-id)))
+ (pgg-gpg-process-region (point)(point) nil pgg-gpg-program args)
+ (insert-buffer-substring pgg-output-buffer)))
+
+(defun pgg-gpg-snarf-keys-region (start end)
+ "Add all public keys in region between START and END to the keyring."
+ (let ((args '("--import" "--batch" "-")) status)
+ (pgg-gpg-process-region start end nil pgg-gpg-program args)
+ (set-buffer pgg-errors-buffer)
+ (goto-char (point-min))
+ (when (re-search-forward "^\\[GNUPG:] IMPORT_RES\\>" nil t)
+ (setq status (buffer-substring (match-end 0)
+ (progn (end-of-line)(point)))
+ status (vconcat (mapcar #'string-to-int (split-string status))))
+ (erase-buffer)
+ (insert (format "Imported %d key(s).
+\tArmor contains %d key(s) [%d bad, %d old].\n"
+ (+ (aref status 2)
+ (aref status 10))
+ (aref status 0)
+ (aref status 1)
+ (+ (aref status 4)
+ (aref status 11)))
+ (if (zerop (aref status 9))
+ ""
+ "\tSecret keys are imported.\n")))
+ (append-to-buffer pgg-output-buffer (point-min)(point-max))
+ (pgg-process-when-success)))
+
+(provide 'pgg-gpg)
+
+;;; pgg-gpg.el ends here
--- /dev/null
+;;; pgg-parse.el --- OpenPGP packet parsing
+
+;; Copyright (C) 1999 Free Software Foundation, Inc.
+
+;; Author: Daiki Ueno <ueno@unixuser.org>
+;; Created: 1999/10/28
+;; Keywords: PGP, OpenPGP, GnuPG
+
+;; 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
+
+;; [OpenPGP] RFC 2440: "OpenPGP Message Format"
+;; by John W. Noerenberg, II <jwn2@qualcomm.com>,
+;; Jon Callas <jon@pgp.com>, Lutz Donnerhacke <lutz@iks-jena.de>,
+;; Hal Finney <hal@pgp.com> and Rodney Thayer <rodney@unitran.com>
+;; (1998/11)
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+
+(require 'custom)
+
+(defgroup pgg-parse ()
+ "OpenPGP packet parsing"
+ :group 'pgg)
+
+(defcustom pgg-parse-public-key-algorithm-alist
+ '((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
+ (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
+ (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
+ (cons (sexp :tag "Number") (sexp :tag "Type"))))
+
+(defcustom pgg-parse-compression-algorithm-alist
+ '((0 . nil); Uncompressed
+ (1 . ZIP)
+ (2 . ZLIB))
+ "Alist of the assigned number to the compression algorithm."
+ :group 'pgg-parse
+ :type '(repeat
+ (cons (sexp :tag "Number") (sexp :tag "Type"))))
+
+(defcustom pgg-parse-signature-type-alist
+ '((0 . "Signature of a binary document")
+ (1 . "Signature of a canonical text document")
+ (2 . "Standalone signature")
+ (16 . "Generic certification of a User ID and Public Key packet")
+ (17 . "Persona certification of a User ID and Public Key packet")
+ (18 . "Casual certification of a User ID and Public Key packet")
+ (19 . "Positive certification of a User ID and Public Key packet")
+ (24 . "Subkey Binding Signature")
+ (31 . "Signature directly on a key")
+ (32 . "Key revocation signature")
+ (40 . "Subkey revocation signature")
+ (48 . "Certification revocation signature")
+ (64 . "Timestamp signature."))
+ "Alist of the assigned number to the signature type."
+ :group 'pgg-parse
+ :type '(repeat
+ (cons (sexp :tag "Number") (sexp :tag "Type"))))
+
+(defcustom pgg-ignore-packet-checksum t; XXX
+ "If non-nil checksum of each ascii armored packet will be ignored."
+ :group 'pgg-parse
+ :type 'boolean)
+
+(defvar pgg-armor-header-lines
+ '("^-----BEGIN PGP MESSAGE\\(, PART [0-9]+\\(/[0-9]+\\)?\\)?-----\r?$"
+ "^-----BEGIN PGP PUBLIC KEY BLOCK-----\r?$"
+ "^-----BEGIN PGP PRIVATE KEY BLOCK-----\r?$"
+ "^-----BEGIN PGP SIGNATURE-----\r?$")
+ "Armor headers.")
+
+(eval-and-compile
+ (defalias 'pgg-char-int (if (fboundp 'char-int)
+ 'char-int
+ 'identity)))
+
+(defmacro pgg-format-key-identifier (string)
+ `(mapconcat (lambda (c) (format "%02X" (pgg-char-int c)))
+ ,string "")
+ ;; `(upcase (apply #'format "%02x%02x%02x%02x%02x%02x%02x%02x"
+ ;; (string-to-int-list ,string)))
+ )
+
+(defmacro pgg-parse-time-field (bytes)
+ `(list (logior (lsh (car ,bytes) 8)
+ (nth 1 ,bytes))
+ (logior (lsh (nth 2 ,bytes) 8)
+ (nth 3 ,bytes))
+ 0))
+
+(defmacro pgg-byte-after (&optional pos)
+ `(pgg-char-int (char-after ,(or pos `(point)))))
+
+(defmacro pgg-read-byte ()
+ `(pgg-char-int (char-after (prog1 (point) (forward-char)))))
+
+(defmacro pgg-read-bytes-string (nbytes)
+ `(buffer-substring
+ (point) (prog1 (+ ,nbytes (point))
+ (forward-char ,nbytes))))
+
+(defmacro pgg-read-bytes (nbytes)
+ `(mapcar #'pgg-char-int (pgg-read-bytes-string ,nbytes))
+ ;; `(string-to-int-list (pgg-read-bytes-string ,nbytes))
+ )
+
+(defmacro pgg-read-body-string (ptag)
+ `(if (nth 1 ,ptag)
+ (pgg-read-bytes-string (nth 1 ,ptag))
+ (pgg-read-bytes-string (- (point-max) (point)))))
+
+(defmacro pgg-read-body (ptag)
+ `(mapcar #'pgg-char-int (pgg-read-body-string ,ptag))
+ ;; `(string-to-int-list (pgg-read-body-string ,ptag))
+ )
+
+(defalias 'pgg-skip-bytes 'forward-char)
+
+(defmacro pgg-skip-header (ptag)
+ `(pgg-skip-bytes (nth 2 ,ptag)))
+
+(defmacro pgg-skip-body (ptag)
+ `(pgg-skip-bytes (nth 1 ,ptag)))
+
+(defmacro pgg-set-alist (alist key value)
+ `(setq ,alist (nconc ,alist (list (cons ,key ,value)))))
+
+(when (fboundp 'define-ccl-program)
+
+ (define-ccl-program pgg-parse-crc24
+ '(1
+ ((loop
+ (read r0) (r1 ^= r0) (r2 ^= 0)
+ (r5 = 0)
+ (loop
+ (r1 <<= 1)
+ (r1 += ((r2 >> 15) & 1))
+ (r2 <<= 1)
+ (if (r1 & 256)
+ ((r1 ^= 390) (r2 ^= 19707)))
+ (if (r5 < 7)
+ ((r5 += 1)
+ (repeat))))
+ (repeat)))))
+
+ (defun pgg-parse-crc24-string (string)
+ (let ((h (vector nil 183 1230 nil nil nil nil nil nil)))
+ (ccl-execute-on-string pgg-parse-crc24 h string)
+ (format "%c%c%c"
+ (logand (aref h 1) 255)
+ (logand (lsh (aref h 2) -8) 255)
+ (logand (aref h 2) 255)))))
+
+(defmacro pgg-parse-length-type (c)
+ `(cond
+ ((< ,c 192) (cons ,c 1))
+ ((< ,c 224)
+ (cons (+ (lsh (- ,c 192) 8)
+ (pgg-byte-after (+ 2 (point)))
+ 192)
+ 2))
+ ((= ,c 255)
+ (cons (cons (logior (lsh (pgg-byte-after (+ 2 (point))) 8)
+ (pgg-byte-after (+ 3 (point))))
+ (logior (lsh (pgg-byte-after (+ 4 (point))) 8)
+ (pgg-byte-after (+ 5 (point)))))
+ 5))
+ (t;partial body length
+ '(0 . 0))))
+
+(defun pgg-parse-packet-header ()
+ (let ((ptag (pgg-byte-after))
+ length-type content-tag packet-bytes header-bytes)
+ (if (zerop (logand 64 ptag));Old format
+ (progn
+ (setq length-type (logand ptag 3)
+ length-type (if (= 3 length-type) 0 (lsh 1 length-type))
+ content-tag (logand 15 (lsh ptag -2))
+ packet-bytes 0
+ header-bytes (1+ length-type))
+ (dotimes (i length-type)
+ (setq packet-bytes
+ (logior (lsh packet-bytes 8)
+ (pgg-byte-after (+ 1 i (point)))))))
+ (setq content-tag (logand 63 ptag)
+ length-type (pgg-parse-length-type
+ (pgg-byte-after (1+ (point))))
+ packet-bytes (car length-type)
+ header-bytes (1+ (cdr length-type))))
+ (list content-tag packet-bytes header-bytes)))
+
+(defun pgg-parse-packet (ptag)
+ (case (car ptag)
+ (1 ;Public-Key Encrypted Session Key Packet
+ (pgg-parse-public-key-encrypted-session-key-packet ptag))
+ (2 ;Signature Packet
+ (pgg-parse-signature-packet ptag))
+ (3 ;Symmetric-Key Encrypted Session Key Packet
+ (pgg-parse-symmetric-key-encrypted-session-key-packet ptag))
+ ;; 4 -- One-Pass Signature Packet
+ ;; 5 -- Secret Key Packet
+ (6 ;Public Key Packet
+ (pgg-parse-public-key-packet ptag))
+ ;; 7 -- Secret Subkey Packet
+ ;; 8 -- Compressed Data Packet
+ (9 ;Symmetrically Encrypted Data Packet
+ (pgg-read-body-string ptag))
+ (10 ;Marker Packet
+ (pgg-read-body-string ptag))
+ (11 ;Literal Data Packet
+ (pgg-read-body-string ptag))
+ ;; 12 -- Trust Packet
+ (13 ;User ID Packet
+ (pgg-read-body-string ptag))
+ ;; 14 -- Public Subkey Packet
+ ;; 60 .. 63 -- Private or Experimental Values
+ ))
+
+(defun pgg-parse-packets (&optional header-parser body-parser)
+ (let ((header-parser
+ (or header-parser
+ (function pgg-parse-packet-header)))
+ (body-parser
+ (or body-parser
+ (function pgg-parse-packet)))
+ result ptag)
+ (while (> (point-max) (1+ (point)))
+ (setq ptag (funcall header-parser))
+ (pgg-skip-header ptag)
+ (push (cons (car ptag)
+ (save-excursion
+ (funcall body-parser ptag)))
+ result)
+ (if (zerop (nth 1 ptag))
+ (goto-char (point-max))
+ (forward-char (nth 1 ptag))))
+ result))
+
+(defun pgg-parse-signature-subpacket-header ()
+ (let ((length-type (pgg-parse-length-type (pgg-byte-after))))
+ (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 'creation-time
+ (let ((bytes (pgg-read-bytes 4)))
+ (pgg-parse-time-field bytes))))
+ (3 ;signature expiration time
+ (cons 'signature-expiry
+ (let ((bytes (pgg-read-bytes 4)))
+ (pgg-parse-time-field bytes))))
+ (4 ;exportable certification
+ (cons 'exportability (pgg-read-byte)))
+ (5 ;trust signature
+ (cons 'trust-level (pgg-read-byte)))
+ (6 ;regular expression
+ (cons 'regular-expression
+ (pgg-read-body-string ptag)))
+ (7 ;revocable
+ (cons 'revocability (pgg-read-byte)))
+ (9 ;key expiration time
+ (cons 'key-expiry
+ (let ((bytes (pgg-read-bytes 4)))
+ (pgg-parse-time-field bytes))))
+ ;; 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))))
+ (12 ;revocation key
+ )
+ (16 ;issuer key ID
+ (cons 'key-identifier
+ (pgg-format-key-identifier (pgg-read-body-string ptag))))
+ (20 ;notation data
+ (pgg-skip-bytes 4)
+ (cons 'notation
+ (let ((name-bytes (pgg-read-bytes 2))
+ (value-bytes (pgg-read-bytes 2)))
+ (cons (pgg-read-bytes-string
+ (logior (lsh (car name-bytes) 8)
+ (nth 1 name-bytes)))
+ (pgg-read-bytes-string
+ (logior (lsh (car value-bytes) 8)
+ (nth 1 value-bytes)))))))
+ (21 ;preferred hash algorithms
+ (cons 'preferred-hash-algorithm
+ (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))))
+ (23 ;key server preferences
+ (cons 'key-server-preferences
+ (pgg-read-body ptag)))
+ (24 ;preferred key server
+ (cons 'preferred-key-server
+ (pgg-read-body-string ptag)))
+ ;; 25 = primary user id
+ (26 ;policy URL
+ (cons 'policy-url (pgg-read-body-string ptag)))
+ ;; 27 = key flags
+ ;; 28 = signer's user id
+ ;; 29 = reason for revocation
+ ;; 100 to 110 = internal or user-defined
+ ))
+
+(defun pgg-parse-signature-packet (ptag)
+ (let* ((signature-version (pgg-byte-after))
+ (result (list (cons 'version signature-version)))
+ hashed-material field n)
+ (cond
+ ((= signature-version 3)
+ (pgg-skip-bytes 2)
+ (setq hashed-material (pgg-read-bytes 5))
+ (pgg-set-alist result
+ 'signature-type
+ (cdr (assq (pop hashed-material)
+ pgg-parse-signature-type-alist)))
+ (pgg-set-alist result
+ 'creation-time
+ (pgg-parse-time-field hashed-material))
+ (pgg-set-alist result
+ 'key-identifier
+ (pgg-format-key-identifier
+ (pgg-read-bytes-string 8)))
+ (pgg-set-alist result
+ 'public-key-algorithm (pgg-read-byte))
+ (pgg-set-alist result
+ 'hash-algorithm (pgg-read-byte)))
+ ((= signature-version 4)
+ (pgg-skip-bytes 1)
+ (pgg-set-alist result
+ 'signature-type
+ (cdr (assq (pgg-read-byte)
+ pgg-parse-signature-type-alist)))
+ (pgg-set-alist result
+ 'public-key-algorithm
+ (pgg-read-byte))
+ (pgg-set-alist result
+ 'hash-algorithm (pgg-read-byte))
+ (when (>= 10000 (setq n (pgg-read-bytes 2)
+ n (logior (lsh (car n) 8)
+ (nth 1 n))))
+ (save-restriction
+ (narrow-to-region (point)(+ n (point)))
+ (nconc result
+ (mapcar (function cdr) ;remove packet types
+ (pgg-parse-packets
+ #'pgg-parse-signature-subpacket-header
+ #'pgg-parse-signature-subpacket)))
+ (goto-char (point-max))))
+ (when (>= 10000 (setq n (pgg-read-bytes 2)
+ n (logior (lsh (car n) 8)
+ (nth 1 n))))
+ (save-restriction
+ (narrow-to-region (point)(+ n (point)))
+ (nconc result
+ (mapcar (function cdr) ;remove packet types
+ (pgg-parse-packets
+ #'pgg-parse-signature-subpacket-header
+ #'pgg-parse-signature-subpacket)))))))
+
+ (setcdr (setq field (assq 'public-key-algorithm
+ result))
+ (cdr (assq (cdr field)
+ pgg-parse-public-key-algorithm-alist)))
+ (setcdr (setq field (assq 'hash-algorithm
+ result))
+ (cdr (assq (cdr field)
+ pgg-parse-hash-algorithm-alist)))
+ result))
+
+(defun pgg-parse-public-key-encrypted-session-key-packet (ptag)
+ (let (result)
+ (pgg-set-alist result
+ 'version (pgg-read-byte))
+ (pgg-set-alist result
+ 'key-identifier
+ (pgg-format-key-identifier
+ (pgg-read-bytes-string 8)))
+ (pgg-set-alist result
+ 'public-key-algorithm
+ (cdr (assq (pgg-read-byte)
+ pgg-parse-public-key-algorithm-alist)))
+ result))
+
+(defun pgg-parse-symmetric-key-encrypted-session-key-packet (ptag)
+ (let (result)
+ (pgg-set-alist result
+ 'version
+ (pgg-read-byte))
+ (pgg-set-alist result
+ 'symmetric-key-algorithm
+ (cdr (assq (pgg-read-byte)
+ pgg-parse-symmetric-key-algorithm-alist)))
+ result))
+
+(defun pgg-parse-public-key-packet (ptag)
+ (let* ((key-version (pgg-read-byte))
+ (result (list (cons 'version key-version)))
+ field)
+ (cond
+ ((= 3 key-version)
+ (pgg-set-alist result
+ 'creation-time
+ (let ((bytes (pgg-read-bytes 4)))
+ (pgg-parse-time-field bytes)))
+ (pgg-set-alist result
+ 'key-expiry (pgg-read-bytes 2))
+ (pgg-set-alist result
+ 'public-key-algorithm (pgg-read-byte)))
+ ((= 4 key-version)
+ (pgg-set-alist result
+ 'creation-time
+ (let ((bytes (pgg-read-bytes 4)))
+ (pgg-parse-time-field bytes)))
+ (pgg-set-alist result
+ 'public-key-algorithm (pgg-read-byte))))
+
+ (setcdr (setq field (assq 'public-key-algorithm
+ result))
+ (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")))))
+
+(defun pgg-decode-armor-region (start end)
+ (save-restriction
+ (narrow-to-region start end)
+ (goto-char (point-min))
+ (re-search-forward "^-+BEGIN PGP" nil t)
+ (delete-region (point-min)
+ (and (search-forward "\n\n")
+ (match-end 0)))
+ (pgg-decode-packets)
+ (goto-char (point-min))
+ (pgg-parse-packets)))
+
+(defun pgg-parse-armor (string)
+ (with-temp-buffer
+ (buffer-disable-undo)
+ (if (fboundp 'set-buffer-multibyte)
+ (set-buffer-multibyte nil))
+ (insert string)
+ (pgg-decode-armor-region (point-min)(point))))
+
+(eval-and-compile
+ (defalias 'pgg-string-as-unibyte (if (fboundp 'string-as-unibyte)
+ 'string-as-unibyte
+ 'identity)))
+
+(defun pgg-parse-armor-region (start end)
+ (pgg-parse-armor (pgg-string-as-unibyte (buffer-substring start end))))
+
+(provide 'pgg-parse)
+
+;;; pgg-parse.el ends here
--- /dev/null
+;;; pgg-pgp.el --- PGP 2.* and 6.* support for PGG.
+
+;; Copyright (C) 1999,2000 Free Software Foundation, Inc.
+
+;; Author: Daiki Ueno <ueno@unixuser.org>
+;; Created: 1999/11/02
+;; Keywords: PGP, OpenPGP
+
+;; 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.
+
+;;; Code:
+
+(eval-when-compile (require 'pgg))
+
+(defgroup pgg-pgp ()
+ "PGP 2.* and 6.* interface"
+ :group 'pgg)
+
+(defcustom pgg-pgp-program "pgp"
+ "PGP 2.* and 6.* executable."
+ :group 'pgg-pgp
+ :type 'string)
+
+(defcustom pgg-pgp-shell-file-name "/bin/sh"
+ "File name to load inferior shells from.
+Bourne shell or its equivalent \(not tcsh) is needed for \"2>\"."
+ :group 'pgg-pgp
+ :type 'string)
+
+(defcustom pgg-pgp-shell-command-switch "-c"
+ "Switch used to have the shell execute its command line argument."
+ :group 'pgg-pgp
+ :type 'string)
+
+(defcustom pgg-pgp-extra-args nil
+ "Extra arguments for every PGP invocation."
+ :group 'pgg-pgp
+ :type '(choice
+ (const :tag "None" nil)
+ (string :tag "Arguments")))
+
+(defvar pgg-pgp-user-id nil
+ "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))
+ (args
+ (append args
+ pgg-pgp-extra-args
+ (list (concat "2>" errors-file-name))))
+ (shell-file-name pgg-pgp-shell-file-name)
+ (shell-command-switch pgg-pgp-shell-command-switch)
+ (process-environment process-environment)
+ (output-buffer pgg-output-buffer)
+ (errors-buffer pgg-errors-buffer)
+ (process-connection-type nil)
+ process status exit-status)
+ (with-current-buffer (get-buffer-create output-buffer)
+ (buffer-disable-undo)
+ (erase-buffer))
+ (when passphrase
+ (setenv "PGPPASSFD" "0"))
+ (unwind-protect
+ (progn
+ (let ((coding-system-for-read 'binary)
+ (coding-system-for-write 'binary))
+ (setq process
+ (apply #'funcall
+ #'start-process-shell-command "*PGP*" output-buffer
+ program args)))
+ (set-process-sentinel process #'ignore)
+ (when passphrase
+ (process-send-string process (concat passphrase "\n")))
+ (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 output-buffer
+ (pgg-convert-lbt-region (point-min)(point-max) 'LF)
+
+ (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 errors-buffer))
+ (buffer-disable-undo)
+ (erase-buffer)
+ (insert-file-contents errors-file-name)))
+ (if (and process (eq 'run (process-status process)))
+ (interrupt-process process))
+ (condition-case nil
+ (delete-file errors-file-name)
+ (file-error nil)))))
+
+(defun pgg-pgp-lookup-key (string &optional type)
+ "Search keys associated with STRING."
+ (let ((args (list "+batchmode" "+language=en" "-kv" string)))
+ (with-current-buffer (get-buffer-create pgg-output-buffer)
+ (buffer-disable-undo)
+ (erase-buffer)
+ (apply #'call-process pgg-pgp-program nil t nil args)
+ (goto-char (point-min))
+ (cond
+ ((re-search-forward "^pub\\s +[0-9]+/" nil t);PGP 2.*
+ (buffer-substring (point)(+ 8 (point))))
+ ((re-search-forward "^Type" nil t);PGP 6.*
+ (beginning-of-line 2)
+ (substring
+ (nth 2 (split-string
+ (buffer-substring (point)(progn (end-of-line) (point)))))
+ 2))))))
+
+(defun pgg-pgp-encrypt-region (start end recipients)
+ "Encrypt the current region between START and END."
+ (let* ((pgg-pgp-user-id (or pgg-pgp-user-id pgg-default-user-id))
+ (args
+ `("+encrypttoself=off +verbose=1" "+batchmode"
+ "+language=us" "-fate"
+ ,@(if recipients
+ (mapcar (lambda (rcpt) (concat "\"" rcpt "\""))
+ (append recipients
+ (if pgg-encrypt-for-me
+ (list pgg-pgp-user-id))))))))
+ (pgg-pgp-process-region start end nil pgg-pgp-program args)
+ (pgg-process-when-success nil)))
+
+(defun pgg-pgp-decrypt-region (start end)
+ "Decrypt the current region between START and END."
+ (let* ((pgg-pgp-user-id (or pgg-pgp-user-id pgg-default-user-id))
+ (passphrase
+ (pgg-read-passphrase
+ (format "PGP passphrase for %s: " pgg-pgp-user-id)
+ (pgg-pgp-lookup-key pgg-pgp-user-id 'encrypt)))
+ (args
+ '("+verbose=1" "+batchmode" "+language=us" "-f")))
+ (pgg-pgp-process-region start end passphrase pgg-pgp-program args)
+ (pgg-process-when-success nil)))
+
+(defun pgg-pgp-sign-region (start end &optional clearsign)
+ "Make detached signature from text between START and END."
+ (let* ((pgg-pgp-user-id (or pgg-pgp-user-id pgg-default-user-id))
+ (passphrase
+ (pgg-read-passphrase
+ (format "PGP passphrase for %s: " pgg-pgp-user-id)
+ (pgg-pgp-lookup-key pgg-pgp-user-id 'sign)))
+ (args
+ (list (if clearsign "-fast" "-fbast")
+ "+verbose=1" "+language=us" "+batchmode"
+ "-u" pgg-pgp-user-id)))
+ (pgg-pgp-process-region start end passphrase pgg-pgp-program args)
+ (pgg-process-when-success
+ (goto-char (point-min))
+ (when (re-search-forward "^-+BEGIN PGP" nil t);XXX
+ (let ((packet
+ (cdr (assq 2 (pgg-parse-armor-region
+ (progn (beginning-of-line 2)
+ (point))
+ (point-max))))))
+ (if pgg-cache-passphrase
+ (pgg-add-passphrase-cache
+ (cdr (assq 'key-identifier packet))
+ passphrase)))))))
+
+(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))
+ (args '("+verbose=1" "+batchmode" "+language=us"))
+ (orig-mode (default-file-modes)))
+ (unwind-protect
+ (progn
+ (set-default-file-modes 448)
+ (let ((coding-system-for-write 'binary)
+ jka-compr-compression-info-list jam-zcat-filename-list)
+ (write-region start end orig-file)))
+ (set-default-file-modes orig-mode))
+ (when (stringp signature)
+ (copy-file signature (setq signature (concat orig-file ".asc")))
+ (setq args (append args (list signature orig-file))))
+ (pgg-pgp-process-region (point)(point) nil pgg-pgp-program args)
+ (delete-file orig-file)
+ (if signature (delete-file signature))
+ (pgg-process-when-success
+ (goto-char (point-min))
+ (let ((case-fold-search t))
+ (while (re-search-forward "^warning: " nil t)
+ (delete-region (match-beginning 0)
+ (progn (beginning-of-line 2) (point)))))
+ (goto-char (point-min))
+ (when (re-search-forward "^\\.$" nil t)
+ (delete-region (point-min)
+ (progn (beginning-of-line 2)
+ (point)))))))
+
+(defun pgg-pgp-insert-key ()
+ "Insert public key at point."
+ (let* ((pgg-pgp-user-id (or pgg-pgp-user-id pgg-default-user-id))
+ (args
+ (list "+verbose=1" "+batchmode" "+language=us" "-kxaf"
+ (concat "\"" pgg-pgp-user-id "\""))))
+ (pgg-pgp-process-region (point)(point) nil pgg-pgp-program args)
+ (insert-buffer-substring pgg-output-buffer)))
+
+(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))
+ (args
+ (list "+verbose=1" "+batchmode" "+language=us" "-kaf"
+ key-file)))
+ (let ((coding-system-for-write 'raw-text-dos))
+ (write-region start end key-file))
+ (pgg-pgp-process-region start end nil pgg-pgp-program args)
+ (delete-file key-file)
+ (pgg-process-when-success nil)))
+
+(provide 'pgg-pgp)
+
+;;; pgg-pgp.el ends here
--- /dev/null
+;;; pgg-pgp5.el --- PGP 5.* support for PGG.
+
+;; Copyright (C) 1999,2000 Free Software Foundation, Inc.
+
+;; Author: Daiki Ueno <ueno@unixuser.org>
+;; Created: 1999/11/02
+;; Keywords: PGP, OpenPGP
+
+;; 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.
+
+;;; Code:
+
+(eval-when-compile (require 'pgg))
+
+(defgroup pgg-pgp5 ()
+ "PGP 5.* interface"
+ :group 'pgg)
+
+(defcustom pgg-pgp5-pgpe-program "pgpe"
+ "PGP 5.* 'pgpe' executable."
+ :group 'pgg-pgp5
+ :type 'string)
+
+(defcustom pgg-pgp5-pgps-program "pgps"
+ "PGP 5.* 'pgps' executable."
+ :group 'pgg-pgp5
+ :type 'string)
+
+(defcustom pgg-pgp5-pgpk-program "pgpk"
+ "PGP 5.* 'pgpk' executable."
+ :group 'pgg-pgp5
+ :type 'string)
+
+(defcustom pgg-pgp5-pgpv-program "pgpv"
+ "PGP 5.* 'pgpv' executable."
+ :group 'pgg-pgp5
+ :type 'string)
+
+(defcustom pgg-pgp5-shell-file-name "/bin/sh"
+ "File name to load inferior shells from.
+Bourne shell or its equivalent \(not tcsh) is needed for \"2>\"."
+ :group 'pgg-pgp5
+ :type 'string)
+
+(defcustom pgg-pgp5-shell-command-switch "-c"
+ "Switch used to have the shell execute its command line argument."
+ :group 'pgg-pgp5
+ :type 'string)
+
+(defcustom pgg-pgp5-extra-args nil
+ "Extra arguments for every PGP 5.* invocation."
+ :group 'pgg-pgp5
+ :type '(choice
+ (const :tag "None" nil)
+ (string :tag "Arguments")))
+
+(defvar pgg-pgp5-user-id nil
+ "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))
+ (args
+ (append args
+ pgg-pgp5-extra-args
+ (list (concat "2>" errors-file-name))))
+ (shell-file-name pgg-pgp5-shell-file-name)
+ (shell-command-switch pgg-pgp5-shell-command-switch)
+ (process-environment process-environment)
+ (output-buffer pgg-output-buffer)
+ (errors-buffer pgg-errors-buffer)
+ (process-connection-type nil)
+ process status exit-status)
+ (with-current-buffer (get-buffer-create output-buffer)
+ (buffer-disable-undo)
+ (erase-buffer))
+ (when passphrase
+ (setenv "PGPPASSFD" "0"))
+ (unwind-protect
+ (progn
+ (let ((coding-system-for-read 'binary)
+ (coding-system-for-write 'binary))
+ (setq process
+ (apply #'funcall
+ #'start-process-shell-command "*PGP*" output-buffer
+ program args)))
+ (set-process-sentinel process #'ignore)
+ (when passphrase
+ (process-send-string process (concat passphrase "\n")))
+ (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 output-buffer
+ (pgg-convert-lbt-region (point-min)(point-max) 'LF)
+
+ (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 errors-buffer))
+ (buffer-disable-undo)
+ (erase-buffer)
+ (insert-file-contents errors-file-name)))
+ (if (and process (eq 'run (process-status process)))
+ (interrupt-process process))
+ (condition-case nil
+ (delete-file errors-file-name)
+ (file-error nil)))))
+
+(defun pgg-pgp5-lookup-key (string &optional type)
+ "Search keys associated with STRING."
+ (let ((args (list "+language=en" "-l" string)))
+ (with-current-buffer (get-buffer-create pgg-output-buffer)
+ (buffer-disable-undo)
+ (erase-buffer)
+ (apply #'call-process pgg-pgp5-pgpk-program nil t nil args)
+ (goto-char (point-min))
+ (when (re-search-forward "^sec" nil t)
+ (substring
+ (nth 2 (split-string
+ (buffer-substring (match-end 0)(progn (end-of-line)(point)))))
+ 2)))))
+
+(defun pgg-pgp5-encrypt-region (start end recipients)
+ "Encrypt the current region between START and END."
+ (let* ((pgg-pgp5-user-id (or pgg-pgp5-user-id pgg-default-user-id))
+ (args
+ `("+NoBatchInvalidKeys=off" "-fat" "+batchmode=1"
+ ,@(if recipients
+ (apply #'append
+ (mapcar (lambda (rcpt)
+ (list "-r"
+ (concat "\"" rcpt "\"")))
+ (append recipients
+ (if pgg-encrypt-for-me
+ (list pgg-pgp5-user-id)))))))))
+ (pgg-pgp5-process-region start end nil pgg-pgp5-pgpe-program args)
+ (pgg-process-when-success nil)))
+
+(defun pgg-pgp5-decrypt-region (start end)
+ "Decrypt the current region between START and END."
+ (let* ((pgg-pgp5-user-id (or pgg-pgp5-user-id pgg-default-user-id))
+ (passphrase
+ (pgg-read-passphrase
+ (format "PGP passphrase for %s: " pgg-pgp5-user-id)
+ (pgg-pgp5-lookup-key pgg-pgp5-user-id 'encrypt)))
+ (args
+ '("+verbose=1" "+batchmode=1" "+language=us" "-f")))
+ (pgg-pgp5-process-region start end passphrase pgg-pgp5-pgpv-program args)
+ (pgg-process-when-success nil)))
+
+(defun pgg-pgp5-sign-region (start end &optional clearsign)
+ "Make detached signature from text between START and END."
+ (let* ((pgg-pgp5-user-id (or pgg-pgp5-user-id pgg-default-user-id))
+ (passphrase
+ (pgg-read-passphrase
+ (format "PGP passphrase for %s: " pgg-pgp5-user-id)
+ (pgg-pgp5-lookup-key pgg-pgp5-user-id 'sign)))
+ (args
+ (list (if clearsign "-fat" "-fbat")
+ "+verbose=1" "+language=us" "+batchmode=1"
+ "-u" pgg-pgp5-user-id)))
+ (pgg-pgp5-process-region start end passphrase pgg-pgp5-pgps-program args)
+ (pgg-process-when-success
+ (when (re-search-forward "^-+BEGIN PGP SIGNATURE" nil t);XXX
+ (let ((packet
+ (cdr (assq 2 (pgg-parse-armor-region
+ (progn (beginning-of-line 2)
+ (point))
+ (point-max))))))
+ (if pgg-cache-passphrase
+ (pgg-add-passphrase-cache
+ (cdr (assq 'key-identifier packet))
+ passphrase)))))))
+
+(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)))
+ (unwind-protect
+ (progn
+ (set-default-file-modes 448)
+ (let ((coding-system-for-write 'binary)
+ jka-compr-compression-info-list jam-zcat-filename-list)
+ (write-region start end orig-file)))
+ (set-default-file-modes orig-mode))
+ (when (stringp signature)
+ (copy-file signature (setq signature (concat orig-file ".asc")))
+ (setq args (append args (list signature))))
+ (pgg-pgp5-process-region (point)(point) nil pgg-pgp5-pgpv-program args)
+ (delete-file orig-file)
+ (if signature (delete-file signature))
+ (with-current-buffer pgg-errors-buffer
+ (goto-char (point-min))
+ (if (re-search-forward "^Good signature" nil t)
+ (progn
+ (set-buffer pgg-output-buffer)
+ (insert-buffer-substring pgg-errors-buffer)
+ t)
+ nil))))
+
+(defun pgg-pgp5-insert-key ()
+ "Insert public key at point."
+ (let* ((pgg-pgp5-user-id (or pgg-pgp5-user-id pgg-default-user-id))
+ (args
+ (list "+verbose=1" "+batchmode=1" "+language=us" "-x"
+ (concat "\"" pgg-pgp5-user-id "\""))))
+ (pgg-pgp5-process-region (point)(point) nil pgg-pgp5-pgpk-program args)
+ (insert-buffer-substring pgg-output-buffer)))
+
+(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))
+ (args
+ (list "+verbose=1" "+batchmode=1" "+language=us" "-a"
+ key-file)))
+ (let ((coding-system-for-write 'raw-text-dos))
+ (write-region start end key-file))
+ (pgg-pgp5-process-region start end nil pgg-pgp5-pgpk-program args)
+ (delete-file key-file)
+ (pgg-process-when-success nil)))
+
+(provide 'pgg-pgp5)
+
+;;; pgg-pgp5.el ends here
--- /dev/null
+;;; pgg.el --- glue for the various PGP implementations.
+
+;; Copyright (C) 1999,2000 Free Software Foundation, Inc.
+
+;; Author: Daiki Ueno <ueno@unixuser.org>
+;; Created: 1999/10/28
+;; Keywords: PGP
+
+;; 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:
+;;
+
+;;; Code:
+
+(require 'pgg-def)
+(require 'pgg-parse)
+
+(eval-when-compile
+ (ignore-errors
+ (require 'w3)
+ (require 'url)))
+
+(defvar pgg-temporary-file-directory
+ (cond ((fboundp 'temp-directory) (temp-directory))
+ ((boundp 'temporary-file-directory) temporary-file-directory)
+ ("/tmp/")))
+
+;;; @ utility functions
+;;;
+
+(defvar pgg-fetch-key-function (if (fboundp 'url-insert-file-contents)
+ (function pgg-fetch-key-with-w3)))
+
+(defun pgg-invoke (func scheme &rest args)
+ (progn
+ (require (intern (format "pgg-%s" scheme)))
+ (apply 'funcall (intern (format "pgg-%s-%s" scheme func)) args)))
+
+(put 'pgg-save-coding-system 'lisp-indent-function 2)
+
+(defmacro pgg-save-coding-system (start end &rest body)
+ `(if (interactive-p)
+ (let ((buffer (current-buffer)))
+ (with-temp-buffer
+ (let (buffer-undo-list)
+ (insert-buffer-substring buffer ,start ,end)
+ (encode-coding-region (point-min)(point-max)
+ buffer-file-coding-system)
+ (prog1 (save-excursion ,@body)
+ (push nil buffer-undo-list)
+ (ignore-errors (undo))))))
+ (save-restriction
+ (narrow-to-region ,start ,end)
+ ,@body)))
+
+(defun pgg-temp-buffer-show-function (buffer)
+ (let ((window (split-window-vertically)))
+ (set-window-buffer window buffer)
+ (shrink-window-if-larger-than-buffer window)))
+
+(defun pgg-display-output-buffer (start end status)
+ (if status
+ (progn
+ (delete-region start end)
+ (insert-buffer-substring pgg-output-buffer)
+ (decode-coding-region start (point) buffer-file-coding-system))
+ (let ((temp-buffer-show-function
+ (function pgg-temp-buffer-show-function)))
+ (with-output-to-temp-buffer pgg-echo-buffer
+ (set-buffer standard-output)
+ (insert-buffer-substring pgg-errors-buffer)))))
+
+(defvar pgg-passphrase-cache (make-vector 7 0))
+
+(defvar pgg-read-passphrase nil)
+(defun pgg-read-passphrase (prompt &optional key)
+ (if (not pgg-read-passphrase)
+ (if (functionp 'read-passwd)
+ (setq pgg-read-passphrase 'read-passwd)
+ (if (load "passwd" t)
+ (setq pgg-read-passphrase 'read-passwd)
+ (autoload 'ange-ftp-read-passwd "ange-ftp")
+ (setq pgg-read-passphrase 'ange-ftp-read-passwd))))
+ (or (and pgg-cache-passphrase
+ key (setq key (pgg-truncate-key-identifier key))
+ (symbol-value (intern-soft key pgg-passphrase-cache)))
+ (funcall pgg-read-passphrase prompt)))
+
+(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))
+
+(defun pgg-remove-passphrase-cache (key)
+ (let ((passphrase (symbol-value (intern-soft key pgg-passphrase-cache))))
+ (when passphrase
+ (fillarray passphrase ?_)
+ (unintern key pgg-passphrase-cache))))
+
+(defmacro pgg-convert-lbt-region (start end lbt)
+ `(let ((pgg-conversion-end (set-marker (make-marker) ,end)))
+ (goto-char ,start)
+ (case ,lbt
+ (CRLF
+ (while (progn
+ (end-of-line)
+ (> (marker-position pgg-conversion-end) (point)))
+ (insert "\r")
+ (forward-line 1)))
+ (LF
+ (while (re-search-forward "\r$" pgg-conversion-end t)
+ (replace-match ""))))))
+
+(put 'pgg-as-lbt 'lisp-indent-function 3)
+
+(defmacro pgg-as-lbt (start end lbt &rest body)
+ `(let ((inhibit-read-only t)
+ buffer-read-only
+ buffer-undo-list)
+ (pgg-convert-lbt-region ,start ,end ,lbt)
+ (let ((,end (point)))
+ ,@body)
+ (push nil buffer-undo-list)
+ (ignore-errors (undo))))
+
+(put 'pgg-process-when-success 'lisp-indent-function 0)
+
+(defmacro pgg-process-when-success (&rest body)
+ `(with-current-buffer pgg-output-buffer
+ (if (zerop (buffer-size)) nil ,@body t)))
+
+;;; @ interface functions
+;;;
+
+;;;###autoload
+(defun pgg-encrypt-region (start end rcpts &optional sign)
+ "Encrypt the current region between START and END for RCPTS.
+If optional argument SIGN is non-nil, do a combined sign and encrypt."
+ (interactive
+ (list (region-beginning)(region-end)
+ (split-string (read-string "Recipients: ") "[ \t,]+")))
+ (let ((status
+ (pgg-save-coding-system start end
+ (pgg-invoke "encrypt-region" (or pgg-scheme pgg-default-scheme)
+ (point-min) (point-max) rcpts sign))))
+ (when (interactive-p)
+ (pgg-display-output-buffer start end status))
+ status))
+
+;;;###autoload
+(defun pgg-encrypt (rcpts &optional sign start end)
+ "Encrypt the current buffer for RCPTS.
+If optional argument SIGN is non-nil, do a combined sign and encrypt.
+If optional arguments START and END are specified, only encrypt within
+the region."
+ (interactive (list (split-string (read-string "Recipients: ") "[ \t,]+")))
+ (let* ((start (or start (point-min)))
+ (end (or end (point-max)))
+ (status (pgg-encrypt-region start end rcpts sign)))
+ (when (interactive-p)
+ (pgg-display-output-buffer start end status))
+ status))
+
+;;;###autoload
+(defun pgg-decrypt-region (start end)
+ "Decrypt the current region between START and END."
+ (interactive "r")
+ (let* ((buf (current-buffer))
+ (packet (cdr (assq 1 (with-temp-buffer
+ (insert-buffer 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)
+ (point-min) (point-max)))))
+ (when (interactive-p)
+ (pgg-display-output-buffer start end status))
+ status))
+
+;;;###autoload
+(defun pgg-decrypt (&optional start end)
+ "Decrypt the current buffer.
+If optional arguments START and END are specified, only decrypt within
+the region."
+ (interactive "")
+ (let* ((start (or start (point-min)))
+ (end (or end (point-max)))
+ (status (pgg-decrypt-region start end)))
+ (when (interactive-p)
+ (pgg-display-output-buffer start end status))
+ status))
+
+;;;###autoload
+(defun pgg-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.
+If this function is called interactively, CLEARTEXT is enabled
+and the the output is displayed."
+ (interactive "r")
+ (let ((status (pgg-save-coding-system start end
+ (pgg-invoke "sign-region" (or pgg-scheme pgg-default-scheme)
+ (point-min) (point-max)
+ (or (interactive-p) cleartext)))))
+ (when (interactive-p)
+ (pgg-display-output-buffer start end status))
+ status))
+
+;;;###autoload
+(defun pgg-sign (&optional cleartext start end)
+ "Sign the current buffer.
+If the optional argument CLEARTEXT is non-nil, it does not create a
+detached signature.
+If optional arguments START and END are specified, only sign data
+within the region.
+If this function is called interactively, CLEARTEXT is enabled
+and the the output is displayed."
+ (interactive "")
+ (let* ((start (or start (point-min)))
+ (end (or end (point-max)))
+ (status (pgg-sign-region start end (or (interactive-p) cleartext))))
+ (when (interactive-p)
+ (pgg-display-output-buffer start end status))
+ status))
+
+;;;###autoload
+(defun pgg-verify-region (start end &optional signature fetch)
+ "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.
+
+If the optional 4th argument FETCH is non-nil, we attempt to fetch the
+signer's public key from `pgg-default-keyserver-address'."
+ (interactive "r")
+ (let* ((packet
+ (if (null signature) nil
+ (with-temp-buffer
+ (buffer-disable-undo)
+ (if (fboundp 'set-buffer-multibyte)
+ (set-buffer-multibyte nil))
+ (insert-file-contents signature)
+ (cdr (assq 2 (pgg-decode-armor-region
+ (point-min)(point-max)))))))
+ (key (cdr (assq 'key-identifier packet)))
+ status keyserver)
+ (and (stringp key)
+ pgg-query-keyserver
+ (setq key (concat "0x" (pgg-truncate-key-identifier key)))
+ (null (pgg-lookup-key key))
+ (or fetch (interactive-p))
+ (y-or-n-p (format "Key %s not found; attempt to fetch? " key))
+ (setq keyserver
+ (or (cdr (assq 'preferred-key-server packet))
+ pgg-default-keyserver-address))
+ (pgg-fetch-key keyserver key))
+ (setq status
+ (pgg-save-coding-system start end
+ (pgg-invoke "verify-region" (or pgg-scheme pgg-default-scheme)
+ (point-min) (point-max) signature)))
+ (when (interactive-p)
+ (let ((temp-buffer-show-function
+ (function pgg-temp-buffer-show-function)))
+ (with-output-to-temp-buffer pgg-echo-buffer
+ (set-buffer standard-output)
+ (insert-buffer-substring (if status pgg-output-buffer
+ pgg-errors-buffer)))))
+ status))
+
+;;;###autoload
+(defun pgg-verify (&optional signature fetch start end)
+ "Verify the current buffer.
+If the optional argument SIGNATURE is non-nil, it is treated as
+the detached signature of the current region.
+If the optional argument FETCH is non-nil, we attempt to fetch the
+signer's public key from `pgg-default-keyserver-address'.
+If optional arguments START and END are specified, only verify data
+within the region."
+ (interactive "")
+ (let* ((start (or start (point-min)))
+ (end (or end (point-max)))
+ (status (pgg-verify-region start end signature fetch)))
+ (when (interactive-p)
+ (let ((temp-buffer-show-function
+ (function pgg-temp-buffer-show-function)))
+ (with-output-to-temp-buffer pgg-echo-buffer
+ (set-buffer standard-output)
+ (insert-buffer-substring (if status pgg-output-buffer
+ pgg-errors-buffer)))))))
+
+;;;###autoload
+(defun pgg-insert-key ()
+ "Insert the ASCII armored public key."
+ (interactive)
+ (pgg-invoke "insert-key" (or pgg-scheme pgg-default-scheme)))
+
+;;;###autoload
+(defun pgg-snarf-keys-region (start end)
+ "Import public keys in the current region between START and END."
+ (interactive "r")
+ (pgg-save-coding-system start end
+ (pgg-invoke "snarf-keys-region" (or pgg-scheme pgg-default-scheme)
+ start end)))
+
+;;;###autoload
+(defun pgg-snarf-keys ()
+ "Import public keys in the current buffer."
+ (interactive "")
+ (pgg-snarf-keys-region (point-min) (point-max)))
+
+(defun pgg-lookup-key (string &optional type)
+ (pgg-invoke "lookup-key" (or pgg-scheme pgg-default-scheme) string type))
+
+(defvar pgg-insert-url-function (function pgg-insert-url-with-w3))
+
+(defun pgg-insert-url-with-w3 (url)
+ (ignore-errors
+ (require 'w3)
+ (require 'url)
+ (let (buffer-file-name)
+ (url-insert-file-contents url))))
+
+(defvar pgg-insert-url-extra-arguments nil)
+(defvar pgg-insert-url-program nil)
+
+(defun pgg-insert-url-with-program (url)
+ (let ((args (copy-sequence pgg-insert-url-extra-arguments))
+ process)
+ (insert
+ (with-temp-buffer
+ (setq process
+ (apply #'start-process " *PGG url*" (current-buffer)
+ pgg-insert-url-program (nconc args (list url))))
+ (set-process-sentinel process #'ignore)
+ (while (eq 'run (process-status process))
+ (accept-process-output process 5))
+ (delete-process process)
+ (if (and process (eq 'run (process-status process)))
+ (interrupt-process process))
+ (buffer-string)))))
+
+(defun pgg-fetch-key (keyserver key)
+ "Attempt to fetch a KEY from KEYSERVER for addition to PGP or GnuPG keyring."
+ (with-current-buffer (get-buffer-create pgg-output-buffer)
+ (buffer-disable-undo)
+ (erase-buffer)
+ (let ((proto (if (string-match "^[a-zA-Z\\+\\.\\\\-]+:" keyserver)
+ (substring keyserver 0 (1- (match-end 0))))))
+ (save-excursion
+ (funcall pgg-insert-url-function
+ (if proto keyserver
+ (format "http://%s:11371/pks/lookup?op=get&search=%s"
+ keyserver key))))
+ (when (re-search-forward "^-+BEGIN" nil 'last)
+ (delete-region (point-min) (match-beginning 0))
+ (when (re-search-forward "^-+END" nil t)
+ (delete-region (progn (end-of-line) (point))
+ (point-max)))
+ (insert "\n")
+ (with-temp-buffer
+ (insert-buffer-substring pgg-output-buffer)
+ (pgg-snarf-keys-region (point-min)(point-max)))))))
+
+
+(provide 'pgg)
+
+;;; pgg.el ends here
message
message-[0-9]*
sieve
+pgg
gnustmp.texi
*.dvi
*.dvi-x
old
thumb*
auto
+*.tpt
%% include file for the Gnus refcard and booklet
\def\progver{5.10}\def\refver{5.10-1} % program and refcard versions
-\def\date{Oct 13th, 2001}
+\def\date{Dec 15th, 2002}
\def\author{Gnus Bugfixing Girls + Boys $<$bugs@gnus.org$>$}
%%
\newcommand{\Notes}{%
\subsection*{Notes}
{\esamepage
- Gnus is complex. Currently it has some 346 interactive (user-callable)
- functions. Of these 279 are in the two major modes (Group and
+ Gnus is complex. Currently it has some 876 interactive (user-callable)
+ functions. Of these 618 are in the two major modes (Group and
Summary/Article). Many of these functions have more than one binding, some
- have 3 or even 4 bindings. The total number of keybindings is 389. So in
+ have 3 or even 4 bindings. The total number of keybindings is 677. So in
order to save 40\% space, every function is listed only once on this
\guide, under the ``more logical'' binding. Alternative bindings are given
in parentheses in the beginning of the description.
C-c C-i & Gnus online-manual ({\bf info}).\\
C-x C-t & {\bf Transpose} two groups.\\
H f & Fetch this group's {\bf FAQ} (using ange-ftp).\\
+ H c & Display this group's {\bf charter}. [Prefix: query for group]\\
+ H C & Display this group's {\bf control message} (using
+ ange-ftp). [Prefix: query for group]\\
H v & (V) Display the Gnus {\bf version} number.\\
H d & (C-c C-d) Show the {\bf description} of this group
[Prefix: re-read from server].\\
--- /dev/null
+\input texinfo @c -*-texinfo-*-
+
+@setfilename pgg.info
+
+@set VERSION 0.1
+
+@direntry
+* PGG: (pgg). Emacs interface to various PGP implementations.
+@end direntry
+
+@settitle PGG @value{VERSION}
+
+@ifinfo
+This file describes the PGG.
+
+Copyright (C) 2001 Daiki Ueno.
+
+Permission is granted to copy, distribute and/or modify this document
+under the terms of the GNU Free Documentation License, Version 1.1 or
+any later version published by the Free Software Foundation; with no
+Invariant Sections, with no Front-Cover Texts, and with no Back-Cover
+Texts. A copy of the license is included in the section entitled "GNU
+Free Documentation License".
+@end ifinfo
+
+@tex
+
+@titlepage
+@title PGG
+
+@author by Daiki Ueno
+@page
+
+@vskip 0pt plus 1filll
+Copyright @copyright{} 2001 Daiki Ueno.
+
+Permission is granted to copy, distribute and/or modify this document
+under the terms of the GNU Free Documentation License, Version 1.1 or
+any later version published by the Free Software Foundation; with no
+Invariant Sections, with no Front-Cover Texts, and with no Back-Cover
+Texts. A copy of the license is included in the section entitled "GNU
+Free Documentation License".
+@end titlepage
+@page
+
+@end tex
+
+@node Top
+@top PGG
+This manual describes PGG. PGG is an interface library between Emacs
+and various tools for secure communication. PGG also provides a simple
+user interface to encrypt, decrypt, sign, and verify MIME messages.
+
+@menu
+* Overview:: What PGG is.
+* Prerequisites:: Complicated stuff you may have to do.
+* How to use:: Getting started quickly.
+* Architecture::
+* Parsing OpenPGP packets::
+* Function Index::
+* Variable Index::
+@end menu
+
+@node Overview
+@chapter Overview
+
+PGG is an interface library between Emacs and various tools for secure
+communication. Even though Mailcrypt has similar feature, it does not
+deal with detached PGP messages, normally used in PGP/MIME
+infrastructure. This was the main reason why I wrote the new library.
+
+PGP/MIME is an application of MIME Object Security Services (RFC1848).
+The standard is documented in RFC2015.
+
+@node Prerequisites
+@chapter Prerequisites
+
+PGG requires at least one implementation of privacy guard system.
+This document assumes that you have already obtained and installed them
+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
+you should look over the GNU Privacy Handbook (GPH) which is available
+at @uref{http://www.gnupg.org/gph/}.
+
+@node How to use
+@chapter How to use
+
+The toplevel interface of this library is quite simple, and only
+intended to use with public-key cryptographic operation.
+
+To use PGG, evaluate following expression at the beginning of your
+application program.
+
+@lisp
+(require 'pgg)
+@end lisp
+
+If you want to check existence of pgg.el at runtime, instead you can
+list autoload setting for desired functions as follows.
+
+@lisp
+(autoload 'pgg-encrypt-region "pgg"
+ "Encrypt the current region." t)
+(autoload 'pgg-decrypt-region "pgg"
+ "Decrypt the current region." t)
+(autoload 'pgg-sign-region "pgg"
+ "Sign the current region." t)
+(autoload 'pgg-verify-region "pgg"
+ "Verify the current region." t)
+(autoload 'pgg-insert-key "pgg"
+ "Insert the ASCII armored public key." t)
+(autoload 'pgg-snarf-keys-region "pgg"
+ "Import public keys in the current region." t)
+@end lisp
+
+@menu
+* User Commands::
+* Selecting an implementation::
+* Caching passphrase::
+@end menu
+
+@node User Commands
+@section User Commands
+
+At this time you can use some cryptographic commands. The behavior of
+these commands relies on a fashion of invocation because they are also
+intended to be used as library functions. In case you don't have the
+signer's public key, for example, the function @code{pgg-verify-region}
+fails immediately, but if the function had been called interactively, it
+would ask you to retrieve the signer's public key from the server.
+
+@deffn Command pgg-encrypt-region start end recipients &optional sign
+Encrypt the current region between @var{start} and @var{end} for
+@var{recipients}. When the function were called interactively, you
+would be asked about the recipients.
+
+If encryption is successful, it replaces the current region contents (in
+the accessible portion) with the resulting data.
+
+If optional argument @var{sign} is non-nil, the function is request to
+do a combined sign and encrypt. This currently only work with GnuPG.
+@end deffn
+
+@deffn Command pgg-decrypt-region start end
+Decrypt the current region between @var{start} and @var{end}. If
+decryption is successful, it replaces the current region contents (in
+the accessible portion) with the resulting data.
+@end deffn
+
+@deffn Command pgg-sign-region start end &optional cleartext
+Make the signature from text between @var{start} and @var{end}. If the
+optional third argument @var{cleartext} is non-@code{nil}, or the
+function is called interactively, it does not create a detached
+signature. In such a case, it replaces the current region contents (in
+the accessible portion) with the resulting data.
+@end deffn
+
+@deffn Command pgg-verify-region start end &optional signature fetch
+Verify the current region between @var{start} and @var{end}. If the
+optional third argument @var{signature} is non-@code{nil}, or the function
+is called interactively, it is treated as the detached signature of the
+current region.
+
+If the optional 4th argument @var{fetch} is non-@code{nil}, or the
+function is called interactively, we attempt to fetch the signer's
+public key from the key server.
+@end deffn
+
+@deffn Command pgg-insert-key
+Retrieve the user's public key and insert it as ASCII-armored format.
+@end deffn
+
+@deffn Command pgg-snarf-keys-region start end
+Collect public keys in the current region between @var{start} and
+@var{end}, and add them into the user's keyring.
+@end deffn
+
+@node Selecting an implementation
+@section Selecting an implementation
+
+Since PGP has a long history and there are a number of PGP
+implementations available today, the function which each one has differs
+considerably. For example, if you are using GnuPG, you know you can
+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
+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
+control which command is used to process the incoming PGP armors. One
+is for encrypting and signing, the other is for decrypting and
+verifying.
+
+@defvar pgg-scheme
+Force specify the scheme of PGP implementation for decrypting and verifying.
+The value can be @code{gpg}, @code{pgp}, and @code{pgp5}.
+@end defvar
+
+@defvar pgg-default-scheme
+Force specify the scheme of PGP implementation for encrypting and signing.
+The value can be @code{gpg}, @code{pgp}, and @code{pgp5}.
+@end defvar
+
+@node Caching passphrase
+@section Caching passphrase
+
+PGG provides a simple passphrase caching mechanism. If you want to
+arrange the interaction, set the variable @var{pgg-read-passphrase}.
+
+@defvar pgg-cache-passphrase
+If non-@code{nil}, store passphrases. The default value of this
+variable is @code{t}. If you were worry about security issue, however,
+you could stop caching with setting it @code{nil}.
+@end defvar
+
+@defvar pgg-passphrase-cache-expiry
+Elapsed time for expiration in seconds.
+@end defvar
+
+@node Architecture
+@chapter Architecture
+
+PGG introduces the notion of a "scheme of PGP implementation" (used
+interchangeably with "scheme" in this document). This term refers to a
+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
+also for extensiblity. In this chapter we explore the architecture
+while finding out how to write the PGG backend.
+
+@menu
+* Initializing::
+* Backend methods::
+* Getting output::
+@end menu
+
+@node Initializing
+@section Initializing
+
+A scheme must be initialized before it is used.
+It had better guarantee to keep only one instance of a scheme.
+
+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.
+
+@lisp
+(defvar pgg-scheme-gpg-instance nil)
+
+(defun pgg-make-scheme-gpg ()
+ (or pgg-scheme-gpg-instance
+ (setq pgg-scheme-gpg-instance
+ (luna-make-entity 'pgg-scheme-gpg))))
+@end lisp
+
+The name of the function must follow the
+regulation---@code{pgg-make-scheme-} follows the backend name.
+
+@node Backend methods
+@section Backend methods
+
+In each backend, these methods must be present. The output of these
+methods is stored in special buffers (@ref{Getting output}), so that
+these methods must tell the status of the execution.
+
+@deffn Method pgg-scheme-lookup-key scheme string &optional type
+Return keys associated with @var{string}. If the optional third
+argument @var{type} is non-@code{nil}, it searches from the secret
+keyrings.
+@end deffn
+
+@deffn Method pgg-scheme-encrypt-region scheme start end recipients &optional sign
+Encrypt the current region between @var{start} and @var{end} for
+@var{recipients}. If @var{sign} is non-nil, do a combined sign and
+encrypt. If encryption is successful, it returns @code{t}, otherwise
+@code{nil}.
+@end deffn
+
+@deffn Method pgg-scheme-decrypt-region scheme start end
+Decrypt the current region between @var{start} and @var{end}. If
+decryption is successful, it returns @code{t}, otherwise @code{nil}.
+@end deffn
+
+@deffn Method pgg-scheme-sign-region scheme start end &optional cleartext
+Make the signature from text between @var{start} and @var{end}. If the
+optional third argument @var{cleartext} is non-@code{nil}, it does not
+create a detached signature. If signing is successful, it returns
+@code{t}, otherwise @code{nil}.
+@end deffn
+
+@deffn Method pgg-scheme-verify-region scheme start end &optional signature
+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}.
+@end deffn
+
+@deffn Method pgg-scheme-insert-key scheme
+Retrieve the user's public key and insert it as ASCII-armored format.
+On success, it returns @code{t}, otherwise @code{nil}.
+@end deffn
+
+@deffn Method pgg-scheme-snarf-keys-region scheme start end
+Collect public keys in the current region between @var{start} and
+@var{end}, and add them into the user's keyring.
+On success, it returns @code{t}, otherwise @code{nil}.
+@end deffn
+
+@node Getting output
+@section Getting output
+
+The output of the backend methods (@ref{Backend methods}) is stored in
+special buffers, so that these methods must tell the status of the
+execution.
+
+@defvar pgg-errors-buffer
+The standard error output of the execution of the PGP command is stored
+here.
+@end defvar
+
+@defvar pgg-output-buffer
+The standard output of the execution of the PGP command is stored here.
+@end defvar
+
+@defvar pgg-status-buffer
+The rest of status information of the execution of the PGP command is
+stored here.
+@end defvar
+
+@node Parsing OpenPGP packets
+@chapter Parsing OpenPGP packets
+
+The format of OpenPGP messages is maintained in order to publish all
+necessary information needed to develop interoperable applications.
+The standard is documented in RFC 2440.
+
+PGG has its own parser for the OpenPGP packets.
+
+@defun pgg-parse-armor string
+List the sequence of packets in @var{string}.
+@end defun
+
+@defun pgg-parse-armor-region start end
+List the sequence of packets in the current region between @var{start}
+and @var{end}.
+@end defun
+
+@defvar pgg-ignore-packet-checksum
+If non-@code{nil}, don't check the checksum of the packets.
+@end defvar
+
+@node Function Index
+@chapter Function Index
+@printindex fn
+
+@node Variable Index
+@chapter Variable Index
+@printindex vr
+
+@summarycontents
+@contents
+@bye
+
+@c End:
projects / elisp / gnus.git- / commitdiff