* riece-epg.el: New add-on.
authorDaiki Ueno <ueno@unixuser.org>
Tue, 25 Apr 2006 08:13:26 +0000 (08:13 +0000)
committerDaiki Ueno <ueno@unixuser.org>
Tue, 25 Apr 2006 08:13:26 +0000 (08:13 +0000)
* riece-addon-modules.el (riece-addon-modules): Added riece-epg.
* Makefile.am (EXTRA_DIST): Added riece-epg.el.

lisp/ChangeLog
lisp/Makefile.am
lisp/riece-addon-modules.el
lisp/riece-epg.el [new file with mode: 0644]

index 4929708..d0b1cbb 100644 (file)
@@ -1,3 +1,9 @@
+2006-04-25  Daiki Ueno  <ueno@unixuser.org>
+
+       * riece-epg.el: New add-on.
+       * riece-addon-modules.el (riece-addon-modules): Added riece-epg.
+       * Makefile.am (EXTRA_DIST): Added riece-epg.el.
+
 2006-04-13  Steve Youngs  <steve@sxemacs.org>
 
        * riece-commands.el (riece-command-invite): Add missing `:' to
index ca46dcf..c393cb3 100644 (file)
@@ -17,7 +17,7 @@ EXTRA_DIST = COMPILE ChangeLog ChangeLog.Liece \
        riece-ctlseq.el riece-ignore.el riece-hangman.el riece-biff.el \
        riece-kakasi.el riece-foolproof.el riece-yank.el riece-toolbar.el \
        riece-eval.el riece-google.el riece-keepalive.el riece-eval-ruby.el \
-       riece-shrink-buffer.el riece-xfaceb.el url-riece.el \
+       riece-shrink-buffer.el riece-xfaceb.el riece-epg.el url-riece.el \
        riece-command-previous-channel.xpm riece-command-next-channel.xpm \
        riece-submit-bug-report.xpm \
        server.rb aproxy.rb
index adb0a18..615b006 100644 (file)
@@ -6,6 +6,7 @@
     (riece-ctcp . "CTCP (Client To Client Protocol) support.")
     (riece-ctlseq . "Mark up control sequences in IRC buffers.")
     (riece-doctor . "Pretend to be a psychotherapist.")
+    (riece-epg . "Encrypt/decrypt messages.")
     (riece-eval-ruby . "Evaluate input string as a Ruby program.")
     (riece-eval . "Evaluate an input string as an elisp form.")
     (riece-foolproof . "Prevent miss-operation in the command buffer.")
diff --git a/lisp/riece-epg.el b/lisp/riece-epg.el
new file mode 100644 (file)
index 0000000..76d7c01
--- /dev/null
@@ -0,0 +1,103 @@
+(require 'riece-message)
+(require 'riece-coding)
+
+(autoload 'epg-make-context "epg")
+(autoload 'epg-decrypt-string "epg")
+(autoload 'epg-encrypt-string "epg")
+(autoload 'epg-passphrase-callback-function "epg")
+(autoload 'epg-context-set-passphrase-callback "epg")
+
+(eval-when-compile
+  (autoload 'riece-command-send-message "riece-commands"))
+
+(defgroup riece-epg nil
+  "Encrypt/decrypt messages."
+  :group 'riece)
+
+(defconst riece-epg-description
+  "Encrypt/decrypt messages.")
+
+(defvar riece-epg-passphrase-alist nil)
+
+(defun riece-epg-passphrase-callback-function (key-id identity)
+  (if (eq key-id 'SYM)
+      (let ((entry (assoc identity riece-epg-passphrase-alist))
+           passphrase)
+       (or (copy-sequence (cdr entry))
+           (progn
+             (unless entry
+               (setq entry (list identity)
+                     riece-epg-passphrase-alist (cons entry
+                                                riece-epg-passphrase-alist)))
+             (setq passphrase (epg-passphrase-callback-function key-id nil))
+             (setcdr entry (copy-sequence passphrase))
+             passphrase)))
+    (epg-passphrase-callback-function key-id nil)))
+
+(defun riece-command-enter-encrypted-message ()
+  "Encrypt the current line send send it to the current channel."
+  (interactive)
+  (let ((context (epg-make-context))
+       (string (riece-encode-coding-string
+                      (buffer-substring
+                       (riece-line-beginning-position)
+                       (riece-line-end-position))))
+       entry)
+    (epg-context-set-passphrase-callback
+     context
+     (cons #'riece-epg-passphrase-callback-function
+          riece-current-channel))
+    (condition-case error
+       (setq string (epg-encrypt-string context string nil))
+      (error
+       (if (setq entry (assoc riece-current-channel
+                             riece-epg-passphrase-alist))
+          (setcdr entry nil))
+       (signal (car error) (cdr error))))
+    (riece-command-send-message
+     (concat "[OpenPGP Encrypted:" (base64-encode-string string t) "]")
+     nil)
+    (let ((next-line-add-newlines t))
+      (next-line 1))))
+
+(defun riece-epg-message-filter (message)
+  (if (get 'riece-epg 'riece-addon-enabled)
+      (when (string-match "\\`\\[OpenPGP Encrypted:\\(.*\\)]"
+                         (riece-message-text message))
+       (let ((context (epg-make-context))
+             (string (riece-decode-coding-string
+                      (base64-decode-string
+                       (match-string 1 (riece-message-text message)))))
+             entry)
+         (epg-context-set-passphrase-callback
+          context
+          (cons #'riece-epg-passphrase-callback-function
+                (riece-message-target message)))
+         (condition-case error
+             (setq string (epg-decrypt-string context string))
+           (error
+            (if (setq entry (assoc (riece-message-target message)
+                                   riece-epg-passphrase-alist))
+                (setcdr entry nil))
+            (message "%s" (cdr error))))
+         (riece-message-set-text message string))))
+  message)
+
+(defun riece-epg-insinuate ()
+  (add-hook 'riece-message-filter-functions 'riece-epg-message-filter))
+
+(defun riece-epg-uninstall ()
+  (remove-hook 'riece-message-filter-functions 'riece-epg-message-filter))
+
+(defvar riece-command-mode-map)
+(defun riece-epg-enable ()
+  (define-key riece-command-mode-map
+    "\C-ce" 'riece-command-enter-encrypted-message))
+
+(defun riece-epg-disable ()
+  (define-key riece-command-mode-map
+    "\C-ce" nil))
+
+(provide 'riece-epg)
+
+;;; riece-epg.el ends here