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
  17 (defvar epg-pgp50i-status nil)
  18
  19 (defun epg-pgp50i--start (context program args)
  20   (let ((args (append '("--headers" "--language=us" "--batchmode=0" "--force")
  21                       (if (epg-context-armor context) '("--armor"))
  22                       (if (epg-context-textmode context) '("--textmode"))
  23                       (if (epg-context-output-file context)
  24                           (list "-o" (epg-context-output-file context)))
  25                       args))
  26         (coding-system-for-write 'binary)
  27         process-connection-type
  28         (orig-mode (default-file-modes))
  29         (buffer (generate-new-buffer " *epg*"))
  30         process)
  31     (if epg-debug
  32         (save-excursion
  33           (unless epg-debug-buffer
  34             (setq epg-debug-buffer (generate-new-buffer " *epg-debug*")))
  35           (set-buffer epg-debug-buffer)
  36           (goto-char (point-max))
  37           (insert (format "%s %s\n"
  38                           program
  39                           (mapconcat #'identity args " ")))))
  40     (with-current-buffer buffer
  41       (make-local-variable 'epg-read-point)
  42       (setq epg-read-point (point-min))
  43       (make-local-variable 'epg-pending-status-list)
  44       (setq epg-pending-status-list nil)
  45       (make-local-variable 'epg-key-id)
  46       (setq epg-key-id nil)
  47       (make-local-variable 'epg-context)
  48       (setq epg-context context)
  49       (make-local-variable 'epg-pgp50i-status)
  50       (setq epg-pgp50i-status nil))
  51     (unwind-protect
  52         (progn
  53           (set-default-file-modes 448)
  54           (setq process
  55                 (apply #'start-process "epg" buffer program args)))
  56       (set-default-file-modes orig-mode))
  57     (set-process-filter process #'epg-pgp50i--process-filter)
  58     (set-process-sentinel process #'ignore)
  59     (epg-context-set-process context process)))
  60
  61 (defun epg-pgp50i--process-filter (process input)
  62   (if epg-debug
  63       (save-excursion
  64         (unless epg-debug-buffer
  65           (setq epg-debug-buffer (generate-new-buffer " *epg-debug*")))
  66         (set-buffer epg-debug-buffer)
  67         (goto-char (point-max))
  68         (insert input)))
  69   (if (buffer-live-p (process-buffer process))
  70       (save-excursion
  71         (set-buffer (process-buffer process))
  72         (goto-char (point-max))
  73         (insert input)
  74         (unless epg-pgp50i-status
  75           (goto-char epg-read-point)
  76           (while (not (eobp))
  77             (save-excursion
  78               (if (looking-at
  79                    "\\(PRI\\|INF\\|QRY\\|STA\\|WRN\\|ERR\\):  \\(.*\\)")
  80                   (let ((message (match-string 2))
  81                         (pointer epg-pgp50i-message-alist)
  82                         status symbol)
  83                     (while pointer
  84                       (if (string-match (car (car pointer)) message)
  85                           (setq status (cdr (car pointer))
  86                                 pointer nil))
  87                       (setq pointer (cdr pointer)))
  88                     (when status
  89                       (unless (looking-at ".*\n")
  90                         (end-of-line)
  91                         (insert "\n"))
  92                       (if (member status epg-pending-status-list)
  93                           (setq epg-pending-status-list nil))
  94                       (setq symbol (intern-soft (concat "epg-pgp50i--status-"
  95                                                         status)))
  96                       (if (and symbol
  97                                (fboundp symbol))
  98                           (unwind-protect
  99                               (progn
 100                                 (setq epg-pgp50i-status status)
 101                                 (funcall symbol epg-context message))
 102                             (setq epg-pgp50i-status nil)))))))
 103             (forward-line)
 104             (setq epg-read-point (point)))))))
 105
 106 (defun epg-pgp50i--wait-for-line (context)
 107   (if (eq (process-status (epg-context-process context)) 'run)
 108       (save-excursion
 109         (set-buffer (process-buffer (epg-context-process context)))
 110         (goto-char epg-read-point)
 111         (beginning-of-line 2)
 112         (while (and (eq (process-status (epg-context-process context)) 'run)
 113                     (not (if (looking-at ".*\n")
 114                              (setq epg-read-point (point)))))
 115           (accept-process-output (epg-context-process context) 1))
 116         (buffer-substring (point) (progn (end-of-line) (point))))))
 117
 118 (defun epg-pgp50i--status-ENTER_PASSPHRASE (context status)
 119   (epg--status-GET_HIDDEN context "passphrase."))
 120
 121 (defun epg-pgp50i--status-NEED_PASSPHRASE_TO_DECRYPT_KEY (context status)
 122   (let ((line (epg-pgp50i--wait-for-line context))
 123         user-id entry)
 124     (when (and line
 125                (string-match "[ 0-9]+ bits, Key ID \\([0-9A-F]+\\)" line))
 126       (setq epg-key-id (match-string 1 line)
 127             line (epg-pgp50i--wait-for-line context))
 128       (when (and line
 129                  (string-match "\"\\([^\"]+\\)\"" line))
 130         (setq user-id (match-string 1 line)
 131               entry (assoc epg-key-id epg-user-id-alist))
 132         (if entry
 133             (setcdr entry user-id)
 134           (setq epg-user-id-alist (cons (cons epg-key-id user-id)
 135                                         epg-user-id-alist)))))))
 136
 137 (defadvice epg-start-decrypt
 138   (around epg-pgp50i activate)
 139   (if (eq (epg-context-protocol (ad-get-arg 0)) 'CMS)
 140       ad-do-it
 141     (unless (epg-data-file (ad-get-arg 1))
 142       (error "Not a file"))
 143     (epg-context-set-operation context 'decrypt)
 144     (epg-context-set-result (ad-get-arg 0) nil)
 145     (epg-pgp50i--start context epg-pgp50i-pgpv-program
 146                        (list (epg-data-file (ad-get-arg 1))))
 147     (epg-wait-for-status (ad-get-arg 0) '("GOOD_PASSPHRASE"))))
 148
 149 (defadvice epg-start-verify
 150   (around epg-pgp50i activate)
 151   (if (eq (epg-context-protocol (ad-get-arg 0)) 'CMS)
 152       ad-do-it
 153     (error "Not implemented yet")))
 154
 155 (defadvice epg-start-sign
 156   (around epg-pgp50i activate)
 157   (if (eq (epg-context-protocol (ad-get-arg 0)) 'CMS)
 158       ad-do-it
 159     (error "Not implemented yet")))
 160
 161 (defadvice epg-start-encrypt
 162   (around epg-pgp50i activate)
 163   (if (eq (epg-context-protocol (ad-get-arg 0)) 'CMS)
 164       ad-do-it
 165     (error "Not implemented yet")))
 166
 167 (provide 'epg-pgp50i)
 168
 169 ;;; epg-pgp50i.el ends here