/[emacs]/emacs/lisp/pgg.el
ViewVC logotype

Diff of /emacs/lisp/pgg.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1 by eliz, Mon Oct 24 09:46:27 2005 UTC revision 1.2 by eliz, Sat Oct 29 11:29:41 2005 UTC
# Line 4  Line 4 
4  ;;   2005 Free Software Foundation, Inc.  ;;   2005 Free Software Foundation, Inc.
5    
6  ;; Author: Daiki Ueno <ueno@unixuser.org>  ;; Author: Daiki Ueno <ueno@unixuser.org>
7    ;; Symmetric encryption added by: Sascha Wilde <wilde@sha-bang.de>
8  ;; Created: 1999/10/28  ;; Created: 1999/10/28
9  ;; Keywords: PGP  ;; Keywords: PGP
10    
# Line 67  Line 68 
68      (set-window-buffer window buffer)      (set-window-buffer window buffer)
69      (shrink-window-if-larger-than-buffer window)))      (shrink-window-if-larger-than-buffer window)))
70    
71    ;; XXX `pgg-display-output-buffer' is a horrible name for this function.
72    ;;     It should be something like `pgg-situate-output-or-display-error'.
73  (defun pgg-display-output-buffer (start end status)  (defun pgg-display-output-buffer (start end status)
74      "Situate en/decryption results or pop up an error buffer.
75    
76    Text from START to END is replaced by contents of output buffer if STATUS
77    is true, or else the output buffer is displayed."
78    (if status    (if status
79        (progn        (pgg-situate-output start end)
80          (delete-region start end)      (pgg-display-error-buffer)))
81          (insert-buffer-substring pgg-output-buffer)  
82          (decode-coding-region start (point) buffer-file-coding-system))  (defun pgg-situate-output (start end)
83      (let ((temp-buffer-show-function    "Place en/decryption result in place of current text from START to END."
84             (function pgg-temp-buffer-show-function)))    (delete-region start end)
85        (with-output-to-temp-buffer pgg-echo-buffer    (insert-buffer-substring pgg-output-buffer)
86          (set-buffer standard-output)    (decode-coding-region start (point) buffer-file-coding-system))
87          (insert-buffer-substring pgg-errors-buffer)))))  
88    (defun pgg-display-error-buffer ()
89      "Pop up an error buffer indicating the reason for an en/decryption failure."
90      (let ((temp-buffer-show-function
91             (function pgg-temp-buffer-show-function)))
92        (with-output-to-temp-buffer pgg-echo-buffer
93          (set-buffer standard-output)
94          (insert-buffer-substring pgg-errors-buffer))))
95    
96  (defvar pgg-passphrase-cache (make-vector 7 0))  (defvar pgg-passphrase-cache (make-vector 7 0))
97    
98  (defun pgg-read-passphrase (prompt &optional key)  (defvar pgg-pending-timers (make-vector 7 0)
99    (or (and pgg-cache-passphrase    "Hash table for managing scheduled pgg cache management timers.
100             key (setq key (pgg-truncate-key-identifier key))  
101             (symbol-value (intern-soft key pgg-passphrase-cache)))  We associate key and timer, so the timer can be cancelled if a new
102    timeout for the key is set while an old one is still pending.")
103    
104    (defun pgg-read-passphrase (prompt &optional key notruncate)
105      "Using PROMPT, obtain passphrase for KEY from cache or user.
106    
107    Truncate the key to 8 trailing characters unless NOTRUNCATE is true
108    \(default false).
109    
110    Custom variables `pgg-cache-passphrase' and `pgg-passphrase-cache-expiry'
111    regulate cache behavior."
112      (or (pgg-read-passphrase-from-cache key notruncate)
113        (read-passwd prompt)))        (read-passwd prompt)))
114    
115    (defun pgg-read-passphrase-from-cache (key &optional notruncate)
116      "Obtain passphrase for KEY from time-limited passphrase cache.
117    
118    Truncate the key to 8 trailing characters unless NOTRUNCATE is true
119    \(default false).
120    
121    Custom variables `pgg-cache-passphrase' and `pgg-passphrase-cache-expiry'
122    regulate cache behavior."
123      (and pgg-cache-passphrase
124           key (or notruncate
125                    (setq key (pgg-truncate-key-identifier key)))
126           (symbol-value (intern-soft key pgg-passphrase-cache))))
127    
128    (defun pgg-add-passphrase-to-cache (key passphrase &optional notruncate)
129      "Associate KEY with PASSPHRASE in time-limited passphrase cache.
130    
131    Truncate the key to 8 trailing characters unless NOTRUNCATE is true
132    \(default false).
133    
134    Custom variables `pgg-cache-passphrase' and `pgg-passphrase-cache-expiry'
135    regulate cache behavior."
136    
137      (let* ((key (if notruncate key (pgg-truncate-key-identifier key)))
138             (interned-timer-key (intern-soft key pgg-pending-timers))
139             (old-timer (symbol-value interned-timer-key))
140             new-timer)
141        (when old-timer
142            (cancel-timer old-timer)
143            (unintern interned-timer-key pgg-pending-timers))
144        (set (intern key pgg-passphrase-cache)
145             passphrase)
146        (set (intern key pgg-pending-timers)
147             (pgg-run-at-time pgg-passphrase-cache-expiry nil
148                               #'pgg-remove-passphrase-from-cache
149                               key notruncate))))
150    
151    (defun pgg-remove-passphrase-from-cache (key &optional notruncate)
152      "Omit passphrase associated with KEY in time-limited passphrase cache.
153    
154    Truncate the key to 8 trailing characters unless NOTRUNCATE is true
155    \(default false).
156    
157    This is a no-op if there is not entry for KEY (eg, it's already expired.
158    
159    The memory for the passphrase is filled with underscores to clear any
160    references to it.
161    
162    Custom variables `pgg-cache-passphrase' and `pgg-passphrase-cache-expiry'
163    regulate cache behavior."
164      (let* ((passphrase (pgg-read-passphrase-from-cache key notruncate))
165             (key (if notruncate key (pgg-truncate-key-identifier key)))
166             (interned-timer-key (intern-soft key pgg-pending-timers))
167             (old-timer (symbol-value interned-timer-key)))
168        (when passphrase
169          (fillarray passphrase ?_)
170          (unintern key pgg-passphrase-cache))
171        (when old-timer
172          (pgg-cancel-timer old-timer)
173          (unintern interned-timer-key pgg-pending-timers))))
174    
175  (eval-when-compile  (eval-when-compile
176    (defmacro pgg-run-at-time-1 (time repeat function args)    (defmacro pgg-run-at-time-1 (time repeat function args)
177      (when (featurep 'xemacs)      (when (featurep 'xemacs)
# Line 151  Line 236 
236    
237  (eval-and-compile  (eval-and-compile
238    (if (featurep 'xemacs)    (if (featurep 'xemacs)
239        (defun pgg-run-at-time (time repeat function &rest args)        (progn
240          "Emulating function run as `run-at-time'.          (defun pgg-run-at-time (time repeat function &rest args)
241              "Emulating function run as `run-at-time'.
242  TIME should be nil meaning now, or a number of seconds from now.  TIME should be nil meaning now, or a number of seconds from now.
243  Return an itimer object which can be used in either `delete-itimer'  Return an itimer object which can be used in either `delete-itimer'
244  or `cancel-timer'."  or `cancel-timer'."
245          (pgg-run-at-time-1 time repeat function args))            (pgg-run-at-time-1 time repeat function args))
246      (defalias 'pgg-run-at-time 'run-at-time)))          (defun pgg-cancel-timer (timer)
247              "Emulate cancel-timer for xemacs."
248  (defun pgg-add-passphrase-cache (key passphrase)            (let ((delete-itimer 'delete-itimer))
249    (setq key (pgg-truncate-key-identifier key))              (funcall delete-itimer timer)))
250    (set (intern key pgg-passphrase-cache)          )
251         passphrase)      (defalias 'pgg-run-at-time 'run-at-time)
252    (pgg-run-at-time pgg-passphrase-cache-expiry nil      (defalias 'pgg-cancel-timer 'cancel-timer)))
                    #'pgg-remove-passphrase-cache  
                    key))  
   
 (defun pgg-remove-passphrase-cache (key)  
   (let ((passphrase (symbol-value (intern-soft key pgg-passphrase-cache))))  
     (when passphrase  
       (fillarray passphrase ?_)  
       (unintern key pgg-passphrase-cache))))  
253    
254  (defmacro pgg-convert-lbt-region (start end lbt)  (defmacro pgg-convert-lbt-region (start end lbt)
255    `(let ((pgg-conversion-end (set-marker (make-marker) ,end)))    `(let ((pgg-conversion-end (set-marker (make-marker) ,end)))
# Line 222  or `cancel-timer'." Line 300  or `cancel-timer'."
300  ;;;  ;;;
301    
302  ;;;###autoload  ;;;###autoload
303  (defun pgg-encrypt-region (start end rcpts &optional sign)  (defun pgg-encrypt-region (start end rcpts &optional sign passphrase)
304    "Encrypt the current region between START and END for RCPTS.    "Encrypt the current region between START and END for RCPTS.
305  If optional argument SIGN is non-nil, do a combined sign and encrypt."  
306    If optional argument SIGN is non-nil, do a combined sign and encrypt.
307    
308    If optional PASSPHRASE is not specified, it will be obtained from the
309    passphrase cache or user."
310    (interactive    (interactive
311     (list (region-beginning)(region-end)     (list (region-beginning)(region-end)
312           (split-string (read-string "Recipients: ") "[ \t,]+")))           (split-string (read-string "Recipients: ") "[ \t,]+")))
313    (let ((status    (let ((status
314           (pgg-save-coding-system start end           (pgg-save-coding-system start end
315             (pgg-invoke "encrypt-region" (or pgg-scheme pgg-default-scheme)             (pgg-invoke "encrypt-region" (or pgg-scheme pgg-default-scheme)
316                         (point-min) (point-max) rcpts sign))))                         (point-min) (point-max) rcpts sign passphrase))))
317      (when (interactive-p)      (when (interactive-p)
318        (pgg-display-output-buffer start end status))        (pgg-display-output-buffer start end status))
319      status))      status))
320    
321  ;;;###autoload  ;;;###autoload
322  (defun pgg-encrypt (rcpts &optional sign start end)  (defun pgg-encrypt-symmetric-region (start end &optional passphrase)
323      "Encrypt the current region between START and END symmetric with passphrase.
324    
325    If optional PASSPHRASE is not specified, it will be obtained from the
326    cache or user."
327      (interactive "r")
328      (let ((status
329             (pgg-save-coding-system start end
330               (pgg-invoke "encrypt-symmetric-region"
331                           (or pgg-scheme pgg-default-scheme)
332                           (point-min) (point-max) passphrase))))
333        (when (interactive-p)
334          (pgg-display-output-buffer start end status))
335        status))
336    
337    ;;;###autoload
338    (defun pgg-encrypt-symmetric (&optional start end passphrase)
339      "Encrypt the current buffer using a symmetric, rather than key-pair, cipher.
340    
341    If optional arguments START and END are specified, only encrypt within
342    the region.
343    
344    If optional PASSPHRASE is not specified, it will be obtained from the
345    passphrase cache or user."
346      (interactive)
347      (let* ((start (or start (point-min)))
348             (end (or end (point-max)))
349             (status (pgg-encrypt-symmetric-region start end passphrase)))
350        (when (interactive-p)
351          (pgg-display-output-buffer start end status))
352        status))
353    
354    ;;;###autoload
355    (defun pgg-encrypt (rcpts &optional sign start end passphrase)
356    "Encrypt the current buffer for RCPTS.    "Encrypt the current buffer for RCPTS.
357    
358  If optional argument SIGN is non-nil, do a combined sign and encrypt.  If optional argument SIGN is non-nil, do a combined sign and encrypt.
359    
360  If optional arguments START and END are specified, only encrypt within  If optional arguments START and END are specified, only encrypt within
361  the region."  the region.
362    
363    If optional PASSPHRASE is not specified, it will be obtained from the
364    passphrase cache or user."
365    (interactive (list (split-string (read-string "Recipients: ") "[ \t,]+")))    (interactive (list (split-string (read-string "Recipients: ") "[ \t,]+")))
366    (let* ((start (or start (point-min)))    (let* ((start (or start (point-min)))
367           (end (or end (point-max)))           (end (or end (point-max)))
368           (status (pgg-encrypt-region start end rcpts sign)))           (status (pgg-encrypt-region start end rcpts sign passphrase)))
369      (when (interactive-p)      (when (interactive-p)
370        (pgg-display-output-buffer start end status))        (pgg-display-output-buffer start end status))
371      status))      status))
372    
373  ;;;###autoload  ;;;###autoload
374  (defun pgg-decrypt-region (start end)  (defun pgg-decrypt-region (start end &optional passphrase)
375    "Decrypt the current region between START and END."    "Decrypt the current region between START and END.
376    
377    If optional PASSPHRASE is not specified, it will be obtained from the
378    passphrase cache or user."
379    (interactive "r")    (interactive "r")
380    (let* ((buf (current-buffer))    (let* ((buf (current-buffer))
381           (status           (status
382            (pgg-save-coding-system start end            (pgg-save-coding-system start end
383              (pgg-invoke "decrypt-region" (or pgg-scheme pgg-default-scheme)              (pgg-invoke "decrypt-region" (or pgg-scheme pgg-default-scheme)
384                          (point-min) (point-max)))))                          (point-min) (point-max) passphrase))))
385      (when (interactive-p)      (when (interactive-p)
386        (pgg-display-output-buffer start end status))        (pgg-display-output-buffer start end status))
387      status))      status))
388    
389  ;;;###autoload  ;;;###autoload
390  (defun pgg-decrypt (&optional start end)  (defun pgg-decrypt (&optional start end passphrase)
391    "Decrypt the current buffer.    "Decrypt the current buffer.
392    
393  If optional arguments START and END are specified, only decrypt within  If optional arguments START and END are specified, only decrypt within
394  the region."  the region.
395    
396    If optional PASSPHRASE is not specified, it will be obtained from the
397    passphrase cache or user."
398    (interactive "")    (interactive "")
399    (let* ((start (or start (point-min)))    (let* ((start (or start (point-min)))
400           (end (or end (point-max)))           (end (or end (point-max)))
401           (status (pgg-decrypt-region start end)))           (status (pgg-decrypt-region start end passphrase)))
402      (when (interactive-p)      (when (interactive-p)
403        (pgg-display-output-buffer start end status))        (pgg-display-output-buffer start end status))
404      status))      status))
405    
406  ;;;###autoload  ;;;###autoload
407  (defun pgg-sign-region (start end &optional cleartext)  (defun pgg-sign-region (start end &optional cleartext passphrase)
408    "Make the signature from text between START and END.    "Make the signature from text between START and END.
409    
410  If the optional 3rd argument CLEARTEXT is non-nil, it does not create  If the optional 3rd argument CLEARTEXT is non-nil, it does not create
411  a detached signature.  a detached signature.
412    
413  If this function is called interactively, CLEARTEXT is enabled  If this function is called interactively, CLEARTEXT is enabled
414  and the the output is displayed."  and the the output is displayed.
415    
416    If optional PASSPHRASE is not specified, it will be obtained from the
417    passphrase cache or user."
418    (interactive "r")    (interactive "r")
419    (let ((status (pgg-save-coding-system start end    (let ((status (pgg-save-coding-system start end
420                    (pgg-invoke "sign-region" (or pgg-scheme pgg-default-scheme)                    (pgg-invoke "sign-region" (or pgg-scheme pgg-default-scheme)
421                                (point-min) (point-max)                                (point-min) (point-max)
422                                (or (interactive-p) cleartext)))))                                (or (interactive-p) cleartext)
423                                  passphrase))))
424      (when (interactive-p)      (when (interactive-p)
425        (pgg-display-output-buffer start end status))        (pgg-display-output-buffer start end status))
426      status))      status))
427    
428  ;;;###autoload  ;;;###autoload
429  (defun pgg-sign (&optional cleartext start end)  (defun pgg-sign (&optional cleartext start end passphrase)
430    "Sign the current buffer.    "Sign the current buffer.
431    
432  If the optional argument CLEARTEXT is non-nil, it does not create a  If the optional argument CLEARTEXT is non-nil, it does not create a
433  detached signature.  detached signature.
434    
435  If optional arguments START and END are specified, only sign data  If optional arguments START and END are specified, only sign data
436  within the region.  within the region.
437    
438  If this function is called interactively, CLEARTEXT is enabled  If this function is called interactively, CLEARTEXT is enabled
439  and the the output is displayed."  and the the output is displayed.
440    
441    If optional PASSPHRASE is not specified, it will be obtained from the
442    passphrase cache or user."
443    (interactive "")    (interactive "")
444    (let* ((start (or start (point-min)))    (let* ((start (or start (point-min)))
445           (end (or end (point-max)))           (end (or end (point-max)))
446           (status (pgg-sign-region start end (or (interactive-p) cleartext))))           (status (pgg-sign-region start end
447                                      (or (interactive-p) cleartext)
448                                      passphrase)))
449      (when (interactive-p)      (when (interactive-p)
450        (pgg-display-output-buffer start end status))        (pgg-display-output-buffer start end status))
451      status))      status))
452      
453  ;;;###autoload  ;;;###autoload
454  (defun pgg-verify-region (start end &optional signature fetch)  (defun pgg-verify-region (start end &optional signature fetch)
455    "Verify the current region between START and END.    "Verify the current region between START and END.

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26