From 1b05adabb6572578431ee2b740f08fbb96c323bf Mon Sep 17 00:00:00 2001 From: ueno Date: Tue, 25 Apr 2006 08:13:26 +0000 Subject: [PATCH] * riece-epg.el: New add-on. * riece-addon-modules.el (riece-addon-modules): Added riece-epg. * Makefile.am (EXTRA_DIST): Added riece-epg.el. --- lisp/ChangeLog | 6 +++ lisp/Makefile.am | 2 +- lisp/riece-addon-modules.el | 1 + lisp/riece-epg.el | 103 +++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 111 insertions(+), 1 deletion(-) create mode 100644 lisp/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 + + * 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 * 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 -- 1.7.10.4