From: Daiki Ueno <ueno@unixuser.org>
Date: Tue, 25 Apr 2006 08:13:26 +0000 (+0000)
Subject: * riece-epg.el: New add-on.
X-Git-Url: http://cgit.sxemacs.org/?a=commitdiff_plain;h=fc5184092925192b08b74b31beb2a620cdf28c02;p=riece

* riece-epg.el: New add-on.
* riece-addon-modules.el (riece-addon-modules): Added riece-epg.
* Makefile.am (EXTRA_DIST): Added riece-epg.el.
---

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 4929708..d0b1cbb 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -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
diff --git a/lisp/Makefile.am b/lisp/Makefile.am
index ca46dcf..c393cb3 100644
--- a/lisp/Makefile.am
+++ b/lisp/Makefile.am
@@ -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
diff --git a/lisp/riece-addon-modules.el b/lisp/riece-addon-modules.el
index adb0a18..615b006 100644
--- a/lisp/riece-addon-modules.el
+++ b/lisp/riece-addon-modules.el
@@ -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
index 0000000..76d7c01
--- /dev/null
+++ b/lisp/riece-epg.el
@@ -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