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-command-enter-encrypted-message ()
  38   "Encrypt the current line send send it to the current channel."
  39   (interactive)
  40   (let ((context (epg-make-context))
  41         (string (buffer-substring
  42                  (riece-line-beginning-position)
  43                  (riece-line-end-position)))
  44         entry)
  45     (riece-with-server-buffer (riece-identity-server riece-current-channel)
  46       (setq string (riece-encode-coding-string-for-identity
  47                     string
  48                     riece-current-channel)))
  49     (epg-context-set-passphrase-callback
  50      context
  51      (cons #'riece-epg-passphrase-callback-function
  52            riece-current-channel))
  53     (condition-case error
  54         (setq string (epg-encrypt-string context string nil))
  55       (error
  56        (if (setq entry (riece-identity-assoc riece-current-channel
  57                                              riece-epg-passphrase-alist))
  58            (setcdr entry nil))
  59        (signal (car error) (cdr error))))
  60     (riece-command-send-message
  61      (concat "[OpenPGP Encrypted:" (base64-encode-string string t) "]")
  62      nil)
  63     (let ((next-line-add-newlines t))
  64       (next-line 1))))
  65
  66 (defun riece-epg-message-filter (message)
  67   (if (get 'riece-epg 'riece-addon-enabled)
  68       (when (string-match "\\`\\[OpenPGP Encrypted:\\(.*\\)]"
  69                           (riece-message-text message))
  70         (let ((context (epg-make-context))
  71               (string (match-string 1 (riece-message-text message)))
  72               (coding-system (or (riece-coding-system-for-identity
  73                                   (riece-message-target message))
  74                                  riece-default-coding-system))
  75               entry)
  76           (epg-context-set-passphrase-callback
  77            context
  78            (cons #'riece-epg-passphrase-callback-function
  79                  (riece-message-target message)))
  80           (condition-case error
  81               (riece-message-set-text
  82                message
  83                (concat
  84                 "[OpenPGP Decrypted:"
  85                 (decode-coding-string
  86                  (epg-decrypt-string context (base64-decode-string string))
  87                  (if (consp coding-system)
  88                      (car coding-system)
  89                    coding-system))
  90                 "]"))
  91             (error
  92              (if (setq entry (riece-identity-assoc
  93                               (riece-message-target message)
  94                               riece-epg-passphrase-alist))
  95                  (setcdr entry nil))
  96              (message "%s" (cdr error)))))))
  97   message)
  98
  99 (defun riece-epg-insinuate ()
 100   (add-hook 'riece-message-filter-functions 'riece-epg-message-filter))
 101
 102 (defun riece-epg-uninstall ()
 103   (remove-hook 'riece-message-filter-functions 'riece-epg-message-filter))
 104
 105 (defvar riece-command-mode-map)
 106 (defun riece-epg-enable ()
 107   (define-key riece-command-mode-map
 108     "\C-ce" 'riece-command-enter-encrypted-message))
 109
 110 (defun riece-epg-disable ()
 111   (define-key riece-command-mode-map
 112     "\C-ce" nil))
 113
 114 (provide 'riece-epg)
 115
 116 ;;; riece-epg.el ends here