cgit.sxemacs.org Git - riece/blob - lisp/riece-epg.el

   1 ;;; riece-epg.el --- Encrypt/decrypt messages add-on
   2 ;; Copyright (C) 2006 Daiki Ueno
   3
   4 ;; Author: Daiki Ueno <ueno@unixuser.org>
   5 ;; Keywords: IRC, riece
   6
   7 ;; This file is part of Riece.
   8
   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)
  12 ;; any later version.
  13
  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.
  18
  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.
  23
  24 ;;; Code:
  25
  26 (require 'riece-message)
  27 (require 'riece-identity)
  28
  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")
  34
  35 (eval-when-compile
  36   (autoload 'riece-command-send-message "riece-commands"))
  37
  38 (defgroup riece-epg nil
  39   "Encrypt/decrypt messages."
  40   :group 'riece)
  41
  42 (defconst riece-epg-description
  43   "Encrypt/decrypt messages.")
  44
  45 (defvar riece-epg-passphrase-alist nil)
  46
  47 (defun riece-epg-passphrase-callback-function (key-id identity)
  48   (if (eq key-id 'SYM)
  49       (let ((entry (riece-identity-assoc identity riece-epg-passphrase-alist))
  50             passphrase)
  51         (or (copy-sequence (cdr entry))
  52             (progn
  53               (unless 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))
  59               passphrase)))
  60     (epg-passphrase-callback-function key-id nil)))
  61
  62 (defun riece-epg-funcall-clear-passphrase (identity function &rest args)
  63   (condition-case error
  64       (apply function args)
  65     (error
  66      (let ((entry (riece-identity-assoc identity riece-epg-passphrase-alist)))
  67        (if entry
  68            (setq riece-epg-passphrase-alist
  69                  (delq entry riece-epg-passphrase-alist))))
  70      (signal (car error) (cdr error)))))
  71
  72 (defun riece-command-enter-encrypted-message ()
  73   "Encrypt the current line send send it to the current channel."
  74   (interactive)
  75   (let ((context (epg-make-context))
  76         (string (buffer-substring
  77                  (riece-line-beginning-position)
  78                  (riece-line-end-position)))
  79         entry)
  80     (riece-with-server-buffer (riece-identity-server riece-current-channel)
  81       (setq string (riece-encode-coding-string-for-identity
  82                     string
  83                     riece-current-channel)))
  84     (epg-context-set-passphrase-callback
  85      context
  86      (cons #'riece-epg-passphrase-callback-function
  87            riece-current-channel))
  88     (setq string (riece-epg-funcall-clear-passphrase riece-current-channel
  89                                                      #'epg-encrypt-string
  90                                                      context string nil))
  91     (riece-command-send-message
  92      (concat "[encrypted:" (base64-encode-string string t) "]")
  93      nil)
  94     (let ((next-line-add-newlines t))
  95       (next-line 1))))
  96
  97 (defun riece-command-change-passphrase (identity passphrase)
  98   "Change PASSPHRASE associated with IDENTITY."
  99   (interactive
 100    (let ((identity
 101           (riece-completing-read-identity
 102            "Channel/user: "
 103            riece-current-channels nil t nil nil
 104            (riece-format-identity riece-current-channel))))
 105      (list identity
 106            (read-passwd (format "Passphrase for %s"
 107                                 (riece-format-identity identity))))))
 108   (let ((entry (riece-identity-assoc identity riece-epg-passphrase-alist)))
 109     (if (equal passphrase "")
 110         (if entry
 111             (setq riece-epg-passphrase-alist
 112                   (delq entry riece-epg-passphrase-alist)))
 113       (if entry
 114           (setcdr entry passphrase)
 115         (setq riece-epg-passphrase-alist
 116               (cons (cons identity passphrase)
 117                     riece-epg-passphrase-alist))))))
 118
 119 (defun riece-epg-message-filter (message)
 120   (if (get 'riece-epg 'riece-addon-enabled)
 121       (when (string-match "\\`\\[encrypted:\\(.*\\)]"
 122                           (riece-message-text message))
 123         (let ((context (epg-make-context))
 124               (string (match-string 1 (riece-message-text message)))
 125               (coding-system (or (riece-coding-system-for-identity
 126                                   (riece-message-target message))
 127                                  riece-default-coding-system))
 128               entry)
 129           (epg-context-set-passphrase-callback
 130            context
 131            (cons #'riece-epg-passphrase-callback-function
 132                  (riece-message-target message)))
 133           (condition-case error
 134               (progn
 135                 (setq string (base64-decode-string string))
 136                 (riece-message-set-text
 137                  message
 138                  (concat
 139                   "[decrypted:"
 140                   (riece-with-server-buffer
 141                       (riece-identity-server (riece-message-target message))
 142                     (decode-coding-string
 143                      (riece-epg-funcall-clear-passphrase
 144                       (riece-message-target message)
 145                       #'epg-decrypt-string context string)
 146                      (if (consp coding-system)
 147                          (car coding-system)
 148                        coding-system)))
 149                   "]")))
 150             (error (message "%s" (cdr error)))))))
 151   message)
 152
 153 (defun riece-epg-insinuate ()
 154   (add-hook 'riece-message-filter-functions 'riece-epg-message-filter))
 155
 156 (defun riece-epg-uninstall ()
 157   (remove-hook 'riece-message-filter-functions 'riece-epg-message-filter))
 158
 159 (defvar riece-command-mode-map)
 160 (defun riece-epg-enable ()
 161   (define-key riece-command-mode-map
 162     "\C-ce" 'riece-command-enter-encrypted-message)
 163   (define-key riece-command-mode-map
 164     "\C-c\C-ec" 'riece-command-change-passphrase))
 165
 166 (defun riece-epg-disable ()
 167   (define-key riece-command-mode-map
 168     "\C-ce" nil)
 169   (define-key riece-command-mode-map
 170     "\C-c\C-ec" nil))
 171
 172 (provide 'riece-epg)
 173
 174 ;;; riece-epg.el ends here