| 1 | ;;; pgg.el --- glue for the various PGP implementations. |
| 2 | |
| 3 | ;; Copyright (C) 1999, 2000, 2002, 2003, 2004, |
| 4 | ;; 2005, 2006 Free Software Foundation, Inc. |
| 5 | |
| 6 | ;; Author: Daiki Ueno <ueno@unixuser.org> |
| 7 | ;; Symmetric encryption added by: Sascha Wilde <wilde@sha-bang.de> |
| 8 | ;; Created: 1999/10/28 |
| 9 | ;; Keywords: PGP |
| 10 | |
| 11 | ;; This file is part of GNU Emacs. |
| 12 | |
| 13 | ;; GNU Emacs is free software; you can redistribute it and/or modify |
| 14 | ;; it under the terms of the GNU General Public License as published by |
| 15 | ;; the Free Software Foundation; either version 2, or (at your option) |
| 16 | ;; any later version. |
| 17 | |
| 18 | ;; GNU Emacs is distributed in the hope that it will be useful, |
| 19 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 20 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 21 | ;; GNU General Public License for more details. |
| 22 | |
| 23 | ;; You should have received a copy of the GNU General Public License |
| 24 | ;; along with GNU Emacs; see the file COPYING. If not, write to the |
| 25 | ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
| 26 | ;; Boston, MA 02110-1301, USA. |
| 27 | |
| 28 | ;;; Commentary: |
| 29 | |
| 30 | ;;; Code: |
| 31 | |
| 32 | (require 'pgg-def) |
| 33 | (require 'pgg-parse) |
| 34 | (autoload 'run-at-time "timer") |
| 35 | |
| 36 | ;; Don't merge these two `eval-when-compile's. |
| 37 | (eval-when-compile |
| 38 | (require 'cl)) |
| 39 | |
| 40 | ;;; @ utility functions |
| 41 | ;;; |
| 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 |
| 181 | (defmacro pgg-run-at-time-1 (time repeat function args) |
| 182 | (when (featurep 'xemacs) |
| 183 | (if (condition-case nil |
| 184 | (let ((delete-itimer 'delete-itimer) |
| 185 | (itimer-driver-start 'itimer-driver-start) |
| 186 | (itimer-value 'itimer-value) |
| 187 | (start-itimer 'start-itimer)) |
| 188 | (unless (or (symbol-value 'itimer-process) |
| 189 | (symbol-value 'itimer-timer)) |
| 190 | (funcall itimer-driver-start)) |
| 191 | ;; Check whether there is a bug to which the difference of |
| 192 | ;; the present time and the time when the itimer driver was |
| 193 | ;; woken up is subtracted from the initial itimer value. |
| 194 | (let* ((inhibit-quit t) |
| 195 | (ctime (current-time)) |
| 196 | (itimer-timer-last-wakeup |
| 197 | (prog1 |
| 198 | ctime |
| 199 | (setcar ctime (1- (car ctime))))) |
| 200 | (itimer-list nil) |
| 201 | (itimer (funcall start-itimer "pgg-run-at-time" |
| 202 | 'ignore 5))) |
| 203 | (sleep-for 0.1) ;; Accept the timeout interrupt. |
| 204 | (prog1 |
| 205 | (> (funcall itimer-value itimer) 0) |
| 206 | (funcall delete-itimer itimer)))) |
| 207 | (error nil)) |
| 208 | `(let ((time ,time)) |
| 209 | (apply #'start-itimer "pgg-run-at-time" |
| 210 | ,function (if time (max time 1e-9) 1e-9) |
| 211 | ,repeat nil t ,args))) |
| 212 | `(let ((time ,time) |
| 213 | (itimers (list nil))) |
| 214 | (setcar |
| 215 | itimers |
| 216 | (apply #'start-itimer "pgg-run-at-time" |
| 217 | (lambda (itimers repeat function &rest args) |
| 218 | (let ((itimer (car itimers))) |
| 219 | (if repeat |
| 220 | (progn |
| 221 | (set-itimer-function |
| 222 | itimer |
| 223 | (lambda (itimer repeat function &rest args) |
| 224 | (set-itimer-restart itimer repeat) |
| 225 | (set-itimer-function itimer function) |
| 226 | (set-itimer-function-arguments itimer args) |
| 227 | (apply function args))) |
| 228 | (set-itimer-function-arguments |
| 229 | itimer |
| 230 | (append (list itimer repeat function) args))) |
| 231 | (set-itimer-function |
| 232 | itimer |
| 233 | (lambda (itimer function &rest args) |
| 234 | (delete-itimer itimer) |
| 235 | (apply function args))) |
| 236 | (set-itimer-function-arguments |
| 237 | itimer |
| 238 | (append (list itimer function) args))))) |
| 239 | 1e-9 (if time (max time 1e-9) 1e-9) |
| 240 | nil t itimers ,repeat ,function ,args)))))) |
| 241 | |
| 242 | (eval-and-compile |
| 243 | (if (featurep 'xemacs) |
| 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. |
| 248 | Return an itimer object which can be used in either `delete-itimer' |
| 249 | or `cancel-timer'." |
| 250 | (pgg-run-at-time-1 time repeat function args)) |
| 251 | (defun pgg-cancel-timer (timer) |
| 252 | "Emulate cancel-timer for xemacs." |
| 253 | (let ((delete-itimer 'delete-itimer)) |
| 254 | (funcall delete-itimer timer))) |
| 255 | ) |
| 256 | (defalias 'pgg-run-at-time 'run-at-time) |
| 257 | (defalias 'pgg-cancel-timer 'cancel-timer))) |
| 258 | |
| 259 | (defmacro pgg-convert-lbt-region (start end lbt) |
| 260 | `(let ((pgg-conversion-end (set-marker (make-marker) ,end))) |
| 261 | (goto-char ,start) |
| 262 | (case ,lbt |
| 263 | (CRLF |
| 264 | (while (progn |
| 265 | (end-of-line) |
| 266 | (> (marker-position pgg-conversion-end) (point))) |
| 267 | (insert "\r") |
| 268 | (forward-line 1))) |
| 269 | (LF |
| 270 | (while (re-search-forward "\r$" pgg-conversion-end t) |
| 271 | (replace-match "")))))) |
| 272 | |
| 273 | (put 'pgg-as-lbt 'lisp-indent-function 3) |
| 274 | |
| 275 | (defmacro pgg-as-lbt (start end lbt &rest body) |
| 276 | `(let ((inhibit-read-only t) |
| 277 | buffer-read-only |
| 278 | buffer-undo-list) |
| 279 | (pgg-convert-lbt-region ,start ,end ,lbt) |
| 280 | (let ((,end (point))) |
| 281 | ,@body) |
| 282 | (push nil buffer-undo-list) |
| 283 | (ignore-errors (undo)))) |
| 284 | |
| 285 | (put 'pgg-process-when-success 'lisp-indent-function 0) |
| 286 | |
| 287 | (defmacro pgg-process-when-success (&rest body) |
| 288 | `(with-current-buffer pgg-output-buffer |
| 289 | (if (zerop (buffer-size)) nil ,@body t))) |
| 290 | |
| 291 | (defalias 'pgg-make-temp-file |
| 292 | (if (fboundp 'make-temp-file) |
| 293 | 'make-temp-file |
| 294 | (lambda (prefix &optional dir-flag) |
| 295 | (let ((file (expand-file-name |
| 296 | (make-temp-name prefix) |
| 297 | (if (fboundp 'temp-directory) |
| 298 | (temp-directory) |
| 299 | temporary-file-directory)))) |
| 300 | (if dir-flag |
| 301 | (make-directory file)) |
| 302 | file)))) |
| 303 | |
| 304 | ;;; @ interface functions |
| 305 | ;;; |
| 306 | |
| 307 | ;;;###autoload |
| 308 | (defun pgg-encrypt-region (start end rcpts &optional sign passphrase) |
| 309 | "Encrypt the current region between START and END for RCPTS. |
| 310 | |
| 311 | If optional argument SIGN is non-nil, do a combined sign and encrypt. |
| 312 | |
| 313 | If optional PASSPHRASE is not specified, it will be obtained from the |
| 314 | passphrase cache or user." |
| 315 | (interactive |
| 316 | (list (region-beginning)(region-end) |
| 317 | (split-string (read-string "Recipients: ") "[ \t,]+"))) |
| 318 | (let ((status |
| 319 | (pgg-save-coding-system start end |
| 320 | (pgg-invoke "encrypt-region" (or pgg-scheme pgg-default-scheme) |
| 321 | (point-min) (point-max) rcpts sign passphrase)))) |
| 322 | (when (interactive-p) |
| 323 | (pgg-display-output-buffer start end status)) |
| 324 | status)) |
| 325 | |
| 326 | ;;;###autoload |
| 327 | (defun pgg-encrypt-symmetric-region (start end &optional passphrase) |
| 328 | "Encrypt the current region between START and END symmetric with passphrase. |
| 329 | |
| 330 | If optional PASSPHRASE is not specified, it will be obtained from the |
| 331 | cache or user." |
| 332 | (interactive "r") |
| 333 | (let ((status |
| 334 | (pgg-save-coding-system start end |
| 335 | (pgg-invoke "encrypt-symmetric-region" |
| 336 | (or pgg-scheme pgg-default-scheme) |
| 337 | (point-min) (point-max) passphrase)))) |
| 338 | (when (interactive-p) |
| 339 | (pgg-display-output-buffer start end status)) |
| 340 | status)) |
| 341 | |
| 342 | ;;;###autoload |
| 343 | (defun pgg-encrypt-symmetric (&optional start end passphrase) |
| 344 | "Encrypt the current buffer using a symmetric, rather than key-pair, cipher. |
| 345 | |
| 346 | If optional arguments START and END are specified, only encrypt within |
| 347 | the region. |
| 348 | |
| 349 | If optional PASSPHRASE is not specified, it will be obtained from the |
| 350 | passphrase cache or user." |
| 351 | (interactive) |
| 352 | (let* ((start (or start (point-min))) |
| 353 | (end (or end (point-max))) |
| 354 | (status (pgg-encrypt-symmetric-region start end passphrase))) |
| 355 | (when (interactive-p) |
| 356 | (pgg-display-output-buffer start end status)) |
| 357 | status)) |
| 358 | |
| 359 | ;;;###autoload |
| 360 | (defun pgg-encrypt (rcpts &optional sign start end passphrase) |
| 361 | "Encrypt the current buffer for RCPTS. |
| 362 | |
| 363 | If optional argument SIGN is non-nil, do a combined sign and encrypt. |
| 364 | |
| 365 | If optional arguments START and END are specified, only encrypt within |
| 366 | the region. |
| 367 | |
| 368 | If optional PASSPHRASE is not specified, it will be obtained from the |
| 369 | passphrase cache or user." |
| 370 | (interactive (list (split-string (read-string "Recipients: ") "[ \t,]+"))) |
| 371 | (let* ((start (or start (point-min))) |
| 372 | (end (or end (point-max))) |
| 373 | (status (pgg-encrypt-region start end rcpts sign passphrase))) |
| 374 | (when (interactive-p) |
| 375 | (pgg-display-output-buffer start end status)) |
| 376 | status)) |
| 377 | |
| 378 | ;;;###autoload |
| 379 | (defun pgg-decrypt-region (start end &optional passphrase) |
| 380 | "Decrypt the current region between START and END. |
| 381 | |
| 382 | If optional PASSPHRASE is not specified, it will be obtained from the |
| 383 | passphrase cache or user." |
| 384 | (interactive "r") |
| 385 | (let* ((buf (current-buffer)) |
| 386 | (status |
| 387 | (pgg-save-coding-system start end |
| 388 | (pgg-invoke "decrypt-region" (or pgg-scheme pgg-default-scheme) |
| 389 | (point-min) (point-max) passphrase)))) |
| 390 | (when (interactive-p) |
| 391 | (pgg-display-output-buffer start end status)) |
| 392 | status)) |
| 393 | |
| 394 | ;;;###autoload |
| 395 | (defun pgg-decrypt (&optional start end passphrase) |
| 396 | "Decrypt the current buffer. |
| 397 | |
| 398 | If optional arguments START and END are specified, only decrypt within |
| 399 | the region. |
| 400 | |
| 401 | If optional PASSPHRASE is not specified, it will be obtained from the |
| 402 | passphrase cache or user." |
| 403 | (interactive "") |
| 404 | (let* ((start (or start (point-min))) |
| 405 | (end (or end (point-max))) |
| 406 | (status (pgg-decrypt-region start end passphrase))) |
| 407 | (when (interactive-p) |
| 408 | (pgg-display-output-buffer start end status)) |
| 409 | status)) |
| 410 | |
| 411 | ;;;###autoload |
| 412 | (defun pgg-sign-region (start end &optional cleartext passphrase) |
| 413 | "Make the signature from text between START and END. |
| 414 | |
| 415 | If the optional 3rd argument CLEARTEXT is non-nil, it does not create |
| 416 | a detached signature. |
| 417 | |
| 418 | If this function is called interactively, CLEARTEXT is enabled |
| 419 | and the the output is displayed. |
| 420 | |
| 421 | If optional PASSPHRASE is not specified, it will be obtained from the |
| 422 | passphrase cache or user." |
| 423 | (interactive "r") |
| 424 | (let ((status (pgg-save-coding-system start end |
| 425 | (pgg-invoke "sign-region" (or pgg-scheme pgg-default-scheme) |
| 426 | (point-min) (point-max) |
| 427 | (or (interactive-p) cleartext) |
| 428 | passphrase)))) |
| 429 | (when (interactive-p) |
| 430 | (pgg-display-output-buffer start end status)) |
| 431 | status)) |
| 432 | |
| 433 | ;;;###autoload |
| 434 | (defun pgg-sign (&optional cleartext start end passphrase) |
| 435 | "Sign the current buffer. |
| 436 | |
| 437 | If the optional argument CLEARTEXT is non-nil, it does not create a |
| 438 | detached signature. |
| 439 | |
| 440 | If optional arguments START and END are specified, only sign data |
| 441 | within the region. |
| 442 | |
| 443 | If this function is called interactively, CLEARTEXT is enabled |
| 444 | and the the output is displayed. |
| 445 | |
| 446 | If optional PASSPHRASE is not specified, it will be obtained from the |
| 447 | passphrase cache or user." |
| 448 | (interactive "") |
| 449 | (let* ((start (or start (point-min))) |
| 450 | (end (or end (point-max))) |
| 451 | (status (pgg-sign-region start end |
| 452 | (or (interactive-p) cleartext) |
| 453 | passphrase))) |
| 454 | (when (interactive-p) |
| 455 | (pgg-display-output-buffer start end status)) |
| 456 | status)) |
| 457 | |
| 458 | ;;;###autoload |
| 459 | (defun pgg-verify-region (start end &optional signature fetch) |
| 460 | "Verify the current region between START and END. |
| 461 | If the optional 3rd argument SIGNATURE is non-nil, it is treated as |
| 462 | the detached signature of the current region. |
| 463 | |
| 464 | If the optional 4th argument FETCH is non-nil, we attempt to fetch the |
| 465 | signer's public key from `pgg-default-keyserver-address'." |
| 466 | (interactive "r") |
| 467 | (let* ((packet |
| 468 | (if (null signature) nil |
| 469 | (with-temp-buffer |
| 470 | (buffer-disable-undo) |
| 471 | (if (fboundp 'set-buffer-multibyte) |
| 472 | (set-buffer-multibyte nil)) |
| 473 | (insert-file-contents signature) |
| 474 | (cdr (assq 2 (pgg-decode-armor-region |
| 475 | (point-min)(point-max))))))) |
| 476 | (key (cdr (assq 'key-identifier packet))) |
| 477 | status keyserver) |
| 478 | (and (stringp key) |
| 479 | pgg-query-keyserver |
| 480 | (setq key (concat "0x" (pgg-truncate-key-identifier key))) |
| 481 | (null (pgg-lookup-key key)) |
| 482 | (or fetch (interactive-p)) |
| 483 | (y-or-n-p (format "Key %s not found; attempt to fetch? " key)) |
| 484 | (setq keyserver |
| 485 | (or (cdr (assq 'preferred-key-server packet)) |
| 486 | pgg-default-keyserver-address)) |
| 487 | (pgg-fetch-key keyserver key)) |
| 488 | (setq status |
| 489 | (pgg-save-coding-system start end |
| 490 | (pgg-invoke "verify-region" (or pgg-scheme pgg-default-scheme) |
| 491 | (point-min) (point-max) signature))) |
| 492 | (when (interactive-p) |
| 493 | (let ((temp-buffer-show-function |
| 494 | (function pgg-temp-buffer-show-function))) |
| 495 | (with-output-to-temp-buffer pgg-echo-buffer |
| 496 | (set-buffer standard-output) |
| 497 | (insert-buffer-substring (if status pgg-output-buffer |
| 498 | pgg-errors-buffer))))) |
| 499 | status)) |
| 500 | |
| 501 | ;;;###autoload |
| 502 | (defun pgg-verify (&optional signature fetch start end) |
| 503 | "Verify the current buffer. |
| 504 | If the optional argument SIGNATURE is non-nil, it is treated as |
| 505 | the detached signature of the current region. |
| 506 | If the optional argument FETCH is non-nil, we attempt to fetch the |
| 507 | signer's public key from `pgg-default-keyserver-address'. |
| 508 | If optional arguments START and END are specified, only verify data |
| 509 | within the region." |
| 510 | (interactive "") |
| 511 | (let* ((start (or start (point-min))) |
| 512 | (end (or end (point-max))) |
| 513 | (status (pgg-verify-region start end signature fetch))) |
| 514 | (when (interactive-p) |
| 515 | (let ((temp-buffer-show-function |
| 516 | (function pgg-temp-buffer-show-function))) |
| 517 | (with-output-to-temp-buffer pgg-echo-buffer |
| 518 | (set-buffer standard-output) |
| 519 | (insert-buffer-substring (if status pgg-output-buffer |
| 520 | pgg-errors-buffer))))) |
| 521 | status)) |
| 522 | |
| 523 | ;;;###autoload |
| 524 | (defun pgg-insert-key () |
| 525 | "Insert the ASCII armored public key." |
| 526 | (interactive) |
| 527 | (pgg-invoke "insert-key" (or pgg-scheme pgg-default-scheme))) |
| 528 | |
| 529 | ;;;###autoload |
| 530 | (defun pgg-snarf-keys-region (start end) |
| 531 | "Import public keys in the current region between START and END." |
| 532 | (interactive "r") |
| 533 | (pgg-save-coding-system start end |
| 534 | (pgg-invoke "snarf-keys-region" (or pgg-scheme pgg-default-scheme) |
| 535 | start end))) |
| 536 | |
| 537 | ;;;###autoload |
| 538 | (defun pgg-snarf-keys () |
| 539 | "Import public keys in the current buffer." |
| 540 | (interactive "") |
| 541 | (pgg-snarf-keys-region (point-min) (point-max))) |
| 542 | |
| 543 | (defun pgg-lookup-key (string &optional type) |
| 544 | (pgg-invoke "lookup-key" (or pgg-scheme pgg-default-scheme) string type)) |
| 545 | |
| 546 | (defvar pgg-insert-url-function (function pgg-insert-url-with-w3)) |
| 547 | |
| 548 | (defun pgg-insert-url-with-w3 (url) |
| 549 | (ignore-errors |
| 550 | (require 'url) |
| 551 | (let (buffer-file-name) |
| 552 | (url-insert-file-contents url)))) |
| 553 | |
| 554 | (defvar pgg-insert-url-extra-arguments nil) |
| 555 | (defvar pgg-insert-url-program nil) |
| 556 | |
| 557 | (defun pgg-insert-url-with-program (url) |
| 558 | (let ((args (copy-sequence pgg-insert-url-extra-arguments)) |
| 559 | process) |
| 560 | (insert |
| 561 | (with-temp-buffer |
| 562 | (setq process |
| 563 | (apply #'start-process " *PGG url*" (current-buffer) |
| 564 | pgg-insert-url-program (nconc args (list url)))) |
| 565 | (set-process-sentinel process #'ignore) |
| 566 | (while (eq 'run (process-status process)) |
| 567 | (accept-process-output process 5)) |
| 568 | (delete-process process) |
| 569 | (if (and process (eq 'run (process-status process))) |
| 570 | (interrupt-process process)) |
| 571 | (buffer-string))))) |
| 572 | |
| 573 | (defun pgg-fetch-key (keyserver key) |
| 574 | "Attempt to fetch a KEY from KEYSERVER for addition to PGP or GnuPG keyring." |
| 575 | (with-current-buffer (get-buffer-create pgg-output-buffer) |
| 576 | (buffer-disable-undo) |
| 577 | (erase-buffer) |
| 578 | (let ((proto (if (string-match "^[a-zA-Z\\+\\.\\\\-]+:" keyserver) |
| 579 | (substring keyserver 0 (1- (match-end 0)))))) |
| 580 | (save-excursion |
| 581 | (funcall pgg-insert-url-function |
| 582 | (if proto keyserver |
| 583 | (format "http://%s:11371/pks/lookup?op=get&search=%s" |
| 584 | keyserver key)))) |
| 585 | (when (re-search-forward "^-+BEGIN" nil 'last) |
| 586 | (delete-region (point-min) (match-beginning 0)) |
| 587 | (when (re-search-forward "^-+END" nil t) |
| 588 | (delete-region (progn (end-of-line) (point)) |
| 589 | (point-max))) |
| 590 | (insert "\n") |
| 591 | (with-temp-buffer |
| 592 | (insert-buffer-substring pgg-output-buffer) |
| 593 | (pgg-snarf-keys-region (point-min)(point-max))))))) |
| 594 | |
| 595 | |
| 596 | (provide 'pgg) |
| 597 | |
| 598 | ;;; arch-tag: 9cc705dd-1e6a-4c90-8dce-c3561f9a2cf4 |
| 599 | ;;; pgg.el ends here |