From 3d5268ef76aa2445593ad40e31708169e3cd2e5a Mon Sep 17 00:00:00 2001 From: Lars Magne Ingebrigtsen Date: Sun, 26 Sep 2010 05:18:25 +0200 Subject: [PATCH] Remove the unused gpg.el and gpg-ring.el files. --- contrib/ChangeLog | 4 + contrib/gpg-ring.el | 481 ---------------- contrib/gpg.el | 1339 ------------------------------------------- 3 files changed, 4 insertions(+), 1820 deletions(-) delete mode 100644 contrib/gpg-ring.el delete mode 100644 contrib/gpg.el diff --git a/contrib/ChangeLog b/contrib/ChangeLog index 52271d505..ec9cde174 100644 --- a/contrib/ChangeLog +++ b/contrib/ChangeLog @@ -1,3 +1,7 @@ +2010-09-26 Lars Magne Ingebrigtsen + + * gpg.el: Removed -- seems unused. + 2009-04-09 Richard M Stallman * sendmail.el (sendmail-send-it): Replace any diff --git a/contrib/gpg-ring.el b/contrib/gpg-ring.el deleted file mode 100644 index a534b5a45..000000000 --- a/contrib/gpg-ring.el +++ /dev/null @@ -1,481 +0,0 @@ -;;; gpg-ring.el --- Major mode for editing GnuPG key rings. - -;; Copyright (C) 2000 RUS-CERT, University Of Stuttgart - -;; Author: Florian Weimer -;; Maintainer: Florian Weimer -;; Keywords: crypto -;; Created: 2000-04-28 - -;; This file is NOT (yet?) part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, 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 GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - - - -;;; Code: - -(require 'gpg) -(eval-when-compile (require 'cl)) - -;;;; Customization: - -;;; Customization: Groups: - -(defgroup gpg-ring nil - "GNU Privacy Guard user interface." - :tag "GnuPG user interface" - :group 'gpg) - -;;; Customization: Variables: - -(defface gpg-ring-key-invalid-face - '((((class color)) - (:foreground "yellow" :background "red")) - (t (:bold t :italic t :underline t))) - "Face for strings indicating key invalidity." - :group 'gpg-ring) - -(defface gpg-ring-uncertain-validity-face - '((((class color)) (:foreground "red")) - (t (:bold t))) - "Face for strings indicating uncertain validity." - :group 'gpg-ring) - -(defface gpg-ring-full-validity-face - '((((class color)) (:foreground "ForestGreen" :bold t)) - (t (:bold t))) - "Face for strings indicating key invalidity." - :group 'gpg-ring) - -(defvar gpg-ring-mode-hook nil - "Normal hook run when entering GnuPG ring mode.") - -;;; Constants - -(defconst gpg-ring-algo-alist - '((rsa . "RSA") - (rsa-encrypt-only . "RSA-E") - (rsa-sign-only . "RSA-S") - (elgamal-encrypt-only . "ELG-E") - (dsa . "DSA") - (elgamal . "ELG-E")) - "Alist mapping algorithm IDs to algorithm abbreviations.") - -(defconst gpg-ring-trust-alist - '((not-known "???" gpg-ring-uncertain-validity-face) - (disabled "DIS" gpg-ring-key-invalid-face) - (revoked "REV" gpg-ring-key-invalid-face) - (expired "EXP" gpg-ring-key-invalid-face) - (trust-undefined "QES" gpg-ring-uncertain-validity-face) - (trust-none "NON" gpg-ring-uncertain-validity-face) - (trust-marginal "MAR") - (trust-full "FUL" gpg-ring-full-validity-face) - (trust-ultimate "ULT" gpg-ring-full-validity-face)) - "Alist mapping trust IDs to trust abbrevs and faces.") - -(defvar gpg-ring-mode-map - (let ((map (make-keymap))) - (suppress-keymap map t) - map) - "Keymap for `gpg-ring-mode'.") - -(define-key gpg-ring-mode-map "0" 'delete-window) -(define-key gpg-ring-mode-map "1" 'delete-other-windows) -(define-key gpg-ring-mode-map "M" 'gpg-ring-mark-process-all) -(define-key gpg-ring-mode-map "U" 'gpg-ring-unmark-all) -(define-key gpg-ring-mode-map "a" 'gpg-ring-toggle-show-unusable) -(define-key gpg-ring-mode-map "d" 'gpg-ring-mark-delete) -(define-key gpg-ring-mode-map "f" 'gpg-ring-update-key) -(define-key gpg-ring-mode-map "g" 'gpg-ring-update) -(define-key gpg-ring-mode-map "i" 'gpg-ring-show-key) -(define-key gpg-ring-mode-map "l" 'gpg-ring-toggle-show-all-ids) -(define-key gpg-ring-mode-map "m" 'gpg-ring-mark-process) -(define-key gpg-ring-mode-map "n" 'gpg-ring-next-record) -(define-key gpg-ring-mode-map "p" 'gpg-ring-previous-record) -(define-key gpg-ring-mode-map "q" 'gpg-ring-quit) -(define-key gpg-ring-mode-map "u" 'gpg-ring-unmark) -(define-key gpg-ring-mode-map "x" 'gpg-ring-extract-keys) -(define-key gpg-ring-mode-map "X" 'gpg-ring-extract-keys-to-kill) - -(define-key gpg-ring-mode-map "\C-c\C-c" 'gpg-ring-action) - -;;; Internal functions: - -(defvar gpg-ring-key-list - nil - "List of keys in the key list buffer.") -(make-variable-buffer-local 'gpg-ring-key-list) - -(defvar gpg-ring-update-funcs - nil - "List of functions called to obtain the key list.") -(make-variable-buffer-local 'gpg-ring-update-funcs) - -(defvar gpg-ring-show-unusable - nil - "If t, show expired, revoked and disabled keys, too.") -(make-variable-buffer-local 'gpg-ring-show-unusable) - -(defvar gpg-ring-show-all-ids - nil - "If t, show all user IDs. If nil, show only the primary user ID.") -(make-variable-buffer-local 'gpg-ring-show-all-ids) - -(defvar gpg-ring-marks-alist - nil - "Alist of (UNIQUE-ID MARK KEY). -UNIQUE-ID is a unique key ID from GnuPG. MARK is either `?D' -(marked for deletion), or `?*' (marked for processing).") -(make-variable-buffer-local 'gpg-ring-marks-alist) - -(defvar gpg-ring-action - nil - "Function to call when `gpg-ring-action' is invoked. -A list of the keys which are marked for processing is passed as argument.") -(make-variable-buffer-local 'gpg-ring-action) - -(defun gpg-ring-mode () - "Mode for editing GnuPG key rings. -\\{gpg-ring-mode-map} -Turning on gpg-ring-mode runs `gpg-ring-mode-hook'." - (interactive) - (kill-all-local-variables) - (buffer-disable-undo) - (setq truncate-lines t) - (setq buffer-read-only t) - (use-local-map gpg-ring-mode-map) - (setq mode-name "Key Ring") - (setq major-mode 'gpg-ring-mode) - (run-hooks 'gpg-ring-mode-hook)) - - -(defmacro gpg-ring-record-start (&optional pos) - "Return buffer position of start of record containing POS." - `(get-text-property (or ,pos (point)) 'gpg-record-start)) - -(defun gpg-ring-current-key (&optional pos) - "Return GnuPG key at POS, or at point if ommitted." - (or (get-text-property (or pos (point)) 'gpg-key) - (error "No record on current line"))) - -(defun gpg-ring-goto-record (pos) - "Go to record starting at POS. -Position point after the marks at the beginning of a record." - (goto-char pos) - (forward-char 2)) - -(defun gpg-ring-next-record () - "Advances point to the start of the next record." - (interactive) - (let ((start (next-single-property-change - (point) 'gpg-record-start nil (point-max)))) - ;; Don't advance to the last line of the buffer. - (when (/= start (point-max)) - (gpg-ring-goto-record start)))) - -(defun gpg-ring-previous-record () - "Advances point to the start of the previous record." - (interactive) - ;; The last line of the buffer doesn't contain a record. - (let ((start (gpg-ring-record-start))) - (if start - (gpg-ring-goto-record (previous-single-property-change - start 'gpg-record-start nil (point-min))) - (gpg-ring-goto-record - (gpg-ring-record-start (1- (point-max))))))) - -(defun gpg-ring-set-mark (&optional pos mark) - "Set MARK on record at POS, or at point if POS is omitted. -If MARK is omitted, clear it." - (save-excursion - (let* ((start (gpg-ring-record-start pos)) - (key (gpg-ring-current-key start)) - (id (gpg-key-unique-id key)) - (entry (assoc id gpg-ring-marks-alist)) - buffer-read-only) - (goto-char start) - ;; Replace the mark character. - (subst-char-in-region (point) (1+ (point)) (char-after) - (or mark ? )) - ;; Store the mark in alist. - (if entry - (setcdr entry (if mark (list mark key))) - (when mark - (push (list id mark key) gpg-ring-marks-alist)))))) - -(defun gpg-ring-marked-keys (&optional only-marked mark) - "Return list of key specs which have MARK. -If no marks are present and ONLY-MARKED is not nil, return singleton -list with key of the current record. If MARK is omitted, `?*' is -used." - (let ((the-marker (or mark ?*)) - (marks gpg-ring-marks-alist) - key-list) - (while marks - (let ((mark (pop marks))) - ;; If this entry has got the right mark ... - (when (equal (nth 1 mark) the-marker) - ;; ... rember the key spec. - (push (nth 2 mark) key-list)))) - (or key-list (if (not only-marked) (list (gpg-ring-current-key)))))) - -(defun gpg-ring-mark-process () - "Mark record at point for processing." - (interactive) - (gpg-ring-set-mark nil ?*) - (gpg-ring-next-record)) - -(defun gpg-ring-mark-delete () - "Mark record at point for processing." - (interactive) - (gpg-ring-set-mark nil ?D) - (gpg-ring-next-record)) - -(defun gpg-ring-unmark () - "Mark record at point for processing." - (interactive) - (gpg-ring-set-mark) - (gpg-ring-next-record)) - -(defun gpg-ring-mark-process-all () - "Put process mark on all records." - (interactive) - (setq gpg-ring-marks-alist - (mapcar (lambda (key) - (list (gpg-key-unique-id key) ?* key)) - gpg-ring-key-list)) - (gpg-ring-regenerate)) - -(defun gpg-ring-unmark-all () - "Remove all record marks." - (interactive) - (setq gpg-ring-marks-alist nil) - (gpg-ring-regenerate)) - -(defun gpg-ring-toggle-show-unusable () - "Toggle value if `gpg-ring-show-unusable'." - (interactive) - (setq gpg-ring-show-unusable (not gpg-ring-show-unusable)) - (gpg-ring-regenerate)) - -(defun gpg-ring-toggle-show-all-ids () - "Toggle value of `gpg-ring-show-all-ids'." - (interactive) - (setq gpg-ring-show-all-ids (not gpg-ring-show-all-ids)) - (gpg-ring-regenerate)) - -(defvar gpg-ring-output-buffer-name "*GnuPG Output*" - "Name buffer to which output from GnuPG is sent.") - -(defmacro gpg-ring-with-output-buffer (&rest body) - "Erase GnuPG output buffer, evaluate BODY in it, and display it." - `(with-current-buffer (get-buffer-create gpg-ring-output-buffer-name) - (erase-buffer) - (setq truncate-lines t) - ,@body - (goto-char (point-min)) - (display-buffer gpg-ring-output-buffer-name))) - -(defun gpg-ring-quit () - "Bury key list buffer and kill GnuPG output buffer." - (interactive) - (let ((output (get-buffer gpg-ring-output-buffer-name))) - (when output - (kill-buffer output))) - (when (eq 'gpg-ring-mode major-mode) - (bury-buffer))) - -(defun gpg-ring-show-key () - "Show information for current key." - (interactive) - (let ((keys (gpg-ring-marked-keys))) - (gpg-ring-with-output-buffer - (gpg-key-insert-information (gpg-key-unique-id-list keys))))) - -(defun gpg-ring-extract-keys () - "Export currently selected public keys in ASCII armor." - (interactive) - (let ((keys (gpg-ring-marked-keys))) - (gpg-ring-with-output-buffer - (gpg-key-insert-public-key (gpg-key-unique-id-list keys))))) - -(defun gpg-ring-extract-keys-to-kill () - "Export currently selected public keys in ASCII armor to kill ring." - (interactive) - (let ((keys (gpg-ring-marked-keys))) - (with-temp-buffer - (gpg-key-insert-public-key (gpg-key-unique-id-list keys)) - (copy-region-as-kill (point-min) (point-max))))) - -(defun gpg-ring-update-key () - "Fetch key information from key server." - (interactive) - (let ((keys (gpg-ring-marked-keys))) - (gpg-ring-with-output-buffer - (gpg-key-retrieve (gpg-key-unique-id-list keys))))) - -(defun gpg-ring-insert-key-stat (key) - (let* ((validity (gpg-key-validity key)) - (validity-entry (assq validity gpg-ring-trust-alist)) - (trust (gpg-key-trust key)) - (trust-entry (assq trust gpg-ring-trust-alist))) - ;; Insert abbrev for key status. - (let ((start (point))) - (insert (nth 1 validity-entry)) - ;; Change face if necessary. - (when (nth 2 validity-entry) - (add-text-properties start (point) - (list 'face (nth 2 validity-entry))))) - ;; Trust, key ID, length, algorithm, creation date. - (insert (format "/%s %-8s/%4d/%-5s created %s" - (nth 1 trust-entry) - (gpg-short-key-id key) - (gpg-key-length key) - (cdr (assq (gpg-key-algorithm key) gpg-ring-algo-alist)) - (gpg-key-creation-date key))) - ;; Expire date. - (when (gpg-key-expire-date key) - (insert ", ") - (let ((start (point)) - (expired (eq 'expired validity)) - (notice (concat ))) - (insert (if expired "EXPIRED" "expires") - " " (gpg-key-expire-date key)) - (when expired - (add-text-properties start (point) - '(face gpg-ring-key-invalid-face))))))) - -(defun gpg-ring-insert-key (key &optional mark) - "Inserts description for KEY into current buffer before point." - (let ((start (point))) - (insert (if mark mark " ") - " " (gpg-key-primary-user-id key) "\n" - " ") - (gpg-ring-insert-key-stat key) - (insert "\n") - (when gpg-ring-show-all-ids - (let ((uids (gpg-key-user-ids key))) - (while uids - (insert " ID " (pop uids) "\n")))) - (add-text-properties start (point) - (list 'gpg-record-start start - 'gpg-key key)))) - -(defun gpg-ring-regenerate () - "Regenerate the key list buffer from stored data." - (interactive) - (let* ((key-list gpg-ring-key-list) - ;; Record position of point. - (old-record (if (eobp) ; No record on last line. - nil - (gpg-key-unique-id (gpg-ring-current-key)))) - (old-pos (if old-record (- (point) (gpg-ring-record-start)))) - found new-pos new-pos-offset buffer-read-only new-marks) - ;; Replace buffer contents with new data. - (erase-buffer) - (while key-list - (let* ((key (pop key-list)) - (id (gpg-key-unique-id key)) - (mark (assoc id gpg-ring-marks-alist))) - (when (or gpg-ring-show-unusable - (not (memq (gpg-key-validity key) - '(disabled revoked expired)))) - ;; Check if point was in this record. - (when (and old-record - (string-equal old-record id)) - (setq new-pos (point)) - (setq new-pos-offset (+ new-pos old-pos))) - ;; Check if this record was marked. - (if (nth 1 mark) - (progn - (push mark new-marks) - (gpg-ring-insert-key key (nth 1 mark))) - (gpg-ring-insert-key key))))) - ;; Replace mark alist with the new one (which does not contain - ;; marks for records which vanished during this update). - (setq gpg-ring-marks-alist new-marks) - ;; Restore point. - (if (not old-record) - ;; We were at the end of the buffer before. - (goto-char (point-max)) - (if new-pos - (if (and (< new-pos-offset (point-max)) - (equal old-record (gpg-key-unique-id - (gpg-ring-current-key new-pos-offset)))) - ;; Record is there, with offset. - (goto-char new-pos-offset) - ;; Record is there, but not offset. - (goto-char new-pos)) - ;; Record is not there. - (goto-char (point-min)))))) - -(defun gpg-ring-update () - "Update the key list buffer with new data." - (interactive) - (let ((funcs gpg-ring-update-funcs) - old) - ;; Merge the sorted lists obtained by calling elements of - ;; `gpg-ring-update-funcs'. - (while funcs - (let ((additional (funcall (pop funcs))) - new) - (while (and additional old) - (if (gpg-key-lessp (car additional) (car old)) - (push (pop additional) new) - (if (gpg-key-lessp (car old) (car additional)) - (push (pop old) new) - ;; Keys are perhaps equal. Always Add old key. - (push (pop old) new) - ;; If new key is equal, drop it, otherwise add it as well. - (if (string-equal (gpg-key-unique-id (car old)) - (gpg-key-unique-id (car additional))) - (pop additional) - (push (pop additional) new))))) - ;; Store new list as old one for next round. - (setq old (nconc (nreverse new) old additional)))) - ;; Store the list in the buffer. - (setq gpg-ring-key-list old)) - (gpg-ring-regenerate)) - -(defun gpg-ring-action () - "Perform the action associated with this buffer." - (interactive) - (if gpg-ring-action - (funcall gpg-ring-action (gpg-ring-marked-keys)) - (error "No action for this buffer specified"))) - -;;;###autoload -(defun gpg-ring-keys (&optional key-list-funcs action) - (interactive) - (let ((buffer (get-buffer-create "*GnuPG Key List*"))) - (with-current-buffer buffer - (gpg-ring-mode) - (setq gpg-ring-action action) - (setq gpg-ring-update-funcs key-list-funcs key-list-funcs) - (gpg-ring-update) - (goto-char (point-min))) - (switch-to-buffer buffer))) - -;;;###autoload -(defun gpg-ring-public (key-spec) - "List public keys matching keys KEY-SPEC." - (interactive "sList public keys containing: ") - (gpg-ring-keys `((lambda () (gpg-key-list-keys ,key-spec))))) - -(provide 'gpg-ring) - -;;; gpg-ring.el ends here diff --git a/contrib/gpg.el b/contrib/gpg.el deleted file mode 100644 index e629c20d7..000000000 --- a/contrib/gpg.el +++ /dev/null @@ -1,1339 +0,0 @@ -;;; gpg.el --- Interface to GNU Privacy Guard - -;; Copyright (C) 2000 RUS-CERT, University Of Stuttgart - -;; Author: Florian Weimer -;; Maintainer: Florian Weimer -;; Keywords: crypto -;; Created: 2000-04-15 - -;; This file is NOT (yet?) part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, 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 GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;; ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA -;; ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA -;; -;; This code is not well-tested. BE CAREFUL! -;; -;; ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA -;; ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA - -;; Implemented features which can be tested: -;; -;; * Customization for all flavors of PGP is possible. -;; * The main operations (verify, decrypt, sign, encrypt, sign & -;; encrypt) are implemented. -;; * Optionally, Gero Treuner's gpg-2comp script is supported, -;; to generate data which is compatible with PGP 2.6.3. - -;; Customizing external programs -;; ============================= - -;; The customization are very similar to those of others programs, -;; only the C-ish "%" constructs have been replaced by more Lisp-like -;; syntax. -;; -;; First, you have to adjust the default executable paths -;; (`gpg-command-default-alist', customization group `gpg-options', -;; "Controlling GnuPG invocation."). After that, you should -;; change the configuration options which control how specific -;; command line flags are built (`gpg-command-flag-sign-with-key', -;; (`gpg-command-flag-recipient'). The elements of these lists are -;; concatenated without spaces, and a new argument is only started -;; where indicated. The `gpg-command-flag-recipient' list is special: -;; it consists of two parts, the first one remains at the beginning -;; of the argument, the second one is repeated for each recipient. -;; Finally, `gpg-command-passphrase-env' has to be changed if there's -;; no command line flag to force the external program to read the data -;; from standard input before the message. -;; -;; In customization group `gpg-commands', "Controlling GnuPG -;; invocation.", you have to supply the actual syntax for external -;; program calls. Each variable consists of a pair of a program -;; specification (if a Lisp symbol is given here, it is translated -;; via `gpg-command-default-alist') and a list of program arguments -;; with placeholders. Please read the documentation of each variable -;; before making your adjustments and try to match the given -;; requirements as closely as possible! -;; -;; The `gpg-commands-key' group, "GnuPG Key Management Commands.", -;; specifies key management commands. The syntax of these variables -;; is like those in the `gpg-commands' group. Note that the output -;; format of some of these external programs has to match very close -;; that of GnuPG. Additional tools (Thomas Roessler's "pgpring.c") -;; are available if your favorite implementation of OpenPGP cannot -;; output the this format. - -;; Security considerations -;; ======================= - -;; On a typical multiuser UNIX system, the memory image of the -;; Emacs process is not locked, therefore it can be swapped to disk -;; at any time. As a result, the passphrase might show up in the -;; swap space (even if you don't use the passphrase cache, i.e. if -;; `gpg-passphrase-timeout' is 0). If someone is able to run `gdb' or -;; another debugger on your Emacs process, he might be able to recover -;; the passphrase as well. Unfortunately, nothing can be done in -;; order to prevent this at the moment. -;; -;; BE CAREFUL: If you use the passphrase cache feature, the passphrase -;; is stored in the variable `gpg-passphrase' -- and it is NOT -;; encrypted in any way. (This is a conceptual problem because the -;; nature of the passphrase cache requires that Emacs is able to -;; decrypt automatically, so only a very weak protection could be -;; applied anyway.) -;; -;; In addition, if you use an unpatched Emacs 20 (and earlier -;; versions), passwords show up in the output of the `view-lossage' -;; function (bound to `C-h l' by default). - - -;;; Code: - -(if (featurep 'xemacs) - (require 'timer-funcs) - (require 'timer)) -(eval-when-compile (require 'cl)) - -(eval-and-compile - (defalias 'gpg-point-at-eol - (if (fboundp 'point-at-eol) - 'point-at-eol - 'line-end-position))) - -;; itimer/timer compatibility -(eval-and-compile - (if (featurep 'xemacs) - (progn - (defalias 'gpg-cancel-timer 'delete-itimer) - (defalias 'gpg-timer-activate 'activate-itimer) - (defalias 'gpg-timer-create 'make-itimer) - (defalias 'gpg-timer-set-function 'set-itimer-function) - (defalias 'gpg-timer-set-time 'set-itimer-value)) - (defalias 'gpg-cancel-timer 'cancel-timer) - (defalias 'gpg-timer-activate 'timer-activate) - (defalias 'gpg-timer-create 'timer-create) - (defalias 'gpg-timer-set-function 'timer-set-function) - (defalias 'gpg-timer-set-time 'timer-set-time))) - -;;;; Customization: - -;;; Customization: Groups: - -(defgroup gpg nil - "GNU Privacy Guard interface." - :tag "GnuPG" - :group 'processes) - -(defgroup gpg-options nil - "Controlling GnuPG invocation." - :tag "GnuPG Options" - :group 'gpg) - -(defgroup gpg-commands nil - "Primary GnuPG Operations." - :tag "GnuPG Commands" - :group 'gpg) - -(defgroup gpg-commands-key nil - "Commands for GnuPG key management." - :tag "GnuPG Key Commands" - :group 'gpg-commands) - -;;; Customization: Widgets: - -(if (get 'alist 'widget-type) - (define-widget 'gpg-command-alist 'alist - "An association list for GnuPG command names." - :key-type '(symbol :tag "Abbreviation") - :value-type '(string :tag "Program name") - :convert-widget 'widget-alist-convert-widget - :tag "Alist") - (define-widget 'gpg-command-alist 'repeat - "An association list for GnuPG command names." - :args '((cons :format "%v" - (symbol :tag "Abbreviation") - (string :tag "Program name"))) - :tag "Alist")) - -(define-widget 'gpg-command-program 'choice - "Widget for entering the name of a program (mostly the GnuPG binary)." - :tag "Program" - :args '((const :tag "Default GnuPG program." - :value gpg) - (const :tag "GnuPG compatibility wrapper." - :value gpg-2comp) - (const :tag "Disabled" - :value nil) - (string :tag "Custom program" :format "%v"))) - -(define-widget 'gpg-command-sign-options 'cons - "Widget for entering signing options." - :args '(gpg-command-program - (repeat - :tag "Arguments" - (choice - :format "%[Type%] %v" - (const :tag "Insert armor option here if necessary." - :value armor) - (const :tag "Insert text mode option here if necessary." - :value textmode) - (const :tag "Insert the sign with key option here if necessary." - :value sign-with-key) - (string :format "%v"))))) - -(define-widget 'gpg-command-key-options 'cons - "Widget for entering key command options." - :args '(gpg-command-program - (repeat - :tag "Arguments" - (choice - :format "%[Type%] %v" - (const :tag "Insert key ID here." - :value key-id) - (string :format "%v"))))) - -;;; Customization: Variables: - -;;; Customization: Variables: Paths and Flags: - -(defcustom gpg-passphrase-timeout - 0 - "Timeout (in seconds) for the passphrase cache. -The passphrase cache is cleared after is hasn't been used for this -many seconds. The values 0 means that the passphrase is not cached at -all." - :tag "Passphrase Timeout" - :type 'number - :group 'gpg-options) - -(defcustom gpg-default-key-id - nil - "Default key/user ID used for signatures." - :tag "Default Key ID" - :type '(choice - (const :tag "Use GnuPG default." :value nil) - (string)) - :group 'gpg-options) - -(defcustom gpg-temp-directory - (expand-file-name "~/tmp") - "Directory for temporary files. -If you are running Emacs 20, this directory must have mode 0700." - :tag "Temp directory" - :type 'string - :group 'gpg-options) - -(defcustom gpg-command-default-alist - '((gpg . "gpg") - (gpg-2comp . "gpg")) - "Default paths for some GnuPG-related programs. -Modify this variable if you have to change the paths to the -executables required by the GnuPG interface. You can enter \"gpg-2comp\" -for `gpg-2comp' if you have obtained this script, in order to gain -PGP 2.6.x compatibility." - :tag "GnuPG programs" - :type 'gpg-command-alist - :group 'gpg-options) - -(defcustom gpg-command-all-arglist - nil - "List of arguments to add to all GPG commands." - :tag "All command args" - :group 'gpg-options) - -(defcustom gpg-command-flag-textmode "--textmode" - "The flag to indicate canonical text mode to GnuPG." - :tag "Text mode flag" - :type 'string - :group 'gpg-options) - -(defcustom gpg-command-flag-armor "--armor" - "The flag to request ASCII-armoring output from GnuPG." - :tag "Armor flag" - :type 'string - :group 'gpg-options) - -(defcustom gpg-command-flag-sign-with-key '("--local-user=" sign-with-key) - "String to include to specify the signing key ID. -The elements are concatenated (without spaces) to form a command line -option." - :tag "Sign with key flag" - :type '(repeat :tag "Argument parts" - (choice :format "%[Type%] %v" - (const :tag "Start next argument." :value next-argument) - (const :tag "Insert signing key ID here." :value sign-with-key) - (string))) - :group 'gpg-options) - -(defcustom gpg-command-flag-recipient - '(nil . ("-r" next-argument recipient next-argument)) - "Format of a recipient specification. -The elements are concatenated (without spaces) to form a command line -option. The second part is repeated for each recipient." - :tag "Recipients Flag" - :type '(cons - (repeat :tag "Common prefix" - (choice :format "%[Type%] %v" - (const :tag "Start next argument." :value next-argument) - (string))) - (repeat :tag "For each recipient" - (choice :format "%[Type%] %v" - (const :tag "Start next argument." :value next-argument) - (const :tag "Insert recipient key ID here." :value recipient) - (string)))) - :group 'gpg-options) - -(defcustom gpg-command-passphrase-env - nil - "Environment variable to set when a passphrase is required, or nil. -If an operation is invoked which requires a passphrase, this -environment variable is set before calling the external program to -indicate that it should read the passphrase from standard input." - :tag "Passphrase environment" - :type '(choice - (const :tag "Disabled" :value nil) - (cons - (string :tag "Variable") - (string :tag "Value"))) - :group 'gpg-options) - -;;; Customization: Variables: GnuPG Commands: - -(defcustom gpg-command-verify - '(gpg . ("--status-fd" "1" "--batch" "--verbose" "--verify" signature-file message-file)) - "Command to verify a detached signature. -The invoked program has to read the signed message and the signature -from the given files. It should write human-readable information to -standard output and/or standard error. The program shall not convert -charsets or line endings; the input data shall be treated as binary." - :tag "Verify Command" - :type '(cons - gpg-command-program - (repeat - :tag "Arguments" - (choice - :format "%[Type%] %v" - (const :tag "Insert name of file containing the message here." - :value message-file) - (const :tag "Insert name of file containing the signature here." - :value signature-file) - (string :format "%v")))) - :group 'gpg-commands) - -(defcustom gpg-command-verify-cleartext - '(gpg . ("--status-fd" "1" "--batch" "--verbose" "--verify" message-file)) - "Command to verify a message. -The invoked program has to read the signed message from the given -file. It should write human-readable information to standard output -and/or standard error. The program shall not convert charsets or line -endings; the input data shall be treated as binary." - :tag "Cleartext Verify Command" - :type '(cons - gpg-command-program - (repeat - :tag "Arguments" - (choice - :format "%[Type%] %v" - (const :tag "Insert name of file containing the message here." - :value message-file) - (string :format "%v")))) - :group 'gpg-commands) - -(defcustom gpg-command-decrypt - '(gpg . ("--status-fd" "2" "--decrypt" "--batch" "--passphrase-fd=0")) - "Command to decrypt a message. -The invoked program has to read the passphrase from standard -input, followed by the encrypted message. It writes the decrypted -message to standard output, and human-readable diagnostic messages to -standard error." - :tag "Decrypt Command" - :type '(cons - gpg-command-program - (repeat - :tag "Arguments" - (choice - :format "%[Type%] %v" - (const :tag "Insert name of file containing the message here." - :value message-file) - (string :format "%v")))) - :group 'gpg-commands) - -(defcustom gpg-command-sign-cleartext - '(gpg-2comp . ("--batch" "--passphrase-fd=0" "--output=-" - armor textmode "--clearsign" - sign-with-key)) - "Command to create a \"clearsign\" text file. -The invoked program has to read the passphrase from standard input, -followed by the message to sign. It should write the ASCII-amored -signed text message to standard output, and diagnostic messages to -standard error." - :tag "Clearsign Command" - :type 'gpg-command-sign-options - :group 'gpg-commands) - -(defcustom gpg-command-sign-detached - '(gpg-2comp . ("--batch" "--passphrase-fd=0" "--output=-" - armor textmode "--detach-sign" - sign-with-key)) - "Command to create a detached signature. -The invoked program has to read the passphrase from standard input, -followed by the message to sign. It should write the ASCII-amored -detached signature to standard output, and diagnostic messages to -standard error. The program shall not convert charsets or line -endings; the input data shall be treated as binary." - :tag "Sign Detached Command" - :type 'gpg-command-sign-options - :group 'gpg-commands) - -(defcustom gpg-command-sign-encrypt - '(gpg-2comp . ("--batch" "--passphrase-fd=0" "--output=-" - armor textmode "--always-trust" sign-with-key recipients - "--sign" "--encrypt" plaintext-file)) - "Command to sign and encrypt a file. -The invoked program has to read the passphrase from standard input, -followed by the message to sign and encrypt if there is no -`plaintext-file' placeholder. It should write the ASCII-amored -encrypted message to standard output, and diagnostic messages to -standard error." - :tag "Sign And Encrypt Command" - :type '(cons - gpg-command-program - (repeat - :tag "Arguments" - (choice - :format "%[Type%] %v" - (const :tag "Insert the `sign with key' option here if necessary." - :value sign-with-key) - (const :tag "Insert list of recipients here." - :value recipients) - (const :tag "Insert here name of file with plaintext." - :value plaintext-file) - (string :format "%v")))) - :group 'gpg-commands) - -(defcustom gpg-command-encrypt - '(gpg-2comp . ("--batch" "--output=-" armor textmode "--always-trust" - "--encrypt" recipients plaintext-file)) - "Command to encrypt a file. -The invoked program has to read the message to encrypt from standard -input or from the plaintext file (if the `plaintext-file' placeholder -is present). It should write the ASCII-amored encrypted message to -standard output, and diagnostic messages to standard error." - :type '(cons - gpg-command-program - (repeat - :tag "Arguments" - (choice - :format "%[Type%] %v" - (const :tag "Insert list of recipients here." - :value recipients) - (const :tag "Insert here name of file with plaintext." - :value plaintext-file) - (string :format "%v")))) - :group 'gpg-commands) - -;;; Customization: Variables: Key Management Commands: - -(defcustom gpg-command-key-import - '(gpg . ("--import" "--verbose" message-file)) - "Command to import a public key from a file." - :tag "Import Command" - :type '(cons - gpg-command-program - (repeat - :tag "Arguments" - (choice - :format "%[Type%] %v" - (const :tag "Insert name of file containing the key here." - :value message-file) - (string :format "%v")))) - :group 'gpg-commands-key) - -(defcustom gpg-command-key-export - '(gpg . ("--no-verbose" "--armor" "--export" key-id)) - "Command to export a public key from the key ring. -The key should be written to standard output using ASCII armor." - :tag "Export Command" - :type 'gpg-command-key-options - :group 'gpg-commands-key) - -(defcustom gpg-command-key-verify - '(gpg . ("--no-verbose" "--batch" "--fingerprint" "--check-sigs" key-id)) - "Command to verify a public key." - :tag "Verification Command" - :type 'gpg-command-key-options - :group 'gpg-commands-key) - -(defcustom gpg-command-key-public-ring - '(gpg . ("--no-verbose" "--batch" "--with-colons" "--list-keys" key-id)) - "Command to list the contents of the public key ring." - :tag "List Public Key Ring Command" - :type 'gpg-command-key-options - :group 'gpg-commands-key) - -(defcustom gpg-command-key-secret-ring - '(gpg . ("--no-verbose" "--batch" "--with-colons" - "--list-secret-keys" key-id)) - "Command to list the contents of the secret key ring." - :tag "List Secret Key Ring Command" - :type 'gpg-command-key-options - :group 'gpg-commands-key) - -(defcustom gpg-command-key-retrieve - '(gpg . ("--batch" "--recv-keys" key-id)) - "Command to retrieve public keys." - :tag "Retrieve Keys Command" - :type 'gpg-command-key-options - :group 'gpg-commands-key) - - -;;;; Helper functions for GnuPG invocation: - -;;; Build the GnuPG command line: - -(defun gpg-build-argument (template substitutions &optional pass-start) - "Build command line argument(s) by substituting placeholders. -TEMPLATE is a list of strings and symbols. The placeholder symbols in -it are replaced by SUBSTITUTIONS, the elements between -`next-argument' symbols are concatenated without spaces and are -returned in a list. - -SUBSTITIONS is a list of (SYMBOL . SEXP) pairs, where SEXP is either -a string (which is inserted literally), a list of strings (which are -inserted as well), or nil, which means to insert nothing. - -If PASS-START is t, `next-argument' is also inserted into the result, -and symbols without a proper substitution are retained in the output, -otherwise, an untranslated symbol results in an error. - -This function does not handle empty arguments reliably." - (let ((current-arg "") - (arglist nil)) - (while template - (let* ((templ (pop template)) - (repl (assoc templ substitutions)) - (new (if repl (cdr repl) templ))) - (cond - ((eq templ 'next-argument) - ;; If the current argument is not empty, start a new one. - (unless (equal current-arg "") - (setq arglist (nconc arglist - (if pass-start - (list current-arg 'next-argument) - (list current-arg)))) - (setq current-arg ""))) - ((null new) nil) ; Drop it. - ((and (not (stringp templ)) (null repl)) - ;; Retain an untranslated symbol in the output if - ;; `pass-start' is true. - (unless pass-start - (error "No replacement for `%s'" templ)) - (setq arglist (nconc arglist (list current-arg templ))) - (setq current-arg "")) - (t - (unless (listp new) - (setq new (list new))) - (setq current-arg (concat current-arg - (apply 'concat new))))))) - (unless (equal current-arg "") - (setq arglist (nconc arglist (list current-arg)))) - arglist)) - -(defun gpg-build-arg-list (template substitutions) - "Build command line by substituting placeholders. -TEMPLATE is a list of strings and symbols. The placeholder symbols in -it are replaced by SUBSTITUTIONS. - -SUBSTITIONS is a list of (SYMBOL . SEXP) pairs, where SEXP is either a -string (which is inserted literally), a list of strings (which are -inserted as well), or nil, which means to insert nothing." - (let ((arglist (copy-sequence gpg-command-all-arglist))) - (while template - (let* ((templ (pop template)) - (repl (assoc templ substitutions)) - (new (if repl (cdr repl) templ))) - (cond - ((and (symbolp templ) (null repl)) - (error "No replacement for `%s'" templ)) - ((null new) nil) ; Drop it. - (t - (unless (listp new) - (setq new (list new))) - (setq arglist (nconc arglist new)))))) - arglist)) - -(defun gpg-build-flag-recipients-one (recipient) - "Build argument for one RECIPIENT." - (gpg-build-argument (cdr gpg-command-flag-recipient) - `((recipient . ,recipient)) t)) - -(defun gpg-build-flag-recipients (recipients) - "Build list of RECIPIENTS using `gpg-command-flag-recipient'." - (gpg-build-argument - (apply 'append (car gpg-command-flag-recipient) - (mapcar 'gpg-build-flag-recipients-one - recipients)) - nil)) - -(defun gpg-read-recipients () - "Query the user for several recipients." - (let ((go t) - recipients r) - (while go - (setq r (read-string "Enter recipient ID [RET when no more]: ")) - (if (equal r "") - (setq go nil) - (setq recipients (nconc recipients (list r))))) - recipients)) - -(defun gpg-build-flag-sign-with-key (key) - "Build sign with key flag using `gpg-command-flag-sign-with-key'." - (let ((k (if key key - (if gpg-default-key-id gpg-default-key-id - nil)))) - (if k - (gpg-build-argument gpg-command-flag-sign-with-key - (list (cons 'sign-with-key k))) - nil))) - -(defmacro gpg-with-passphrase-env (&rest body) - "Adjust the process environment and evaluate BODY. -During the evaluation of the body forms, the process environment is -adjust according to `gpg-command-passphrase-env'." - (let ((env-value (make-symbol "env-value"))) - `(let ((,env-value)) - (unwind-protect - (progn - (when gpg-command-passphrase-env - (setq ,env-value (getenv (car gpg-command-passphrase-env))) - (setenv (car gpg-command-passphrase-env) - (cdr gpg-command-passphrase-env))) - ,@body) - (when gpg-command-passphrase-env - ;; This will clear the variable if it wasn't set before. - (setenv (car gpg-command-passphrase-env) ,env-value)))))) -(put 'gpg-with-passphrase-env 'lisp-indent-function 0) -(put 'gpg-with-passphrase-env 'edebug-form-spec '(body)) - -;;; Temporary files: - -(defun gpg-make-temp-file () - "Create a temporary file in a safe way" - (let ((name ;; User may use "~/" - (expand-file-name "gnupg" gpg-temp-directory))) - (if (fboundp 'make-temp-file) - ;; If we've got make-temp-file, we are on the save side. - (make-temp-file name) - ;; make-temp-name doesn't create the file, and an ordinary - ;; write-file operation is prone to nasty symlink attacks if the - ;; temporary file resides in a world-writable directory. - (unless (or (memq system-type '(windows-nt cygwin32 win32 w32 mswindows)) - (eq (file-modes gpg-temp-directory) 448)) ; mode 0700 - (error "Directory for temporary files (%s) must have mode 0700" gpg-temp-directory)) - (setq name (make-temp-name name)) - (let ((mode (default-file-modes))) - (unwind-protect - (progn - (set-default-file-modes 384) ; mode 0600 - (with-temp-file name)) - (set-default-file-modes mode))) - name))) - -(defvar gpg-temp-files nil - "List of temporary files used by the GnuPG interface. -Do not set this variable. Call `gpg-with-temp-files' if you need -temporary files.") - -(defun gpg-with-temp-files-create (count) - "Do not call this function. Used internally by `gpg-with-temp-files'." - (while (> count 0) - (setq gpg-temp-files (cons (gpg-make-temp-file) gpg-temp-files)) - (setq count (1- count)))) - -(defun gpg-with-temp-files-delete () - "Do not call this function. Used internally by `gpg-with-temp-files'." - (while gpg-temp-files - (let ((file (pop gpg-temp-files))) - (condition-case nil - (delete-file file) - (error nil))))) - -(defmacro gpg-with-temp-files (count &rest body) - "Create COUNT temporary files, USE them, and delete them. -The function USE is called with the names of all temporary files as -arguments." - `(let ((gpg-temp-files)) - (unwind-protect - (progn - ;; Create the temporary files. - (gpg-with-temp-files-create ,count) - ,@body) - (gpg-with-temp-files-delete)))) -(put 'gpg-with-temp-files 'lisp-indent-function 1) -(put 'gpg-with-temp-files 'edebug-form-spec '(body)) - -;;; Making subprocesses: - -(defun gpg-exec-path (option) - "Return the program name for OPTION. -OPTION is of the form (PROGRAM . ARGLIST). This functions returns -PROGRAM, but takes default values into account." - (let* ((prg (car option)) - (path (assq prg gpg-command-default-alist))) - (cond - (path (if (null (cdr path)) - (error "Command `%s' is not available" prg) - (cdr path))) - ((null prg) (error "Command is disabled")) - (t prg)))) - -(defun gpg-call-process (cmd args stdin stdout stderr &optional passphrase) - "Invoke external program CMD with ARGS on buffer STDIN. -Standard output is insert before point in STDOUT, standard error in -STDERR. If PASSPHRASE is given, send it before STDIN. PASSPHRASE -should not end with a line feed (\"\\n\"). - -If `stdin-file' is present in ARGS, it is replaced by the name of a -temporary file. Before invoking CMD, the contents of STDIN is written -to this file." - (gpg-with-temp-files 2 - (let* ((coding-system-for-read 'no-conversion) - (coding-system-for-write 'no-conversion) - (have-stdin-file (memq 'stdin-file args)) - (stdin-file (nth 0 gpg-temp-files)) - (stderr-file (nth 1 gpg-temp-files)) - (cpr-args `(,cmd - nil ; don't delete - (,stdout ,stderr-file) - nil ; don't display - ;; Replace `stdin-file'. - ,@(gpg-build-arg-list - args (list (cons 'stdin-file stdin-file))))) - res) - (when have-stdin-file - (with-temp-file stdin-file - (buffer-disable-undo) - (insert-buffer-substring stdin))) - (setq res - (if passphrase - (with-temp-buffer - (buffer-disable-undo) - (insert passphrase "\n") - (unless have-stdin-file - (apply 'insert-buffer-substring - (if (listp stdin) stdin (list stdin)))) - (apply 'call-process-region (point-min) (point-max) cpr-args) - ;; Wipe out passphrase. - (goto-char (point-min)) - (translate-region (point) (gpg-point-at-eol) - (make-string 256 ? ))) - (if (listp stdin) - (with-current-buffer (car stdin) - (apply 'call-process-region - (cadr stdin) - (if have-stdin-file (cadr stdin) (caddr stdin)) - cpr-args)) - (with-current-buffer stdin - (apply 'call-process-region - (point-min) - (if have-stdin-file (point-min) (point-max)) - cpr-args))))) - (with-current-buffer stderr - (insert-file-contents-literally stderr-file)) - (if (or (stringp res) (> res 0)) - ;; Signal or abnormal exit. - (with-current-buffer stderr - (goto-char (point-max)) - (insert (format "\nCommand exit status: %s\n" res)) - nil) - t)))) - -(defvar gpg-result-buffer nil - "The result of a GnuPG operation is stored in this buffer. -Never set this variable directly, use `gpg-show-result' instead.") - -(defun gpg-show-result-buffer (always-show result) - "Called by `gpg-show-results' to actually show the buffer." - (with-current-buffer gpg-result-buffer - ;; Only proceed if the buffer is non-empty. - (when (and (/= (point-min) (point-max)) - (or always-show (not result))) - (save-window-excursion - (display-buffer (current-buffer)) - (unless (y-or-n-p "Continue? ") - (error "GnuPG operation aborted")))))) - -(defmacro gpg-show-result (always-show &rest body) - "Show GnuPG result to user for confirmation. -This macro binds `gpg-result-buffer' to a temporary buffer and -evaluates BODY, like `progn'. If BODY evaluates to `nil' (or -`always-show' is not nil), the user is asked for confirmation." - `(let ((gpg-result-buffer (get-buffer-create - (generate-new-buffer-name "*GnuPG Output*")))) - (unwind-protect - (gpg-show-result-buffer ,always-show (progn ,@body)) - (kill-buffer gpg-result-buffer)))) -(put 'gpg-show-result 'lisp-indent-function 1) -(put 'gpg-show-result 'edebug-form-spec '(body)) - -;;; Passphrase handling: - -(defvar gpg-passphrase-timer - (gpg-timer-create) - "This timer will clear the passphrase cache periodically.") - -(defvar gpg-passphrase - nil - "The (unencrypted) passphrase cache.") - -(defun gpg-passphrase-clear-string (str) - "Erases STR by overwriting all characters." - (let ((pos 0) - (len (length str))) - (while (< pos len) - (aset str pos ? ) - (incf pos)))) - -;;;###autoload -(defun gpg-passphrase-forget () - "Forget stored passphrase." - (interactive) - (when gpg-passphrase - (gpg-cancel-timer gpg-passphrase-timer) - (setq gpg-passphrase-timer nil) - (gpg-passphrase-clear-string gpg-passphrase) - (setq gpg-passphrase nil))) - -(defun gpg-passphrase-store (passphrase) - "Store PASSPHRASE in cache. -Updates the timeout for clearing the cache to `gpg-passphrase-timeout'." - (unless (equal gpg-passphrase-timeout 0) - (if (null gpg-passphrase-timer) - (setq gpg-passphrase-timer (gpg-timer-create))) - (gpg-timer-set-time gpg-passphrase-timer - (timer-relative-time (current-time) - gpg-passphrase-timeout)) - (gpg-timer-set-function gpg-passphrase-timer 'gpg-passphrase-forget) - (unless (and (fboundp 'itimer-live-p) - (itimer-live-p gpg-passphrase-timer)) - (gpg-timer-activate gpg-passphrase-timer)) - (setq gpg-passphrase passphrase)) - passphrase) - -(defun gpg-passphrase-read () - "Read a passphrase and remember it for some time." - (interactive) - (if gpg-passphrase - ;; This reinitializes the timer. - (gpg-passphrase-store gpg-passphrase) - (let ((pp (read-passwd "Enter passphrase: "))) - (gpg-passphrase-store pp)))) - - -;;;; Main operations: - -;;;###autoload -(defun gpg-verify (message signature result) - "Verify buffer MESSAGE against detached SIGNATURE buffer. -Returns t if everything worked out well, nil otherwise. Consult -buffer RESULT for details." - (interactive "bBuffer containing message: \nbBuffer containing signature: \nbBuffor for result: ") - (gpg-with-temp-files 2 - (let* ((sig-file (nth 0 gpg-temp-files)) - (msg-file (nth 1 gpg-temp-files)) - (cmd (gpg-exec-path gpg-command-verify)) - (args (gpg-build-arg-list (cdr gpg-command-verify) - `((signature-file . ,sig-file) - (message-file . ,msg-file)))) - res) - (with-temp-file sig-file - (buffer-disable-undo) - (apply 'insert-buffer-substring (if (listp signature) - signature - (list signature)))) - (with-temp-file msg-file - (buffer-disable-undo) - (apply 'insert-buffer-substring (if (listp message) - message - (list message)))) - (setq res (apply 'call-process-region - (point-min) (point-min) ; no data - cmd - nil ; don't delete - result - nil ; don't display - args)) - (if (or (stringp res) (> res 0)) - ;; Signal or abnormal exit. - (with-current-buffer result - (insert (format "\nCommand exit status: %s\n" res)) - nil) - t)))) - -;;;###autoload -(defun gpg-verify-cleartext (message result) - "Verify message in buffer MESSAGE. -Returns t if everything worked out well, nil otherwise. Consult -buffer RESULT for details. - -NOTE: Use of this function is deprecated." - (interactive "bBuffer containing message: \nbBuffor for result: ") - (gpg-with-temp-files 1 - (let* ((msg-file (nth 0 gpg-temp-files)) - (cmd (gpg-exec-path gpg-command-verify-cleartext)) - (args (gpg-build-arg-list (cdr gpg-command-verify-cleartext) - `((message-file . ,msg-file)))) - res) - (with-temp-file msg-file - (buffer-disable-undo) - (apply 'insert-buffer-substring (if (listp message) - message - (list message)))) - (setq res (apply 'call-process-region - (point-min) (point-min) ; no data - cmd - nil ; don't delete - result - nil ; don't display - args)) - (if (or (stringp res) (> res 0)) - ;; Signal or abnormal exit. - (with-current-buffer result - (insert (format "\nCommand exit status: %s\n" res)) - nil) - t)))) - -;;;###autoload -(defun gpg-decrypt (ciphertext plaintext result &optional passphrase) - "Decrypt buffer CIPHERTEXT to buffer PLAINTEXT. -Returns t if everything worked out well, nil otherwise. Consult -buffer RESULT for details. Reads a missing PASSPHRASE using -`gpg-passphrase-read'." - (interactive "bBuffer containing ciphertext: \nbBuffer for plaintext: \nbBuffor for decryption status: ") - (gpg-call-process (gpg-exec-path gpg-command-decrypt) - (gpg-build-arg-list (cdr gpg-command-decrypt) nil) - ciphertext plaintext result - (if passphrase passphrase (gpg-passphrase-read))) - (when passphrase - (gpg-passphrase-clear-string passphrase))) - -;;;###autoload -(defun gpg-sign-cleartext - (plaintext signed-text result &optional passphrase sign-with-key) - "Sign buffer PLAINTEXT, and store PLAINTEXT with signature in -SIGNED-TEXT. -Reads a missing PASSPHRASE using `gpg-passphrase-read'. Uses key ID -SIGN-WITH-KEY if given, otherwise the default key ID. Returns t if -everything worked out well, nil otherwise. Consult buffer RESULT for -details. - -NOTE: Use of this function is deprecated." - (interactive "bBuffer containing plaintext: \nbBuffer for text with signature: \nbBuffer for status information: ") - (let ((subst (list (cons 'sign-with-key - (gpg-build-flag-sign-with-key sign-with-key)) - (cons 'armor gpg-command-flag-armor) - (cons 'textmode gpg-command-flag-textmode)))) - (gpg-call-process (gpg-exec-path gpg-command-sign-cleartext) - (gpg-build-arg-list (cdr gpg-command-sign-cleartext) - subst) - plaintext signed-text result - (if passphrase passphrase (gpg-passphrase-read)))) - (when passphrase - (gpg-passphrase-clear-string passphrase))) - -;;;###autoload -(defun gpg-sign-detached - (plaintext signature result &optional passphrase sign-with-key - armor textmode) - "Sign buffer PLAINTEXT, and store SIGNATURE in that buffer. -Reads a missing PASSPHRASE using `gpg-passphrase-read'. Uses key ID -SIGN-WITH-KEY if given, otherwise the default key ID. Returns t if -everything worked out well, nil otherwise. Consult buffer RESULT for -details. ARMOR the result and activate canonical TEXTMODE if -requested." - (interactive "bBuffer containing plaintext: \nbBuffer for text with signature: \nbBuffer for status information: ") - (let ((subst (list (cons 'sign-with-key - (gpg-build-flag-sign-with-key sign-with-key)) - (cons 'armor (if armor gpg-command-flag-armor)) - (cons 'textmode (if armor gpg-command-flag-textmode))))) - (gpg-call-process (gpg-exec-path gpg-command-sign-detached) - (gpg-build-arg-list (cdr gpg-command-sign-detached) - subst) - plaintext signature result - (if passphrase passphrase (gpg-passphrase-read)))) - (when passphrase - (gpg-passphrase-clear-string passphrase))) - - -;;;###autoload -(defun gpg-sign-encrypt - (plaintext ciphertext result recipients &optional passphrase sign-with-key - armor textmode) - "Sign buffer PLAINTEXT, and store SIGNATURE in that buffer. -RECIPIENTS is a list of key IDs used for encryption. This function -reads a missing PASSPHRASE using `gpg-passphrase-read', and uses key -ID SIGN-WITH-KEY for the signature if given, otherwise the default key -ID. Returns t if everything worked out well, nil otherwise. Consult -buffer RESULT for details. ARMOR the result and activate canonical -TEXTMODE if requested." - (interactive (list - (read-buffer "Buffer containing plaintext: " nil t) - (read-buffer "Buffer for ciphertext: " nil t) - (read-buffer "Buffer for status informationt: " nil t) - (gpg-read-recipients))) - (let ((subst `((sign-with-key . ,(gpg-build-flag-sign-with-key - sign-with-key)) - (plaintext-file . stdin-file) - (recipients . ,(gpg-build-flag-recipients recipients)) - (armor ,(if armor gpg-command-flag-armor)) - (textmode ,(if armor gpg-command-flag-textmode))))) - (gpg-call-process (gpg-exec-path gpg-command-sign-encrypt) - (gpg-build-arg-list (cdr gpg-command-sign-encrypt) - subst) - plaintext ciphertext result - (if passphrase passphrase (gpg-passphrase-read)))) - (when passphrase - (gpg-passphrase-clear-string passphrase))) - - -;;;###autoload -(defun gpg-encrypt - (plaintext ciphertext result recipients &optional passphrase armor textmode) - "Encrypt buffer PLAINTEXT, and store CIPHERTEXT in that buffer. -RECIPIENTS is a list of key IDs used for encryption. Returns t if -everything worked out well, nil otherwise. Consult buffer RESULT for -details. ARMOR the result and activate canonical -TEXTMODE if requested." - (interactive (list - (read-buffer "Buffer containing plaintext: " nil t) - (read-buffer "Buffer for ciphertext: " nil t) - (read-buffer "Buffer for status informationt: " nil t) - (gpg-read-recipients))) - (let ((subst `((plaintext-file . stdin-file) - (recipients . ,(gpg-build-flag-recipients recipients)) - (armor ,(if armor gpg-command-flag-armor)) - (textmode ,(if armor gpg-command-flag-textmode))))) - (gpg-call-process (gpg-exec-path gpg-command-encrypt) - (gpg-build-arg-list (cdr gpg-command-encrypt) subst) - plaintext ciphertext result nil)) - (when passphrase - (gpg-passphrase-clear-string passphrase))) - - -;;;; Key management - -;;; ADT: OpenPGP Key - -(defun gpg-key-make (user-id key-id unique-id length algorithm - creation-date expire-date validity trust) - "Create a new key object (for internal use only)." - (vector - ;; 0 1 2 3 4 - user-id key-id unique-id length algorithm - ;; 5 6 7 8 - creation-date expire-date validity trust)) - - -(defun gpg-key-p (key) - "Return t if KEY is a key specification." - (and (arrayp key) (equal (length key) 9) key)) - -(defmacro gpg-key-primary-user-id (key) - "The primary user ID for KEY (human-readable). -DO NOT USE this ID for selecting recipients. It is probably not -unique." - (list 'car (list 'aref key 0))) - -(defmacro gpg-key-user-ids (key) - "A list of additional user IDs for KEY (human-readable). -DO NOT USE these IDs for selecting recipients. They are probably not -unique." - (list 'cdr (list 'aref key 0))) - -(defmacro gpg-key-id (key) - "The key ID of KEY. -DO NOT USE this ID for selecting recipients. It is not guaranteed to -be unique." - (list 'aref key 1)) - -(defun gpg-short-key-id (key) - "The short key ID of KEY." - (let* ((id (gpg-key-id key)) - (len (length id))) - (if (> len 8) - (substring id (- len 8)) - id))) - -(defmacro gpg-key-unique-id (key) - "A non-standard ID of KEY which is only valid locally. -This ID can be used to specify recipients in a safe manner. Note, -even this ID might not be unique unless GnuPG is used." - (list 'aref key 2)) - -(defmacro gpg-key-unique-id-list (key-list) - "Like `gpg-key-unique-id', but operate on a list." - `(mapcar (lambda (key) (gpg-key-unique-id key)) - ,key-list)) - -(defmacro gpg-key-length (key) - "Returns the key length." - (list 'aref key 3)) - -(defmacro gpg-key-algorithm (key) - "The encryption algorithm used by KEY. -One of the symbols `rsa', `rsa-encrypt', `rsa-sign', `elgamal', -`elgamal-encrypt', `dsa'." - (list 'aref key 4)) - -(defmacro gpg-key-creation-date (key) - "A string with the creation date of KEY in ISO format." - (list 'aref key 5)) - -(defmacro gpg-key-expire-date (key) - "A string with the expiration date of KEY in ISO format." - (list 'aref key 6)) - -(defmacro gpg-key-validity (key) - "The calculated validity of KEY. -One of the symbols `not-known', `disabled', `revoked', `expired', -`undefined', `trust-none', `trust-marginal', `trust-full', -`trust-ultimate' (see the GnuPG documentation for details)." - (list 'aref key 7)) - -(defmacro gpg-key-trust (key) - "The assigned trust for KEY. -One of the symbols `not-known', `undefined', `trust-none', -`trust-marginal', `trust-full' (see the GnuPG -documentation for details)." - (list 'aref key 8)) - -(defun gpg-key-lessp (a b) - "Returns t if primary user ID of A is less than B." - (string-lessp (gpg-key-primary-user-id a) (gpg-key-primary-user-id b) )) - -;;; Accessing the key database: - -;; Internal functions: - -(defmacro gpg-key-list-keys-skip-field () - '(search-forward ":" eol 'move)) - -(defmacro gpg-key-list-keys-get-field () - '(buffer-substring (point) (if (gpg-key-list-keys-skip-field) - (1- (point)) - eol))) -(defmacro gpg-key-list-keys-string-field () - '(gpg-key-list-keys-get-field)) - -(defmacro gpg-key-list-keys-read-field () - (let ((field (make-symbol "field"))) - `(let ((,field (gpg-key-list-keys-get-field))) - (if (equal (length ,field) 0) - nil - (read ,field))))) - -(defun gpg-key-list-keys-parse-line () - "Parse the line in the current buffer and return a vector of fields." - (let* ((eol (gpg-point-at-eol)) - (v (if (eolp) - nil - (vector - (gpg-key-list-keys-read-field) ; type - (gpg-key-list-keys-get-field) ; trust - (gpg-key-list-keys-read-field) ; key length - (gpg-key-list-keys-read-field) ; algorithm - (gpg-key-list-keys-get-field) ; key ID - (gpg-key-list-keys-get-field) ; creation data - (gpg-key-list-keys-get-field) ; expire - (gpg-key-list-keys-get-field) ; unique (local) ID - (gpg-key-list-keys-get-field) ; ownertrust - (gpg-key-list-keys-string-field) ; user ID - )))) - (if (eolp) - (when v - (forward-char 1)) - (error "Too many fields in GnuPG key database")) - v)) - -(defconst gpg-pubkey-algo-alist - '((1 . rsa) - (2 . rsa-encrypt-only) - (3 . rsa-sign-only) - (16 . elgamal-encrypt-only) - (17 . dsa) - (20 . elgamal)) - "Alist mapping OpenPGP public key algorithm numbers to symbols.") - -(defconst gpg-trust-alist - '((?- . not-known) - (?o . not-known) - (?d . disabled) - (?r . revoked) - (?e . expired) - (?q . trust-undefined) - (?n . trust-none) - (?m . trust-marginal) - (?f . trust-full) - (?u . trust-ultimate)) - "Alist mapping GnuPG trust value short forms to long symbols.") - -(defconst gpg-unabbrev-trust-alist - '(("TRUST_UNDEFINED" . trust-undefined) - ("TRUST_NEVER" . trust-none) - ("TRUST_MARGINAL" . trust-marginal) - ("TRUST_FULLY" . trust-full) - ("TRUST_ULTIMATE" . trust-ultimate)) - "Alist mapping capitalized GnuPG trust values to long symbols.") - -(defmacro gpg-key-list-keys-in-buffer-store () - '(when primary-user-id - (sort user-id 'string-lessp) - (push (gpg-key-make (cons primary-user-id user-id) - key-id unique-id key-length - algorithm creation-date - expire-date validity trust) - key-list))) - -(defun gpg-key-list-keys-in-buffer (&optional buffer) - "Return a list of keys for BUFFER. -If BUFFER is omitted, use current buffer." - (with-current-buffer (if buffer buffer (current-buffer)) - (goto-char (point-min)) - ;; Skip key ring filename written by GnuPG. - (search-forward "\n---------------------------\n" nil t) - ;; Loop over all lines in buffer and analyze them. - (let (primary-user-id user-id key-id unique-id ; current key components - key-length algorithm creation-date expire-date validity trust - line ; fields in current line - key-list) ; keys gather so far - - (while (setq line (gpg-key-list-keys-parse-line)) - (cond - ;; Public or secret key. - ((memq (aref line 0) '(pub sec)) - ;; Store previous key, if any. - (gpg-key-list-keys-in-buffer-store) - ;; Record field values. - (setq primary-user-id (aref line 9)) - (setq user-id nil) - (setq key-id (aref line 4)) - ;; We use the key ID if no unique ID is available. - (setq unique-id (if (> (length (aref line 7)) 0) - (concat "#" (aref line 7)) - (concat "0x" key-id))) - (setq key-length (aref line 2)) - (setq algorithm (assq (aref line 3) gpg-pubkey-algo-alist)) - (if algorithm - (setq algorithm (cdr algorithm)) - (error "Unknown algorithm %s" (aref line 3))) - (setq creation-date (if (> (length (aref line 5)) 0) - (aref line 5))) - (setq expire-date (if (> (length (aref line 6)) 0) - (aref line 6))) - (setq validity (assq (aref (aref line 1) 0) gpg-trust-alist)) - (if validity - (setq validity (cdr validity)) - (error "Unknown validity specification %S" (aref line 1))) - (setq trust (assq (aref (aref line 8) 0) gpg-trust-alist)) - (if trust - (setq trust (cdr trust)) - (error "Unknown trust specification %S" (aref line 8)))) - - ;; Additional user ID - ((eq 'uid (aref line 0)) - (setq user-id (cons (aref line 9) user-id))) - - ;; Subkeys are ignored for now. - ((memq (aref line 0) '(sub ssb)) - t) - (t (error "Unknown record type %S" (aref line 0))))) - - ;; Store the key retrieved last. - (gpg-key-list-keys-in-buffer-store) - ;; Sort the keys according to the primary user ID. - (sort key-list 'gpg-key-lessp)))) - -(defun gpg-key-list-keyspec (command &optional keyspec stderr ignore-error) - "Insert the output of COMMAND before point in current buffer." - (let* ((cmd (gpg-exec-path command)) - (key (if (equal keyspec "") nil keyspec)) - (args (gpg-build-arg-list (cdr command) `((key-id . ,key)))) - exit-status) - (setq exit-status - (apply 'call-process-region - (point-min) (point-min) ; no data - cmd - nil ; don't delete - (if stderr t '(t nil)) - nil ; don't display - args)) - (unless (or ignore-error (equal exit-status 0)) - (error "GnuPG command exited unsuccessfully")))) - - -(defun gpg-key-list-keyspec-parse (command &optional keyspec) - "Return a list of keys matching KEYSPEC. -COMMAND is used to obtain the key list. The usual substring search -for keys is performed." - (with-temp-buffer - (buffer-disable-undo) - (gpg-key-list-keyspec command keyspec) - (gpg-key-list-keys-in-buffer))) - -;;;###autoload -(defun gpg-key-list-keys (&optional keyspec) - "A list of public keys matching KEYSPEC. -The usual substring search for keys is performed." - (gpg-key-list-keyspec-parse gpg-command-key-public-ring keyspec)) - -;;;###autoload -(defun gpg-key-list-secret-keys (&optional keyspec) - "A list of secret keys matching KEYSPEC. -The usual substring search for keys is performed." - (gpg-key-list-keyspec-parse gpg-command-key-secret-ring keyspec)) - -;;;###autoload -(defun gpg-key-insert-public-key (key) - "Inserts the public key(s) matching KEYSPEC. -The ASCII-armored key is inserted before point into current buffer." - (gpg-key-list-keyspec gpg-command-key-export key)) - -;;;###autoload -(defun gpg-key-insert-information (key) - "Insert human-readable information (including fingerprint) on KEY. -Insertion takes place in current buffer before point." - (gpg-key-list-keyspec gpg-command-key-verify key)) - -;;;###autoload -(defun gpg-key-retrieve (key) - "Fetch KEY from default key server. -KEY is a key ID or a list of key IDs. Status information about this -operation is inserted into the current buffer before point." - (gpg-key-list-keyspec gpg-command-key-retrieve key t t)) - -;;;###autoload -(defun gpg-key-add-to-ring (key result) - "Adds key in buffer KEY to the GnuPG key ring. -Human-readable information on the RESULT is stored in buffer RESULT -before point.") - -(provide 'gpg) - -;;; gpg.el ends here -- 2.25.1