epg-pgp50i.el

   1 (eval-when-compile (require 'epg))
   2
   3 (defvar epg-pgp50i-pgpv-program "pgpv")
   4
   5 (defconst epg-pgp50i-message-alist
   6   '(("Message is encrypted." .
   7      "MESSAGE_IS_ENCRYPTED")
   8     ("Need a pass phrase to decrypt private key:" .
   9      "NEED_PASSPHRASE_TO_DECRYPT_KEY")
  10     ("Enter pass phrase: " .
  11      "ENTER_PASSPHRASE")
  12     ("Pass phrase is good." .
  13      "GOOD_PASSPHRASE")
  14     ("Cannot decrypt message.  It can only be decrypted by:" .
  15      "CANNOT_DECRYPT")
  16     ("Good signature made .* by key:" .
  17      "GOOD_SIGNATURE")
  18     ("BAD signature made .* by key:" .
  19      "BAD_SIGNATURE")
  20     ("Error .* checking signature:  " .
  21      "ERROR_SIGNATURE")
  22     ("Signature by unknown keyid: " .
  23      "UNKNOWN_SIGNATURE")))
  24
  25 (defvar epg-pgp50i-status nil)
  26
  27 (defun epg-pgp50i--start (context program args)
  28   (let ((args (append '("--headers" "--language=us")
  29                       (if (epg-context-armor context) '("--armor"))
  30                       (if (epg-context-textmode context) '("--textmode"))
  31                       (if (epg-context-output-file context)
  32                           (list "-o" (epg-context-output-file context)))
  33                       args))
  34         (coding-system-for-write 'binary)
  35         process-connection-type
  36         (orig-mode (default-file-modes))
  37         (buffer (generate-new-buffer " *epg*"))
  38         process)
  39     (if epg-debug
  40         (save-excursion
  41           (unless epg-debug-buffer
  42             (setq epg-debug-buffer (generate-new-buffer " *epg-debug*")))
  43           (set-buffer epg-debug-buffer)
  44           (goto-char (point-max))
  45           (insert (format "%s %s\n"
  46                           program
  47                           (mapconcat #'identity args " ")))))
  48     (with-current-buffer buffer
  49       (make-local-variable 'epg-read-point)
  50       (setq epg-read-point (point-min))
  51       (make-local-variable 'epg-pending-status-list)
  52       (setq epg-pending-status-list nil)
  53       (make-local-variable 'epg-key-id)
  54       (setq epg-key-id nil)
  55       (make-local-variable 'epg-context)
  56       (setq epg-context context)
  57       (make-local-variable 'epg-pgp50i-status)
  58       (setq epg-pgp50i-status nil))
  59     (unwind-protect
  60         (progn
  61           (set-default-file-modes 448)
  62           (setq process
  63                 (apply #'start-process "epg" buffer program args)))
  64       (set-default-file-modes orig-mode))
  65     (set-process-filter process #'epg-pgp50i--process-filter)
  66     (set-process-sentinel process #'ignore)
  67     (epg-context-set-process context process)))
  68
  69 (defun epg-pgp50i--process-filter (process input)
  70   (if epg-debug
  71       (save-excursion
  72         (unless epg-debug-buffer
  73           (setq epg-debug-buffer (generate-new-buffer " *epg-debug*")))
  74         (set-buffer epg-debug-buffer)
  75         (goto-char (point-max))
  76         (insert input)))
  77   (if (buffer-live-p (process-buffer process))
  78       (save-excursion
  79         (set-buffer (process-buffer process))
  80         (goto-char (point-max))
  81         (insert input)
  82         (unless epg-pgp50i-status
  83           (goto-char epg-read-point)
  84           (while (not (eobp))
  85             (save-excursion
  86               (if (looking-at
  87                    "\\(PRI\\|INF\\|QRY\\|STA\\|WRN\\|ERR\\):  \\(.*\\)")
  88                   (let ((message (match-string 2))
  89                         (pointer epg-pgp50i-message-alist)
  90                         status symbol)
  91                     (while pointer
  92                       (if (string-match (car (car pointer)) message)
  93                           (setq status (cdr (car pointer))
  94                                 pointer nil))
  95                       (setq pointer (cdr pointer)))
  96                     (when status
  97                       (unless (looking-at ".*\n")
  98                         (end-of-line)
  99                         (insert "\n"))
 100                       (if (member status epg-pending-status-list)
 101                           (setq epg-pending-status-list nil))
 102                       (setq symbol (intern-soft (concat "epg-pgp50i--status-"
 103                                                         status)))
 104                       (if (and symbol
 105                                (fboundp symbol))
 106                           (unwind-protect
 107                               (progn
 108                                 (setq epg-pgp50i-status status)
 109                                 (funcall symbol epg-context message))
 110                             (setq epg-pgp50i-status nil)))))))
 111             (forward-line)
 112             (setq epg-read-point (point)))))))
 113
 114 (defun epg-pgp50i--wait-for-line (context)
 115   (if (eq (process-status (epg-context-process context)) 'run)
 116       (save-excursion
 117         (set-buffer (process-buffer (epg-context-process context)))
 118         (goto-char epg-read-point)
 119         (beginning-of-line 2)
 120         (while (and (eq (process-status (epg-context-process context)) 'run)
 121                     (not (if (looking-at ".*\n")
 122                              (setq epg-read-point (point)))))
 123           (accept-process-output (epg-context-process context) 1))
 124         (buffer-substring (point) (progn (end-of-line) (point))))))
 125
 126 (defun epg-pgp50i--status-ENTER_PASSPHRASE (context message)
 127   (epg--status-GET_HIDDEN context "passphrase."))
 128
 129 (defun epg-pgp50i--read-key (context)
 130   (let ((line (epg-pgp50i--wait-for-line context))
 131         key-id user-id-list)
 132     (when (and line
 133                (string-match "[ 0-9]+ bits, Key ID \\([0-9A-F]+\\)" line))
 134       (setq key-id (match-string 1 line))
 135       (when (and (setq line (epg-pgp50i--wait-for-line context))
 136                  (string-match "\"\\([^\"]+\\)\"" line))
 137         (setq user-id-list (cons (match-string 1 line) user-id-list)))
 138       (cons key-id user-id-list))))
 139
 140 (defun epg-pgp50i--status-NEED_PASSPHRASE_TO_DECRYPT_KEY (context message)
 141   (let* ((key (epg-pgp50i--read-key context))
 142          (entry (assoc (car key) epg-user-id-alist)))
 143     (if entry
 144         (setcdr entry (car (cdr key)))
 145       (setq epg-user-id-alist (cons (cons (car key) (car (cdr key)))
 146                                     epg-user-id-alist)))
 147     (setq epg-key-id (car key))))
 148
 149 (defun epg-pgp50i--status-GOOD_SIGNATURE (context message)
 150   (let ((key (epg-pgp50i--read-key context)))
 151     (epg--status-*SIG context 'good (concat (car key) " " (car (cdr key))))))
 152
 153 (defadvice epg-start-decrypt
 154   (around epg-pgp50i activate)
 155   (if (eq (epg-context-protocol (ad-get-arg 0)) 'CMS)
 156       ad-do-it
 157     (let ((context (ad-get-arg 0))
 158           (cipher (ad-get-arg 1)))
 159       (unless (epg-data-file cipher)
 160         (error "Not a file"))
 161       (epg-context-set-operation context 'decrypt)
 162       (epg-context-set-result context nil)
 163       (epg-pgp50i--start context epg-pgp50i-pgpv-program
 164                          (list  "--batchmode=0" "--force"
 165                                 (epg-data-file cipher))))))
 166
 167 (defadvice epg-start-verify
 168   (around epg-pgp50i activate)
 169   (if (eq (epg-context-protocol (ad-get-arg 0)) 'CMS)
 170       ad-do-it
 171     (let ((context (ad-get-arg 0))
 172           (signature (ad-get-arg 1))
 173           (signed-text (ad-get-arg 2)))
 174       (epg-context-set-operation context 'verify)
 175       (epg-context-set-result context nil)
 176       (if signed-text
 177           ;; Detached signature.
 178           (if (epg-data-file signed-text)
 179               (epg-pgp50i--start context
 180                                  epg-pgp50i-pgpv-program
 181                                  (list  "--batchmode=1" "--force"
 182                                         (epg-data-file signature)
 183                                         (epg-data-file signed-text)))
 184             (epg-pgp50i--start context
 185                                epg-pgp50i-pgpv-program
 186                                (list  "--batchmode=1" "--force"
 187                                       (epg-data-file signature)))
 188             (if (eq (process-status (epg-context-process context)) 'run)
 189                 (process-send-string (epg-context-process context)
 190                                      (epg-data-string signed-text)))
 191             (if (eq (process-status (epg-context-process context)) 'run)
 192                 (process-send-eof (epg-context-process context))))
 193         ;; Normal (or cleartext) signature.
 194         (if (epg-data-file signature)
 195             (epg-pgp50i--start context
 196                                epg-pgp50i-pgpv-program
 197                                (list "--batchmode=1" "--force"
 198                                      (epg-data-file signature)))
 199           (epg-pgp50i--start context
 200                              epg-pgp50i-pgpv-program
 201                              (list "--batchmode=1" "--force"))
 202           (if (eq (process-status (epg-context-process context)) 'run)
 203               (process-send-string (epg-context-process context)
 204                                    (epg-data-string signature)))
 205           (if (eq (process-status (epg-context-process context)) 'run)
 206               (process-send-eof (epg-context-process context))))))))
 207
 208 (defadvice epg-start-sign
 209   (around epg-pgp50i activate)
 210   (if (eq (epg-context-protocol (ad-get-arg 0)) 'CMS)
 211       ad-do-it
 212     (error "Not implemented yet")))
 213
 214 (defadvice epg-start-encrypt
 215   (around epg-pgp50i activate)
 216   (if (eq (epg-context-protocol (ad-get-arg 0)) 'CMS)
 217       ad-do-it
 218     (error "Not implemented yet")))
 219
 220 (provide 'epg-pgp50i)
 221
 222 ;;; epg-pgp50i.el ends here