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 (defun epg-pgp50i--start (context program args)
  26   (let ((args (append '("--headers" "--language=us")
  27                       (if (epg-context-armor context) '("--armor"))
  28                       (if (epg-context-textmode context) '("--textmode"))
  29                       (if (epg-context-output-file context)
  30                           (list "-o" (epg-context-output-file context)))
  31                       args))
  32         (coding-system-for-write 'binary)
  33         process-connection-type
  34         (orig-mode (default-file-modes))
  35         (buffer (generate-new-buffer " *epg*"))
  36         process)
  37     (if epg-debug
  38         (save-excursion
  39           (unless epg-debug-buffer
  40             (setq epg-debug-buffer (generate-new-buffer " *epg-debug*")))
  41           (set-buffer epg-debug-buffer)
  42           (goto-char (point-max))
  43           (insert (format "%s %s\n"
  44                           program
  45                           (mapconcat #'identity args " ")))))
  46     (with-current-buffer buffer
  47       (make-local-variable 'epg-read-point)
  48       (setq epg-read-point (point-min))
  49       (make-local-variable 'epg-process-filter-running)
  50       (setq epg-process-filter-running nil)
  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     (unwind-protect
  58         (progn
  59           (set-default-file-modes 448)
  60           (setq process
  61                 (apply #'start-process "epg" buffer program args)))
  62       (set-default-file-modes orig-mode))
  63     (set-process-filter process #'epg-pgp50i--process-filter)
  64     (set-process-sentinel process #'ignore)
  65     (epg-context-set-process context process)))
  66
  67 (defun epg-pgp50i--process-filter (process input)
  68   (if epg-debug
  69       (save-excursion
  70         (unless epg-debug-buffer
  71           (setq epg-debug-buffer (generate-new-buffer " *epg-debug*")))
  72         (set-buffer epg-debug-buffer)
  73         (goto-char (point-max))
  74         (insert input)))
  75   (if (buffer-live-p (process-buffer process))
  76       (save-excursion
  77         (set-buffer (process-buffer process))
  78         (goto-char (point-max))
  79         (insert input)
  80         (unless epg-process-filter-running
  81           (unwind-protect
  82               (progn
  83                 (setq epg-process-filter-running t)
  84                 (goto-char epg-read-point)
  85                 (while (not (eobp))
  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
 103                                                      "epg-pgp50i--status-"
 104                                                      status)))
 105                           (if (and symbol
 106                                    (fboundp symbol))
 107                               (funcall symbol epg-context message)))))
 108                   (forward-line)
 109                   (setq epg-read-point (point))))
 110             (setq epg-process-filter-running nil))))))
 111
 112 (defun epg-pgp50i--read-line (context)
 113   (if (eq (process-status (epg-context-process context)) 'run)
 114       (save-excursion
 115         (set-buffer (process-buffer (epg-context-process context)))
 116         (forward-line)
 117         (goto-char epg-read-point)
 118         (if (looking-at ".*\n")
 119             (buffer-substring (point) (progn (end-of-line) (point)))))))
 120
 121 (defun epg-pgp50i--status-ENTER_PASSPHRASE (context message)
 122   (epg--status-GET_HIDDEN context "passphrase."))
 123
 124 (defun epg-pgp50i--read-key (context)
 125   (let ((line (epg-pgp50i--read-line context))
 126         key-id user-id-list)
 127     (when (and line
 128                (string-match "[ 0-9]+ bits, Key ID \\([0-9A-F]+\\)" line))
 129       (setq key-id (match-string 1 line))
 130       (while (and (setq line (epg-pgp50i--read-line context))
 131                   (string-match "\"\\([^\"]+\\)\"" line))
 132         (setq user-id-list (cons (match-string 1 line) user-id-list)))
 133       (cons key-id user-id-list))))
 134
 135 (defun epg-pgp50i--status-NEED_PASSPHRASE_TO_DECRYPT_KEY (context message)
 136   (let* ((key (epg-pgp50i--read-key context))
 137          (entry (assoc (car key) epg-user-id-alist)))
 138     (if entry
 139         (setcdr entry (car (cdr key)))
 140       (setq epg-user-id-alist (cons (cons (car key) (car (cdr key)))
 141                                     epg-user-id-alist)))
 142     (setq epg-key-id (car key))))
 143
 144 (defun epg-pgp50i--status-CANNOT_DECRYPT (context message)
 145   (epg-context-set-result-for
 146    context 'error
 147    (cons (cons 'decryption-failed
 148                (epg-pgp50i--read-key context))
 149          (epg-context-result-for context 'error))))
 150
 151 (defun epg-pgp50i--parse-time (string)
 152   (if (string-match "\\`\\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\) \
 153 \\([0-9][0-9]\\):\\([0-9][0-9]\\) GMT\\'" string)
 154       (encode-time 0
 155                    (string-to-number (match-string 5 string))
 156                    (string-to-number (match-string 4 string))
 157                    (string-to-number (match-string 3 string))
 158                    (string-to-number (match-string 2 string))
 159                    (string-to-number (match-string 1 string))
 160                    0)))
 161
 162 (defun epg-pgp50i--status-GOOD_SIGNATURE (context message)
 163   (if (string-match "Good signature made \\(.*\\) by key:" message)
 164       (let ((time (epg-pgp50i--parse-time (match-string 1 message)))
 165             (key (epg-pgp50i--read-key context)))
 166         (epg--status-*SIG context 'good (concat (car key) " " (car (cdr key))))
 167         (epg-signature-set-creation-time
 168          (car (epg-context-result-for context 'verify))
 169          time))))
 170
 171 (defun epg-pgp50i--status-BAD_SIGNATURE (context message)
 172   (if (string-match "BAD signature made \\(.*\\) by key:" message)
 173       (let ((time (epg-pgp50i--parse-time (match-string 1 message)))
 174             (key (epg-pgp50i--read-key context)))
 175         (epg--status-*SIG context 'good (concat (car key) " " (car (cdr key))))
 176         (epg-signature-set-creation-time
 177          (car (epg-context-result-for context 'verify))
 178          time))))
 179
 180 (defadvice epg-start-decrypt
 181   (around epg-pgp50i activate)
 182   (if (eq (epg-context-protocol (ad-get-arg 0)) 'CMS)
 183       ad-do-it
 184     (let ((context (ad-get-arg 0))
 185           (cipher (ad-get-arg 1)))
 186       (unless (epg-data-file cipher)
 187         (error "Not a file"))
 188       (epg-context-set-operation context 'decrypt)
 189       (epg-context-set-result context nil)
 190       (epg-pgp50i--start context epg-pgp50i-pgpv-program
 191                          (list  "--batchmode=0" "--force"
 192                                 (epg-data-file cipher))))))
 193
 194 (defadvice epg-start-verify
 195   (around epg-pgp50i activate)
 196   (if (eq (epg-context-protocol (ad-get-arg 0)) 'CMS)
 197       ad-do-it
 198     (let ((context (ad-get-arg 0))
 199           (signature (ad-get-arg 1))
 200           (signed-text (ad-get-arg 2)))
 201       (epg-context-set-operation context 'verify)
 202       (epg-context-set-result context nil)
 203       (if signed-text
 204           ;; Detached signature.
 205           (if (epg-data-file signed-text)
 206               (epg-pgp50i--start context
 207                                  epg-pgp50i-pgpv-program
 208                                  (list  "--batchmode=1" "--force"
 209                                         (epg-data-file signature)
 210                                         (epg-data-file signed-text)))
 211             (epg-pgp50i--start context
 212                                epg-pgp50i-pgpv-program
 213                                (list  "--batchmode=1" "--force"
 214                                       (epg-data-file signature)))
 215             (if (eq (process-status (epg-context-process context)) 'run)
 216                 (process-send-string (epg-context-process context)
 217                                      (epg-data-string signed-text)))
 218             (if (eq (process-status (epg-context-process context)) 'run)
 219                 (process-send-eof (epg-context-process context))))
 220         ;; Normal (or cleartext) signature.
 221         (if (epg-data-file signature)
 222             (epg-pgp50i--start context
 223                                epg-pgp50i-pgpv-program
 224                                (list "--batchmode=1" "--force"
 225                                      (epg-data-file signature)))
 226           (epg-pgp50i--start context
 227                              epg-pgp50i-pgpv-program
 228                              (list "--batchmode=1" "--force"))
 229           (if (eq (process-status (epg-context-process context)) 'run)
 230               (process-send-string (epg-context-process context)
 231                                    (epg-data-string signature)))
 232           (if (eq (process-status (epg-context-process context)) 'run)
 233               (process-send-eof (epg-context-process context))))))))
 234
 235 (defadvice epg-start-sign
 236   (around epg-pgp50i activate)
 237   (if (eq (epg-context-protocol (ad-get-arg 0)) 'CMS)
 238       ad-do-it
 239     (let ((context (ad-get-arg 0))
 240           (plain (ad-get-arg 1))
 241           (mode (ad-get-arg 2)))
 242       (epg-context-set-operation context 'sign)
 243       (epg-context-set-result context nil)
 244       (unless (memq mode '(t detached nil normal))
 245         (epg-context-set-armor context t))
 246       (epg-pgp50i--start context
 247                          epg-pgp50i-pgps-program
 248                          (append (list (if (memq mode '(t detached))
 249                                            "-b"))
 250                                  (apply #'nconc
 251                                         (mapcar
 252                                          (lambda (signer)
 253                                            (list "-u"
 254                                                  (epg-sub-key-id
 255                                       (car (epg-key-sub-key-list signer)))))
 256                              (epg-context-signers context)))
 257                      (if (epg-data-file plain)
 258                          (list (epg-data-file plain)))))
 259   ;; `gpgsm' does not read passphrase from stdin, so waiting is not needed.
 260   (unless (eq (epg-context-protocol context) 'CMS)
 261     (epg-wait-for-status context '("BEGIN_SIGNING")))
 262   (when (epg-data-string plain)
 263     (if (eq (process-status (epg-context-process context)) 'run)
 264         (process-send-string (epg-context-process context)
 265                              (epg-data-string plain)))
 266     (if (eq (process-status (epg-context-process context)) 'run)
 267         (process-send-eof (epg-context-process context)))))
 268     ))
 269
 270 (defadvice epg-start-encrypt
 271   (around epg-pgp50i activate)
 272   (if (eq (epg-context-protocol (ad-get-arg 0)) 'CMS)
 273       ad-do-it
 274     (error "Not implemented yet")))
 275
 276 (provide 'epg-pgp50i)
 277
 278 ;;; epg-pgp50i.el ends here