cgit.sxemacs.org Git - riece/blob - lisp/riece-epg.el

   1 (require 'riece-message)
   2 (require 'riece-identity)
   3
   4 (autoload 'epg-make-context "epg")
   5 (autoload 'epg-decrypt-string "epg")
   6 (autoload 'epg-encrypt-string "epg")
   7 (autoload 'epg-passphrase-callback-function "epg")
   8 (autoload 'epg-context-set-passphrase-callback "epg")
   9
  10 (eval-when-compile
  11   (autoload 'riece-command-send-message "riece-commands"))
  12
  13 (defgroup riece-epg nil
  14   "Encrypt/decrypt messages."
  15   :group 'riece)
  16
  17 (defconst riece-epg-description
  18   "Encrypt/decrypt messages.")
  19
  20 (defvar riece-epg-passphrase-alist nil)
  21
  22 (defun riece-epg-passphrase-callback-function (key-id identity)
  23   (if (eq key-id 'SYM)
  24       (let ((entry (riece-identity-assoc identity riece-epg-passphrase-alist))
  25             passphrase)
  26         (or (copy-sequence (cdr entry))
  27             (progn
  28               (unless entry
  29                 (setq entry (list identity)
  30                       riece-epg-passphrase-alist (cons entry
  31                                                  riece-epg-passphrase-alist)))
  32               (setq passphrase (epg-passphrase-callback-function key-id nil))
  33               (setcdr entry (copy-sequence passphrase))
  34               passphrase)))
  35     (epg-passphrase-callback-function key-id nil)))
  36
  37 (defun riece-epg-funcall-clear-passphrase (identity function &rest args)
  38   (condition-case error
  39       (apply function args)
  40     (error
  41      (let ((entry (riece-identity-assoc identity riece-epg-passphrase-alist)))
  42        (if entry
  43            (setq riece-epg-passphrase-alist (delq entry
  44                                                   riece-epg-passphrase-alist)))
  45        (signal (car error) (cdr error))))))
  46
  47 (defun riece-command-enter-encrypted-message ()
  48   "Encrypt the current line send send it to the current channel."
  49   (interactive)
  50   (let ((context (epg-make-context))
  51         (string (buffer-substring
  52                  (riece-line-beginning-position)
  53                  (riece-line-end-position)))
  54         entry)
  55     (riece-with-server-buffer (riece-identity-server riece-current-channel)
  56       (setq string (riece-encode-coding-string-for-identity
  57                     string
  58                     riece-current-channel)))
  59     (epg-context-set-passphrase-callback
  60      context
  61      (cons #'riece-epg-passphrase-callback-function
  62            riece-current-channel))
  63     (setq string (riece-epg-funcall-clear-passphrase riece-current-channel
  64                                                      #'epg-encrypt-string
  65                                                      context string nil))
  66     (riece-command-send-message
  67      (concat "[encrypted:" (base64-encode-string string t) "]")
  68      nil)
  69     (let ((next-line-add-newlines t))
  70       (next-line 1))))
  71
  72 (defun riece-epg-message-filter (message)
  73   (if (get 'riece-epg 'riece-addon-enabled)
  74       (when (string-match "\\`\\[encrypted:\\(.*\\)]"
  75                           (riece-message-text message))
  76         (let ((context (epg-make-context))
  77               (string (match-string 1 (riece-message-text message)))
  78               (coding-system (or (riece-coding-system-for-identity
  79                                   (riece-message-target message))
  80                                  riece-default-coding-system))
  81               entry)
  82           (epg-context-set-passphrase-callback
  83            context
  84            (cons #'riece-epg-passphrase-callback-function
  85                  (riece-message-target message)))
  86           (condition-case error
  87               (progn
  88                 (setq string (base64-decode-string string))
  89                 (riece-message-set-text
  90                  message
  91                  (concat
  92                   "[decrypted:"
  93                   (riece-with-server-buffer
  94                       (riece-identity-server (riece-message-target message))
  95                     (decode-coding-string
  96                      (riece-epg-funcall-clear-passphrase
  97                       (riece-message-target message)
  98                       #'epg-decrypt-string context string)
  99                      (if (consp coding-system)
 100                          (car coding-system)
 101                        coding-system)))
 102                   "]")))
 103             (error (message "%s" (cdr error)))))))
 104   message)
 105
 106 (defun riece-epg-insinuate ()
 107   (add-hook 'riece-message-filter-functions 'riece-epg-message-filter))
 108
 109 (defun riece-epg-uninstall ()
 110   (remove-hook 'riece-message-filter-functions 'riece-epg-message-filter))
 111
 112 (defvar riece-command-mode-map)
 113 (defun riece-epg-enable ()
 114   (define-key riece-command-mode-map
 115     "\C-ce" 'riece-command-enter-encrypted-message))
 116
 117 (defun riece-epg-disable ()
 118   (define-key riece-command-mode-map
 119     "\C-ce" nil))
 120
 121 (provide 'riece-epg)
 122
 123 ;;; riece-epg.el ends here