+++ /dev/null
-(eval-when-compile (require 'epg))
-
-(defvar epg-pgp50i-pgpv-program "pgpv")
-
-(defconst epg-pgp50i-message-alist
- '(("Message is encrypted." .
- "MESSAGE_IS_ENCRYPTED")
- ("Need a pass phrase to decrypt private key:" .
- "NEED_PASSPHRASE_TO_DECRYPT_KEY")
- ("Enter pass phrase: " .
- "ENTER_PASSPHRASE")
- ("Pass phrase is good." .
- "GOOD_PASSPHRASE")
- ("Cannot decrypt message. It can only be decrypted by:" .
- "CANNOT_DECRYPT")
- ("Good signature made .* by key:" .
- "GOOD_SIGNATURE")
- ("BAD signature made .* by key:" .
- "BAD_SIGNATURE")
- ("Error .* checking signature: " .
- "ERROR_SIGNATURE")
- ("Signature by unknown keyid: " .
- "UNKNOWN_SIGNATURE")))
-
-(defun epg-pgp50i--start (context program args)
- (let ((args (append '("--headers" "--language=us")
- (if (epg-context-armor context) '("--armor"))
- (if (epg-context-textmode context) '("--textmode"))
- (if (epg-context-output-file context)
- (list "-o" (epg-context-output-file context)))
- args))
- (coding-system-for-write '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"
- program
- (mapconcat #'identity args " ")))))
- (with-current-buffer buffer
- (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 program args)))
- (set-default-file-modes orig-mode))
- (set-process-filter process #'epg-pgp50i--process-filter)
- (set-process-sentinel process #'ignore)
- (epg-context-set-process context process)))
-
-(defun epg-pgp50i--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)
- (while (not (eobp))
- (if (looking-at
- "^\\(PRI\\|INF\\|QRY\\|STA\\|WRN\\|ERR\\): \\(.*\\)")
- (let ((message (match-string 2))
- (pointer epg-pgp50i-message-alist)
- status symbol)
- (while pointer
- (if (string-match (car (car pointer)) message)
- (setq status (cdr (car pointer))
- pointer nil))
- (setq pointer (cdr pointer)))
- (when status
- (unless (looking-at ".*\n")
- (end-of-line)
- (insert "\n"))
- (if (member status epg-pending-status-list)
- (setq epg-pending-status-list nil))
- (setq symbol (intern-soft (concat
- "epg-pgp50i--status-"
- status)))
- (if (and symbol
- (fboundp symbol))
- (funcall symbol epg-context message)))))
- (forward-line)
- (setq epg-read-point (point))))
- (setq epg-process-filter-running nil))))))
-
-(defun epg-pgp50i--read-line (context)
- (if (eq (process-status (epg-context-process context)) 'run)
- (save-excursion
- (set-buffer (process-buffer (epg-context-process context)))
- (forward-line)
- (goto-char epg-read-point)
- (if (looking-at ".*\n")
- (buffer-substring (point) (progn (end-of-line) (point)))))))
-
-(defun epg-pgp50i--status-ENTER_PASSPHRASE (context message)
- (epg--status-GET_HIDDEN context "passphrase."))
-
-(defun epg-pgp50i--read-key (context)
- (let ((line (epg-pgp50i--read-line context))
- key-id user-id-list)
- (when (and line
- (string-match "[ 0-9]+ bits, Key ID \\([0-9A-F]+\\)" line))
- (setq key-id (match-string 1 line))
- (while (and (setq line (epg-pgp50i--read-line context))
- (string-match "\"\\([^\"]+\\)\"" line))
- (setq user-id-list (cons (match-string 1 line) user-id-list)))
- (cons key-id user-id-list))))
-
-(defun epg-pgp50i--status-NEED_PASSPHRASE_TO_DECRYPT_KEY (context message)
- (let* ((key (epg-pgp50i--read-key context))
- (entry (assoc (car key) epg-user-id-alist)))
- (if entry
- (setcdr entry (car (cdr key)))
- (setq epg-user-id-alist (cons (cons (car key) (car (cdr key)))
- epg-user-id-alist)))
- (setq epg-key-id (car key))))
-
-(defun epg-pgp50i--status-CANNOT_DECRYPT (context message)
- (epg-context-set-result-for
- context 'error
- (cons (cons 'decryption-failed
- (epg-pgp50i--read-key context))
- (epg-context-result-for context 'error))))
-
-(defun epg-pgp50i--parse-time (string)
- (if (string-match "\\`\\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\) \
-\\([0-9][0-9]\\):\\([0-9][0-9]\\) GMT\\'" string)
- (encode-time 0
- (string-to-number (match-string 5 string))
- (string-to-number (match-string 4 string))
- (string-to-number (match-string 3 string))
- (string-to-number (match-string 2 string))
- (string-to-number (match-string 1 string))
- 0)))
-
-(defun epg-pgp50i--status-GOOD_SIGNATURE (context message)
- (if (string-match "Good signature made \\(.*\\) by key:" message)
- (let ((time (epg-pgp50i--parse-time (match-string 1 message)))
- (key (epg-pgp50i--read-key context)))
- (epg--status-*SIG context 'good (concat (car key) " " (car (cdr key))))
- (epg-signature-set-creation-time
- (car (epg-context-result-for context 'verify))
- time))))
-
-(defun epg-pgp50i--status-BAD_SIGNATURE (context message)
- (if (string-match "BAD signature made \\(.*\\) by key:" message)
- (let ((time (epg-pgp50i--parse-time (match-string 1 message)))
- (key (epg-pgp50i--read-key context)))
- (epg--status-*SIG context 'good (concat (car key) " " (car (cdr key))))
- (epg-signature-set-creation-time
- (car (epg-context-result-for context 'verify))
- time))))
-
-(defadvice epg-start-decrypt
- (around epg-pgp50i activate)
- (if (eq (epg-context-protocol (ad-get-arg 0)) 'CMS)
- ad-do-it
- (let ((context (ad-get-arg 0))
- (cipher (ad-get-arg 1)))
- (unless (epg-data-file cipher)
- (error "Not a file"))
- (epg-context-set-operation context 'decrypt)
- (epg-context-set-result context nil)
- (epg-pgp50i--start context epg-pgp50i-pgpv-program
- (list "--batchmode=0" "--force"
- (epg-data-file cipher))))))
-
-(defadvice epg-start-verify
- (around epg-pgp50i activate)
- (if (eq (epg-context-protocol (ad-get-arg 0)) 'CMS)
- ad-do-it
- (let ((context (ad-get-arg 0))
- (signature (ad-get-arg 1))
- (signed-text (ad-get-arg 2)))
- (epg-context-set-operation context 'verify)
- (epg-context-set-result context nil)
- (if signed-text
- ;; Detached signature.
- (if (epg-data-file signed-text)
- (epg-pgp50i--start context
- epg-pgp50i-pgpv-program
- (list "--batchmode=1" "--force"
- (epg-data-file signature)
- (epg-data-file signed-text)))
- (epg-pgp50i--start context
- epg-pgp50i-pgpv-program
- (list "--batchmode=1" "--force"
- (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-pgp50i--start context
- epg-pgp50i-pgpv-program
- (list "--batchmode=1" "--force"
- (epg-data-file signature)))
- (epg-pgp50i--start context
- epg-pgp50i-pgpv-program
- (list "--batchmode=1" "--force"))
- (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))))))))
-
-(defadvice epg-start-sign
- (around epg-pgp50i activate)
- (if (eq (epg-context-protocol (ad-get-arg 0)) 'CMS)
- ad-do-it
- (error "Not implemented yet")))
-
-(defadvice epg-start-encrypt
- (around epg-pgp50i activate)
- (if (eq (epg-context-protocol (ad-get-arg 0)) 'CMS)
- ad-do-it
- (error "Not implemented yet")))
-
-(provide 'epg-pgp50i)
-
-;;; epg-pgp50i.el ends here
\ No newline at end of file
OSDN Git Service
