X-Git-Url: http://cgit.sxemacs.org/?p=riece;a=blobdiff_plain;f=lisp%2Friece-epg.el;h=355b9c93b9e81429f5da5c4eece09a53c02d5194;hp=4a93efb0a667c9a6640d757db77f91b457ed7f99;hb=a593e07b578e462d617b096261a5d964b466ac10;hpb=c46700f644df580897478b53e20a449f9670fc59

diff --git a/lisp/riece-epg.el b/lisp/riece-epg.el
index 4a93efb..355b9c9 100644
--- a/lisp/riece-epg.el
+++ b/lisp/riece-epg.el
@@ -1,5 +1,30 @@
+;;; riece-epg.el --- Encrypt/decrypt messages add-on
+;; Copyright (C) 2006 Daiki Ueno
+
+;; Author: Daiki Ueno <ueno@unixuser.org>
+;; Keywords: IRC, riece
+
+;; This file is part of Riece.
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.	 See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+
+;;; Code:
+
 (require 'riece-message)
-(require 'riece-coding)
+(require 'riece-identity)
 
 (autoload 'epg-make-context "epg")
 (autoload 'epg-decrypt-string "epg")
@@ -19,9 +44,9 @@
 
 (defvar riece-epg-passphrase-alist nil)
 
-(defun riece-epg-passphrase-callback-function (key-id identity)
+(defun riece-epg-passphrase-callback-function (context key-id identity)
   (if (eq key-id 'SYM)
-      (let ((entry (assoc identity riece-epg-passphrase-alist))
+      (let ((entry (riece-identity-assoc identity riece-epg-passphrase-alist))
 	    passphrase)
 	(or (copy-sequence (cdr entry))
 	    (progn
@@ -29,75 +54,185 @@
 		(setq entry (list identity)
 		      riece-epg-passphrase-alist (cons entry
 						 riece-epg-passphrase-alist)))
-	      (setq passphrase (epg-passphrase-callback-function key-id nil))
+	      (setq passphrase (epg-passphrase-callback-function context
+								 key-id nil))
 	      (setcdr entry (copy-sequence passphrase))
 	      passphrase)))
-    (epg-passphrase-callback-function key-id nil)))
+    (epg-passphrase-callback-function context key-id nil)))
 
+(defun riece-epg-passphrase-callback-function-for-decrypt (context key-id
+								   identity)
+  (if (eq key-id 'SYM)
+      (let ((entry (riece-identity-assoc identity riece-epg-passphrase-alist))
+	    passphrase)
+	(if (cdr entry)
+	    (copy-sequence (cdr entry))
+	  (epg-cancel context)))
+    (epg-passphrase-callback-function context key-id nil)))
+
+(defun riece-epg-funcall-clear-passphrase (identity function &rest args)
+  (condition-case error
+      (apply function args)
+    (error
+     (let ((entry (riece-identity-assoc identity riece-epg-passphrase-alist)))
+       (if entry
+	   (setq riece-epg-passphrase-alist
+		 (delq entry riece-epg-passphrase-alist))))
+     (signal (car error) (cdr error)))))
+  
 (defun riece-command-enter-encrypted-message ()
-  "Encrypt the current line send send it to the current channel."
+  "Encrypt the current line and 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))))
+	(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)
+    (riece-send-string
+     (format "PRIVMSG %s :[encrypted:%s]\r\n"
+	     (riece-identity-prefix riece-current-channel)
+	     (base64-encode-string
+	      (riece-epg-funcall-clear-passphrase
+	       riece-current-channel
+	       #'epg-encrypt-string
+	       context
+	       (riece-with-server-buffer
+		   (riece-identity-server riece-current-channel)
+		 (riece-encode-coding-string-for-identity
+		  string
+		  riece-current-channel))
+	       nil)
+	      t)))
+    (riece-display-message
+     (riece-make-message (riece-current-nickname) riece-current-channel
+			 (concat "[decrypted:" string "]") nil t))
     (let ((next-line-add-newlines t))
       (next-line 1))))
 
+(defun riece-command-set-passphrase (identity passphrase)
+  "Set PASSPHRASE associated with IDENTITY."
+  (interactive
+   (let ((identity
+	  (riece-completing-read-identity
+	   "Channel/user: "
+	   riece-current-channels nil t nil nil
+	   (riece-format-identity riece-current-channel))))
+     (list identity
+	   (read-passwd (format "Passphrase for %s: "
+				(riece-format-identity identity))))))
+  (let ((entry (riece-identity-assoc identity riece-epg-passphrase-alist)))
+    (if (equal passphrase "")
+	(if entry
+	    (setq riece-epg-passphrase-alist
+		  (delq entry riece-epg-passphrase-alist)))
+      (if entry
+	  (setcdr entry passphrase)
+	(setq riece-epg-passphrase-alist
+	      (cons (cons identity passphrase)
+		    riece-epg-passphrase-alist))))))
+
+(defun riece-epg-decrypt-string-for-identity (context cipher target)
+  (let ((coding-system
+	 (or (riece-coding-system-for-identity target)
+	     riece-default-coding-system)))
+    (riece-with-server-buffer (riece-identity-server target)
+      (decode-coding-string
+       (riece-epg-funcall-clear-passphrase
+	target
+	#'epg-decrypt-string
+	context
+	(base64-decode-string cipher))
+       (if (consp coding-system)
+	   (car coding-system)
+	 coding-system)))))
+
 (defun riece-epg-message-filter (message)
   (if (get 'riece-epg 'riece-addon-enabled)
-      (when (string-match "\\`\\[OpenPGP Encrypted:\\(.*\\)]"
+      (when (string-match "\\`\\[encrypted:\\(.*\\)]"
 			  (riece-message-text message))
 	(let ((context (epg-make-context))
 	      (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)))
+	   (cons #'riece-epg-passphrase-callback-function-for-decrypt
+		 riece-current-channel))
 	  (condition-case error
-	      (setq string (epg-decrypt-string
-			    context
-			    (base64-decode-string string)))
+	      (progn
+		(riece-message-set-text
+		 message
+		 (format "[decrypted:%s]"
+			 (riece-epg-decrypt-string-for-identity
+			  context string (riece-message-target message)))))
 	    (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
-				  (riece-decode-coding-string string)))))
+	     (riece-put-text-property-nonsticky
+	      0 (length (riece-message-text message))
+	      'riece-epg-encryption-target (riece-message-target message)
+	      (riece-message-text message))
+	     (if riece-debug
+		 (message "Couldn't decrypt: %s" (cdr error))
+	       (message "Couldn't decrypt")))))))
   message)
 
+(defun riece-epg-add-encrypted-button (start end)
+  (if (and (get 'riece-button 'riece-addon-enabled)
+	   (get 'riece-epg 'riece-addon-enabled))
+      (riece-scan-property-region
+       'riece-epg-encryption-target
+       start end
+       (lambda (start end)
+	 (let ((inhibit-read-only t)
+	       buffer-read-only)
+	   (widget-convert-button
+	    'link start end
+	    :help-echo "Click to decrypt"
+	    :notify #'riece-epg-encrypted-button-notify
+	    (get-text-property start 'riece-epg-encryption-target)))))))
+
+(defun riece-epg-encrypted-button-notify (widget &rest ignore)
+  (let* ((from (marker-position (widget-get widget :from)))
+	 (to (marker-position (widget-get widget :to)))
+	 (target (widget-get widget :value))
+	 (cipher (buffer-substring from to))
+	 (inhibit-read-only t)
+	 buffer-read-only
+	 plain)
+    (when (string-match "\\`\\[encrypted:\\(.*\\)]" cipher)
+      (setq plain (riece-epg-decrypt-string-for-identity
+		   (epg-make-context) (match-string 1 cipher) target))
+      (widget-delete widget)
+      (delete-region from to)
+      (save-excursion
+	(goto-char from)
+	(insert "[decrypted:" plain "]")))))
+
+(defun riece-epg-requires ()
+  (if (memq 'riece-button riece-addons)
+      '(riece-button)))
+
 (defun riece-epg-insinuate ()
-  (add-hook 'riece-message-filter-functions 'riece-epg-message-filter))
+  (add-hook 'riece-message-filter-functions 'riece-epg-message-filter)
+  (add-hook 'riece-after-insert-functions 'riece-epg-add-encrypted-button))
 
 (defun riece-epg-uninstall ()
-  (remove-hook 'riece-message-filter-functions 'riece-epg-message-filter))
+  (remove-hook 'riece-message-filter-functions 'riece-epg-message-filter)
+  (remove-hook 'riece-after-insert-functions 'riece-epg-add-encrypted-button))
 
 (defvar riece-command-mode-map)
 (defun riece-epg-enable ()
   (define-key riece-command-mode-map
-    "\C-ce" 'riece-command-enter-encrypted-message))
+    "\C-ce" 'riece-command-enter-encrypted-message)
+  (define-key riece-command-mode-map
+    "\C-c\C-ec" 'riece-command-set-passphrase))
 
 (defun riece-epg-disable ()
   (define-key riece-command-mode-map
-    "\C-ce" nil))
+    "\C-ce" nil)
+  (define-key riece-command-mode-map
+    "\C-c\C-ec" nil))
 
 (provide 'riece-epg)