Mercurial > emacs

comparison lisp/pgg.el @ 86496:e793ef63bdb9

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(pgg-clear-string): Declare as a function. (pgg-run-at-time-1): Wrap whole definition in (featurep 'xemacs) test. (pgg-run-at-time, pgg-cancel-timer): Move definitions before use.
author Glenn Morris <rgm@gnu.org>
date Tue, 27 Nov 2007 04:20:20 +0000
parents b98604865ea0
children bc4976b7380e
comparison
equal deleted inserted replaced
86495:65af9ed993be 86496:e793ef63bdb9
38 (require 'cl)) 38 (require 'cl))
39 39
40 ;;; @ utility functions 40 ;;; @ utility functions
41 ;;; 41 ;;;
42 42
43 (defun pgg-invoke (func scheme &rest args)
44 (progn
45 (require (intern (format "pgg-%s" scheme)))
46 (apply 'funcall (intern (format "pgg-%s-%s" scheme func)) args)))
47
48 (put 'pgg-save-coding-system 'lisp-indent-function 2)
49
50 (defmacro pgg-save-coding-system (start end &rest body)
51 `(if (interactive-p)
52 (let ((buffer (current-buffer)))
53 (with-temp-buffer
54 (let (buffer-undo-list)
55 (insert-buffer-substring buffer ,start ,end)
56 (encode-coding-region (point-min)(point-max)
57 buffer-file-coding-system)
58 (prog1 (save-excursion ,@body)
59 (push nil buffer-undo-list)
60 (ignore-errors (undo))))))
61 (save-restriction
62 (narrow-to-region ,start ,end)
63 ,@body)))
64
65 (defun pgg-temp-buffer-show-function (buffer)
66 (let ((window (or (get-buffer-window buffer 'visible)
67 (split-window-vertically))))
68 (set-window-buffer window buffer)
69 (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)
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
79 (pgg-situate-output start end)
80 (pgg-display-error-buffer)))
81
82 (defun pgg-situate-output (start end)
83 "Place en/decryption result in place of current text from START to END."
84 (delete-region start end)
85 (insert-buffer-substring pgg-output-buffer)
86 (decode-coding-region start (point) buffer-file-coding-system))
87
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))
97
98 (defvar pgg-pending-timers (make-vector 7 0)
99 "Hash table for managing scheduled pgg cache management timers.
100
101 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)))
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 (if (fboundp 'clear-string)
152 (defalias 'pgg-clear-string 'clear-string)
153 (defun pgg-clear-string (string)
154 (fillarray string ?_)))
155
156 (defun pgg-remove-passphrase-from-cache (key &optional notruncate)
157 "Omit passphrase associated with KEY in time-limited passphrase cache.
158
159 Truncate the key to 8 trailing characters unless NOTRUNCATE is true
160 \(default false).
161
162 This is a no-op if there is not entry for KEY (eg, it's already expired.
163
164 The memory for the passphrase is filled with underscores to clear any
165 references to it.
166
167 Custom variables `pgg-cache-passphrase' and `pgg-passphrase-cache-expiry'
168 regulate cache behavior."
169 (let* ((passphrase (pgg-read-passphrase-from-cache key notruncate))
170 (key (if notruncate key (pgg-truncate-key-identifier key)))
171 (interned-timer-key (intern-soft key pgg-pending-timers))
172 (old-timer (symbol-value interned-timer-key)))
173 (when passphrase
174 (pgg-clear-string passphrase)
175 (unintern key pgg-passphrase-cache))
176 (when old-timer
177 (pgg-cancel-timer old-timer)
178 (unintern interned-timer-key pgg-pending-timers))))
179
180 (eval-when-compile 43 (eval-when-compile
181 (defmacro pgg-run-at-time-1 (time repeat function args) 44 (unless (featurep 'xemacs)
182 (when (featurep 'xemacs) 45 (defalias 'pgg-run-at-time 'run-at-time)
46 (defalias 'pgg-cancel-timer 'cancel-timer))
47
48 (when (featurep 'xemacs)
49 (defmacro pgg-run-at-time-1 (time repeat function args)
183 (if (condition-case nil 50 (if (condition-case nil
184 (let ((delete-itimer 'delete-itimer) 51 (let ((delete-itimer 'delete-itimer)
185 (itimer-driver-start 'itimer-driver-start) 52 (itimer-driver-start 'itimer-driver-start)
186 (itimer-value 'itimer-value) 53 (itimer-value 'itimer-value)
187 (start-itimer 'start-itimer)) 54 (start-itimer 'start-itimer))
235 (apply function args))) 102 (apply function args)))
236 (set-itimer-function-arguments 103 (set-itimer-function-arguments
237 itimer 104 itimer
238 (append (list itimer function) args))))) 105 (append (list itimer function) args)))))
239 1e-9 (if time (max time 1e-9) 1e-9) 106 1e-9 (if time (max time 1e-9) 1e-9)
240 nil t itimers ,repeat ,function ,args)))))) 107 nil t itimers ,repeat ,function ,args))))
241 108
242 (eval-and-compile 109 (defun pgg-run-at-time (time repeat function &rest args)
243 (if (featurep 'xemacs) 110 "Emulating function run as `run-at-time'.
244 (progn
245 (defun pgg-run-at-time (time repeat function &rest args)
246 "Emulating function run as `run-at-time'.
247 TIME should be nil meaning now, or a number of seconds from now. 111 TIME should be nil meaning now, or a number of seconds from now.
248 Return an itimer object which can be used in either `delete-itimer' 112 Return an itimer object which can be used in either `delete-itimer'
249 or `cancel-timer'." 113 or `cancel-timer'."
250 (pgg-run-at-time-1 time repeat function args)) 114 (pgg-run-at-time-1 time repeat function args))
251 (defun pgg-cancel-timer (timer) 115 (defun pgg-cancel-timer (timer)
252 "Emulate cancel-timer for xemacs." 116 "Emulate cancel-timer for xemacs."
253 (let ((delete-itimer 'delete-itimer)) 117 (let ((delete-itimer 'delete-itimer))
254 (funcall delete-itimer timer))) 118 (funcall delete-itimer timer)))
255 ) 119 ))
256 (defalias 'pgg-run-at-time 'run-at-time) 120
257 (defalias 'pgg-cancel-timer 'cancel-timer))) 121 (defun pgg-invoke (func scheme &rest args)
122 (progn
123 (require (intern (format "pgg-%s" scheme)))
124 (apply 'funcall (intern (format "pgg-%s-%s" scheme func)) args)))
125
126 (put 'pgg-save-coding-system 'lisp-indent-function 2)
127
128 (defmacro pgg-save-coding-system (start end &rest body)
129 `(if (interactive-p)
130 (let ((buffer (current-buffer)))
131 (with-temp-buffer
132 (let (buffer-undo-list)
133 (insert-buffer-substring buffer ,start ,end)
134 (encode-coding-region (point-min)(point-max)
135 buffer-file-coding-system)
136 (prog1 (save-excursion ,@body)
137 (push nil buffer-undo-list)
138 (ignore-errors (undo))))))
139 (save-restriction
140 (narrow-to-region ,start ,end)
141 ,@body)))
142
143 (defun pgg-temp-buffer-show-function (buffer)
144 (let ((window (or (get-buffer-window buffer 'visible)
145 (split-window-vertically))))
146 (set-window-buffer window buffer)
147 (shrink-window-if-larger-than-buffer window)))
148
149 ;; XXX `pgg-display-output-buffer' is a horrible name for this function.
150 ;; It should be something like `pgg-situate-output-or-display-error'.
151 (defun pgg-display-output-buffer (start end status)
152 "Situate en/decryption results or pop up an error buffer.
153
154 Text from START to END is replaced by contents of output buffer if STATUS
155 is true, or else the output buffer is displayed."
156 (if status
157 (pgg-situate-output start end)
158 (pgg-display-error-buffer)))
159
160 (defun pgg-situate-output (start end)
161 "Place en/decryption result in place of current text from START to END."
162 (delete-region start end)
163 (insert-buffer-substring pgg-output-buffer)
164 (decode-coding-region start (point) buffer-file-coding-system))
165
166 (defun pgg-display-error-buffer ()
167 "Pop up an error buffer indicating the reason for an en/decryption failure."
168 (let ((temp-buffer-show-function
169 (function pgg-temp-buffer-show-function)))
170 (with-output-to-temp-buffer pgg-echo-buffer
171 (set-buffer standard-output)
172 (insert-buffer-substring pgg-errors-buffer))))
173
174 (defvar pgg-passphrase-cache (make-vector 7 0))
175
176 (defvar pgg-pending-timers (make-vector 7 0)
177 "Hash table for managing scheduled pgg cache management timers.
178
179 We associate key and timer, so the timer can be cancelled if a new
180 timeout for the key is set while an old one is still pending.")
181
182 (defun pgg-read-passphrase (prompt &optional key notruncate)
183 "Using PROMPT, obtain passphrase for KEY from cache or user.
184
185 Truncate the key to 8 trailing characters unless NOTRUNCATE is true
186 \(default false).
187
188 Custom variables `pgg-cache-passphrase' and `pgg-passphrase-cache-expiry'
189 regulate cache behavior."
190 (or (pgg-read-passphrase-from-cache key notruncate)
191 (read-passwd prompt)))
192
193 (defun pgg-read-passphrase-from-cache (key &optional notruncate)
194 "Obtain passphrase for KEY from time-limited passphrase cache.
195
196 Truncate the key to 8 trailing characters unless NOTRUNCATE is true
197 \(default false).
198
199 Custom variables `pgg-cache-passphrase' and `pgg-passphrase-cache-expiry'
200 regulate cache behavior."
201 (and pgg-cache-passphrase
202 key (or notruncate
203 (setq key (pgg-truncate-key-identifier key)))
204 (symbol-value (intern-soft key pgg-passphrase-cache))))
205
206 (defun pgg-add-passphrase-to-cache (key passphrase &optional notruncate)
207 "Associate KEY with PASSPHRASE in time-limited passphrase cache.
208
209 Truncate the key to 8 trailing characters unless NOTRUNCATE is true
210 \(default false).
211
212 Custom variables `pgg-cache-passphrase' and `pgg-passphrase-cache-expiry'
213 regulate cache behavior."
214
215 (let* ((key (if notruncate key (pgg-truncate-key-identifier key)))
216 (interned-timer-key (intern-soft key pgg-pending-timers))
217 (old-timer (symbol-value interned-timer-key))
218 new-timer)
219 (when old-timer
220 (cancel-timer old-timer)
221 (unintern interned-timer-key pgg-pending-timers))
222 (set (intern key pgg-passphrase-cache)
223 passphrase)
224 (set (intern key pgg-pending-timers)
225 (pgg-run-at-time pgg-passphrase-cache-expiry nil
226 #'pgg-remove-passphrase-from-cache
227 key notruncate))))
228
229 (if (fboundp 'clear-string)
230 (defalias 'pgg-clear-string 'clear-string)
231 (defun pgg-clear-string (string)
232 (fillarray string ?_)))
233
234 (declare-function pgg-clear-string "pgg" (string))
235
236 (defun pgg-remove-passphrase-from-cache (key &optional notruncate)
237 "Omit passphrase associated with KEY in time-limited passphrase cache.
238
239 Truncate the key to 8 trailing characters unless NOTRUNCATE is true
240 \(default false).
241
242 This is a no-op if there is not entry for KEY (eg, it's already expired.
243
244 The memory for the passphrase is filled with underscores to clear any
245 references to it.
246
247 Custom variables `pgg-cache-passphrase' and `pgg-passphrase-cache-expiry'
248 regulate cache behavior."
249 (let* ((passphrase (pgg-read-passphrase-from-cache key notruncate))
250 (key (if notruncate key (pgg-truncate-key-identifier key)))
251 (interned-timer-key (intern-soft key pgg-pending-timers))
252 (old-timer (symbol-value interned-timer-key)))
253 (when passphrase
254 (pgg-clear-string passphrase)
255 (unintern key pgg-passphrase-cache))
256 (when old-timer
257 (pgg-cancel-timer old-timer)
258 (unintern interned-timer-key pgg-pending-timers))))
258 259
259 (defmacro pgg-convert-lbt-region (start end lbt) 260 (defmacro pgg-convert-lbt-region (start end lbt)
260 `(let ((pgg-conversion-end (set-marker (make-marker) ,end))) 261 `(let ((pgg-conversion-end (set-marker (make-marker) ,end)))
261 (goto-char ,start) 262 (goto-char ,start)
262 (case ,lbt 263 (case ,lbt