1 ;;; riece-epg.el --- Encrypt/decrypt messages add-on
2 ;; Copyright (C) 2006 Daiki Ueno
4 ;; Author: Daiki Ueno <ueno@unixuser.org>
5 ;; Keywords: IRC, riece
7 ;; This file is part of Riece.
9 ;; This program is free software; you can redistribute it and/or modify
10 ;; it under the terms of the GNU General Public License as published by
11 ;; the Free Software Foundation; either version 2, or (at your option)
14 ;; This program is distributed in the hope that it will be useful,
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 ;; GNU General Public License for more details.
19 ;; You should have received a copy of the GNU General Public License
20 ;; along with GNU Emacs; see the file COPYING. If not, write to the
21 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
22 ;; Boston, MA 02110-1301, USA.
26 (require 'riece-message)
27 (require 'riece-identity)
29 (autoload 'epg-make-context "epg")
30 (autoload 'epg-decrypt-string "epg")
31 (autoload 'epg-encrypt-string "epg")
32 (autoload 'epg-passphrase-callback-function "epg")
33 (autoload 'epg-context-set-passphrase-callback "epg")
36 (autoload 'riece-command-send-message "riece-commands"))
38 (defgroup riece-epg nil
39 "Encrypt/decrypt messages."
42 (defconst riece-epg-description
43 "Encrypt/decrypt messages.")
45 (defvar riece-epg-passphrase-alist nil)
47 (defun riece-epg-passphrase-callback-function (key-id identity)
49 (let ((entry (riece-identity-assoc identity riece-epg-passphrase-alist))
51 (or (copy-sequence (cdr entry))
54 (setq entry (list identity)
55 riece-epg-passphrase-alist (cons entry
56 riece-epg-passphrase-alist)))
57 (setq passphrase (epg-passphrase-callback-function key-id nil))
58 (setcdr entry (copy-sequence passphrase))
60 (epg-passphrase-callback-function key-id nil)))
62 (defun riece-epg-passphrase-callback-function-for-decrypt (key-id identity)
64 (let ((entry (riece-identity-assoc identity riece-epg-passphrase-alist))
67 (copy-sequence (cdr entry))
68 (epg-cancel epg-context)))
69 (epg-passphrase-callback-function key-id nil)))
71 (defun riece-epg-funcall-clear-passphrase (identity function &rest args)
75 (let ((entry (riece-identity-assoc identity riece-epg-passphrase-alist)))
77 (setq riece-epg-passphrase-alist
78 (delq entry riece-epg-passphrase-alist))))
79 (signal (car error) (cdr error)))))
81 (defun riece-command-enter-encrypted-message ()
82 "Encrypt the current line send send it to the current channel."
84 (let ((context (epg-make-context))
85 (string (buffer-substring
86 (riece-line-beginning-position)
87 (riece-line-end-position)))
89 (riece-with-server-buffer (riece-identity-server riece-current-channel)
90 (setq string (riece-encode-coding-string-for-identity
92 riece-current-channel)))
93 (epg-context-set-passphrase-callback
95 (cons #'riece-epg-passphrase-callback-function
96 riece-current-channel))
97 (setq string (riece-epg-funcall-clear-passphrase riece-current-channel
100 (riece-command-send-message
101 (concat "[encrypted:" (base64-encode-string string t) "]")
103 (let ((next-line-add-newlines t))
106 (defun riece-command-set-passphrase (identity passphrase)
107 "Set PASSPHRASE associated with IDENTITY."
110 (riece-completing-read-identity
112 riece-current-channels nil t nil nil
113 (riece-format-identity riece-current-channel))))
115 (read-passwd (format "Passphrase for %s: "
116 (riece-format-identity identity))))))
117 (let ((entry (riece-identity-assoc identity riece-epg-passphrase-alist)))
118 (if (equal passphrase "")
120 (setq riece-epg-passphrase-alist
121 (delq entry riece-epg-passphrase-alist)))
123 (setcdr entry passphrase)
124 (setq riece-epg-passphrase-alist
125 (cons (cons identity passphrase)
126 riece-epg-passphrase-alist))))))
128 (defun riece-epg-decrypt-string-for-identity (context cipher target)
130 (or (riece-coding-system-for-identity target)
131 riece-default-coding-system)))
132 (riece-with-server-buffer (riece-identity-server target)
133 (decode-coding-string
134 (riece-epg-funcall-clear-passphrase
138 (base64-decode-string cipher))
139 (if (consp coding-system)
143 (defun riece-epg-message-filter (message)
144 (if (get 'riece-epg 'riece-addon-enabled)
145 (when (string-match "\\`\\[encrypted:\\(.*\\)]"
146 (riece-message-text message))
147 (let ((context (epg-make-context))
148 (string (match-string 1 (riece-message-text message)))
150 (epg-context-set-passphrase-callback
152 (cons #'riece-epg-passphrase-callback-function-for-decrypt
153 riece-current-channel))
154 (condition-case error
156 (riece-message-set-text
160 (riece-epg-decrypt-string-for-identity
161 context string (riece-message-target message))
164 (riece-put-text-property-nonsticky
165 0 (length (riece-message-text message))
166 'riece-epg-encryption-target (riece-message-target message)
167 (riece-message-text message))
168 (message "%s" (cdr error)))))))
171 (defun riece-epg-add-encrypted-button (start end)
172 (if (and (get 'riece-button 'riece-addon-enabled)
173 (get 'riece-epg 'riece-addon-enabled))
174 (riece-scan-property-region
175 'riece-epg-encryption-target
178 (let ((inhibit-read-only t)
180 (widget-convert-button
182 :help-echo "Click to decrypt"
183 :notify #'riece-epg-encrypted-button-notify
184 (get-text-property start 'riece-epg-encryption-target)))))))
186 (defun riece-epg-encrypted-button-notify (widget &rest ignore)
187 (let* ((from (marker-position (widget-get widget :from)))
188 (to (marker-position (widget-get widget :to)))
189 (target (widget-get widget :value))
190 (cipher (buffer-substring from to))
191 (inhibit-read-only t)
194 (when (string-match "\\`\\[encrypted:\\(.*\\)]" cipher)
195 (setq plain (riece-epg-decrypt-string-for-identity
196 (epg-make-context) (match-string 1 cipher) target))
197 (widget-delete widget)
198 (delete-region from to)
201 (insert "[decrypted:" plain "]")))))
203 (defun riece-epg-requires ()
204 (if (memq 'riece-button riece-addons)
207 (defun riece-epg-insinuate ()
208 (add-hook 'riece-message-filter-functions 'riece-epg-message-filter)
209 (add-hook 'riece-after-insert-functions 'riece-epg-add-encrypted-button))
211 (defun riece-epg-uninstall ()
212 (remove-hook 'riece-message-filter-functions 'riece-epg-message-filter)
213 (remove-hook 'riece-after-insert-functions 'riece-epg-add-encrypted-button))
215 (defvar riece-command-mode-map)
216 (defun riece-epg-enable ()
217 (define-key riece-command-mode-map
218 "\C-ce" 'riece-command-enter-encrypted-message)
219 (define-key riece-command-mode-map
220 "\C-c\C-ec" 'riece-command-set-passphrase))
222 (defun riece-epg-disable ()
223 (define-key riece-command-mode-map
225 (define-key riece-command-mode-map
230 ;;; riece-epg.el ends here