e2a5af9b7ca4d26cdb9ab1f38de26e918ae92994
[riece] / 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               (setq string (epg-decrypt-string context
82                                                (base64-decode-string string)))
83             (error
84              (if (setq entry (riece-identity-assoc
85                               (riece-message-target message)
86                               riece-epg-passphrase-alist))
87                  (setcdr entry nil))
88              (message "%s" (cdr error))))
89           (riece-message-set-text
90            message
91            (decode-coding-string string
92                                  (if (consp coding-system)
93                                      (car coding-system)
94                                    coding-system))))))
95   message)
96
97 (defun riece-epg-insinuate ()
98   (add-hook 'riece-message-filter-functions 'riece-epg-message-filter))
99
100 (defun riece-epg-uninstall ()
101   (remove-hook 'riece-message-filter-functions 'riece-epg-message-filter))
102
103 (defvar riece-command-mode-map)
104 (defun riece-epg-enable ()
105   (define-key riece-command-mode-map
106     "\C-ce" 'riece-command-enter-encrypted-message))
107
108 (defun riece-epg-disable ()
109   (define-key riece-command-mode-map
110     "\C-ce" nil))
111
112 (provide 'riece-epg)
113
114 ;;; riece-epg.el ends here