diff options
| -rw-r--r-- | doc/misc/Makefile.in | 8 | ||||
| -rw-r--r-- | doc/misc/epa.texi | 393 | ||||
| -rw-r--r-- | etc/NEWS | 8 | ||||
| -rw-r--r-- | lisp/epa-dired.el | 87 | ||||
| -rw-r--r-- | lisp/epa-file.el | 318 | ||||
| -rw-r--r-- | lisp/epa-mail.el | 178 | ||||
| -rw-r--r-- | lisp/epa-setup.el | 39 | ||||
| -rw-r--r-- | lisp/epa.el | 1176 | ||||
| -rw-r--r-- | lisp/epg-config.el | 140 | ||||
| -rw-r--r-- | lisp/epg-package-info.el | 37 | ||||
| -rw-r--r-- | lisp/epg.el | 2654 |
11 files changed, 5038 insertions, 0 deletions
diff --git a/doc/misc/Makefile.in b/doc/misc/Makefile.in index 3d14d9a78a..4460b6f596 100644 --- a/doc/misc/Makefile.in +++ b/doc/misc/Makefile.in @@ -49,6 +49,7 @@ INFO_TARGETS = \ $(infodir)/ebrowse \ $(infodir)/ediff \ $(infodir)/emacs-mime \ + $(infodir)/epa \ $(infodir)/erc \ $(infodir)/eshell \ $(infodir)/eudc \ @@ -91,6 +92,7 @@ DVI_TARGETS = \ ebrowse.dvi \ ediff.dvi \ emacs-mime.dvi \ + epa.dvi \ erc.dvi \ eshell.dvi \ eudc.dvi \ @@ -207,6 +209,12 @@ $(infodir)/emacs-mime: emacs-mime.texi emacs-mime.dvi: emacs-mime.texi $(ENVADD) $(TEXI2DVI) ${srcdir}/emacs-mime.texi +epa : $(infodir)/epa +$(infodir)/epa: epa.texi + cd $(srcdir); $(MAKEINFO) epa.texi +epa.dvi: epa.texi + $(ENVADD) $(TEXI2DVI) ${srcdir}/epa.texi + erc : $(infodir)/erc $(infodir)/erc: erc.texi cd $(srcdir); $(MAKEINFO) erc.texi diff --git a/doc/misc/epa.texi b/doc/misc/epa.texi new file mode 100644 index 0000000000..8fb5877ca2 --- /dev/null +++ b/doc/misc/epa.texi @@ -0,0 +1,393 @@ +\input texinfo @c -*- mode: texinfo -*- +@c %**start of header +@setfilename ../../info/epa +@settitle EasyPG Assistant User's Manual +@c %**end of header + +@set VERSION 1.0.0 + +@copying +This file describes EasyPG Assistant. + +Copyright @copyright{} 2007, 2008 Free Software Foundation, Inc. + +@quotation +Permission is granted to copy, distribute and/or modify this document +under the terms of the GNU Free Documentation License, Version 1.2 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 quotation +@end copying + +@dircategory Emacs +@direntry +* EasyPG Assistant: (epa). An Emacs user interface to GNU Privacy Guard. +@end direntry + + +@titlepage +@title EasyPG Assistant + +@author by Daiki Ueno +@page + +@vskip 0pt plus 1filll +@insertcopying +@end titlepage +@page + +@c @summarycontents +@c @contents + +@node Top +@top EasyPG Assistant user's manual + +EasyPG Assistant is an Emacs user interface to GNU Privacy Guard +(GnuPG, @pxref{Top, , Top, gnupg, Using the GNU Privacy Guard}). + +EasyPG Assistant is a part of the package called EasyPG, an all-in-one +GnuPG interface for Emacs. EasyPG also contains the library interface +called EasyPG Library. + +@noindent +This manual covers EasyPG version @value{VERSION}. + +@menu +* Overview:: +* Quick start:: +* Commands:: +@end menu + +@node Overview +@chapter Overview + +EasyPG Assistant provides the following features. + +@itemize @bullet +@item Key manegement. +@item Cryptographic operations on regions. +@item Cryptographic operations on files. +@item Dired integration. +@item Mail-mode integration. +@item Automatic encryption/decryption of *.gpg files. +@end itemize + +@node Quick start +@chapter Quick start + +To install, just follow the standard CMMI installation instructions. + +@cartouche +@example +$ ./configure +$ sudo make install +@end example +@end cartouche + +@noindent +Then, add the following line to your @file{~/.emacs} + +@cartouche +@lisp +(require 'epa-setup) +@end lisp +@end cartouche + +@noindent +That's all. Restart emacs and type @kbd{M-x epa- @key{TAB}}, and you will see a +lot of commands available. For example, + +@itemize @bullet +@item To browse your keyring, type @kbd{M-x epa-list-keys} + +@item To create a cleartext signature of the region, type @kbd{M-x epa-sign-region} +@end itemize + +@node Commands +@chapter Commands + +This chapter introduces various commands for typical use cases. + +@menu +* Key management:: +* Cryptographic operations on regions:: +* Cryptographic operations on files:: +* Dired integration:: +* Mail-mode integration:: +* Encrypting/decrypting *.gpg files:: +@end menu + +@node Key management +@section Key management +Probably the first step of using EasyPG Assistant is to browse your +keyring. @kbd{M-x epa-list-keys} is corresponding to @samp{gpg +--list-keys} from the command line. + +@deffn Command epa-list-keys name mode +Show all keys matched with @var{name} from the public keyring. +@end deffn + +@noindent +The output looks as follows. + +@example + u A5B6B2D4B15813FE Daiki Ueno <ueno@@unixuser.org> +@end example + +@noindent +A character on the leftmost column indicates the trust level of the +key. If it is @samp{u}, the key is marked as ultimately trusted. The +second column is the key ID, and the rest is the user ID. + +You can move over entries by @key{TAB}. If you type @key{RET} or +click button1 on an entry, you will see more detailed information +about the key you selected. + +@example + u Daiki Ueno <ueno@@unixuser.org> + u A5B6B2D4B15813FE 1024bits DSA + Created: 2001-10-09 + Expires: 2007-09-04 + Capabilities: sign certify + Fingerprint: 8003 7CD0 0F1A 9400 03CA 50AA A5B6 B2D4 B158 13FE + u 4447461B2A9BEA2D 2048bits ELGAMAL_E + Created: 2001-10-09 + Expires: 2007-09-04 + Capabilities: encrypt + Fingerprint: 9003 D76B 73B7 4A8A E588 10AF 4447 461B 2A9B EA2D +@end example + +@noindent +To browse your private keyring, use @kbd{M-x epa-list-secret-keys}. + +@deffn Command epa-list-secret-keys name +Show all keys matched with @var{name} from the private keyring. +@end deffn + +@noindent +In @samp{*Keys*} buffer, several commands are available. The common +use case is to export some keys to a file. To do that, type @kbd{m} +to select keys, type @kbd{o}, and then supply the filename. + +Below are other commands related to key management. Some of them take +a file as input/output, and others take the current region. + +@deffn Command epa-insert-keys keys +Insert selected @var{keys} after the point. It will let you select +keys before insertion. By default, it will encode keys in the OpenPGP +armor format. +@end deffn + +@deffn Command epa-import-keys file +Import keys from @var{file} to your keyring. +@end deffn + +@deffn Command epa-import-keys-region start end +Import keys from the current region between @var{start} and @var{end} +to your keyring. +@end deffn + +@deffn Command epa-import-armor-in-region start end +Import keys in the OpenPGP armor format in the current region between +@var{start} and @var{end}. The difference from +@code{epa-import-keys-region} is that +@code{epa-import-armor-in-region} searches armors in the region and +applies @code{epa-import-keys-region} to each of them. +@end deffn + +@deffn Command epa-delete-keys allow-secret +Delete selected keys. If @var{allow-secret} is non-@code{nil}, it +also delete the secret keys. +@end deffn + +@node Cryptographic operations on regions +@section Cryptographic operations on regions + +@deffn Command epa-decrypt-region start end +Decrypt the current region between @var{start} and @var{end}. It +replaces the region with the decrypted text. +@end deffn + +@deffn Command epa-decrypt-armor-in-region start end +Decrypt OpenPGP armors in the current region between @var{start} and +@var{end}. The difference from @code{epa-decrypt-region} is that +@code{epa-decrypt-armor-in-region} searches armors in the region +and applies @code{epa-decrypt-region} to each of them. That is, this +command does not alter the original text around armors. +@end deffn + +@deffn Command epa-verify-region start end +Verify the current region between @var{start} and @var{end}. It sends +the verification result to the minibuffer or a popup window. It +replaces the region with the signed text. +@end deffn + +@deffn Command epa-verify-cleartext-in-region +Verify OpenPGP cleartext blocks in the current region between +@var{start} and @var{end}. The difference from +@code{epa-verify-region} is that @code{epa-verify-cleartext-in-region} +searches OpenPGP cleartext blocks in the region and applies +@code{epa-verify-region} to each of them. That is, this command does +not alter the original text around OpenPGP cleartext blocks. +@end deffn + +@deffn Command epa-sign-region start end signers type +Sign the current region between @var{start} and @var{end}. By +default, it creates a cleartext signature. If a prefix argument is +given, it will let you select signing keys, and then a signature +type. +@end deffn + +@deffn Command epa-encrypt-region start end recipients sign signers +Encrypt the current region between @var{start} and @var{end}. It will +let you select recipients. If a prefix argument is given, it will +also ask you whether or not to sign the text before encryption and if +you answered yes, it will let you select the signing keys. +@end deffn + +@node Cryptographic operations on files +@section Cryptographic operations on files + +@deffn Command epa-decrypt-file file +Decrypt @var{file}. +@end deffn + +@deffn Command epa-verify-file file +Verify @var{file}. +@end deffn + +@deffn Command epa-sign-file file signers type +Sign @var{file}. If a prefix argument is given, it will let you +select signing keys, and then a signature type. +@end deffn + +@deffn Command epa-encrypt-file file recipients +Encrypt @var{file}. It will let you select recipients. +@end deffn + +@node Dired integration +@section Dired integration + +EasyPG Assistant extends Dired Mode for GNU Emacs to allow users to +easily do cryptographic operations on files. For example, + +@example +M-x dired +(mark some files) +: e (or M-x epa-dired-do-encrypt) +(select recipients by 'm' and click [OK]) +@end example + +@noindent +The following keys are assigned. + +@table @kbd +@item : d +@kindex @kbd{: d} +@findex epa-dired-do-decrypt +Decrypt marked files. + +@item : v +@kindex @kbd{: v} +@findex epa-dired-do-verify +Verify marked files. + +@item : s +@kindex @kbd{: s} +@findex epa-dired-do-sign +Sign marked files. + +@item : e +@kindex @kbd{: e} +@findex epa-dired-do-encrypt +Encrypt marked files. + +@end table + +@node Mail-mode integration +@section Mail-mode integration + +EasyPG Assistant provides a minor mode to help user compose inline PGP +messages. Inline PGP is sending the OpenPGP blobs directly inside a +mail message and it is not recommended and you should consider to use +PGP/MIME. See +@uref{http://josefsson.org/inline-openpgp-considered-harmful.html, +Inline PGP in E-mail is bad, Mm'kay?}. + +@noindent +The following keys are assigned. + +@table @kbd +@item C-c C-e d +@kindex @kbd{C-c C-e d} +@findex epa-mail-decrypt +Decrypt OpenPGP armors in the current buffer. + +@item C-c C-e v +@kindex @kbd{C-c C-e v} +@findex epa-mail-verify +Verify OpenPGP cleartext signed messages in the current buffer. + +@item C-c C-e s +@kindex @kbd{C-c C-e s} +@findex epa-mail-sign +Compose a signed message from the current buffer. + +@item C-c C-e e +@kindex @kbd{C-c C-e e} +@findex epa-mail-encrypt +Compose an encrypted message from the current buffer. + +@end table + +@node Encrypting/decrypting *.gpg files +@section Encrypting/decrypting *.gpg files +Once @code{epa-setup} is loaded, every file whose extension is +@samp{.gpg} will be treated as encrypted. That is, when you attempt +to open such a file which already exists, the decrypted text is +inserted in the buffer rather than encrypted one. On the other hand, +when you attempt to save the buffer to a file whose extension is +@samp{.gpg}, encrypted data is written. + +If you want to temporarily disable this behavior, use @kbd{M-x +epa-file-disable}, and then to enable this behavior use @kbd{M-x +epa-file-enable}. + +@deffn Command epa-file-disable +Disable automatic encryption/decryption of *.gpg files. +@end deffn + +@deffn Command epa-file-enable +Enable automatic encryption/decryption of *.gpg files. +@end deffn + +@noindent +@code{epa-file} will let you select recipients. If you want to +suppress this question, it might be a good idea to put the following +line on the first line of the text being encrypted. +@vindex epa-file-encrypt-to + +@cartouche +@lisp +;; -*- epa-file-encrypt-to: ("ueno@@unixuser.org") -*- +@end lisp +@end cartouche + +Other variables which control the automatic encryption/decryption +behavior are below. + +@defvar epa-file-cache-passphrase-for-symmetric-encryption +If non-@code{nil}, cache passphrase for symmetric encryption. The +default value is @code{nil}. +@end defvar + +@defvar epa-file-inhibit-auto-save +If non-@code{nil}, disable auto-saving when opening an encrypted file. +The default value is @code{t}. +@end defvar + +@bye + +@c End: @@ -229,6 +229,14 @@ consult the Remember Manual for usage details. dbus.el and by extensions to the C modules of Emacs. D-Bus is an inter-process communication mechanism for applications residing on the same host, based on messages. See the manual for further details. + +** EasyPG is now part of the Emacs distribution. +EasyPG is an all-in-one GnuPG interface for Emacs. It consists of two +parts: EasyPG Assistant and EasyPG Library. + +EasyPG Assistant is a set of convenient tools to use GnuPG from +Emacs. EasyPG Library is a sort of an elisp port of GPGME, a wrapper +library which provides API to access some of the GnuPG functions. * Changes in Specialized Modes and Packages in Emacs 23.1 diff --git a/lisp/epa-dired.el b/lisp/epa-dired.el new file mode 100644 index 0000000000..b20218b0ff --- /dev/null +++ b/lisp/epa-dired.el @@ -0,0 +1,87 @@ +;;; epa-dired.el --- the EasyPG Assistant, dired extension +;; Copyright (C) 2006, 2007, 2008 Free Software Foundation, Inc. + +;; Author: Daiki Ueno <ueno@unixuser.org> +;; Keywords: PGP, GnuPG + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published 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 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 'epa) +(require 'dired) + +(defvar epa-dired-map + (let ((keymap (make-sparse-keymap))) + (define-key keymap "d" 'epa-dired-do-decrypt) + (define-key keymap "v" 'epa-dired-do-verify) + (define-key keymap "s" 'epa-dired-do-sign) + (define-key keymap "e" 'epa-dired-do-encrypt) + keymap)) + +(fset 'epa-dired-prefix epa-dired-map) + +(defun epa-dired-mode-hook () + (define-key dired-mode-map ":" 'epa-dired-prefix)) + +(defun epa-dired-do-decrypt () + "Decrypt marked files." + (interactive) + (let ((file-list (dired-get-marked-files))) + (while file-list + (epa-decrypt-file (expand-file-name (car file-list))) + (setq file-list (cdr file-list))) + (revert-buffer))) + +(defun epa-dired-do-verify () + "Verify marked files." + (interactive) + (let ((file-list (dired-get-marked-files))) + (while file-list + (epa-verify-file (expand-file-name (car file-list))) + (setq file-list (cdr file-list))))) + +(defun epa-dired-do-sign () + "Sign marked files." + (interactive) + (let ((file-list (dired-get-marked-files))) + (while file-list + (epa-sign-file + (expand-file-name (car file-list)) + (epa-select-keys (epg-make-context) "Select keys for signing. +If no one is selected, default secret key is used. " + nil t) + (y-or-n-p "Make a detached signature? ")) + (setq file-list (cdr file-list))) + (revert-buffer))) + +(defun epa-dired-do-encrypt () + "Encrypt marked files." + (interactive) + (let ((file-list (dired-get-marked-files))) + (while file-list + (epa-encrypt-file + (expand-file-name (car file-list)) + (epa-select-keys (epg-make-context) "Select recipents for encryption. +If no one is selected, symmetric encryption will be performed. ")) + (setq file-list (cdr file-list))) + (revert-buffer))) + +(provide 'epa-dired) + +;;; epa-dired.el ends here diff --git a/lisp/epa-file.el b/lisp/epa-file.el new file mode 100644 index 0000000000..e6438295ae --- /dev/null +++ b/lisp/epa-file.el @@ -0,0 +1,318 @@ +;;; epa-file.el --- the EasyPG Assistant, transparent file encryption +;; Copyright (C) 2006, 2007, 2008 Free Software Foundation, Inc. + +;; Author: Daiki Ueno <ueno@unixuser.org> +;; Keywords: PGP, GnuPG + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published 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 'epa) + +(defgroup epa-file nil + "The EasyPG Assistant hooks for transparent file encryption" + :group 'epa) + +(defun epa-file--file-name-regexp-set (variable value) + (set-default variable value) + (if (fboundp 'epa-file-name-regexp-update) + (epa-file-name-regexp-update))) + +(defcustom epa-file-name-regexp "\\.gpg\\(~\\|\\.~[0-9]+~\\)?\\'" + "Regexp which matches filenames to be encrypted with GnuPG. + +If you set this outside Custom while epa-file is already enabled, you +have to call `epa-file-name-regexp-update' after setting it to +properly update file-name-handler-alist. Setting this through Custom +does that automatically." + :type 'regexp + :group 'epa-file + :set 'epa-file--file-name-regexp-set) + +(defcustom epa-file-cache-passphrase-for-symmetric-encryption nil + "If non-nil, cache passphrase for symmetric encryption." + :type 'boolean + :group 'epa-file) + +(defcustom epa-file-inhibit-auto-save t + "If non-nil, disable auto-saving when opening an encrypted file." + :type 'boolean + :group 'epa-file) + +(defcustom epa-file-select-keys nil + "If non-nil, always asks user to select recipients." + :type 'boolean + :group 'epa-file) + +(defvar epa-file-encrypt-to nil + "*Recipient(s) used for encrypting files. +May either be a string or a list of strings.") + +;;;###autoload +(put 'epa-file-encrypt-to 'safe-local-variable + (lambda (val) + (or (stringp val) + (and (listp val) + (catch 'safe + (mapc (lambda (elt) + (unless (stringp elt) + (throw 'safe nil))) + val) + t))))) + +;;;###autoload +(put 'epa-file-encrypt-to 'permanent-local t) + +(defvar epa-file-handler + (cons epa-file-name-regexp 'epa-file-handler)) + +(defvar epa-file-auto-mode-alist-entry + (list epa-file-name-regexp nil 'epa-file)) + +(defvar epa-file-passphrase-alist nil) + +(eval-and-compile + (if (fboundp 'encode-coding-string) + (defalias 'epa-file--encode-coding-string 'encode-coding-string) + (defalias 'epa-file--encode-coding-string 'identity))) + +(eval-and-compile + (if (fboundp 'decode-coding-string) + (defalias 'epa-file--decode-coding-string 'decode-coding-string) + (defalias 'epa-file--decode-coding-string 'identity))) + +(defun epa-file-name-regexp-update () + (interactive) + (unless (equal (car epa-file-handler) epa-file-name-regexp) + (setcar epa-file-handler epa-file-name-regexp))) + +(defun epa-file-passphrase-callback-function (context key-id file) + (if (and epa-file-cache-passphrase-for-symmetric-encryption + (eq key-id 'SYM)) + (progn + (setq file (file-truename file)) + (let ((entry (assoc file epa-file-passphrase-alist)) + passphrase) + (or (copy-sequence (cdr entry)) + (progn + (unless entry + (setq entry (list file) + epa-file-passphrase-alist + (cons entry + epa-file-passphrase-alist))) + (setq passphrase (epa-passphrase-callback-function context + key-id nil)) + (setcdr entry (copy-sequence passphrase)) + passphrase)))) + (epa-passphrase-callback-function context key-id nil))) + +(defun epa-file-handler (operation &rest args) + (save-match-data + (let ((op (get operation 'epa-file))) + (if op + (apply op args) + (epa-file-run-real-handler operation args))))) + +(defun epa-file-run-real-handler (operation args) + (let ((inhibit-file-name-handlers + (cons 'epa-file-handler + (and (eq inhibit-file-name-operation operation) + inhibit-file-name-handlers))) + (inhibit-file-name-operation operation)) + (apply operation args))) + +(defun epa-file-decode-and-insert (string file visit beg end replace) + (if (fboundp 'decode-coding-inserted-region) + (save-restriction + (narrow-to-region (point) (point)) + (let ((multibyte enable-multibyte-characters)) + (set-buffer-multibyte nil) + (insert string) + (set-buffer-multibyte multibyte) + (decode-coding-inserted-region + (point-min) (point-max) + (substring file 0 (string-match epa-file-name-regexp file)) + visit beg end replace))) + (insert (epa-file--decode-coding-string string (or coding-system-for-read + 'undecided))))) + +(defvar last-coding-system-used) +(defun epa-file-insert-file-contents (file &optional visit beg end replace) + (barf-if-buffer-read-only) + (if (and visit (or beg end)) + (error "Attempt to visit less than an entire file")) + (setq file (expand-file-name file)) + (let* ((local-copy + (condition-case inl + (epa-file-run-real-handler #'file-local-copy (list file)) + (error))) + (local-file (or local-copy file)) + (context (epg-make-context)) + string length entry) + (if visit + (setq buffer-file-name file)) + (epg-context-set-passphrase-callback + context + (cons #'epa-file-passphrase-callback-function + local-file)) + (epg-context-set-progress-callback context + #'epa-progress-callback-function) + (unwind-protect + (progn + (if replace + (goto-char (point-min))) + (condition-case error + (setq string (epg-decrypt-file context local-file nil)) + (error + (if (setq entry (assoc file epa-file-passphrase-alist)) + (setcdr entry nil)) + (signal 'file-error + (cons "Opening input file" (cdr error))))) + (make-local-variable 'epa-file-encrypt-to) + (setq epa-file-encrypt-to + (mapcar #'car (epg-context-result-for context 'encrypted-to))) + (if (or beg end) + (setq string (substring string (or beg 0) end))) + (save-excursion + (save-restriction + (narrow-to-region (point) (point)) + (epa-file-decode-and-insert string file visit beg end replace) + (setq length (- (point-max) (point-min)))) + (if replace + (delete-region (point) (point-max))))) + (if (and local-copy + (file-exists-p local-copy)) + (delete-file local-copy))) + (list file length))) +(put 'insert-file-contents 'epa-file 'epa-file-insert-file-contents) + +(defun epa-file-write-region (start end file &optional append visit lockname + mustbenew) + (if append + (error "Can't append to the file.")) + (setq file (expand-file-name file)) + (let* ((coding-system (or coding-system-for-write + (if (fboundp 'select-safe-coding-system) + ;; This is needed since Emacs 22 has + ;; no-conversion setting for *.gpg in + ;; `auto-coding-alist'. + (let ((buffer-file-name + (file-name-sans-extension file))) + (select-safe-coding-system + (point-min) (point-max))) + buffer-file-coding-system))) + (context (epg-make-context)) + (coding-system-for-write 'binary) + string entry + (recipients + (cond + ((listp epa-file-encrypt-to) epa-file-encrypt-to) + ((stringp epa-file-encrypt-to) (list epa-file-encrypt-to))))) + (epg-context-set-passphrase-callback + context + (cons #'epa-file-passphrase-callback-function + file)) + (epg-context-set-progress-callback context + #'epa-progress-callback-function) + (epg-context-set-armor context epa-armor) + (condition-case error + (setq string + (epg-encrypt-string + context + (if (stringp start) + (epa-file--encode-coding-string start coding-system) + (epa-file--encode-coding-string (buffer-substring start end) + coding-system)) + (if (or epa-file-select-keys + (not (local-variable-p 'epa-file-encrypt-to + (current-buffer)))) + (epa-select-keys + context + "Select recipents for encryption. +If no one is selected, symmetric encryption will be performed. " + recipients) + (if epa-file-encrypt-to + (epg-list-keys context recipients))))) + (error + (if (setq entry (assoc file epa-file-passphrase-alist)) + (setcdr entry nil)) + (signal 'file-error (cons "Opening output file" (cdr error))))) + (epa-file-run-real-handler + #'write-region + (list string nil file append visit lockname mustbenew)) + (if (boundp 'last-coding-system-used) + (setq last-coding-system-used coding-system)) + (if (eq visit t) + (progn + (setq buffer-file-name file) + (set-visited-file-modtime)) + (if (stringp visit) + (progn + (set-visited-file-modtime) + (setq buffer-file-name visit)))) + (if (or (eq visit t) + (eq visit nil) + (stringp visit)) + (message "Wrote %s" buffer-file-name)))) +(put 'write-region 'epa-file 'epa-file-write-region) + +(defun epa-file-find-file-hook () + (if (and buffer-file-name + (string-match epa-file-name-regexp buffer-file-name) + epa-file-inhibit-auto-save) + (auto-save-mode 0)) + (set-buffer-modified-p nil)) + +(defun epa-file-select-keys () + "Select recipients for encryption." + (interactive) + (make-local-variable 'epa-file-encrypt-to) + (setq epa-file-encrypt-to + (epa-select-keys + (epg-make-context) + "Select recipents for encryption. +If no one is selected, symmetric encryption will be performed. "))) + +;;;###autoload +(defun epa-file-enable () + (interactive) + (if (memq epa-file-handler file-name-handler-alist) + (message "`epa-file' already enabled") + (setq file-name-handler-alist + (cons epa-file-handler file-name-handler-alist)) + (add-hook 'find-file-hooks 'epa-file-find-file-hook) + (setq auto-mode-alist (cons epa-file-auto-mode-alist-entry auto-mode-alist)) + (message "`epa-file' enabled"))) + +;;;###autoload +(defun epa-file-disable () + (interactive) + (if (memq epa-file-handler file-name-handler-alist) + (progn + (setq file-name-handler-alist + (delq epa-file-handler file-name-handler-alist)) + (remove-hook 'find-file-hooks 'epa-file-find-file-hook) + (setq auto-mode-alist (delq epa-file-auto-mode-alist-entry + auto-mode-alist)) + (message "`epa-file' disabled")) + (message "`epa-file' already disabled"))) + +(provide 'epa-file) + +;;; epa-file.el ends here diff --git a/lisp/epa-mail.el b/lisp/epa-mail.el new file mode 100644 index 0000000000..f88a6f11b4 --- /dev/null +++ b/lisp/epa-mail.el @@ -0,0 +1,178 @@ +;;; epa-mail.el --- the EasyPG Assistant, minor-mode for mail composer +;; Copyright (C) 2006, 2007, 2008 Free Software Foundation, Inc. + +;; Author: Daiki Ueno <ueno@unixuser.org> +;; Keywords: PGP, GnuPG, mail, message + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published 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 'epa) +(require 'mail-utils) + +(defvar epa-mail-mode-map + (let ((keymap (make-sparse-keymap))) + (define-key keymap "\C-c\C-ed" 'epa-mail-decrypt) + (define-key keymap "\C-c\C-ev" 'epa-mail-verify) + (define-key keymap "\C-c\C-es" 'epa-mail-sign) + (define-key keymap "\C-c\C-ee" 'epa-mail-encrypt) + (define-key keymap "\C-c\C-ei" 'epa-mail-import-keys) + (define-key keymap "\C-c\C-eo" 'epa-insert-keys) + keymap)) + +(defvar epa-mail-mode-hook nil) +(defvar epa-mail-mode-on-hook nil) +(defvar epa-mail-mode-off-hook nil) + +(define-minor-mode epa-mail-mode + "A minor-mode for composing encrypted/clearsigned mails." + nil " epa-mail" epa-mail-mode-map) + +(defun epa-mail--find-usable-key (keys usage) + "Find a usable key from KEYS for USAGE." + (catch 'found + (while keys + (let ((pointer (epg-key-sub-key-list (car keys)))) + (while pointer + (if (and (memq usage (epg-sub-key-capability (car pointer))) + (not (memq (epg-sub-key-validity (car pointer)) + '(revoked expired)))) + (throw 'found (car keys))) + (setq pointer (cdr pointer)))) + (setq keys (cdr keys))))) + +;;;###autoload +(defun epa-mail-decrypt () + "Decrypt OpenPGP armors in the current buffer. +The buffer is expected to contain a mail message. + +Don't use this command in Lisp programs!" + (interactive) + (epa-decrypt-armor-in-region (point-min) (point-max))) + +;;;###autoload +(defun epa-mail-verify () + "Verify OpenPGP cleartext signed messages in the current buffer. +The buffer is expected to contain a mail message. + +Don't use this command in Lisp programs!" + (interactive) + (epa-verify-cleartext-in-region (point-min) (point-max))) + +;;;###autoload +(defun epa-mail-sign (start end signers mode) + "Sign the current buffer. +The buffer is expected to contain a mail message. + +Don't use this command in Lisp programs!" + (interactive + (save-excursion + (goto-char (point-min)) + (if (search-forward mail-header-separator nil t) + (forward-line)) + (setq epa-last-coding-system-specified + (or coding-system-for-write + (epa--select-safe-coding-system (point) (point-max)))) + (let ((verbose current-prefix-arg)) + (list (point) (point-max) + (if verbose + (epa-select-keys (epg-make-context epa-protocol) + "Select keys for signing. +If no one is selected, default secret key is used. " + nil t)) + (if verbose + (epa--read-signature-type) + 'clear))))) + (epa-sign-region start end signers mode)) + +;;;###autoload +(defun epa-mail-encrypt (start end recipients sign signers) + "Encrypt the current buffer. +The buffer is expected to contain a mail message. + +Don't use this command in Lisp programs!" + (interactive + (save-excursion + (let ((verbose current-prefix-arg) + (context (epg-make-context epa-protocol)) + recipients recipient-key) + (goto-char (point-min)) + (save-restriction + (narrow-to-region (point) + (if (search-forward mail-header-separator nil 0) + (match-beginning 0) + (point))) + (setq recipients + (mail-strip-quoted-names + (mapconcat #'identity + (nconc (mail-fetch-field "to" nil nil t) + (mail-fetch-field "cc" nil nil t) + (mail-fetch-field "bcc" nil nil t)) + ",")))) + (if recipients + (setq recipients (delete "" + (split-string recipients "[ \t\n]+")))) + (goto-char (point-min)) + (if (search-forward mail-header-separator nil t) + (forward-line)) + (setq epa-last-coding-system-specified + (or coding-system-for-write + (epa--select-safe-coding-system (point) (point-max)))) + (list (point) (point-max) + (if verbose + (epa-select-keys + context + "Select recipients for encryption. +If no one is selected, symmetric encryption will be performed. " + recipients) + (if recipients + (mapcar + (lambda (recipient) + (setq recipient-key + (epa-mail--find-usable-key + (epg-list-keys + (epg-make-context epa-protocol) + (concat "<" recipient ">")) + 'encrypt)) + (unless (or recipient-key + (y-or-n-p + (format + "No public key for %s; skip it? " + recipient))) + (error "No public key for %s" recipient)) + recipient-key) + recipients))) + (setq sign (if verbose (y-or-n-p "Sign? "))) + (if sign + (epa-select-keys context + "Select keys for signing. ")))))) + (epa-encrypt-region start end recipients sign signers)) + +;;;###autoload +(defun epa-mail-import-keys () + "Import keys in the OpenPGP armor format in the current buffer. +The buffer is expected to contain a mail message. + +Don't use this command in Lisp programs!" + (interactive) + (epa-import-armor-in-region (point-min) (point-max))) + +(provide 'epa-mail) + +;;; epa-mail.el ends here diff --git a/lisp/epa-setup.el b/lisp/epa-setup.el new file mode 100644 index 0000000000..8737fed4a5 --- /dev/null +++ b/lisp/epa-setup.el @@ -0,0 +1,39 @@ +;;; epa-setup.el --- setup routine for the EasyPG Assistant. +;; Copyright (C) 2006, 2007, 2008 Free Software Foundation, Inc. + +;; Author: Daiki Ueno <ueno@unixuser.org> +;; Keywords: PGP, GnuPG + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published 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: + +(autoload 'epa-list-keys "epa") + +(autoload 'epa-dired-mode-hook "epa-dired") +(add-hook 'dired-mode-hook 'epa-dired-mode-hook) + +(require 'epa-file) +(epa-file-enable) + +(autoload 'epa-mail-mode "epa-mail") +(add-hook 'mail-mode-hook 'epa-mail-mode) + +(provide 'epa-setup) + +;;; epa-setup.el ends here diff --git a/lisp/epa.el b/lisp/epa.el new file mode 100644 index 0000000000..700a41f36f --- /dev/null +++ b/lisp/epa.el @@ -0,0 +1,1176 @@ +;;; epa.el --- the EasyPG Assistant +;; Copyright (C) 2006, 2007, 2008 Free Software Foundation, Inc. + +;; Author: Daiki Ueno <ueno@unixuser.org> +;; Keywords: PGP, GnuPG + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published 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 'epg) +(require 'font-lock) +(require 'widget) +(eval-when-compile (require 'wid-edit)) +(require 'derived) + +(defgroup epa nil + "The EasyPG Assistant" + :group 'epg) + +(defcustom epa-popup-info-window t + "If non-nil, status information from epa commands is displayed on +the separate window." + :type 'boolean + :group 'epa) + +(defcustom epa-info-window-height 5 + "Number of lines used to display status information." + :type 'integer + :group 'epa) + +(defgroup epa-faces nil + "Faces for epa-mode." + :group 'epa) + +(defface epa-validity-high + `((((class color) (background dark)) + (:foreground "PaleTurquoise" + ,@(if (assq ':weight custom-face-attributes) + '(:weight bold) + '(:bold t)))) + (t + (,@(if (assq ':weight custom-face-attributes) + '(:weight bold) + '(:bold t))))) + "Face used for displaying the high validity." + :group 'epa-faces) + +(defface epa-validity-medium + `((((class color) (background dark)) + (:foreground "PaleTurquoise" + ,@(if (assq ':slant custom-face-attributes) + '(:slant italic) + '(:italic t)))) + (t + (,@(if (assq ':slant custom-face-attributes) + '(:slant italic) + '(:italic t))))) + "Face used for displaying the medium validity." + :group 'epa-faces) + +(defface epa-validity-low + `((t + (,@(if (assq ':slant custom-face-attributes) + '(:slant italic) + '(:italic t))))) + "Face used for displaying the low validity." + :group 'epa-faces) + +(defface epa-validity-disabled + `((t + (,@(if (assq ':slant custom-face-attributes) + '(:slant italic) + '(:italic t)) + :inverse-video t))) + "Face used for displaying the disabled validity." + :group 'epa-faces) + +(defface epa-string + '((((class color) (background dark)) + (:foreground "lightyellow")) + (((class color) (background light)) + (:foreground "blue4"))) + "Face used for displaying the string." + :group 'epa-faces) + +(defface epa-mark + `((((class color) (background dark)) + (:foreground "orange" + ,@(if (assq ':weight custom-face-attributes) + '(:weight bold) + '(:bold t)))) + (((class color) (background light)) + (:foreground "red" + ,@(if (assq ':weight custom-face-attributes) + '(:weight bold) + '(:bold t)))) + (t + (,@(if (assq ':weight custom-face-attributes) + '(:weight bold) + '(:bold t))))) + "Face used for displaying the high validity." + :group 'epa-faces) + +(defface epa-field-name + `((((class color) (background dark)) + (:foreground "PaleTurquoise" + ,@(if (assq ':weight custom-face-attributes) + '(:weight bold) + '(:bold t)))) + (t + (,@(if (assq ':weight custom-face-attributes) + '(:weight bold) + '(:bold t))))) + "Face for the name of the attribute field." + :group 'epa) + +(defface epa-field-body + `((((class color) (background dark)) + (:foreground "turquoise" + ,@(if (assq ':slant custom-face-attributes) + '(:slant italic) + '(:italic t)))) + (t + (,@(if (assq ':slant custom-face-attributes) + '(:slant italic) + '(:italic t))))) + "Face for the body of the attribute field." + :group 'epa) + +(defcustom epa-validity-face-alist + '((unknown . epa-validity-disabled) + (invalid . epa-validity-disabled) + (disabled . epa-validity-disabled) + (revoked . epa-validity-disabled) + (expired . epa-validity-disabled) + (none . epa-validity-low) + (undefined . epa-validity-low) + (never . epa-validity-low) + (marginal . epa-validity-medium) + (full . epa-validity-high) + (ultimate . epa-validity-high)) + "An alist mapping validity values to faces." + :type '(repeat (cons symbol face)) + :group 'epa) + +(defvar epa-font-lock-keywords + '(("^\\*" + (0 'epa-mark)) + ("^\t\\([^\t:]+:\\)[ \t]*\\(.*\\)$" + (1 'epa-field-name) + (2 'epa-field-body))) + "Default expressions to addon in epa-mode.") + +(defconst epa-pubkey-algorithm-letter-alist + '((1 . ?R) + (2 . ?r) + (3 . ?s) + (16 . ?g) + (17 . ?D) + (20 . ?G))) + +(defvar epa-protocol 'OpenPGP + "*The default protocol. +The value can be either OpenPGP or CMS. + +You should bind this variable with `let', but do not set it globally.") + +(defvar epa-armor nil + "*If non-nil, epa commands create ASCII armored output. + +You should bind this variable with `let', but do not set it globally.") + +(defvar epa-textmode nil + "*If non-nil, epa commands treat input files as text. + +You should bind this variable with `let', but do not set it globally.") + +(defvar epa-keys-buffer nil) +(defvar epa-key-buffer-alist nil) +(defvar epa-key nil) +(defvar epa-list-keys-arguments nil) +(defvar epa-info-buffer nil) +(defvar epa-last-coding-system-specified nil) + +(defvar epa-key-list-mode-map + (let ((keymap (make-sparse-keymap))) + (define-key keymap "m" 'epa-mark-key) + (define-key keymap "u" 'epa-unmark-key) + (define-key keymap "d" 'epa-decrypt-file) + (define-key keymap "v" 'epa-verify-file) + (define-key keymap "s" 'epa-sign-file) + (define-key keymap "e" 'epa-encrypt-file) + (define-key keymap "r" 'epa-delete-keys) + (define-key keymap "i" 'epa-import-keys) + (define-key keymap "o" 'epa-export-keys) + (define-key keymap "g" 'revert-buffer) + (define-key keymap "n" 'next-line) + (define-key keymap "p" 'previous-line) + (define-key keymap " " 'scroll-up) + (define-key keymap [delete] 'scroll-down) + (define-key keymap "q" 'epa-exit-buffer) + keymap)) + +(defvar epa-key-mode-map + (let ((keymap (make-sparse-keymap))) + (define-key keymap "q" 'epa-exit-buffer) + keymap)) + +(defvar epa-info-mode-map + (let ((keymap (make-sparse-keymap))) + (define-key keymap "q" 'delete-window) + keymap)) + +(defvar epa-exit-buffer-function #'bury-buffer) + +(define-widget 'epa-key 'push-button + "Button for representing a epg-key object." + :format "%[%v%]" + :button-face-get 'epa--key-widget-button-face-get + :value-create 'epa--key-widget-value-create + :action 'epa--key-widget-action + :help-echo 'epa--key-widget-help-echo) + +(defun epa--key-widget-action (widget &optional event) + (epa--show-key (widget-get widget :value))) + +(defun epa--key-widget-value-create (widget) + (let* ((key (widget-get widget :value)) + (primary-sub-key (car (epg-key-sub-key-list key))) + (primary-user-id (car (epg-key-user-id-list key)))) + (insert (format "%c " + (if (epg-sub-key-validity primary-sub-key) + (car (rassq (epg-sub-key-validity primary-sub-key) + epg-key-validity-alist)) + ? )) + (epg-sub-key-id primary-sub-key) + " " + (if primary-user-id + (if (stringp (epg-user-id-string primary-user-id)) + (epg-user-id-string primary-user-id) + (epg-decode-dn (epg-user-id-string primary-user-id))) + "")))) + +(defun epa--key-widget-button-face-get (widget) + (let ((validity (epg-sub-key-validity (car (epg-key-sub-key-list + (widget-get widget :value)))))) + (if validity + (cdr (assq validity epa-validity-face-alist)) + 'default))) + +(defun epa--key-widget-help-echo (widget) + (format "Show %s" + (epg-sub-key-id (car (epg-key-sub-key-list + (widget-get widget :value)))))) + +(eval-and-compile + (if (fboundp 'encode-coding-string) + (defalias 'epa--encode-coding-string 'encode-coding-string) + (defalias 'epa--encode-coding-string 'identity))) + +(eval-and-compile + (if (fboundp 'decode-coding-string) + (defalias 'epa--decode-coding-string 'decode-coding-string) + (defalias 'epa--decode-coding-string 'identity))) + +(defun epa-key-list-mode () + "Major mode for `epa-list-keys'." + (kill-all-local-variables) + (buffer-disable-undo) + (setq major-mode 'epa-key-list-mode + mode-name "Keys" + truncate-lines t + buffer-read-only t) + (use-local-map epa-key-list-mode-map) + (make-local-variable 'font-lock-defaults) + (setq font-lock-defaults '(epa-font-lock-keywords t)) + ;; In XEmacs, auto-initialization of font-lock is not effective + ;; if buffer-file-name is not set. + (font-lock-set-defaults) + (make-local-variable 'epa-exit-buffer-function) + (make-local-variable 'revert-buffer-function) + (setq revert-buffer-function 'epa--key-list-revert-buffer) + (run-hooks 'epa-key-list-mode-hook)) + +(defun epa-key-mode () + "Major mode for a key description." + (kill-all-local-variables) + (buffer-disable-undo) + (setq major-mode 'epa-key-mode + mode-name "Key" + truncate-lines t + buffer-read-only t) + (use-local-map epa-key-mode-map) + (make-local-variable 'font-lock-defaults) + (setq font-lock-defaults '(epa-font-lock-keywords t)) + ;; In XEmacs, auto-initialization of font-lock is not effective + ;; if buffer-file-name is not set. + (font-lock-set-defaults) + (make-local-variable 'epa-exit-buffer-function) + (run-hooks 'epa-key-mode-hook)) + +(defun epa-info-mode () + "Major mode for `epa-info-buffer'." + (kill-all-local-variables) + (buffer-disable-undo) + (setq major-mode 'epa-info-mode + mode-name "Info" + truncate-lines t + buffer-read-only t) + (use-local-map epa-info-mode-map) + (run-hooks 'epa-info-mode-hook)) + +(defun epa-mark-key (&optional arg) + "Mark a key on the current line. +If ARG is non-nil, unmark the key." + (interactive "P") + (let ((inhibit-read-only t) + buffer-read-only + properties) + (beginning-of-line) + (unless (get-text-property (point) 'epa-key) + (error "No key on this line")) + (setq properties (text-properties-at (point))) + (delete-char 1) + (insert (if arg " " "*")) + (set-text-properties (1- (point)) (point) properties) + (forward-line))) + +(defun epa-unmark-key (&optional arg) + "Unmark a key on the current line. +If ARG is non-nil, mark the key." + (interactive "P") + (epa-mark-key (not arg))) + +(defun epa-exit-buffer () + "Exit the current buffer. +`epa-exit-buffer-function' is called if it is set." + (interactive) + (funcall epa-exit-buffer-function)) + +(defun epa--insert-keys (keys) + (save-excursion + (save-restriction + (narrow-to-region (point) (point)) + (let (point) + (while keys + (setq point (point)) + (insert " ") + (add-text-properties point (point) + (list 'epa-key (car keys) + 'front-sticky nil + 'rear-nonsticky t + 'start-open t + 'end-open t)) + (widget-create 'epa-key :value (car keys)) + (insert "\n") + (setq keys (cdr keys)))) + (add-text-properties (point-min) (point-max) + (list 'epa-list-keys t + 'front-sticky nil + 'rear-nonsticky t + 'start-open t + 'end-open t))))) + +(defun epa--list-keys (name secret) + (unless (and epa-keys-buffer + (buffer-live-p epa-keys-buffer)) + (setq epa-keys-buffer (generate-new-buffer "*Keys*"))) + (set-buffer epa-keys-buffer) + (epa-key-list-mode) + (let ((inhibit-read-only t) + buffer-read-only + (point (point-min)) + (context (epg-make-context epa-protocol))) + (unless (get-text-property point 'epa-list-keys) + (setq point (next-single-property-change point 'epa-list-keys))) + (when point + (delete-region point + (or (next-single-property-change point 'epa-list-keys) + (point-max))) + (goto-char point)) + (epa--insert-keys (epg-list-keys context name secret)) + (widget-setup) + (set-keymap-parent (current-local-map) widget-keymap)) + (make-local-variable 'epa-list-keys-arguments) + (setq epa-list-keys-arguments (list name secret)) + (goto-char (point-min)) + (pop-to-buffer (current-buffer))) + +;;;###autoload +(defun epa-list-keys (&optional name) + "List all keys matched with NAME from the public keyring." + (interactive + (if current-prefix-arg + (let ((name (read-string "Pattern: " + (if epa-list-keys-arguments + (car epa-list-keys-arguments))))) + (list (if (equal name "") nil name))) + (list nil))) + (epa--list-keys name nil)) + +;;;###autoload +(defun epa-list-secret-keys (&optional name) + "List all keys matched with NAME from the private keyring." + (interactive + (if current-prefix-arg + (let ((name (read-string "Pattern: " + (if epa-list-keys-arguments + (car epa-list-keys-arguments))))) + (list (if (equal name "") nil name))) + (list nil))) + (epa--list-keys name t)) + +(defun epa--key-list-revert-buffer (&optional ignore-auto noconfirm) + (apply #'epa--list-keys epa-list-keys-arguments)) + +(defun epa--marked-keys () + (or (save-excursion + (set-buffer epa-keys-buffer) + (goto-char (point-min)) + (let (keys key) + (while (re-search-forward "^\\*" nil t) + (if (setq key (get-text-property (match-beginning 0) + 'epa-key)) + (setq keys (cons key keys)))) + (nreverse keys))) + (save-excursion + (beginning-of-line) + (let ((key (get-text-property (point) 'epa-key))) + (if key + (list key)))))) + +(defun epa--select-keys (prompt keys) + (save-excursion + (unless (and epa-keys-buffer + (buffer-live-p epa-keys-buffer)) + (setq epa-keys-buffer (generate-new-buffer "*Keys*"))) + (set-buffer epa-keys-buffer) + (epa-key-list-mode) + (let ((inhibit-read-only t) + buffer-read-only) + (erase-buffer) + (insert prompt "\n" + (substitute-command-keys "\ +- `\\[epa-mark-key]' to mark a key on the line +- `\\[epa-unmark-key]' to unmark a key on the line\n")) + (widget-create 'link + :notify (lambda (&rest ignore) (abort-recursive-edit)) + :help-echo + (substitute-command-keys + "Click here or \\[abort-recursive-edit] to cancel") + "Cancel") + (widget-create 'link + :notify (lambda (&rest ignore) (exit-recursive-edit)) + :help-echo + (substitute-command-keys + "Click here or \\[exit-recursive-edit] to finish") + "OK") + (insert "\n\n") + (epa--insert-keys keys) + (widget-setup) + (set-keymap-parent (current-local-map) widget-keymap) + (setq epa-exit-buffer-function #'abort-recursive-edit) + (goto-char (point-min)) + (pop-to-buffer (current-buffer))) + (unwind-protect + (progn + (recursive-edit) + (epa--marked-keys)) + (if (get-buffer-window epa-keys-buffer) + (delete-window (get-buffer-window epa-keys-buffer))) + (kill-buffer epa-keys-buffer)))) + +;;;###autoload +(defun epa-select-keys (context prompt &optional names secret) + "Display a user's keyring and ask him to select keys. +CONTEXT is an epg-context. +PROMPT is a string to prompt with. +NAMES is a list of strings to be matched with keys. If it is nil, all +the keys are listed. +If SECRET is non-nil, list secret keys instead of public keys." + (let ((keys (epg-list-keys context names secret))) + (if (> (length keys) 1) + (epa--select-keys prompt keys) + keys))) + +(defun epa--show-key (key) + (let* ((primary-sub-key (car (epg-key-sub-key-list key))) + (entry (assoc (epg-sub-key-id primary-sub-key) + epa-key-buffer-alist)) + (inhibit-read-only t) + buffer-read-only + pointer) + (unless entry + (setq entry (cons (epg-sub-key-id primary-sub-key) nil) + epa-key-buffer-alist (cons entry epa-key-buffer-alist))) + (unless (and (cdr entry) + (buffer-live-p (cdr entry))) + (setcdr entry (generate-new-buffer + (format "*Key*%s" (epg-sub-key-id primary-sub-key))))) + (set-buffer (cdr entry)) + (epa-key-mode) + (make-local-variable 'epa-key) + (setq epa-key key) + (erase-buffer) + (setq pointer (epg-key-user-id-list key)) + (while pointer + (if (car pointer) + (insert " " + (if (epg-user-id-validity (car pointer)) + (char-to-string + (car (rassq (epg-user-id-validity (car pointer)) + epg-key-validity-alist))) + " ") + " " + (if (stringp (epg-user-id-string (car pointer))) + (epg-user-id-string (car pointer)) + (epg-decode-dn (epg-user-id-string (car pointer)))) + "\n")) + (setq pointer (cdr pointer))) + (setq pointer (epg-key-sub-key-list key)) + (while pointer + (insert " " + (if (epg-sub-key-validity (car pointer)) + (char-to-string + (car (rassq (epg-sub-key-validity (car pointer)) + epg-key-validity-alist))) + " ") + " " + (epg-sub-key-id (car pointer)) + " " + (format "%dbits" + (epg-sub-key-length (car pointer))) + " " + (cdr (assq (epg-sub-key-algorithm (car pointer)) + epg-pubkey-algorithm-alist)) + "\n\tCreated: " + (condition-case nil + (format-time-string "%Y-%m-%d" + (epg-sub-key-creation-time (car pointer))) + (error "????-??-??")) + (if (epg-sub-key-expiration-time (car pointer)) + (format "\n\tExpires: %s" + (condition-case nil + (format-time-string "%Y-%m-%d" + (epg-sub-key-expiration-time + (car pointer))) + (error "????-??-??"))) + "") + "\n\tCapabilities: " + (mapconcat #'symbol-name + (epg-sub-key-capability (car pointer)) + " ") + "\n\tFingerprint: " + (epg-sub-key-fingerprint (car pointer)) + "\n") + (setq pointer (cdr pointer))) + (goto-char (point-min)) + (pop-to-buffer (current-buffer)))) + +(defun epa-display-info (info) + (if epa-popup-info-window + (save-selected-window + (unless (and epa-info-buffer (buffer-live-p epa-info-buffer)) + (setq epa-info-buffer (generate-new-buffer "*Info*"))) + (if (get-buffer-window epa-info-buffer) + (delete-window (get-buffer-window epa-info-buffer))) + (save-excursion + (set-buffer epa-info-buffer) + (let ((inhibit-read-only t) + buffer-read-only) + (erase-buffer) + (insert info)) + (epa-info-mode) + (goto-char (point-min))) + (if (> (window-height) + epa-info-window-height) + (set-window-buffer (split-window nil (- (window-height) + epa-info-window-height)) + epa-info-buffer) + (pop-to-buffer epa-info-buffer) + (if (> (window-height) epa-info-window-height) + (shrink-window (- (window-height) epa-info-window-height))))) + (message "%s" info))) + +(defun epa-display-verify-result (verify-result) + (epa-display-info (epg-verify-result-to-string verify-result))) +(make-obsolete 'epa-display-verify-result 'epa-display-info) + +(defun epa-passphrase-callback-function (context key-id handback) + (if (eq key-id 'SYM) + (read-passwd "Passphrase for symmetric encryption: " + (eq (epg-context-operation context) 'encrypt)) + (read-passwd + (if (eq key-id 'PIN) + "Passphrase for PIN: " + (let ((entry (assoc key-id epg-user-id-alist))) + (if entry + (format "Passphrase for %s %s: " key-id (cdr entry)) + (format "Passphrase for %s: " key-id))))))) + +(defun epa-progress-callback-function (context what char current total + handback) + (message "%s%d%% (%d/%d)" (or handback + (concat what ": ")) + (if (> total 0) (floor (* (/ current (float total)) 100)) 0) + current total)) + +;;;###autoload +(defun epa-decrypt-file (file) + "Decrypt FILE." + (interactive "fFile: ") + (setq file (expand-file-name file)) + (let* ((default-name (file-name-sans-extension file)) + (plain (expand-file-name + (read-file-name + (concat "To file (default " + (file-name-nondirectory default-name) + ") ") + (file-name-directory default-name) + default-name))) + (context (epg-make-context epa-protocol))) + (epg-context-set-passphrase-callback context + #'epa-passphrase-callback-function) + (epg-context-set-progress-callback context + (cons + #'epa-progress-callback-function + (format "Decrypting %s..." + (file-name-nondirectory file)))) + (message "Decrypting %s..." (file-name-nondirectory file)) + (epg-decrypt-file context file plain) + (message "Decrypting %s...wrote %s" (file-name-nondirectory file) + (file-name-nondirectory plain)) + (if (epg-context-result-for context 'verify) + (epa-display-info (epg-verify-result-to-string + (epg-context-result-for context 'verify)))))) + +;;;###autoload +(defun epa-verify-file (file) + "Verify FILE." + (interactive "fFile: ") + (setq file (expand-file-name file)) + (let* ((context (epg-make-context epa-protocol)) + (plain (if (equal (file-name-extension file) "sig") + (file-name-sans-extension file)))) + (epg-context-set-progress-callback context + (cons + #'epa-progress-callback-function + (format "Verifying %s..." + (file-name-nondirectory file)))) + (message "Verifying %s..." (file-name-nondirectory file)) + (epg-verify-file context file plain) + (message "Verifying %s...done" (file-name-nondirectory file)) + (if (epg-context-result-for context 'verify) + (epa-display-info (epg-verify-result-to-string + (epg-context-result-for context 'verify)))))) + +(defun epa--read-signature-type () + (let (type c) + (while (null type) + (message "Signature type (n,c,d,?) ") + (setq c (read-char)) + (cond ((eq c ?c) + (setq type 'clear)) + ((eq c ?d) + (setq type 'detached)) + ((eq c ??) + (with-output-to-temp-buffer "*Help*" + (save-excursion + (set-buffer standard-output) + (insert "\ +n - Create a normal signature +c - Create a cleartext signature +d - Create a detached signature +? - Show this help +")))) + (t + (setq type 'normal)))))) + +;;;###autoload +(defun epa-sign-file (file signers mode) + "Sign FILE by SIGNERS keys selected." + (interactive + (let ((verbose current-prefix-arg)) + (list (expand-file-name (read-file-name "File: ")) + (if verbose + (epa-select-keys (epg-make-context epa-protocol) + "Select keys for signing. +If no one is selected, default secret key is used. " + nil t)) + (if verbose + (epa--read-signature-type) + 'clear)))) + (let ((signature (concat file + (if (eq epa-protocol 'OpenPGP) + (if (or epa-armor + (not (memq mode + '(nil t normal detached)))) + ".asc" + (if (memq mode '(t detached)) + ".sig" + ".gpg")) + (if (memq mode '(t detached)) + ".p7s" + ".p7m")))) + (context (epg-make-context epa-protocol))) + (epg-context-set-armor context epa-armor) + (epg-context-set-textmode context epa-textmode) + (epg-context-set-signers context signers) + (epg-context-set-passphrase-callback context + #'epa-passphrase-callback-function) + (epg-context-set-progress-callback context + (cons + #'epa-progress-callback-function + (format "Signing %s..." + (file-name-nondirectory file)))) + (message "Signing %s..." (file-name-nondirectory file)) + (epg-sign-file context file signature mode) + (message "Signing %s...wrote %s" (file-name-nondirectory file) + (file-name-nondirectory signature)))) + +;;;###autoload +(defun epa-encrypt-file (file recipients) + "Encrypt FILE for RECIPIENTS." + (interactive + (list (expand-file-name (read-file-name "File: ")) + (epa-select-keys (epg-make-context epa-protocol) + "Select recipients for encryption. +If no one is selected, symmetric encryption will be performed. "))) + (let ((cipher (concat file (if (eq epa-protocol 'OpenPGP) + (if epa-armor ".asc" ".gpg") + ".p7m"))) + (context (epg-make-context epa-protocol))) + (epg-context-set-armor context epa-armor) + (epg-context-set-textmode context epa-textmode) + (epg-context-set-passphrase-callback context + #'epa-passphrase-callback-function) + (epg-context-set-progress-callback context + (cons + #'epa-progress-callback-function + (format "Encrypting %s..." + (file-name-nondirectory file)))) + (message "Encrypting %s..." (file-name-nondirectory file)) + (epg-encrypt-file context file recipients cipher) + (message "Encrypting %s...wrote %s" (file-name-nondirectory file) + (file-name-nondirectory cipher)))) + +;;;###autoload +(defun epa-decrypt-region (start end) + "Decrypt the current region between START and END. + +Don't use this command in Lisp programs!" + (interactive "r") + (save-excursion + (let ((context (epg-make-context epa-protocol)) + plain) + (epg-context-set-passphrase-callback context + #'epa-passphrase-callback-function) + (epg-context-set-progress-callback context + (cons + #'epa-progress-callback-function + "Decrypting...")) + (message "Decrypting...") + (setq plain (epg-decrypt-string context (buffer-substring start end))) + (message "Decrypting...done") + (setq plain (epa--decode-coding-string + plain + (or coding-system-for-read + (get-text-property start 'epa-coding-system-used)))) + (if (y-or-n-p "Replace the original text? ") + (let ((inhibit-read-only t) + buffer-read-only) + (delete-region start end) + (goto-char start) + (insert plain)) + (with-output-to-temp-buffer "*Temp*" + (set-buffer standard-output) + (insert plain) + (epa-info-mode))) + (if (epg-context-result-for context 'verify) + (epa-display-info (epg-verify-result-to-string + (epg-context-result-for context 'verify))))))) + +(defun epa--find-coding-system-for-mime-charset (mime-charset) + (if (featurep 'xemacs) + (if (fboundp 'find-coding-system) + (find-coding-system mime-charset)) + (let ((pointer (coding-system-list))) + (while (and pointer + (eq (coding-system-get (car pointer) 'mime-charset) + mime-charset)) + (setq pointer (cdr pointer))) + pointer))) + +;;;###autoload +(defun epa-decrypt-armor-in-region (start end) + "Decrypt OpenPGP armors in the current region between START and END. + +Don't use this command in Lisp programs!" + (interactive "r") + (save-excursion + (save-restriction + (narrow-to-region start end) + (goto-char start) + (let (armor-start armor-end) + (while (re-search-forward "-----BEGIN PGP MESSAGE-----$" nil t) + (setq armor-start (match-beginning 0) + armor-end (re-search-forward "^-----END PGP MESSAGE-----$" + nil t)) + (unless armor-end + (error "No armor tail")) + (goto-char armor-start) + (let ((coding-system-for-read + (or coding-system-for-read + (if (re-search-forward "^Charset: \\(.*\\)" armor-end t) + (epa--find-coding-system-for-mime-charset + (intern (downcase (match-string 1)))))))) + (goto-char armor-end) + (epa-decrypt-region armor-start armor-end))))))) + +;;;###autoload +(defun epa-verify-region (start end) + "Verify the current region between START and END. + +Don't use this command in Lisp programs!" + (interactive "r") + (let ((context (epg-make-context epa-protocol)) + plain) + (epg-context-set-progress-callback context + (cons + #'epa-progress-callback-function + "Verifying...")) + (message "Verifying...") + (setq plain (epg-verify-string + context + (epa--encode-coding-string + (buffer-substring start end) + (or coding-system-for-write + (get-text-property start 'epa-coding-system-used))))) + (message "Verifying...done") + (setq plain (epa--decode-coding-string + plain + (or coding-system-for-read + (get-text-property start 'epa-coding-system-used)))) + (if (y-or-n-p "Replace the original text? ") + (let ((inhibit-read-only t) + buffer-read-only) + (delete-region start end) + (goto-char start) + (insert plain)) + (with-output-to-temp-buffer "*Temp*" + (set-buffer standard-output) + (insert plain) + (epa-info-mode))) + (if (epg-context-result-for context 'verify) + (epa-display-info (epg-verify-result-to-string + (epg-context-result-for context 'verify)))))) + +;;;###autoload +(defun epa-verify-cleartext-in-region (start end) + "Verify OpenPGP cleartext signed messages in the current region +between START and END. + +Don't use this command in Lisp programs!" + (interactive "r") + (save-excursion + (save-restriction + (narrow-to-region start end) + (goto-char start) + (let (cleartext-start cleartext-end) + (while (re-search-forward "-----BEGIN PGP SIGNED MESSAGE-----$" + nil t) + (setq cleartext-start (match-beginning 0)) + (unless (re-search-forward "^-----BEGIN PGP SIGNATURE-----$" + nil t) + (error "Invalid cleartext signed message")) + (setq cleartext-end (re-search-forward + "^-----END PGP SIGNATURE-----$" + nil t)) + (unless cleartext-end + (error "No cleartext tail")) + (epa-verify-region cleartext-start cleartext-end)))))) + +(eval-and-compile + (if (fboundp 'select-safe-coding-system) + (defalias 'epa--select-safe-coding-system 'select-safe-coding-system) + (defun epa--select-safe-coding-system (from to) + buffer-file-coding-system))) + +;;;###autoload +(defun epa-sign-region (start end signers mode) + "Sign the current region between START and END by SIGNERS keys selected. + +Don't use this command in Lisp programs!" + (interactive + (let ((verbose current-prefix-arg)) + (setq epa-last-coding-system-specified + (or coding-system-for-write + (epa--select-safe-coding-system + (region-beginning) (region-end)))) + (list (region-beginning) (region-end) + (if verbose + (epa-select-keys (epg-make-context epa-protocol) + "Select keys for signing. +If no one is selected, default secret key is used. " + nil t)) + (if verbose + (epa--read-signature-type) + 'clear)))) + (save-excursion + (let ((context (epg-make-context epa-protocol)) + signature) + ;;(epg-context-set-armor context epa-armor) + (epg-context-set-armor context t) + ;;(epg-context-set-textmode context epa-textmode) + (epg-context-set-textmode context t) + (epg-context-set-signers context signers) + (epg-context-set-passphrase-callback context + #'epa-passphrase-callback-function) + (epg-context-set-progress-callback context + (cons + #'epa-progress-callback-function + "Signing...")) + (message "Signing...") + (setq signature (epg-sign-string context + (epa--encode-coding-string + (buffer-substring start end) + epa-last-coding-system-specified) + mode)) + (message "Signing...done") + (delete-region start end) + (goto-char start) + (add-text-properties (point) + (progn + (insert (epa--decode-coding-string + signature + (or coding-system-for-read + epa-last-coding-system-specified))) + (point)) + (list 'epa-coding-system-used + epa-last-coding-system-specified + 'front-sticky nil + 'rear-nonsticky t + 'start-open t + 'end-open t))))) + +(eval-and-compile + (if (fboundp 'derived-mode-p) + (defalias 'epa--derived-mode-p 'derived-mode-p) + (defun epa--derived-mode-p (&rest modes) + "Non-nil if the current major mode is derived from one of MODES. +Uses the `derived-mode-parent' property of the symbol to trace backwards." + (let ((parent major-mode)) + (while (and (not (memq parent modes)) + (setq parent (get parent 'derived-mode-parent)))) + parent)))) + +;;;###autoload +(defun epa-encrypt-region (start end recipients sign signers) + "Encrypt the current region between START and END for RECIPIENTS. + +Don't use this command in Lisp programs!" + (interactive + (let ((verbose current-prefix-arg) + (context (epg-make-context epa-protocol)) + sign) + (setq epa-last-coding-system-specified + (or coding-system-for-write + (epa--select-safe-coding-system + (region-beginning) (region-end)))) + (list (region-beginning) (region-end) + (epa-select-keys context + "Select recipients for encryption. +If no one is selected, symmetric encryption will be performed. ") + (setq sign (if verbose (y-or-n-p "Sign? "))) + (if sign + (epa-select-keys context + "Select keys for signing. "))))) + (save-excursion + (let ((context (epg-make-context epa-protocol)) + cipher) + ;;(epg-context-set-armor context epa-armor) + (epg-context-set-armor context t) + ;;(epg-context-set-textmode context epa-textmode) + (epg-context-set-textmode context t) + (if sign + (epg-context-set-signers context signers)) + (epg-context-set-passphrase-callback context + #'epa-passphrase-callback-function) + (epg-context-set-progress-callback context + (cons + #'epa-progress-callback-function + "Encrypting...")) + (message "Encrypting...") + (setq cipher (epg-encrypt-string context + (epa--encode-coding-string + (buffer-substring start end) + epa-last-coding-system-specified) + recipients + sign)) + (message "Encrypting...done") + (delete-region start end) + (goto-char start) + (add-text-properties (point) + (progn + (insert cipher) + (point)) + (list 'epa-coding-system-used + epa-last-coding-system-specified + 'front-sticky nil + 'rear-nonsticky t + 'start-open t + 'end-open t))))) + +;;;###autoload +(defun epa-delete-keys (keys &optional allow-secret) + "Delete selected KEYS. + +Don't use this command in Lisp programs!" + (interactive + (let ((keys (epa--marked-keys))) + (unless keys + (error "No keys selected")) + (list keys + (eq (nth 1 epa-list-keys-arguments) t)))) + (let ((context (epg-make-context epa-protocol))) + (message "Deleting...") + (epg-delete-keys context keys allow-secret) + (message "Deleting...done") + (apply #'epa-list-keys epa-list-keys-arguments))) + +;;;###autoload +(defun epa-import-keys (file) + "Import keys from FILE. + +Don't use this command in Lisp programs!" + (interactive "fFile: ") + (setq file (expand-file-name file)) + (let ((context (epg-make-context epa-protocol))) + (message "Importing %s..." (file-name-nondirectory file)) + (condition-case nil + (progn + (epg-import-keys-from-file context file) + (message "Importing %s...done" (file-name-nondirectory file))) + (error + (message "Importing %s...failed" (file-name-nondirectory file)))) + (if (epg-context-result-for context 'import) + (epa-display-info (epg-import-result-to-string + (epg-context-result-for context 'import)))) + (if (eq major-mode 'epa-key-list-mode) + (apply #'epa-list-keys epa-list-keys-arguments)))) + +;;;###autoload +(defun epa-import-keys-region (start end) + "Import keys from the region. + +Don't use this command in Lisp programs!" + (interactive "r") + (let ((context (epg-make-context epa-protocol))) + (message "Importing...") + (condition-case nil + (progn + (epg-import-keys-from-string context (buffer-substring start end)) + (message "Importing...done")) + (error + (message "Importing...failed"))) + (if (epg-context-result-for context 'import) + (epa-display-info (epg-import-result-to-string + (epg-context-result-for context 'import)))))) + +;;;###autoload +(defun epa-import-armor-in-region (start end) + "Import keys in the OpenPGP armor format in the current region +between START and END. + +Don't use this command in Lisp programs!" + (interactive "r") + (save-excursion + (save-restriction + (narrow-to-region start end) + (goto-char start) + (let (armor-start armor-end) + (while (re-search-forward + "-----BEGIN \\(PGP \\(PUBLIC\\|PRIVATE\\) KEY BLOCK\\)-----$" + nil t) + (setq armor-start (match-beginning 0) + armor-end (re-search-forward + (concat "^-----END " (match-string 1) "-----$") + nil t)) + (unless armor-end + (error "No armor tail")) + (epa-import-keys-region armor-start armor-end)))))) + +;;;###autoload +(defun epa-export-keys (keys file) + "Export selected KEYS to FILE. + +Don't use this command in Lisp programs!" + (interactive + (let ((keys (epa--marked-keys)) + default-name) + (unless keys + (error "No keys selected")) + (setq default-name + (expand-file-name + (concat (epg-sub-key-id (car (epg-key-sub-key-list (car keys)))) + (if epa-armor ".asc" ".gpg")) + default-directory)) + (list keys + (expand-file-name + (read-file-name + (concat "To file (default " + (file-name-nondirectory default-name) + ") ") + (file-name-directory default-name) + default-name))))) + (let ((context (epg-make-context epa-protocol))) + (epg-context-set-armor context epa-armor) + (message "Exporting to %s..." (file-name-nondirectory file)) + (epg-export-keys-to-file context keys file) + (message "Exporting to %s...done" (file-name-nondirectory file)))) + +;;;###autoload +(defun epa-insert-keys (keys) + "Insert selected KEYS after the point. + +Don't use this command in Lisp programs!" + (interactive + (list (epa-select-keys (epg-make-context epa-protocol) + "Select keys to export. "))) + (let ((context (epg-make-context epa-protocol))) + ;;(epg-context-set-armor context epa-armor) + (epg-context-set-armor context t) + (insert (epg-export-keys-to-string context keys)))) + +;; (defun epa-sign-keys (keys &optional local) +;; "Sign selected KEYS. +;; If a prefix-arg is specified, the signature is marked as non exportable. + +;; Don't use this command in Lisp programs!" +;; (interactive +;; (let ((keys (epa--marked-keys))) +;; (unless keys +;; (error "No keys selected")) +;; (list keys current-prefix-arg))) +;; (let ((context (epg-make-context epa-protocol))) +;; (epg-context-set-passphrase-callback context +;; #'epa-passphrase-callback-function) +;; (epg-context-set-progress-callback context +;; (cons +;; #'epa-progress-callback-function +;; "Signing keys...")) +;; (message "Signing keys...") +;; (epg-sign-keys context keys local) +;; (message "Signing keys...done"))) +;; (make-obsolete 'epa-sign-keys "Do not use.") + +(provide 'epa) + +;;; epa.el ends here diff --git a/lisp/epg-config.el b/lisp/epg-config.el new file mode 100644 index 0000000000..6675cbc2ee --- /dev/null +++ b/lisp/epg-config.el @@ -0,0 +1,140 @@ +;;; epg-config.el --- configuration of the EasyPG Library +;; Copyright (C) 2006, 2007, 2008 Free Software Foundation, Inc. + +;; Author: Daiki Ueno <ueno@unixuser.org> +;; Keywords: PGP, GnuPG + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published 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 'epg-package-info) + +(defgroup epg () + "The EasyPG Library" + :group 'emacs) + +(defcustom epg-gpg-program "gpg" + "The `gpg' executable." + :group 'epg + :type 'string) + +(defcustom epg-gpgsm-program "gpgsm" + "The `gpgsm' executable." + :group 'epg + :type 'string) + +(defcustom epg-gpg-home-directory nil + "The directory which contains the configuration files of `epg-gpg-program'." + :group 'epg + :type '(choice (const :tag "Default" nil) directory)) + +(defcustom epg-passphrase-coding-system nil + "Coding system to use with messages from `epg-gpg-program'." + :group 'epg + :type 'symbol) + +(defcustom epg-debug nil + "If non-nil, debug output goes to the \" *epg-debug*\" buffer. +Note that the buffer name starts with a space." + :group 'epg + :type 'boolean) + +(defconst epg-gpg-minimum-version "1.4.3") + +;;;###autoload +(defun epg-configuration () + "Return a list of internal configuration parameters of `epg-gpg-program'." + (let (config groups type args) + (with-temp-buffer + (apply #'call-process epg-gpg-program nil (list t nil) nil + (append (if epg-gpg-home-directory + (list "--homedir" epg-gpg-home-directory)) + '("--with-colons" "--list-config"))) + (goto-char (point-min)) + (while (re-search-forward "^cfg:\\([^:]+\\):\\(.*\\)" nil t) + (setq type (intern (match-string 1)) + args (match-string 2)) + (cond + ((eq type 'group) + (if (string-match "\\`\\([^:]+\\):" args) + (setq groups + (cons (cons (downcase (match-string 1 args)) + (delete "" (split-string + (substring args + (match-end 0)) + ";"))) + groups)) + (if epg-debug + (message "Invalid group configuration: %S" args)))) + ((memq type '(pubkey cipher digest compress)) + (if (string-match "\\`\\([0-9]+\\)\\(;[0-9]+\\)*" args) + (setq config + (cons (cons type + (mapcar #'string-to-number + (delete "" (split-string args ";")))) + config)) + (if epg-debug + (message "Invalid %S algorithm configuration: %S" + type args)))) + (t + (setq config (cons (cons type args) config)))))) + (if groups + (cons (cons 'groups groups) config) + config))) + +(defun epg-config--parse-version (string) + (let ((index 0) + version) + (while (eq index (string-match "\\([0-9]+\\)\\.?" string index)) + (setq version (cons (string-to-number (match-string 1 string)) + version) + index (match-end 0))) + (nreverse version))) + +(defun epg-config--compare-version (v1 v2) + (while (and v1 v2 (= (car v1) (car v2))) + (setq v1 (cdr v1) v2 (cdr v2))) + (- (or (car v1) 0) (or (car v2) 0))) + +;;;###autoload +(defun epg-check-configuration (config &optional minimum-version) + "Verify that a sufficient version of GnuPG is installed." + (let ((entry (assq 'version config)) + version) + (unless (and entry + (stringp (cdr entry))) + (error "Undetermined version: %S" entry)) + (setq version (epg-config--parse-version (cdr entry)) + minimum-version (epg-config--parse-version + (or minimum-version + epg-gpg-minimum-version))) + (unless (>= (epg-config--compare-version version minimum-version) 0) + (error "Unsupported version: %s" (cdr entry))))) + +;;;###autoload +(defun epg-expand-group (config group) + "Look at CONFIG and try to expand GROUP." + (let ((entry (assq 'groups config))) + (if (and entry + (setq entry (assoc (downcase group) (cdr entry)))) + (cdr entry)))) + +(provide 'epg-config) + +;;; epg-config.el ends here diff --git a/lisp/epg-package-info.el b/lisp/epg-package-info.el new file mode 100644 index 0000000000..01709ee2a1 --- /dev/null +++ b/lisp/epg-package-info.el @@ -0,0 +1,37 @@ +;;; epg-package-info.el --- package information about EasyPG +;; Copyright (C) 2007, 2008 Free Software Foundation, Inc. + +;; Author: Daiki Ueno <ueno@unixuser.org> +;; Keywords: PGP, GnuPG + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published 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: + +(defconst epg-package-name "epg" + "Name of this package.") + +(defconst epg-version-number "1.0.0" + "Version number of this package.") + +(defconst epg-bug-report-address "ueno@unixuser.org" + "Report bugs to this address.") + +(provide 'epg-package-info) + +;;; epg-package-info.el ends here diff --git a/lisp/epg.el b/lisp/epg.el new file mode 100644 index 0000000000..d9c334d2f0 --- /dev/null +++ b/lisp/epg.el @@ -0,0 +1,2654 @@ +;;; epg.el --- the EasyPG Library +;; Copyright (C) 1999, 2000, 2002, 2003, 2004, +;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. + +;; Author: Daiki Ueno <ueno@unixuser.org> +;; Keywords: PGP, GnuPG + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published 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 'epg-config) + +(defvar epg-user-id nil + "GnuPG ID of your default identity.") + +(defvar epg-user-id-alist nil + "An alist mapping from key ID to user ID.") + +(defvar epg-last-status nil) +(defvar epg-read-point nil) +(defvar epg-process-filter-running nil) +(defvar epg-pending-status-list nil) +(defvar epg-key-id nil) +(defvar epg-context nil) +(defvar epg-debug-buffer nil) + +;; from gnupg/include/cipher.h +(defconst epg-cipher-algorithm-alist + '((0 . "NONE") + (1 . "IDEA") + (2 . "3DES") + (3 . "CAST5") + (4 . "BLOWFISH") + (7 . "AES") + (8 . "AES192") + (9 . "AES256") + (10 . "TWOFISH") + (110 . "DUMMY"))) + +;; from gnupg/include/cipher.h +(defconst epg-pubkey-algorithm-alist + '((1 . "RSA") + (2 . "RSA_E") + (3 . "RSA_S") + (16 . "ELGAMAL_E") + (17 . "DSA") + (20 . "ELGAMAL"))) + +;; from gnupg/include/cipher.h +(defconst epg-digest-algorithm-alist + '((1 . "MD5") + (2 . "SHA1") + (3 . "RMD160") + (8 . "SHA256") + (9 . "SHA384") + (10 . "SHA512"))) + +;; from gnupg/include/cipher.h +(defconst epg-compress-algorithm-alist + '((0 . "NONE") + (1 . "ZIP") + (2 . "ZLIB") + (3 . "BZIP2"))) + +(defconst epg-invalid-recipients-reason-alist + '((0 . "No specific reason given") + (1 . "Not Found") + (2 . "Ambigious specification") + (3 . "Wrong key usage") + (4 . "Key revoked") + (5 . "Key expired") + (6 . "No CRL known") + (7 . "CRL too old") + (8 . "Policy mismatch") + (9 . "Not a secret key") + (10 . "Key not trusted"))) + +(defconst epg-delete-problem-reason-alist + '((1 . "No such key") + (2 . "Must delete secret key first") + (3 . "Ambigious specification"))) + +(defconst epg-import-ok-reason-alist + '((0 . "Not actually changed") + (1 . "Entirely new key") + (2 . "New user IDs") + (4 . "New signatures") + (8 . "New subkeys") + (16 . "Contains private key"))) + +(defconst epg-import-problem-reason-alist + '((0 . "No specific reason given") + (1 . "Invalid Certificate") + (2 . "Issuer Certificate missing") + (3 . "Certificate Chain too long") + (4 . "Error storing certificate"))) + +(defconst epg-no-data-reason-alist + '((1 . "No armored data") + (2 . "Expected a packet but did not found one") + (3 . "Invalid packet found, this may indicate a non OpenPGP message") + (4 . "Signature expected but not found"))) + +(defconst epg-unexpected-reason-alist nil) + +(defvar epg-key-validity-alist + '((?o . unknown) + (?i . invalid) + (?d . disabled) + (?r . revoked) + (?e . expired) + (?- . none) + (?q . undefined) + (?n . never) + (?m . marginal) + (?f . full) + (?u . ultimate))) + +(defvar epg-key-capablity-alist + '((?e . encrypt) + (?s . sign) + (?c . certify) + (?a . authentication))) + +(defvar epg-new-signature-type-alist + '((?D . detached) + (?C . clear) + (?S . normal))) + +(defvar epg-dn-type-alist + '(("1.2.840.113549.1.9.1" . "EMail") + ("2.5.4.12" . "T") + ("2.5.4.42" . "GN") + ("2.5.4.4" . "SN") + ("0.2.262.1.10.7.20" . "NameDistinguisher") + ("2.5.4.16" . "ADDR") + ("2.5.4.15" . "BC") + ("2.5.4.13" . "D") + ("2.5.4.17" . "PostalCode") + ("2.5.4.65" . "Pseudo") + ("2.5.4.5" . "SerialNumber"))) + +(defvar epg-prompt-alist nil) + +(put 'epg-error 'error-conditions '(epg-error error)) + +(defun epg-make-data-from-file (file) + "Make a data object from FILE." + (cons 'epg-data (vector file nil))) + +(defun epg-make-data-from-string (string) + "Make a data object from STRING." + (cons 'epg-data (vector nil string))) + +(defun epg-data-file (data) + "Return the file of DATA." + (unless (eq (car-safe data) 'epg-data) + (signal 'wrong-type-argument (list 'epg-data-p data))) + (aref (cdr data) 0)) + +(defun epg-data-string (data) + "Return the string of DATA." + (unless (eq (car-safe data) 'epg-data) + (signal 'wrong-type-argument (list 'epg-data-p data))) + (aref (cdr data) 1)) + +(defun epg-make-context (&optional protocol armor textmode include-certs + cipher-algorithm digest-algorithm + compress-algorithm) + "Return a context object." + (cons 'epg-context + (vector (or protocol 'OpenPGP) armor textmode include-certs + cipher-algorithm digest-algorithm compress-algorithm + #'epg-passphrase-callback-function + nil + nil nil nil nil nil nil))) + +(defun epg-context-protocol (context) + "Return the protocol used within CONTEXT." + (unless (eq (car-safe context) 'epg-context) + (signal 'wrong-type-argument (list 'epg-context-p context))) + (aref (cdr context) 0)) + +(defun epg-context-armor (context) + "Return t if the output shouled be ASCII armored in CONTEXT." + (unless (eq (car-safe context) 'epg-context) + (signal 'wrong-type-argument (list 'epg-context-p context))) + (aref (cdr context) 1)) + +(defun epg-context-textmode (context) + "Return t if canonical text mode should be used in CONTEXT." + (unless (eq (car-safe context) 'epg-context) + (signal 'wrong-type-argument (list 'epg-context-p context))) + (aref (cdr context) 2)) + +(defun epg-context-include-certs (context) + "Return how many certificates should be included in an S/MIME signed +message." + (unless (eq (car-safe context) 'epg-context) + (signal 'wrong-type-argument (list 'epg-context-p context))) + (aref (cdr context) 3)) + +(defun epg-context-cipher-algorithm (context) + "Return the cipher algorithm in CONTEXT." + (unless (eq (car-safe context) 'epg-context) + (signal 'wrong-type-argument (list 'epg-context-p context))) + (aref (cdr context) 4)) + +(defun epg-context-digest-algorithm (context) + "Return the digest algorithm in CONTEXT." + (unless (eq (car-safe context) 'epg-context) + (signal 'wrong-type-argument (list 'epg-context-p context))) + (aref (cdr context) 5)) + +(defun epg-context-compress-algorithm (context) + "Return the compress algorithm in CONTEXT." + (unless (eq (car-safe context) 'epg-context) + (signal 'wrong-type-argument (list 'epg-context-p context))) + (aref (cdr context) 6)) + +(defun epg-context-passphrase-callback (context) + "Return the function used to query passphrase." + (unless (eq (car-safe context) 'epg-context) + (signal 'wrong-type-argument (list 'epg-context-p context))) + (aref (cdr context) 7)) + +(defun epg-context-progress-callback (context) + "Return the function which handles progress update." + (unless (eq (car-safe context) 'epg-context) + (signal 'wrong-type-argument (list 'epg-context-p context))) + (aref (cdr context) 8)) + +(defun epg-context-signers (context) + "Return the list of key-id for singning." + (unless (eq (car-safe context) 'epg-context) + (signal 'wrong-type-argument (list 'epg-context-p context))) + (aref (cdr context) 9)) + +(defun epg-context-sig-notations (context) + "Return the list of notations for singning." + (unless (eq (car-safe context) 'epg-context) + (signal 'wrong-type-argument (list 'epg-context-p context))) + (aref (cdr context) 10)) + +(defun epg-context-process (context) + "Return the process object of `epg-gpg-program'. +This function is for internal use only." + (unless (eq (car-safe context) 'epg-context) + (signal 'wrong-type-argument (list 'epg-context-p context))) + (aref (cdr context) 11)) + +(defun epg-context-output-file (context) + "Return the output file of `epg-gpg-program'. +This function is for internal use only." + (unless (eq (car-safe context) 'epg-context) + (signal 'wrong-type-argument (list 'epg-context-p context))) + (aref (cdr context) 12)) + +(defun epg-context-result (context) + "Return the result of the previous cryptographic operation." + (unless (eq (car-safe context) 'epg-context) + (signal 'wrong-type-argument (list 'epg-context-p context))) + (aref (cdr context) 13)) + +(defun epg-context-operation (context) + "Return the name of the current cryptographic operation." + (unless (eq (car-safe context) 'epg-context) + (signal 'wrong-type-argument (list 'epg-context-p context))) + (aref (cdr context) 14)) + +(defun epg-context-set-protocol (context protocol) + "Set the protocol used within CONTEXT." + (unless (eq (car-safe context) 'epg-context) + (signal 'wrong-type-argument (list 'epg-context-p context))) + (aset (cdr context) 0 protocol)) + +(defun epg-context-set-armor (context armor) + "Specify if the output shouled be ASCII armored in CONTEXT." + (unless (eq (car-safe context) 'epg-context) + (signal 'wrong-type-argument (list 'epg-context-p context))) + (aset (cdr context) 1 armor)) + +(defun epg-context-set-textmode (context textmode) + "Specify if canonical text mode should be used in CONTEXT." + (unless (eq (car-safe context) 'epg-context) + (signal 'wrong-type-argument (list 'epg-context-p context))) + (aset (cdr context) 2 textmode)) + +(defun epg-context-set-include-certs (context include-certs) + "Set how many certificates should be included in an S/MIME signed message." + (unless (eq (car-safe context) 'epg-context) + (signal 'wrong-type-argument (list 'epg-context-p context))) + (aset (cdr context) 3 include-certs)) + +(defun epg-context-set-cipher-algorithm (context cipher-algorithm) + "Set the cipher algorithm in CONTEXT." + (unless (eq (car-safe context) 'epg-context) + (signal 'wrong-type-argument (list 'epg-context-p context))) + (aset (cdr context) 4 cipher-algorithm)) + +(defun epg-context-set-digest-algorithm (context digest-algorithm) + "Set the digest algorithm in CONTEXT." + (unless (eq (car-safe context) 'epg-context) + (signal 'wrong-type-argument (list 'epg-context-p context))) + (aset (cdr context) 5 digest-algorithm)) + +(defun epg-context-set-compress-algorithm (context compress-algorithm) + "Set the compress algorithm in CONTEXT." + (unless (eq (car-safe context) 'epg-context) + (signal 'wrong-type-argument (list 'epg-context-p context))) + (aset (cdr context) 6 compress-algorithm)) + +(defun epg-context-set-passphrase-callback (context + passphrase-callback) + "Set the function used to query passphrase." + (unless (eq (car-safe context) 'epg-context) + (signal 'wrong-type-argument (list 'epg-context-p context))) + (aset (cdr context) 7 passphrase-callback)) + +(defun epg-context-set-progress-callback (context + progress-callback) + "Set the function which handles progress update. +If optional argument HANDBACK is specified, it is passed to PROGRESS-CALLBACK." + (unless (eq (car-safe context) 'epg-context) + (signal 'wrong-type-argument (list 'epg-context-p context))) + (aset (cdr context) 8 progress-callback)) + +(defun epg-context-set-signers (context signers) + "Set the list of key-id for singning." + (unless (eq (car-safe context) 'epg-context) + (signal 'wrong-type-argument (list 'epg-context-p context))) + (aset (cdr context) 9 signers)) + +(defun epg-context-set-sig-notations (context notations) + "Set the list of notations for singning." + (unless (eq (car-safe context) 'epg-context) + (signal 'wrong-type-argument (list 'epg-context-p context))) + (aset (cdr context) 10 notations)) + +(defun epg-context-set-process (context process) + "Set the process object of `epg-gpg-program'. +This function is for internal use only." + (unless (eq (car-safe context) 'epg-context) + (signal 'wrong-type-argument (list 'epg-context-p context))) + (aset (cdr context) 11 process)) + +(defun epg-context-set-output-file (context output-file) + "Set the output file of `epg-gpg-program'. +This function is for internal use only." + (unless (eq (car-safe context) 'epg-context) + (signal 'wrong-type-argument (list 'epg-context-p context))) + (aset (cdr context) 12 output-file)) + +(defun epg-context-set-result (context result) + "Set the result of the previous cryptographic operation." + (unless (eq (car-safe context) 'epg-context) + (signal 'wrong-type-argument (list 'epg-context-p context))) + (aset (cdr context) 13 result)) + +(defun epg-context-set-operation (context operation) + "Set the name of the current cryptographic operation." + (unless (eq (car-safe context) 'epg-context) + (signal 'wrong-type-argument (list 'epg-context-p context))) + (aset (cdr context) 14 operation)) + +(defun epg-make-signature (status &optional key-id) + "Return a signature object." + (cons 'epg-signature (vector status key-id nil nil nil nil nil nil nil nil + nil))) + +(defun epg-signature-status (signature) + "Return the status code of SIGNATURE." + (unless (eq (car-safe signature) 'epg-signature) + (signal 'wrong-type-argument (list 'epg-signature-p signature))) + (aref (cdr signature) 0)) + +(defun epg-signature-key-id (signature) + "Return the key-id of SIGNATURE." + (unless (eq (car-safe signature) 'epg-signature) + (signal 'wrong-type-argument (list 'epg-signature-p signature))) + (aref (cdr signature) 1)) + +(defun epg-signature-validity (signature) + "Return the validity of SIGNATURE." + (unless (eq (car-safe signature) 'epg-signature) + (signal 'wrong-type-argument (list 'epg-signature-p signature))) + (aref (cdr signature) 2)) + +(defun epg-signature-fingerprint (signature) + "Return the fingerprint of SIGNATURE." + (unless (eq (car-safe signature) 'epg-signature) + (signal 'wrong-type-argument (list 'epg-signature-p signature))) + (aref (cdr signature) 3)) + +(defun epg-signature-creation-time (signature) + "Return the creation time of SIGNATURE." + (unless (eq (car-safe signature) 'epg-signature) + (signal 'wrong-type-argument (list 'epg-signature-p signature))) + (aref (cdr signature) 4)) + +(defun epg-signature-expiration-time (signature) + "Return the expiration time of SIGNATURE." + (unless (eq (car-safe signature) 'epg-signature) + (signal 'wrong-type-argument (list 'epg-signature-p signature))) + (aref (cdr signature) 5)) + +(defun epg-signature-pubkey-algorithm (signature) + "Return the public key algorithm of SIGNATURE." + (unless (eq (car-safe signature) 'epg-signature) + (signal 'wrong-type-argument (list 'epg-signature-p signature))) + (aref (cdr signature) 6)) + +(defun epg-signature-digest-algorithm (signature) + "Return the digest algorithm of SIGNATURE." + (unless (eq (car-safe signature) 'epg-signature) + (signal 'wrong-type-argument (list 'epg-signature-p signature))) + (aref (cdr signature) 7)) + +(defun epg-signature-class (signature) + "Return the class of SIGNATURE." + (unless (eq (car-safe signature) 'epg-signature) + (signal 'wrong-type-argument (list 'epg-signature-p signature))) + (aref (cdr signature) 8)) + +(defun epg-signature-version (signature) + "Return the version of SIGNATURE." + (unless (eq (car-safe signature) 'epg-signature) + (signal 'wrong-type-argument (list 'epg-signature-p signature))) + (aref (cdr signature) 9)) + +(defun epg-sig-notations (signature) + "Return the list of notations of SIGNATURE." + (unless (eq (car-safe signature) 'epg-signature) + (signal 'wrong-type-argument (list 'epg-signature-p signature))) + (aref (cdr signature) 10)) + +(defun epg-signature-set-status (signature status) + "Set the status code of SIGNATURE." + (unless (eq (car-safe signature) 'epg-signature) + (signal 'wrong-type-argument (list 'epg-signature-p signature))) + (aset (cdr signature) 0 status)) + +(defun epg-signature-set-key-id (signature key-id) + "Set the key-id of SIGNATURE." + (unless (eq (car-safe signature) 'epg-signature) + (signal 'wrong-type-argument (list 'epg-signature-p signature))) + (aset (cdr signature) 1 key-id)) + +(defun epg-signature-set-validity (signature validity) + "Set the validity of SIGNATURE." + (unless (eq (car-safe signature) 'epg-signature) + (signal 'wrong-type-argument (list 'epg-signature-p signature))) + (aset (cdr signature) 2 validity)) + +(defun epg-signature-set-fingerprint (signature fingerprint) + "Set the fingerprint of SIGNATURE." + (unless (eq (car-safe signature) 'epg-signature) + (signal 'wrong-type-argument (list 'epg-signature-p signature))) + (aset (cdr signature) 3 fingerprint)) + +(defun epg-signature-set-creation-time (signature creation-time) + "Set the creation time of SIGNATURE." + (unless (eq (car-safe signature) 'epg-signature) + (signal 'wrong-type-argument (list 'epg-signature-p signature))) + (aset (cdr signature) 4 creation-time)) + +(defun epg-signature-set-expiration-time (signature expiration-time) + "Set the expiration time of SIGNATURE." + (unless (eq (car-safe signature) 'epg-signature) + (signal 'wrong-type-argument (list 'epg-signature-p signature))) + (aset (cdr signature) 5 expiration-time)) + +(defun epg-signature-set-pubkey-algorithm (signature pubkey-algorithm) + "Set the public key algorithm of SIGNATURE." + (unless (eq (car-safe signature) 'epg-signature) + (signal 'wrong-type-argument (list 'epg-signature-p signature))) + (aset (cdr signature) 6 pubkey-algorithm)) + +(defun epg-signature-set-digest-algorithm (signature digest-algorithm) + "Set the digest algorithm of SIGNATURE." + (unless (eq (car-safe signature) 'epg-signature) + (signal 'wrong-type-argument (list 'epg-signature-p signature))) + (aset (cdr signature) 7 digest-algorithm)) + +(defun epg-signature-set-class (signature class) + "Set the class of SIGNATURE." + (unless (eq (car-safe signature) 'epg-signature) + (signal 'wrong-type-argument (list 'epg-signature-p signature))) + (aset (cdr signature) 8 class)) + +(defun epg-signature-set-version (signature version) + "Set the version of SIGNATURE." + (unless (eq (car-safe signature) 'epg-signature) + (signal 'wrong-type-argument (list 'epg-signature-p signature))) + (aset (cdr signature) 9 version)) + +(defun epg-signature-set-notations (signature notations) + "Set the list of notations of SIGNATURE." + (unless (eq (car-safe signature) 'epg-signature) + (signal 'wrong-type-argument (list 'epg-signature-p signature))) + (aset (cdr signature) 10 notations)) + +(defun epg-make-new-signature (type pubkey-algorithm digest-algorithm + class creation-time fingerprint) + "Return a new signature object." + (cons 'epg-new-signature (vector type pubkey-algorithm digest-algorithm + class creation-time fingerprint))) + +(defun epg-new-signature-type (new-signature) + "Return the type of NEW-SIGNATURE." + (unless (eq (car-safe new-signature) 'epg-new-signature) + (signal 'wrong-type-argument (list 'epg-new-signature-p new-signature))) + (aref (cdr new-signature) 0)) + +(defun epg-new-signature-pubkey-algorithm (new-signature) + "Return the public key algorithm of NEW-SIGNATURE." + (unless (eq (car-safe new-signature) 'epg-new-signature) + (signal 'wrong-type-argument (list 'epg-new-signature-p new-signature))) + (aref (cdr new-signature) 1)) + +(defun epg-new-signature-digest-algorithm (new-signature) + "Return the digest algorithm of NEW-SIGNATURE." + (unless (eq (car-safe new-signature) 'epg-new-signature) + (signal 'wrong-type-argument (list 'epg-new-signature-p new-signature))) + (aref (cdr new-signature) 2)) + +(defun epg-new-signature-class (new-signature) + "Return the class of NEW-SIGNATURE." + (unless (eq (car-safe new-signature) 'epg-new-signature) + (signal 'wrong-type-argument (list 'epg-new-signature-p new-signature))) + (aref (cdr new-signature) 3)) + +(defun epg-new-signature-creation-time (new-signature) + "Return the creation time of NEW-SIGNATURE." + (unless (eq (car-safe new-signature) 'epg-new-signature) + (signal 'wrong-type-argument (list 'epg-new-signature-p new-signature))) + (aref (cdr new-signature) 4)) + +(defun epg-new-signature-fingerprint (new-signature) + "Return the fingerprint of NEW-SIGNATURE." + (unless (eq (car-safe new-signature) 'epg-new-signature) + (signal 'wrong-type-argument (list 'epg-new-signature-p new-signature))) + (aref (cdr new-signature) 5)) + +(defun epg-make-key (owner-trust) + "Return a key object." + (cons 'epg-key (vector owner-trust nil nil))) + +(defun epg-key-owner-trust (key) + "Return the owner trust of KEY." + (unless (eq (car-safe key) 'epg-key) + (signal 'wrong-type-argument (list 'epg-key-p key))) + (aref (cdr key) 0)) + +(defun epg-key-sub-key-list (key) + "Return the sub key list of KEY." + (unless (eq (car-safe key) 'epg-key) + (signal 'wrong-type-argument (list 'epg-key-p key))) + (aref (cdr key) 1)) + +(defun epg-key-user-id-list (key) + "Return the user ID list of KEY." + (unless (eq (car-safe key) 'epg-key) + (signal 'wrong-type-argument (list 'epg-key-p key))) + (aref (cdr key) 2)) + +(defun epg-key-set-sub-key-list (key sub-key-list) + "Set the sub key list of KEY." + (unless (eq (car-safe key) 'epg-key) + (signal 'wrong-type-argument (list 'epg-key-p key))) + (aset (cdr key) 1 sub-key-list)) + +(defun epg-key-set-user-id-list (key user-id-list) + "Set the user ID list of KEY." + (unless (eq (car-safe key) 'epg-key) + (signal 'wrong-type-argument (list 'epg-key-p key))) + (aset (cdr key) 2 user-id-list)) + +(defun epg-make-sub-key (validity capability secret-p algorithm length id + creation-time expiration-time) + "Return a sub key object." + (cons 'epg-sub-key + (vector validity capability secret-p algorithm length id creation-time + expiration-time nil))) + +(defun epg-sub-key-validity (sub-key) + "Return the validity of SUB-KEY." + (unless (eq (car-safe sub-key) 'epg-sub-key) + (signal 'wrong-type-argument (list 'epg-sub-key-p sub-key))) + (aref (cdr sub-key) 0)) + +(defun epg-sub-key-capability (sub-key) + "Return the capability of SUB-KEY." + (unless (eq (car-safe sub-key) 'epg-sub-key) + (signal 'wrong-type-argument (list 'epg-sub-key-p sub-key))) + (aref (cdr sub-key) 1)) + +(defun epg-sub-key-secret-p (sub-key) + "Return non-nil if SUB-KEY is a secret key." + (unless (eq (car-safe sub-key) 'epg-sub-key) + (signal 'wrong-type-argument (list 'epg-sub-key-p sub-key))) + (aref (cdr sub-key) 2)) + +(defun epg-sub-key-algorithm (sub-key) + "Return the algorithm of SUB-KEY." + (unless (eq (car-safe sub-key) 'epg-sub-key) + (signal 'wrong-type-argument (list 'epg-sub-key-p sub-key))) + (aref (cdr sub-key) 3)) + +(defun epg-sub-key-length (sub-key) + "Return the length of SUB-KEY." + (unless (eq (car-safe sub-key) 'epg-sub-key) + (signal 'wrong-type-argument (list 'epg-sub-key-p sub-key))) + (aref (cdr sub-key) 4)) + +(defun epg-sub-key-id (sub-key) + "Return the ID of SUB-KEY." + (unless (eq (car-safe sub-key) 'epg-sub-key) + (signal 'wrong-type-argument (list 'epg-sub-key-p sub-key))) + (aref (cdr sub-key) 5)) + +(defun epg-sub-key-creation-time (sub-key) + "Return the creation time of SUB-KEY." + (unless (eq (car-safe sub-key) 'epg-sub-key) + (signal 'wrong-type-argument (list 'epg-sub-key-p sub-key))) + (aref (cdr sub-key) 6)) + +(defun epg-sub-key-expiration-time (sub-key) + "Return the expiration time of SUB-KEY." + (unless (eq (car-safe sub-key) 'epg-sub-key) + (signal 'wrong-type-argument (list 'epg-sub-key-p sub-key))) + (aref (cdr sub-key) 7)) + +(defun epg-sub-key-fingerprint (sub-key) + "Return the fingerprint of SUB-KEY." + (unless (eq (car-safe sub-key) 'epg-sub-key) + (signal 'wrong-type-argument (list 'epg-sub-key-p sub-key))) + (aref (cdr sub-key) 8)) + +(defun epg-sub-key-set-fingerprint (sub-key fingerprint) + "Set the fingerprint of SUB-KEY. +This function is for internal use only." + (unless (eq (car-safe sub-key) 'epg-sub-key) + (signal 'wrong-type-argument (list 'epg-sub-key-p sub-key))) + (aset (cdr sub-key) 8 fingerprint)) + +(defun epg-make-user-id (validity string) + "Return a user ID object." + (cons 'epg-user-id (vector validity string nil))) + +(defun epg-user-id-validity (user-id) + "Return the validity of USER-ID." + (unless (eq (car-safe user-id) 'epg-user-id) + (signal 'wrong-type-argument (list 'epg-user-id-p user-id))) + (aref (cdr user-id) 0)) + +(defun epg-user-id-string (user-id) + "Return the name of USER-ID." + (unless (eq (car-safe user-id) 'epg-user-id) + (signal 'wrong-type-argument (list 'epg-user-id-p user-id))) + (aref (cdr user-id) 1)) + +(defun epg-user-id-signature-list (user-id) + "Return the signature list of USER-ID." + (unless (eq (car-safe user-id) 'epg-user-id) + (signal 'wrong-type-argument (list 'epg-user-id-p user-id))) + (aref (cdr user-id) 2)) + +(defun epg-user-id-set-signature-list (user-id signature-list) + "Set the signature list of USER-ID." + (unless (eq (car-safe user-id) 'epg-user-id) + (signal 'wrong-type-argument (list 'epg-user-id-p user-id))) + (aset (cdr user-id) 2 signature-list)) + +(defun epg-make-key-signature (validity pubkey-algorithm key-id creation-time + expiration-time user-id class + exportable-p) + "Return a key signature object." + (cons 'epg-key-signature + (vector validity pubkey-algorithm key-id creation-time expiration-time + user-id class exportable-p))) + +(defun epg-key-signature-validity (key-signature) + "Return the validity of KEY-SIGNATURE." + (unless (eq (car-safe key-signature) 'epg-key-signature) + (signal 'wrong-type-argument (list 'epg-key-signature-p key-signature))) + (aref (cdr key-signature) 0)) + +(defun epg-key-signature-pubkey-algorithm (key-signature) + "Return the public key algorithm of KEY-SIGNATURE." + (unless (eq (car-safe key-signature) 'epg-key-signature) + (signal 'wrong-type-argument (list 'epg-key-signature-p key-signature))) + (aref (cdr key-signature) 1)) + +(defun epg-key-signature-key-id (key-signature) + "Return the key-id of KEY-SIGNATURE." + (unless (eq (car-safe key-signature) 'epg-key-signature) + (signal 'wrong-type-argument (list 'epg-key-signature-p key-signature))) + (aref (cdr key-signature) 2)) + +(defun epg-key-signature-creation-time (key-signature) + "Return the creation time of KEY-SIGNATURE." + (unless (eq (car-safe key-signature) 'epg-key-signature) + (signal 'wrong-type-argument (list 'epg-key-signature-p key-signature))) + (aref (cdr key-signature) 3)) + +(defun epg-key-signature-expiration-time (key-signature) + "Return the expiration time of KEY-SIGNATURE." + (unless (eq (car-safe key-signature) 'epg-key-signature) + (signal 'wrong-type-argument (list 'epg-key-signature-p key-signature))) + (aref (cdr key-signature) 4)) + +(defun epg-key-signature-user-id (key-signature) + "Return the user-id of KEY-SIGNATURE." + (unless (eq (car-safe key-signature) 'epg-key-signature) + (signal 'wrong-type-argument (list 'epg-key-signature-p key-signature))) + (aref (cdr key-signature) 5)) + +(defun epg-key-signature-class (key-signature) + "Return the class of KEY-SIGNATURE." + (unless (eq (car-safe key-signature) 'epg-key-signature) + (signal 'wrong-type-argument (list 'epg-key-signature-p key-signature))) + (aref (cdr key-signature) 6)) + +(defun epg-key-signature-exportable-p (key-signature) + "Return t if KEY-SIGNATURE is exportable." + (unless (eq (car-safe key-signature) 'epg-key-signature) + (signal 'wrong-type-argument (list 'epg-key-signature-p key-signature))) + (aref (cdr key-signature) 7)) + +(defun epg-make-sig-notation (name value &optional human-readable + critical) + "Return a notation object." + (cons 'epg-sig-notation (vector name value human-readable critical))) + +(defun epg-sig-notation-name (sig-notation) + "Return the name of SIG-NOTATION." + (unless (eq (car-safe sig-notation) 'epg-sig-notation) + (signal 'wrong-type-argument (list 'epg-sig-notation-p + sig-notation))) + (aref (cdr sig-notation) 0)) + +(defun epg-sig-notation-value (sig-notation) + "Return the value of SIG-NOTATION." + (unless (eq (car-safe sig-notation) 'epg-sig-notation) + (signal 'wrong-type-argument (list 'epg-sig-notation-p + sig-notation))) + (aref (cdr sig-notation) 1)) + +(defun epg-sig-notation-human-readable (sig-notation) + "Return the human-readable of SIG-NOTATION." + (unless (eq (car-safe sig-notation) 'epg-sig-notation) + (signal 'wrong-type-argument (list 'epg-sig-notation-p + sig-notation))) + (aref (cdr sig-notation) 2)) + +(defun epg-sig-notation-critical (sig-notation) + "Return the critical of SIG-NOTATION." + (unless (eq (car-safe sig-notation) 'epg-sig-notation) + (signal 'wrong-type-argument (list 'epg-sig-notation-p + sig-notation))) + (aref (cdr sig-notation) 3)) + +(defun epg-sig-notation-set-value (sig-notation value) + "Set the value of SIG-NOTATION." + (unless (eq (car-safe sig-notation) 'epg-sig-notation) + (signal 'wrong-type-argument (list 'epg-sig-notation-p + sig-notation))) + (aset (cdr sig-notation) 1 value)) + +(defun epg-make-import-status (fingerprint &optional reason new user-id + signature sub-key secret) + "Return a import status object." + (cons 'epg-import-status (vector fingerprint reason new user-id signature + sub-key secret))) + +(defun epg-import-status-fingerprint (import-status) + "Return the fingerprint of the key that was considered." + (unless (eq (car-safe import-status) 'epg-import-status) + (signal 'wrong-type-argument (list 'epg-import-status-p import-status))) + (aref (cdr import-status) 0)) + +(defun epg-import-status-reason (import-status) + "Return the reason code for import failure." + (unless (eq (car-safe import-status) 'epg-import-status) + (signal 'wrong-type-argument (list 'epg-import-status-p import-status))) + (aref (cdr import-status) 1)) + +(defun epg-import-status-new (import-status) + "Return t if the imported key was new." + (unless (eq (car-safe import-status) 'epg-import-status) + (signal 'wrong-type-argument (list 'epg-import-status-p import-status))) + (aref (cdr import-status) 2)) + +(defun epg-import-status-user-id (import-status) + "Return t if the imported key contained new user IDs." + (unless (eq (car-safe import-status) 'epg-import-status) + (signal 'wrong-type-argument (list 'epg-import-status-p import-status))) + (aref (cdr import-status) 3)) + +(defun epg-import-status-signature (import-status) + "Return t if the imported key contained new signatures." + (unless (eq (car-safe import-status) 'epg-import-status) + (signal 'wrong-type-argument (list 'epg-import-status-p import-status))) + (aref (cdr import-status) 4)) + +(defun epg-import-status-sub-key (import-status) + "Return t if the imported key contained new sub keys." + (unless (eq (car-safe import-status) 'epg-import-status) + (signal 'wrong-type-argument (list 'epg-import-status-p import-status))) + (aref (cdr import-status) 5)) + +(defun epg-import-status-secret (import-status) + "Return t if the imported key contained a secret key." + (unless (eq (car-safe import-status) 'epg-import-status) + (signal 'wrong-type-argument (list 'epg-import-status-p import-status))) + (aref (cdr import-status) 6)) + +(defun epg-make-import-result (considered no-user-id imported imported-rsa + unchanged new-user-ids new-sub-keys + new-signatures new-revocations + secret-read secret-imported + secret-unchanged not-imported + imports) + "Return a import result object." + (cons 'epg-import-result (vector considered no-user-id imported imported-rsa + unchanged new-user-ids new-sub-keys + new-signatures new-revocations secret-read + secret-imported secret-unchanged + not-imported imports))) + +(defun epg-import-result-considered (import-result) + "Return the total number of considered keys." + (unless (eq (car-safe import-result) 'epg-import-result) + (signal 'wrong-type-argument (list 'epg-import-result-p import-result))) + (aref (cdr import-result) 0)) + +(defun epg-import-result-no-user-id (import-result) + "Return the number of keys without user ID." + (unless (eq (car-safe import-result) 'epg-import-result) + (signal 'wrong-type-argument (list 'epg-import-result-p import-result))) + (aref (cdr import-result) 1)) + +(defun epg-import-result-imported (import-result) + "Return the number of imported keys." + (unless (eq (car-safe import-result) 'epg-import-result) + (signal 'wrong-type-argument (list 'epg-import-result-p import-result))) + (aref (cdr import-result) 2)) + +(defun epg-import-result-imported-rsa (import-result) + "Return the number of imported RSA keys." + (unless (eq (car-safe import-result) 'epg-import-result) + (signal 'wrong-type-argument (list 'epg-import-result-p import-result))) + (aref (cdr import-result) 3)) + +(defun epg-import-result-unchanged (import-result) + "Return the number of unchanged keys." + (unless (eq (car-safe import-result) 'epg-import-result) + (signal 'wrong-type-argument (list 'epg-import-result-p import-result))) + (aref (cdr import-result) 4)) + +(defun epg-import-result-new-user-ids (import-result) + "Return the number of new user IDs." + (unless (eq (car-safe import-result) 'epg-import-result) + (signal 'wrong-type-argument (list 'epg-import-result-p import-result))) + (aref (cdr import-result) 5)) + +(defun epg-import-result-new-sub-keys (import-result) + "Return the number of new sub keys." + (unless (eq (car-safe import-result) 'epg-import-result) + (signal 'wrong-type-argument (list 'epg-import-result-p import-result))) + (aref (cdr import-result) 6)) + +(defun epg-import-result-new-signatures (import-result) + "Return the number of new signatures." + (unless (eq (car-safe import-result) 'epg-import-result) + (signal 'wrong-type-argument (list 'epg-import-result-p import-result))) + (aref (cdr import-result) 7)) + +(defun epg-import-result-new-revocations (import-result) + "Return the number of new revocations." + (unless (eq (car-safe import-result) 'epg-import-result) + (signal 'wrong-type-argument (list 'epg-import-result-p import-result))) + (aref (cdr import-result) 8)) + +(defun epg-import-result-secret-read (import-result) + "Return the total number of secret keys read." + (unless (eq (car-safe import-result) 'epg-import-result) + (signal 'wrong-type-argument (list 'epg-import-result-p import-result))) + (aref (cdr import-result) 9)) + +(defun epg-import-result-secret-imported (import-result) + "Return the number of imported secret keys." + (unless (eq (car-safe import-result) 'epg-import-result) + (signal 'wrong-type-argument (list 'epg-import-result-p import-result))) + (aref (cdr import-result) 10)) + +(defun epg-import-result-secret-unchanged (import-result) + "Return the number of unchanged secret keys." + (unless (eq (car-safe import-result) 'epg-import-result) + (signal 'wrong-type-argument (list 'epg-import-result-p import-result))) + (aref (cdr import-result) 11)) + +(defun epg-import-result-not-imported (import-result) + "Return the number of keys not imported." + (unless (eq (car-safe import-result) 'epg-import-result) + (signal 'wrong-type-argument (list 'epg-import-result-p import-result))) + (aref (cdr import-result) 12)) + +(defun epg-import-result-imports (import-result) + "Return the list of `epg-import-status' objects." + (unless (eq (car-safe import-result) 'epg-import-result) + (signal 'wrong-type-argument (list 'epg-import-result-p import-result))) + (aref (cdr import-result) 13)) + +(defun epg-context-result-for (context name) + "Return the result of CONTEXT associated with NAME." + (cdr (assq name (epg-context-result context)))) + +(defun epg-context-set-result-for (context name value) + "Set the result of CONTEXT associated with NAME to VALUE." + (let* ((result (epg-context-result context)) + (entry (assq name result))) + (if entry + (setcdr entry value) + (epg-context-set-result context (cons (cons name value) result))))) + +(defun epg-signature-to-string (signature) + "Convert SIGNATURE to a human readable string." + (let* ((user-id (cdr (assoc (epg-signature-key-id signature) + epg-user-id-alist))) + (pubkey-algorithm (epg-signature-pubkey-algorithm signature))) + (concat + (cond ((eq (epg-signature-status signature) 'good) + "Good signature from ") + ((eq (epg-signature-status signature) 'bad) + "Bad signature from ") + ((eq (epg-signature-status signature) 'expired) + "Expired signature from ") + ((eq (epg-signature-status signature) 'expired-key) + "Signature made by expired key ") + ((eq (epg-signature-status signature) 'revoked-key) + "Signature made by revoked key ") + ((eq (epg-signature-status signature) 'no-pubkey) + "No public key for ")) + (epg-signature-key-id signature) + (if user-id + (concat " " + (if (stringp user-id) + user-id + (epg-decode-dn user-id))) + "") + (if (epg-signature-validity signature) + (format " (trust %s)" (epg-signature-validity signature)) + "") + (if (epg-signature-creation-time signature) + (format-time-string " created at %Y-%m-%dT%T%z" + (epg-signature-creation-time signature)) + "") + (if pubkey-algorithm + (concat " using " + (or (cdr (assq pubkey-algorithm epg-pubkey-algorithm-alist)) + (format "(unknown algorithm %d)" pubkey-algorithm))) + "")))) + +(defun epg-verify-result-to-string (verify-result) + "Convert VERIFY-RESULT to a human readable string." + (mapconcat #'epg-signature-to-string verify-result "\n")) + +(defun epg-new-signature-to-string (new-signature) + "Convert NEW-SIGNATURE to a human readable string." + (concat + (cond ((eq (epg-new-signature-type new-signature) 'detached) + "Detached signature ") + ((eq (epg-new-signature-type new-signature) 'clear) + "Cleartext signature ") + (t + "Signature ")) + (cdr (assq (epg-new-signature-pubkey-algorithm new-signature) + epg-pubkey-algorithm-alist)) + "/" + (cdr (assq (epg-new-signature-digest-algorithm new-signature) + epg-digest-algorithm-alist)) + " " + (format "%02X " (epg-new-signature-class new-signature)) + (epg-new-signature-fingerprint new-signature))) + +(defun epg-import-result-to-string (import-result) + "Convert IMPORT-RESULT to a human readable string." + (concat (format "Total number processed: %d\n" + (epg-import-result-considered import-result)) + (if (> (epg-import-result-not-imported import-result) 0) + (format " skipped new keys: %d\n" + (epg-import-result-not-imported import-result))) + (if (> (epg-import-result-no-user-id import-result) 0) + (format " w/o user IDs: %d\n" + (epg-import-result-no-user-id import-result))) + (if (> (epg-import-result-imported import-result) 0) + (concat (format " imported: %d" + (epg-import-result-imported import-result)) + (if (> (epg-import-result-imported-rsa import-result) 0) + (format " (RSA: %d)" + (epg-import-result-imported-rsa + import-result))) + "\n")) + (if (> (epg-import-result-unchanged import-result) 0) + (format " unchanged: %d\n" + (epg-import-result-unchanged import-result))) + (if (> (epg-import-result-new-user-ids import-result) 0) + (format " new user IDs: %d\n" + (epg-import-result-new-user-ids import-result))) + (if (> (epg-import-result-new-sub-keys import-result) 0) + (format " new subkeys: %d\n" + (epg-import-result-new-sub-keys import-result))) + (if (> (epg-import-result-new-signatures import-result) 0) + (format " new signatures: %d\n" + (epg-import-result-new-signatures import-result))) + (if (> (epg-import-result-new-revocations import-result) 0) + (format " new key revocations: %d\n" + (epg-import-result-new-revocations import-result))) + (if (> (epg-import-result-secret-read import-result) 0) + (format " secret keys read: %d\n" + (epg-import-result-secret-read import-result))) + (if (> (epg-import-result-secret-imported import-result) 0) + (format " secret keys imported: %d\n" + (epg-import-result-secret-imported import-result))) + (if (> (epg-import-result-secret-unchanged import-result) 0) + (format " secret keys unchanged: %d\n" + (epg-import-result-secret-unchanged import-result))))) + +(defun epg--start (context args) + "Start `epg-gpg-program' in a subprocess with given ARGS." + (if (and (epg-context-process context) + (eq (process-status (epg-context-process context)) 'run)) + (error "%s is already running in this context" + (if (eq (epg-context-protocol context) 'CMS) + epg-gpgsm-program + epg-gpg-program))) + (let* ((args (append (list "--no-tty" + "--status-fd" "1" + "--yes") + (if (and (not (eq (epg-context-protocol context) 'CMS)) + (string-match ":" (or (getenv "GPG_AGENT_INFO") + ""))) + '("--use-agent")) + (if (and (not (eq (epg-context-protocol context) 'CMS)) + (epg-context-progress-callback context)) + '("--enable-progress-filter")) + (if epg-gpg-home-directory + (list "--homedir" epg-gpg-home-directory)) + (unless (eq (epg-context-protocol context) 'CMS) + '("--command-fd" "0")) + (if (epg-context-armor context) '("--armor")) + (if (epg-context-textmode context) '("--textmode")) + (if (epg-context-output-file context) + (list "--output" (epg-context-output-file context))) + args)) + (coding-system-for-write 'binary) + (coding-system-for-read 'binary) + process-connection-type + (orig-mode (default-file-modes)) + (buffer (generate-new-buffer " *epg*")) + process) + (if epg-debug + (save-excursion + (unless epg-debug-buffer + (setq epg-debug-buffer (generate-new-buffer " *epg-debug*"))) + (set-buffer epg-debug-buffer) + (goto-char (point-max)) + (insert (format "%s %s\n" + (if (eq (epg-context-protocol context) 'CMS) + epg-gpgsm-program + epg-gpg-program) + (mapconcat #'identity args " "))))) + (with-current-buffer buffer + (if (fboundp 'set-buffer-multibyte) + (set-buffer-multibyte nil)) + (make-local-variable 'epg-last-status) + (setq epg-last-status nil) + (make-local-variable 'epg-read-point) + (setq epg-read-point (point-min)) + (make-local-variable 'epg-process-filter-running) + (setq epg-process-filter-running nil) + (make-local-variable 'epg-pending-status-list) + (setq epg-pending-status-list nil) + (make-local-variable 'epg-key-id) + (setq epg-key-id nil) + (make-local-variable 'epg-context) + (setq epg-context context)) + (unwind-protect + (progn + (set-default-file-modes 448) + (setq process + (apply #'start-process "epg" buffer + (if (eq (epg-context-protocol context) 'CMS) + epg-gpgsm-program + epg-gpg-program) + args))) + (set-default-file-modes orig-mode)) + (set-process-filter process #'epg--process-filter) + (epg-context-set-process context process))) + +(defun epg--process-filter (process input) + (if epg-debug + (save-excursion + (unless epg-debug-buffer + (setq epg-debug-buffer (generate-new-buffer " *epg-debug*"))) + (set-buffer epg-debug-buffer) + (goto-char (point-max)) + (insert input))) + (if (buffer-live-p (process-buffer process)) + (save-excursion + (set-buffer (process-buffer process)) + (goto-char (point-max)) + (insert input) + (unless epg-process-filter-running + (unwind-protect + (progn + (setq epg-process-filter-running t) + (goto-char epg-read-point) + (beginning-of-line) + (while (looking-at ".*\n") ;the input line finished + (if (looking-at "\\[GNUPG:] \\([A-Z_]+\\) ?\\(.*\\)") + (let* ((status (match-string 1)) + (string (match-string 2)) + (symbol (intern-soft (concat "epg--status-" + status)))) + (if (member status epg-pending-status-list) + (setq epg-pending-status-list nil)) + (if (and symbol + (fboundp symbol)) + (funcall symbol epg-context string)) + (setq epg-last-status (cons status string)))) + (forward-line) + (setq epg-read-point (point)))) + (setq epg-process-filter-running nil)))))) + +(defun epg-read-output (context) + "Read the output file CONTEXT and return the content as a string." + (with-temp-buffer + (if (fboundp 'set-buffer-multibyte) + (set-buffer-multibyte nil)) + (if (file-exists-p (epg-context-output-file context)) + (let ((coding-system-for-read 'binary)) + (insert-file-contents (epg-context-output-file context)) + (buffer-string))))) + +(defun epg-wait-for-status (context status-list) + "Wait until one of elements in STATUS-LIST arrives." + (with-current-buffer (process-buffer (epg-context-process context)) + (setq epg-pending-status-list status-list) + (while (and (eq (process-status (epg-context-process context)) 'run) + epg-pending-status-list) + (accept-process-output (epg-context-process context) 1)))) + +(defun epg-wait-for-completion (context) + "Wait until the `epg-gpg-program' process completes." + (while (eq (process-status (epg-context-process context)) 'run) + (accept-process-output (epg-context-process context) 1))) + +(defun epg-reset (context) + "Reset the CONTEXT." + (if (and (epg-context-process context) + (buffer-live-p (process-buffer (epg-context-process context)))) + (kill-buffer (process-buffer (epg-context-process context)))) + (epg-context-set-process context nil)) + +(defun epg-delete-output-file (context) + "Delete the output file of CONTEXT." + (if (and (epg-context-output-file context) + (file-exists-p (epg-context-output-file context))) + (delete-file (epg-context-output-file context)))) + +(eval-and-compile + (if (fboundp 'decode-coding-string) + (defalias 'epg--decode-coding-string 'decode-coding-string) + (defalias 'epg--decode-coding-string 'identity))) + +(defun epg--status-USERID_HINT (context string) + (if (string-match "\\`\\([^ ]+\\) \\(.*\\)" string) + (let* ((key-id (match-string 1 string)) + (user-id (match-string 2 string)) + (entry (assoc key-id epg-user-id-alist))) + (condition-case nil + (setq user-id (epg--decode-coding-string + (epg--decode-percent-escape user-id) + 'utf-8)) + (error)) + (if entry + (setcdr entry user-id) + (setq epg-user-id-alist (cons (cons key-id user-id) + epg-user-id-alist)))))) + +(defun epg--status-NEED_PASSPHRASE (context string) + (if (string-match "\\`\\([^ ]+\\)" string) + (setq epg-key-id (match-string 1 string)))) + +(defun epg--status-NEED_PASSPHRASE_SYM (context string) + (setq epg-key-id 'SYM)) + +(defun epg--status-NEED_PASSPHRASE_PIN (context string) + (setq epg-key-id 'PIN)) + +(eval-and-compile + (if (fboundp 'clear-string) + (defalias 'epg--clear-string 'clear-string) + (defun epg--clear-string (string) + (fillarray string 0)))) + +(eval-and-compile + (if (fboundp 'encode-coding-string) + (defalias 'epg--encode-coding-string 'encode-coding-string) + (defalias 'epg--encode-coding-string 'identity))) + +(defun epg--status-GET_HIDDEN (context string) + (when (and epg-key-id + (string-match "\\`passphrase\\." string)) + (unless (epg-context-passphrase-callback context) + (error "passphrase-callback not set")) + (let (inhibit-quit + passphrase + passphrase-with-new-line + encoded-passphrase-with-new-line) + (unwind-protect + (condition-case nil + (progn + (setq passphrase + (funcall + (if (consp (epg-context-passphrase-callback context)) + (car (epg-context-passphrase-callback context)) + (epg-context-passphrase-callback context)) + context + epg-key-id + (if (consp (epg-context-passphrase-callback context)) + (cdr (epg-context-passphrase-callback context))))) + (when passphrase + (setq passphrase-with-new-line (concat passphrase "\n")) + (epg--clear-string passphrase) + (setq passphrase nil) + (if epg-passphrase-coding-system + (progn + (setq encoded-passphrase-with-new-line + (epg--encode-coding-string + passphrase-with-new-line + (coding-system-change-eol-conversion + epg-passphrase-coding-system 'unix))) + (epg--clear-string passphrase-with-new-line) + (setq passphrase-with-new-line nil)) + (setq encoded-passphrase-with-new-line + passphrase-with-new-line + passphrase-with-new-line nil)) + (process-send-string (epg-context-process context) + encoded-passphrase-with-new-line))) + (quit + (epg-context-set-result-for + context 'error + (cons '(quit) + (epg-context-result-for context 'error))) + (delete-process (epg-context-process context)))) + (if passphrase + (epg--clear-string passphrase)) + (if passphrase-with-new-line + (epg--clear-string passphrase-with-new-line)) + (if encoded-passphrase-with-new-line + (epg--clear-string encoded-passphrase-with-new-line)))))) + +(defun epg--prompt-GET_BOOL (context string) + (let ((entry (assoc string epg-prompt-alist))) + (y-or-n-p (if entry (cdr entry) (concat string "? "))))) + +(defun epg--prompt-GET_BOOL-untrusted_key.override (context string) + (y-or-n-p (if (and (equal (car epg-last-status) "USERID_HINT") + (string-match "\\`\\([^ ]+\\) \\(.*\\)" + (cdr epg-last-status))) + (let* ((key-id (match-string 1 (cdr epg-last-status))) + (user-id (match-string 2 (cdr epg-last-status))) + (entry (assoc key-id epg-user-id-alist))) + (if entry + (setq user-id (cdr entry))) + (format "Untrusted key %s %s. Use anyway? " key-id user-id)) + "Use untrusted key anyway? "))) + +(defun epg--status-GET_BOOL (context string) + (let (inhibit-quit) + (condition-case nil + (if (funcall (or (intern-soft (concat "epg--prompt-GET_BOOL-" string)) + #'epg--prompt-GET_BOOL) + context string) + (process-send-string (epg-context-process context) "y\n") + (process-send-string (epg-context-process context) "n\n")) + (quit + (epg-context-set-result-for + context 'error + (cons '(quit) + (epg-context-result-for context 'error))) + (delete-process (epg-context-process context)))))) + +(defun epg--status-GET_LINE (context string) + (let ((entry (assoc string epg-prompt-alist)) + inhibit-quit) + (condition-case nil + (process-send-string (epg-context-process context) + (concat (read-string + (if entry + (cdr entry) + (concat string ": "))) + "\n")) + (quit + (epg-context-set-result-for + context 'error + (cons '(quit) + (epg-context-result-for context 'error))) + (delete-process (epg-context-process context)))))) + +(defun epg--status-*SIG (context status string) + (if (string-match "\\`\\([^ ]+\\) \\(.*\\)" string) + (let* ((key-id (match-string 1 string)) + (user-id (match-string 2 string)) + (entry (assoc key-id epg-user-id-alist))) + (epg-context-set-result-for + context + 'verify + (cons (epg-make-signature status key-id) + (epg-context-result-for context 'verify))) + (condition-case nil + (if (eq (epg-context-protocol context) 'CMS) + (setq user-id (epg-dn-from-string user-id)) + (setq user-id (epg--decode-coding-string + (epg--decode-percent-escape user-id) + 'utf-8))) + (error)) + (if entry + (setcdr entry user-id) + (setq epg-user-id-alist + (cons (cons key-id user-id) epg-user-id-alist)))) + (epg-context-set-result-for + context + 'verify + (cons (epg-make-signature status) + (epg-context-result-for context 'verify))))) + +(defun epg--status-GOODSIG (context string) + (epg--status-*SIG context 'good string)) + +(defun epg--status-EXPSIG (context string) + (epg--status-*SIG context 'expired string)) + +(defun epg--status-EXPKEYSIG (context string) + (epg--status-*SIG context 'expired-key string)) + +(defun epg--status-REVKEYSIG (context string) + (epg--status-*SIG context 'revoked-key string)) + +(defun epg--status-BADSIG (context string) + (epg--status-*SIG context 'bad string)) + +(defun epg--status-NO_PUBKEY (context string) + (let ((signature (car (epg-context-result-for context 'verify)))) + (if (and signature + (eq (epg-signature-status signature) 'error) + (equal (epg-signature-key-id signature) string)) + (epg-signature-set-status signature 'no-pubkey)))) + +(defun epg--time-from-seconds (seconds) + (let ((number-seconds (string-to-number (concat seconds ".0")))) + (cons (floor (/ number-seconds 65536)) + (floor (mod number-seconds 65536))))) + +(defun epg--status-ERRSIG (context string) + (if (string-match "\\`\\([^ ]+\\) \\([0-9]+\\) \\([0-9]+\\) \ +\\([0-9A-Fa-f][0-9A-Fa-f]\\) \\([^ ]+\\) \\([0-9]+\\)" + string) + (let ((signature (epg-make-signature 'error))) + (epg-context-set-result-for + context + 'verify + (cons signature + (epg-context-result-for context 'verify))) + (epg-signature-set-key-id + signature + (match-string 1 string)) + (epg-signature-set-pubkey-algorithm + signature + (string-to-number (match-string 2 string))) + (epg-signature-set-digest-algorithm + signature + (string-to-number (match-string 3 string))) + (epg-signature-set-class + signature + (string-to-number (match-string 4 string) 16)) + (epg-signature-set-creation-time + signature + (epg--time-from-seconds (match-string 5 string)))))) + +(defun epg--status-VALIDSIG (context string) + (let ((signature (car (epg-context-result-for context 'verify)))) + (when (and signature + (eq (epg-signature-status signature) 'good) + (string-match "\\`\\([^ ]+\\) [^ ]+ \\([^ ]+\\) \\([^ ]+\\) \ +\\([0-9]+\\) [^ ]+ \\([0-9]+\\) \\([0-9]+\\) \\([0-9A-Fa-f][0-9A-Fa-f]\\) \ +\\(.*\\)" + string)) + (epg-signature-set-fingerprint + signature + (match-string 1 string)) + (epg-signature-set-creation-time + signature + (epg--time-from-seconds (match-string 2 string))) + (unless (equal (match-string 3 string) "0") + (epg-signature-set-expiration-time + signature + (epg--time-from-seconds (match-string 3 string)))) + (epg-signature-set-version + signature + (string-to-number (match-string 4 string))) + (epg-signature-set-pubkey-algorithm + signature + (string-to-number (match-string 5 string))) + (epg-signature-set-digest-algorithm + signature + (string-to-number (match-string 6 string))) + (epg-signature-set-class + signature + (string-to-number (match-string 7 string) 16))))) + +(defun epg--status-TRUST_UNDEFINED (context string) + (let ((signature (car (epg-context-result-for context 'verify)))) + (if (and signature + (eq (epg-signature-status signature) 'good)) + (epg-signature-set-validity signature 'undefined)))) + +(defun epg--status-TRUST_NEVER (context string) + (let ((signature (car (epg-context-result-for context 'verify)))) + (if (and signature + (eq (epg-signature-status signature) 'good)) + (epg-signature-set-validity signature 'never)))) + +(defun epg--status-TRUST_MARGINAL (context string) + (let ((signature (car (epg-context-result-for context 'verify)))) + (if (and signature + (eq (epg-signature-status signature) 'marginal)) + (epg-signature-set-validity signature 'marginal)))) + +(defun epg--status-TRUST_FULLY (context string) + (let ((signature (car (epg-context-result-for context 'verify)))) + (if (and signature + (eq (epg-signature-status signature) 'good)) + (epg-signature-set-validity signature 'full)))) + +(defun epg--status-TRUST_ULTIMATE (context string) + (let ((signature (car (epg-context-result-for context 'verify)))) + (if (and signature + (eq (epg-signature-status signature) 'good)) + (epg-signature-set-validity signature 'ultimate)))) + +(defun epg--status-NOTATION_NAME (context string) + (let ((signature (car (epg-context-result-for context 'verify)))) + (if signature + (epg-signature-set-notations + signature + (cons (epg-make-sig-notation string nil t nil) + (epg-sig-notations signature)))))) + +(defun epg--status-NOTATION_DATA (context string) + (let ((signature (car (epg-context-result-for context 'verify))) + notation) + (if (and signature + (setq notation (car (epg-sig-notations signature)))) + (epg-sig-notation-set-value notation string)))) + +(defun epg--status-POLICY_URL (context string) + (let ((signature (car (epg-context-result-for context 'verify)))) + (if signature + (epg-signature-set-notations + signature + (cons (epg-make-sig-notation nil string t nil) + (epg-sig-notations signature)))))) + +(defun epg--status-PROGRESS (context string) + (if (and (epg-context-progress-callback context) + (string-match "\\`\\([^ ]+\\) \\([^ ]\\) \\([0-9]+\\) \\([0-9]+\\)" + string)) + (funcall (if (consp (epg-context-progress-callback context)) + (car (epg-context-progress-callback context)) + (epg-context-progress-callback context)) + context + (match-string 1 string) + (match-string 2 string) + (string-to-number (match-string 3 string)) + (string-to-number (match-string 4 string)) + (if (consp (epg-context-progress-callback context)) + (cdr (epg-context-progress-callback context)))))) + +(defun epg--status-ENC_TO (context string) + (if (string-match "\\`\\([0-9A-Za-z]+\\) \\([0-9]+\\) \\([0-9]+\\)" string) + (epg-context-set-result-for + context 'encrypted-to + (cons (list (match-string 1 string) + (string-to-number (match-string 2 string)) + (string-to-number (match-string 3 string))) + (epg-context-result-for context 'encrypted-to))))) + +(defun epg--status-DECRYPTION_FAILED (context string) + (epg-context-set-result-for context 'decryption-failed t)) + +(defun epg--status-DECRYPTION_OKAY (context string) + (epg-context-set-result-for context 'decryption-okay t)) + +(defun epg--status-NODATA (context string) + (epg-context-set-result-for + context 'error + (cons (cons 'no-data (string-to-number string)) + (epg-context-result-for context 'error)))) + +(defun epg--status-UNEXPECTED (context string) + (epg-context-set-result-for + context 'error + (cons (cons 'unexpected (string-to-number string)) + (epg-context-result-for context 'error)))) + +(defun epg--status-KEYEXPIRED (context string) + (epg-context-set-result-for + context 'error + (cons (list 'key-expired (cons 'expiration-time + (epg--time-from-seconds string))) + (epg-context-result-for context 'error)))) + +(defun epg--status-KEYREVOKED (context string) + (epg-context-set-result-for + context 'error + (cons '(key-revoked) + (epg-context-result-for context 'error)))) + +(defun epg--status-BADARMOR (context string) + (epg-context-set-result-for + context 'error + (cons '(bad-armor) + (epg-context-result-for context 'error)))) + +(defun epg--status-INV_RECP (context string) + (if (string-match "\\`\\([0-9]+\\) \\(.*\\)" string) + (epg-context-set-result-for + context 'error + (cons (list 'invalid-recipient + (cons 'reason + (string-to-number (match-string 1 string))) + (cons 'requested-recipient + (match-string 2 string))) + (epg-context-result-for context 'error))))) + +(defun epg--status-NO_RECP (context string) + (epg-context-set-result-for + context 'error + (cons '(no-recipients) + (epg-context-result-for context 'error)))) + +(defun epg--status-DELETE_PROBLEM (context string) + (if (string-match "\\`\\([0-9]+\\)" string) + (epg-context-set-result-for + context 'error + (cons (cons 'delete-problem + (string-to-number (match-string 1 string))) + (epg-context-result-for context 'error))))) + +(defun epg--status-SIG_CREATED (context string) + (if (string-match "\\`\\([DCS]\\) \\([0-9]+\\) \\([0-9]+\\) \ +\\([0-9A-Fa-F][0-9A-Fa-F]\\) \\(.*\\) " string) + (epg-context-set-result-for + context 'sign + (cons (epg-make-new-signature + (cdr (assq (aref (match-string 1 string) 0) + epg-new-signature-type-alist)) + (string-to-number (match-string 2 string)) + (string-to-number (match-string 3 string)) + (string-to-number (match-string 4 string) 16) + (epg--time-from-seconds (match-string 5 string)) + (substring string (match-end 0))) + (epg-context-result-for context 'sign))))) + +(defun epg--status-KEY_CREATED (context string) + (if (string-match "\\`\\([BPS]\\) \\([^ ]+\\)" string) + (epg-context-set-result-for + context 'generate-key + (cons (list (cons 'type (string-to-char (match-string 1 string))) + (cons 'fingerprint (match-string 2 string))) + (epg-context-result-for context 'generate-key))))) + +(defun epg--status-KEY_NOT_CREATED (context string) + (epg-context-set-result-for + context 'error + (cons '(key-not-created) + (epg-context-result-for context 'error)))) + +(defun epg--status-IMPORTED (context string) + (if (string-match "\\`\\([^ ]+\\) \\(.*\\)" string) + (let* ((key-id (match-string 1 string)) + (user-id (match-string 2 string)) + (entry (assoc key-id epg-user-id-alist))) + (condition-case nil + (setq user-id (epg--decode-coding-string + (epg--decode-percent-escape user-id) + 'utf-8)) + (error)) + (if entry + (setcdr entry user-id) + (setq epg-user-id-alist (cons (cons key-id user-id) + epg-user-id-alist)))))) + +(defun epg--status-IMPORT_OK (context string) + (if (string-match "\\`\\([0-9]+\\)\\( \\(.+\\)\\)?" string) + (let ((reason (string-to-number (match-string 1 string)))) + (epg-context-set-result-for + context 'import-status + (cons (epg-make-import-status (if (match-beginning 2) + (match-string 3 string)) + nil + (/= (logand reason 1) 0) + (/= (logand reason 2) 0) + (/= (logand reason 4) 0) + (/= (logand reason 8) 0) + (/= (logand reason 16) 0)) + (epg-context-result-for context 'import-status)))))) + +(defun epg--status-IMPORT_PROBLEM (context string) + (if (string-match "\\`\\([0-9]+\\)\\( \\(.+\\)\\)?" string) + (epg-context-set-result-for + context 'import-status + (cons (epg-make-import-status + (if (match-beginning 2) + (match-string 3 string)) + (string-to-number (match-string 1 string))) + (epg-context-result-for context 'import-status))))) + +(defun epg--status-IMPORT_RES (context string) + (when (string-match "\\`\\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\) \ +\\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\) \ +\\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\)" string) + (epg-context-set-result-for + context 'import + (epg-make-import-result (string-to-number (match-string 1 string)) + (string-to-number (match-string 2 string)) + (string-to-number (match-string 3 string)) + (string-to-number (match-string 4 string)) + (string-to-number (match-string 5 string)) + (string-to-number (match-string 6 string)) + (string-to-number (match-string 7 string)) + (string-to-number (match-string 8 string)) + (string-to-number (match-string 9 string)) + (string-to-number (match-string 10 string)) + (string-to-number (match-string 11 string)) + (string-to-number (match-string 12 string)) + (string-to-number (match-string 13 string)) + (epg-context-result-for context 'import-status))) + (epg-context-set-result-for context 'import-status nil))) + +(defun epg-passphrase-callback-function (context key-id handback) + (if (eq key-id 'SYM) + (read-passwd "Passphrase for symmetric encryption: " + (eq (epg-context-operation context) 'encrypt)) + (read-passwd + (if (eq key-id 'PIN) + "Passphrase for PIN: " + (let ((entry (assoc key-id epg-user-id-alist))) + (if entry + (format "Passphrase for %s %s: " key-id (cdr entry)) + (format "Passphrase for %s: " key-id))))))) + +(make-obsolete 'epg-passphrase-callback-function + 'epa-passphrase-callback-function) + +(defun epg--list-keys-1 (context name mode) + (let ((args (append (if epg-gpg-home-directory + (list "--homedir" epg-gpg-home-directory)) + '("--with-colons" "--no-greeting" "--batch" + "--with-fingerprint" "--with-fingerprint") + (unless (eq (epg-context-protocol context) 'CMS) + '("--fixed-list-mode")))) + (list-keys-option (if (memq mode '(t secret)) + "--list-secret-keys" + (if (memq mode '(nil public)) + "--list-keys" + "--list-sigs"))) + (coding-system-for-read 'binary) + keys string field index) + (if name + (progn + (unless (listp name) + (setq name (list name))) + (while name + (setq args (append args (list list-keys-option (car name))) + name (cdr name)))) + (setq args (append args (list list-keys-option)))) + (with-temp-buffer + (apply #'call-process + (if (eq (epg-context-protocol context) 'CMS) + epg-gpgsm-program + epg-gpg-program) + nil (list t nil) nil args) + (goto-char (point-min)) + (while (re-search-forward "^[a-z][a-z][a-z]:.*" nil t) + (setq keys (cons (make-vector 15 nil) keys) + string (match-string 0) + index 0 + field 0) + (while (eq index + (string-match "\\([^:]+\\)?:" string index)) + (setq index (match-end 0)) + (aset (car keys) field (match-string 1 string)) + (setq field (1+ field)))) + (nreverse keys)))) + +(defun epg--make-sub-key-1 (line) + (epg-make-sub-key + (if (aref line 1) + (cdr (assq (string-to-char (aref line 1)) epg-key-validity-alist))) + (delq nil + (mapcar (lambda (char) (cdr (assq char epg-key-capablity-alist))) + (aref line 11))) + (member (aref line 0) '("sec" "ssb")) + (string-to-number (aref line 3)) + (string-to-number (aref line 2)) + (aref line 4) + (epg--time-from-seconds (aref line 5)) + (if (aref line 6) + (epg--time-from-seconds (aref line 6))))) + +;;;###autoload +(defun epg-list-keys (context &optional name mode) + "Return a list of epg-key objects matched with NAME. +If MODE is nil or 'public, only public keyring should be searched. +If MODE is t or 'secret, only secret keyring should be searched. +Otherwise, only public keyring should be searched and the key +signatures should be included. +NAME is either a string or a list of strings." + (let ((lines (epg--list-keys-1 context name mode)) + keys cert pointer pointer-1 index string) + (while lines + (cond + ((member (aref (car lines) 0) '("pub" "sec" "crt" "crs")) + (setq cert (member (aref (car lines) 0) '("crt" "crs")) + keys (cons (epg-make-key + (if (aref (car lines) 8) + (cdr (assq (string-to-char (aref (car lines) 8)) + epg-key-validity-alist)))) + keys)) + (epg-key-set-sub-key-list + (car keys) + (cons (epg--make-sub-key-1 (car lines)) + (epg-key-sub-key-list (car keys))))) + ((member (aref (car lines) 0) '("sub" "ssb")) + (epg-key-set-sub-key-list + (car keys) + (cons (epg--make-sub-key-1 (car lines)) + (epg-key-sub-key-list (car keys))))) + ((equal (aref (car lines) 0) "uid") + ;; Decode the UID name as a backslash escaped UTF-8 string, + ;; generated by GnuPG/GpgSM. + (setq string (copy-sequence (aref (car lines) 9)) + index 0) + (while (string-match "\"" string index) + (setq string (replace-match "\\\"" t t string) + index (1+ (match-end 0)))) + (condition-case nil + (setq string (epg--decode-coding-string + (car (read-from-string (concat "\"" string "\""))) + 'utf-8)) + (error + (setq string (aref (car lines) 9)))) + (epg-key-set-user-id-list + (car keys) + (cons (epg-make-user-id + (if (aref (car lines) 1) + (cdr (assq (string-to-char (aref (car lines) 1)) + epg-key-validity-alist))) + (if cert + (condition-case nil + (epg-dn-from-string string) + (error string)) + string)) + (epg-key-user-id-list (car keys))))) + ((equal (aref (car lines) 0) "fpr") + (epg-sub-key-set-fingerprint (car (epg-key-sub-key-list (car keys))) + (aref (car lines) 9))) + ((equal (aref (car lines) 0) "sig") + (epg-user-id-set-signature-list + (car (epg-key-user-id-list (car keys))) + (cons + (epg-make-key-signature + (if (aref (car lines) 1) + (cdr (assq (string-to-char (aref (car lines) 1)) + epg-key-validity-alist))) + (string-to-number (aref (car lines) 3)) + (aref (car lines) 4) + (epg--time-from-seconds (aref (car lines) 5)) + (epg--time-from-seconds (aref (car lines) 6)) + (aref (car lines) 9) + (string-to-number (aref (car lines) 10) 16) + (eq (aref (aref (car lines) 10) 2) ?x)) + (epg-user-id-signature-list + (car (epg-key-user-id-list (car keys)))))))) + (setq lines (cdr lines))) + (setq keys (nreverse keys) + pointer keys) + (while pointer + (epg-key-set-sub-key-list + (car pointer) + (nreverse (epg-key-sub-key-list (car pointer)))) + (setq pointer-1 (epg-key-set-user-id-list + (car pointer) + (nreverse (epg-key-user-id-list (car pointer))))) + (while pointer-1 + (epg-user-id-set-signature-list + (car pointer-1) + (nreverse (epg-user-id-signature-list (car pointer-1)))) + (setq pointer-1 (cdr pointer-1))) + (setq pointer (cdr pointer))) + keys)) + +(eval-and-compile + (if (fboundp 'make-temp-file) + (defalias 'epg--make-temp-file 'make-temp-file) + (defvar temporary-file-directory) + ;; stolen from poe.el. + (defun epg--make-temp-file (prefix) + "Create a temporary file. +The returned file name (created by appending some random characters at the end +of PREFIX, and expanding against `temporary-file-directory' if necessary), +is guaranteed to point to a newly created empty file. +You can then use `write-region' to write new data into the file." + (let (tempdir tempfile) + (setq prefix (expand-file-name prefix + (if (featurep 'xemacs) + (temp-directory) + temporary-file-directory))) + (unwind-protect + (let (file) + ;; First, create a temporary directory. + (while (condition-case () + (progn + (setq tempdir (make-temp-name + (concat + (file-name-directory prefix) + "DIR"))) + ;; return nil or signal an error. + (make-directory tempdir)) + ;; let's try again. + (file-already-exists t))) + (set-file-modes tempdir 448) + ;; Second, create a temporary file in the tempdir. + ;; There *is* a race condition between `make-temp-name' + ;; and `write-region', but we don't care it since we are + ;; in a private directory now. + (setq tempfile (make-temp-name (concat tempdir "/EMU"))) + (write-region "" nil tempfile nil 'silent) + (set-file-modes tempfile 384) + ;; Finally, make a hard-link from the tempfile. + (while (condition-case () + (progn + (setq file (make-temp-name prefix)) + ;; return nil or signal an error. + (add-name-to-file tempfile file)) + ;; let's try again. + (file-already-exists t))) + file) + ;; Cleanup the tempfile. + (and tempfile + (file-exists-p tempfile) + (delete-file tempfile)) + ;; Cleanup the tempdir. + (and tempdir + (file-directory-p tempdir) + (delete-directory tempdir))))))) + +(defun epg--args-from-sig-notations (notations) + (apply #'nconc + (mapcar + (lambda (notation) + (if (and (epg-sig-notation-name notation) + (not (epg-sig-notation-human-readable notation))) + (error "Unreadable")) + (if (epg-sig-notation-name notation) + (list "--sig-notation" + (if (epg-sig-notation-critical notation) + (concat "!" (epg-sig-notation-name notation) + "=" (epg-sig-notation-value notation)) + (concat (epg-sig-notation-name notation) + "=" (epg-sig-notation-value notation)))) + (list "--sig-policy-url" + (if (epg-sig-notation-critical notation) + (concat "!" (epg-sig-notation-value notation)) + (epg-sig-notation-value notation))))) + notations))) + +;;;###autoload +(defun epg-cancel (context) + (if (buffer-live-p (process-buffer (epg-context-process context))) + (save-excursion + (set-buffer (process-buffer (epg-context-process context))) + (epg-context-set-result-for + epg-context 'error + (cons '(quit) + (epg-context-result-for epg-context 'error))))) + (if (eq (process-status (epg-context-process context)) 'run) + (delete-process (epg-context-process context)))) + +;;;###autoload +(defun epg-start-decrypt (context cipher) + "Initiate a decrypt operation on CIPHER. +CIPHER must be a file data object. + +If you use this function, you will need to wait for the completion of +`epg-gpg-program' by using `epg-wait-for-completion' and call +`epg-reset' to clear a temporaly output file. +If you are unsure, use synchronous version of this function +`epg-decrypt-file' or `epg-decrypt-string' instead." + (unless (epg-data-file cipher) + (error "Not a file")) + (epg-context-set-operation context 'decrypt) + (epg-context-set-result context nil) + (epg--start context (list "--decrypt" "--" (epg-data-file cipher))) + ;; `gpgsm' does not read passphrase from stdin, so waiting is not needed. + (unless (eq (epg-context-protocol context) 'CMS) + (epg-wait-for-status context '("BEGIN_DECRYPTION")))) + +(defun epg--check-error-for-decrypt (context) + (if (epg-context-result-for context 'decryption-failed) + (signal 'epg-error (list "Decryption failed"))) + (if (epg-context-result-for context 'no-secret-key) + (signal 'epg-error + (list "No secret key" + (epg-context-result-for context 'no-secret-key)))) + (unless (epg-context-result-for context 'decryption-okay) + (let* ((error (epg-context-result-for context 'error))) + (if (assq 'no-data error) + (signal 'epg-error (list "No data"))) + (signal 'epg-error (list "Can't decrypt" error))))) + +;;;###autoload +(defun epg-decrypt-file (context cipher plain) + "Decrypt a file CIPHER and store the result to a file PLAIN. +If PLAIN is nil, it returns the result as a string." + (unwind-protect + (progn + (if plain + (epg-context-set-output-file context plain) + (epg-context-set-output-file context + (epg--make-temp-file "epg-output"))) + (epg-start-decrypt context (epg-make-data-from-file cipher)) + (epg-wait-for-completion context) + (epg--check-error-for-decrypt context) + (unless plain + (epg-read-output context))) + (unless plain + (epg-delete-output-file context)) + (epg-reset context))) + +;;;###autoload +(defun epg-decrypt-string (context cipher) + "Decrypt a string CIPHER and return the plain text." + (let ((input-file (epg--make-temp-file "epg-input")) + (coding-system-for-write 'binary)) + (unwind-protect + (progn + (write-region cipher nil input-file nil 'quiet) + (epg-context-set-output-file context + (epg--make-temp-file "epg-output")) + (epg-start-decrypt context (epg-make-data-from-file input-file)) + (epg-wait-for-completion context) + (epg--check-error-for-decrypt context) + (epg-read-output context)) + (epg-delete-output-file context) + (if (file-exists-p input-file) + (delete-file input-file)) + (epg-reset context)))) + +;;;###autoload +(defun epg-start-verify (context signature &optional signed-text) + "Initiate a verify operation on SIGNATURE. +SIGNATURE and SIGNED-TEXT are a data object if they are specified. + +For a detached signature, both SIGNATURE and SIGNED-TEXT should be set. +For a normal or a cleartext signature, SIGNED-TEXT should be nil. + +If you use this function, you will need to wait for the completion of +`epg-gpg-program' by using `epg-wait-for-completion' and call +`epg-reset' to clear a temporaly output file. +If you are unsure, use synchronous version of this function +`epg-verify-file' or `epg-verify-string' instead." + (epg-context-set-operation context 'verify) + (epg-context-set-result context nil) + (if signed-text + ;; Detached signature. + (if (epg-data-file signed-text) + (epg--start context (list "--verify" "--" (epg-data-file signature) + (epg-data-file signed-text))) + (epg--start context (list "--verify" "--" (epg-data-file signature) + "-")) + (if (eq (process-status (epg-context-process context)) 'run) + (process-send-string (epg-context-process context) + (epg-data-string signed-text))) + (if (eq (process-status (epg-context-process context)) 'run) + (process-send-eof (epg-context-process context)))) + ;; Normal (or cleartext) signature. + (if (epg-data-file signature) + (epg--start context (list "--" (epg-data-file signature))) + (epg--start context '("-")) + (if (eq (process-status (epg-context-process context)) 'run) + (process-send-string (epg-context-process context) + (epg-data-string signature))) + (if (eq (process-status (epg-context-process context)) 'run) + (process-send-eof (epg-context-process context)))))) + +;;;###autoload +(defun epg-verify-file (context signature &optional signed-text plain) + "Verify a file SIGNATURE. +SIGNED-TEXT and PLAIN are also a file if they are specified. + +For a detached signature, both SIGNATURE and SIGNED-TEXT should be +string. For a normal or a cleartext signature, SIGNED-TEXT should be +nil. In the latter case, if PLAIN is specified, the plaintext is +stored into the file after successful verification." + (unwind-protect + (progn + (if plain + (epg-context-set-output-file context plain) + (epg-context-set-output-file context + (epg--make-temp-file "epg-output"))) + (if signed-text + (epg-start-verify context + (epg-make-data-from-file signature) + (epg-make-data-from-file signed-text)) + (epg-start-verify context + (epg-make-data-from-file signature))) + (epg-wait-for-completion context) + (unless plain + (epg-read-output context))) + (unless plain + (epg-delete-output-file context)) + (epg-reset context))) + +;;;###autoload +(defun epg-verify-string (context signature &optional signed-text) + "Verify a string SIGNATURE. +SIGNED-TEXT is a string if it is specified. + +For a detached signature, both SIGNATURE and SIGNED-TEXT should be +string. For a normal or a cleartext signature, SIGNED-TEXT should be +nil. In the latter case, this function returns the plaintext after +successful verification." + (let ((coding-system-for-write 'binary) + input-file) + (unwind-protect + (progn + (epg-context-set-output-file context + (epg--make-temp-file "epg-output")) + (if signed-text + (progn + (setq input-file (epg--make-temp-file "epg-signature")) + (write-region signature nil input-file nil 'quiet) + (epg-start-verify context + (epg-make-data-from-file input-file) + (epg-make-data-from-string signed-text))) + (epg-start-verify context (epg-make-data-from-string signature))) + (epg-wait-for-completion context) + (epg-read-output context)) + (epg-delete-output-file context) + (if (and input-file + (file-exists-p input-file)) + (delete-file input-file)) + (epg-reset context)))) + +;;;###autoload +(defun epg-start-sign (context plain &optional mode) + "Initiate a sign operation on PLAIN. +PLAIN is a data object. + +If optional 3rd argument MODE is t or 'detached, it makes a detached signature. +If it is nil or 'normal, it makes a normal signature. +Otherwise, it makes a cleartext signature. + +If you use this function, you will need to wait for the completion of +`epg-gpg-program' by using `epg-wait-for-completion' and call +`epg-reset' to clear a temporaly output file. +If you are unsure, use synchronous version of this function +`epg-sign-file' or `epg-sign-string' instead." + (epg-context-set-operation context 'sign) + (epg-context-set-result context nil) + (unless (memq mode '(t detached nil normal)) ;i.e. cleartext + (epg-context-set-armor context nil) + (epg-context-set-textmode context nil)) + (epg--start context + (append (list (if (memq mode '(t detached)) + "--detach-sign" + (if (memq mode '(nil normal)) + "--sign" + "--clearsign"))) + (apply #'nconc + (mapcar + (lambda (signer) + (list "-u" + (epg-sub-key-id + (car (epg-key-sub-key-list signer))))) + (epg-context-signers context))) + (epg--args-from-sig-notations + (epg-context-sig-notations context)) + (if (epg-data-file plain) + (list "--" (epg-data-file plain))))) + ;; `gpgsm' does not read passphrase from stdin, so waiting is not needed. + (unless (eq (epg-context-protocol context) 'CMS) + (epg-wait-for-status context '("BEGIN_SIGNING"))) + (when (epg-data-string plain) + (if (eq (process-status (epg-context-process context)) 'run) + (process-send-string (epg-context-process context) + (epg-data-string plain))) + (if (eq (process-status (epg-context-process context)) 'run) + (process-send-eof (epg-context-process context))))) + +;;;###autoload +(defun epg-sign-file (context plain signature &optional mode) + "Sign a file PLAIN and store the result to a file SIGNATURE. +If SIGNATURE is nil, it returns the result as a string. +If optional 3rd argument MODE is t or 'detached, it makes a detached signature. +If it is nil or 'normal, it makes a normal signature. +Otherwise, it makes a cleartext signature." + (unwind-protect + (progn + (if signature + (epg-context-set-output-file context signature) + (epg-context-set-output-file context + (epg--make-temp-file "epg-output"))) + (epg-start-sign context (epg-make-data-from-file plain) mode) + (epg-wait-for-completion context) + (unless (epg-context-result-for context 'sign) + (if (epg-context-result-for context 'error) + (error "Sign failed: %S" + (epg-context-result-for context 'error)) + (error "Sign failed"))) + (unless signature + (epg-read-output context))) + (unless signature + (epg-delete-output-file context)) + (epg-reset context))) + +;;;###autoload +(defun epg-sign-string (context plain &optional mode) + "Sign a string PLAIN and return the output as string. +If optional 3rd argument MODE is t or 'detached, it makes a detached signature. +If it is nil or 'normal, it makes a normal signature. +Otherwise, it makes a cleartext signature." + (let ((input-file + (unless (or (eq (epg-context-protocol context) 'CMS) + (condition-case nil + (progn + (epg-check-configuration (epg-configuration)) + t) + (error))) + (epg--make-temp-file "epg-input"))) + (coding-system-for-write 'binary)) + (unwind-protect + (progn + (epg-context-set-output-file context + (epg--make-temp-file "epg-output")) + (if input-file + (write-region plain nil input-file nil 'quiet)) + (epg-start-sign context + (if input-file + (epg-make-data-from-file input-file) + (epg-make-data-from-string plain)) + mode) + (epg-wait-for-completion context) + (unless (epg-context-result-for context 'sign) + (if (epg-context-result-for context 'error) + (error "Sign failed: %S" + (epg-context-result-for context 'error)) + (error "Sign failed"))) + (epg-read-output context)) + (epg-delete-output-file context) + (if input-file + (delete-file input-file)) + (epg-reset context)))) + +;;;###autoload +(defun epg-start-encrypt (context plain recipients + &optional sign always-trust) + "Initiate an encrypt operation on PLAIN. +PLAIN is a data object. +If RECIPIENTS is nil, it performs symmetric encryption. + +If you use this function, you will need to wait for the completion of +`epg-gpg-program' by using `epg-wait-for-completion' and call +`epg-reset' to clear a temporaly output file. +If you are unsure, use synchronous version of this function +`epg-encrypt-file' or `epg-encrypt-string' instead." + (epg-context-set-operation context 'encrypt) + (epg-context-set-result context nil) + (epg--start context + (append (if always-trust '("--always-trust")) + (if recipients '("--encrypt") '("--symmetric")) + (if sign '("--sign")) + (if sign + (apply #'nconc + (mapcar + (lambda (signer) + (list "-u" + (epg-sub-key-id + (car (epg-key-sub-key-list + signer))))) + (epg-context-signers context)))) + (if sign + (epg--args-from-sig-notations + (epg-context-sig-notations context))) + (apply #'nconc + (mapcar + (lambda (recipient) + (list "-r" + (epg-sub-key-id + (car (epg-key-sub-key-list recipient))))) + recipients)) + (if (epg-data-file plain) + (list "--" (epg-data-file plain))))) + ;; `gpgsm' does not read passphrase from stdin, so waiting is not needed. + (unless (eq (epg-context-protocol context) 'CMS) + (if sign + (epg-wait-for-status context '("BEGIN_SIGNING")) + (epg-wait-for-status context '("BEGIN_ENCRYPTION")))) + (when (epg-data-string plain) + (if (eq (process-status (epg-context-process context)) 'run) + (process-send-string (epg-context-process context) + (epg-data-string plain))) + (if (eq (process-status (epg-context-process context)) 'run) + (process-send-eof (epg-context-process context))))) + +;;;###autoload +(defun epg-encrypt-file (context plain recipients + cipher &optional sign always-trust) + "Encrypt a file PLAIN and store the result to a file CIPHER. +If CIPHER is nil, it returns the result as a string. +If RECIPIENTS is nil, it performs symmetric encryption." + (unwind-protect + (progn + (if cipher + (epg-context-set-output-file context cipher) + (epg-context-set-output-file context + (epg--make-temp-file "epg-output"))) + (epg-start-encrypt context (epg-make-data-from-file plain) + recipients sign always-trust) + (epg-wait-for-completion context) + (if (and sign + (not (epg-context-result-for context 'sign))) + (if (epg-context-result-for context 'error) + (error "Sign failed: %S" + (epg-context-result-for context 'error)) + (error "Sign failed"))) + (if (epg-context-result-for context 'error) + (error "Encrypt failed: %S" + (epg-context-result-for context 'error))) + (unless cipher + (epg-read-output context))) + (unless cipher + (epg-delete-output-file context)) + (epg-reset context))) + +;;;###autoload +(defun epg-encrypt-string (context plain recipients + &optional sign always-trust) + "Encrypt a string PLAIN. +If RECIPIENTS is nil, it performs symmetric encryption." + (let ((input-file + (unless (or (not sign) + (eq (epg-context-protocol context) 'CMS) + (condition-case nil + (progn + (epg-check-configuration (epg-configuration)) + t) + (error))) + (epg--make-temp-file "epg-input"))) + (coding-system-for-write 'binary)) + (unwind-protect + (progn + (epg-context-set-output-file context + (epg--make-temp-file "epg-output")) + (if input-file + (write-region plain nil input-file nil 'quiet)) + (epg-start-encrypt context + (if input-file + (epg-make-data-from-file input-file) + (epg-make-data-from-string plain)) + recipients sign always-trust) + (epg-wait-for-completion context) + (if (and sign + (not (epg-context-result-for context 'sign))) + (if (epg-context-result-for context 'error) + (error "Sign failed: %S" + (epg-context-result-for context 'error)) + (error "Sign failed"))) + (if (epg-context-result-for context 'error) + (error "Encrypt failed: %S" + (epg-context-result-for context 'error))) + (epg-read-output context)) + (epg-delete-output-file context) + (if input-file + (delete-file input-file)) + (epg-reset context)))) + +;;;###autoload +(defun epg-start-export-keys (context keys) + "Initiate an export keys operation. + +If you use this function, you will need to wait for the completion of +`epg-gpg-program' by using `epg-wait-for-completion' and call +`epg-reset' to clear a temporaly output file. +If you are unsure, use synchronous version of this function +`epg-export-keys-to-file' or `epg-export-keys-to-string' instead." + (epg-context-set-operation context 'export-keys) + (epg-context-set-result context nil) + (epg--start context (cons "--export" + (mapcar + (lambda (key) + (epg-sub-key-id + (car (epg-key-sub-key-list key)))) + keys)))) + +;;;###autoload +(defun epg-export-keys-to-file (context keys file) + "Extract public KEYS." + (unwind-protect + (progn + (if file + (epg-context-set-output-file context file) + (epg-context-set-output-file context + (epg--make-temp-file "epg-output"))) + (epg-start-export-keys context keys) + (epg-wait-for-completion context) + (if (epg-context-result-for context 'error) + (error "Export keys failed: %S" + (epg-context-result-for context 'error))) + (unless file + (epg-read-output context))) + (unless file + (epg-delete-output-file context)) + (epg-reset context))) + +;;;###autoload +(defun epg-export-keys-to-string (context keys) + "Extract public KEYS and return them as a string." + (epg-export-keys-to-file context keys nil)) + +;;;###autoload +(defun epg-start-import-keys (context keys) + "Initiate an import keys operation. +KEYS is a data object. + +If you use this function, you will need to wait for the completion of +`epg-gpg-program' by using `epg-wait-for-completion' and call +`epg-reset' to clear a temporaly output file. +If you are unsure, use synchronous version of this function +`epg-import-keys-from-file' or `epg-import-keys-from-string' instead." + (epg-context-set-operation context 'import-keys) + (epg-context-set-result context nil) + (epg--start context (if (epg-data-file keys) + (list "--import" "--" (epg-data-file keys)) + (list "--import"))) + (when (epg-data-string keys) + (if (eq (process-status (epg-context-process context)) 'run) + (process-send-string (epg-context-process context) + (epg-data-string keys))) + (if (eq (process-status (epg-context-process context)) 'run) + (process-send-eof (epg-context-process context))))) + +(defun epg--import-keys-1 (context keys) + (unwind-protect + (progn + (epg-start-import-keys context keys) + (epg-wait-for-completion context) + (if (epg-context-result-for context 'error) + (error "Import keys failed: %S" + (epg-context-result-for context 'error)))) + (epg-reset context))) + +;;;###autoload +(defun epg-import-keys-from-file (context keys) + "Add keys from a file KEYS." + (epg--import-keys-1 context (epg-make-data-from-file keys))) + +;;;###autoload +(defun epg-import-keys-from-string (context keys) + "Add keys from a string KEYS." + (epg--import-keys-1 context (epg-make-data-from-string keys))) + +;;;###autoload +(defun epg-start-receive-keys (context key-id-list) + "Initiate a receive key operation. +KEY-ID-LIST is a list of key IDs. + +If you use this function, you will need to wait for the completion of +`epg-gpg-program' by using `epg-wait-for-completion' and call +`epg-reset' to clear a temporaly output file. +If you are unsure, use synchronous version of this function +`epg-generate-key-from-file' or `epg-generate-key-from-string' instead." + (epg-context-set-operation context 'receive-keys) + (epg-context-set-result context nil) + (epg--start context (cons "--recv-keys" key-id-list))) + +;;;###autoload +(defun epg-receive-keys (context keys) + "Add keys from server. +KEYS is a list of key IDs" + (unwind-protect + (progn + (epg-start-receive-keys context keys) + (epg-wait-for-completion context) + (if (epg-context-result-for context 'error) + (error "Receive keys failed: %S" + (epg-context-result-for context 'error)))) + (epg-reset context))) + +;;;###autoload +(defalias 'epg-import-keys-from-server 'epg-receive-keys) + +;;;###autoload +(defun epg-start-delete-keys (context keys &optional allow-secret) + "Initiate an delete keys operation. + +If you use this function, you will need to wait for the completion of +`epg-gpg-program' by using `epg-wait-for-completion' and call +`epg-reset' to clear a temporaly output file. +If you are unsure, use synchronous version of this function +`epg-delete-keys' instead." + (epg-context-set-operation context 'delete-keys) + (epg-context-set-result context nil) + (epg--start context (cons (if allow-secret + "--delete-secret-key" + "--delete-key") + (mapcar + (lambda (key) + (epg-sub-key-id + (car (epg-key-sub-key-list key)))) + keys)))) + +;;;###autoload +(defun epg-delete-keys (context keys &optional allow-secret) + "Delete KEYS from the key ring." + (unwind-protect + (progn + (epg-start-delete-keys context keys allow-secret) + (epg-wait-for-completion context) + (let ((entry (assq 'delete-problem + (epg-context-result-for context 'error)))) + (if entry + (if (setq entry (assq (cdr entry) + epg-delete-problem-reason-alist)) + (error "Delete keys failed: %s" (cdr entry)) + (error "Delete keys failed"))))) + (epg-reset context))) + +;;;###autoload +(defun epg-start-sign-keys (context keys &optional local) + "Initiate a sign keys operation. + +If you use this function, you will need to wait for the completion of +`epg-gpg-program' by using `epg-wait-for-completion' and call +`epg-reset' to clear a temporaly output file. +If you are unsure, use synchronous version of this function +`epg-sign-keys' instead." + (epg-context-set-operation context 'sign-keys) + (epg-context-set-result context nil) + (epg--start context (cons (if local + "--lsign-key" + "--sign-key") + (mapcar + (lambda (key) + (epg-sub-key-id + (car (epg-key-sub-key-list key)))) + keys)))) +(make-obsolete 'epg-start-sign-keys "Do not use.") + +;;;###autoload +(defun epg-sign-keys (context keys &optional local) + "Sign KEYS from the key ring." + (unwind-protect + (progn + (epg-start-sign-keys context keys local) + (epg-wait-for-completion context) + (if (epg-context-result-for context 'error) + (error "Sign keys failed: %S" + (epg-context-result-for context 'error)))) + (epg-reset context))) +(make-obsolete 'epg-sign-keys "Do not use.") + +;;;###autoload +(defun epg-start-generate-key (context parameters) + "Initiate a key generation. +PARAMETERS specifies parameters for the key. + +If you use this function, you will need to wait for the completion of +`epg-gpg-program' by using `epg-wait-for-completion' and call +`epg-reset' to clear a temporaly output file. +If you are unsure, use synchronous version of this function +`epg-generate-key-from-file' or `epg-generate-key-from-string' instead." + (epg-context-set-operation context 'generate-key) + (epg-context-set-result context nil) + (if (epg-data-file parameters) + (epg--start context (list "--batch" "--genkey" "--" + (epg-data-file parameters))) + (epg--start context '("--batch" "--genkey")) + (if (eq (process-status (epg-context-process context)) 'run) + (process-send-string (epg-context-process context) + (epg-data-string parameters))) + (if (eq (process-status (epg-context-process context)) 'run) + (process-send-eof (epg-context-process context))))) + +;;;###autoload +(defun epg-generate-key-from-file (context parameters) + "Generate a new key pair. +PARAMETERS is a file which tells how to create the key." + (unwind-protect + (progn + (epg-start-generate-key context (epg-make-data-from-file parameters)) + (epg-wait-for-completion context) + (if (epg-context-result-for context 'error) + (error "Generate key failed: %S" + (epg-context-result-for context 'error)))) + (epg-reset context))) + +;;;###autoload +(defun epg-generate-key-from-string (context parameters) + "Generate a new key pair. +PARAMETERS is a string which tells how to create the key." + (unwind-protect + (progn + (epg-start-generate-key context (epg-make-data-from-string parameters)) + (epg-wait-for-completion context) + (if (epg-context-result-for context 'error) + (error "Generate key failed: %S" + (epg-context-result-for context 'error)))) + (epg-reset context))) + +(defun epg--decode-percent-escape (string) + (let ((index 0)) + (while (string-match "%\\(\\(%\\)\\|\\([0-9A-Fa-f][0-9A-Fa-f]\\)\\)" + string index) + (if (match-beginning 2) + (setq string (replace-match "%" t t string) + index (1- (match-end 0))) + (setq string (replace-match + (string (string-to-number (match-string 3 string) 16)) + t t string) + index (- (match-end 0) 2)))) + string)) + +(defun epg--decode-hexstring (string) + (let ((index 0)) + (while (eq index (string-match "[0-9A-Fa-f][0-9A-Fa-f]" string index)) + (setq string (replace-match (string (string-to-number + (match-string 0 string) 16)) + t t string) + index (1- (match-end 0)))) + string)) + +(defun epg--decode-quotedstring (string) + (let ((index 0)) + (while (string-match "\\\\\\(\\([,=+<>#;\\\"]\\)\\|\ +\\([0-9A-Fa-f][0-9A-Fa-f]\\)\\)" + string index) + (if (match-beginning 2) + (setq string (replace-match "\\2" t nil string) + index (1- (match-end 0))) + (if (match-beginning 3) + (setq string (replace-match (string (string-to-number + (match-string 0 string) 16)) + t t string) + index (- (match-end 0) 2))))) + string)) + +(defun epg-dn-from-string (string) + "Parse STRING as LADPv3 Distinguished Names (RFC2253). +The return value is an alist mapping from types to values." + (let ((index 0) + (length (length string)) + alist type value group) + (while (< index length) + (if (eq index (string-match "[ \t\n\r]*" string index)) + (setq index (match-end 0))) + (if (eq index (string-match + "\\([0-9]+\\(\\.[0-9]+\\)*\\)\[ \t\n\r]*=[ \t\n\r]*" + string index)) + (setq type (match-string 1 string) + index (match-end 0)) + (if (eq index (string-match "\\([0-9A-Za-z]+\\)[ \t\n\r]*=[ \t\n\r]*" + string index)) + (setq type (match-string 1 string) + index (match-end 0)))) + (unless type + (error "Invalid type")) + (if (eq index (string-match + "\\([^,=+<>#;\\\"]\\|\\\\.\\)+" + string index)) + (setq index (match-end 0) + value (epg--decode-quotedstring (match-string 0 string))) + (if (eq index (string-match "#\\([0-9A-Fa-f]+\\)" string index)) + (setq index (match-end 0) + value (epg--decode-hexstring (match-string 1 string))) + (if (eq index (string-match "\"\\([^\\\"]\\|\\\\.\\)*\"" + string index)) + (setq index (match-end 0) + value (epg--decode-quotedstring + (match-string 0 string)))))) + (if group + (if (stringp (car (car alist))) + (setcar alist (list (cons type value) (car alist))) + (setcar alist (cons (cons type value) (car alist)))) + (if (consp (car (car alist))) + (setcar alist (nreverse (car alist)))) + (setq alist (cons (cons type value) alist) + type nil + value nil)) + (if (eq index (string-match "[ \t\n\r]*\\([,;+]\\)" string index)) + (setq index (match-end 0) + group (eq (aref string (match-beginning 1)) ?+)))) + (nreverse alist))) + +(defun epg-decode-dn (alist) + "Convert ALIST returned by `epg-dn-from-string' to a human readable form. +Type names are resolved using `epg-dn-type-alist'." + (mapconcat + (lambda (rdn) + (if (stringp (car rdn)) + (let ((entry (assoc (car rdn) epg-dn-type-alist))) + (if entry + (format "%s=%s" (cdr entry) (cdr rdn)) + (format "%s=%s" (car rdn) (cdr rdn)))) + (concat "(" (epg-decode-dn rdn) ")"))) + alist + ", ")) + +(provide 'epg) + +;;; epg.el ends here |