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

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