Mercurial > hg > xemacs-beta

comparison lisp/package-get.el @ 681:c00aa0615465

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2001-12-02 07:27:14 by youngs] 2001-12-02 Steve Youngs <youngs@xemacs.org> * package-get.el (package-get-base-filename): Rename default file to 'package-index.LATEST.gpg' (package-get-require-signed-base-updates): Update doc string. 2001-11-29 Steve Youngs <youngs@xemacs.org> * package-get.el (package-entries-are-signed): New. (package-get-continue-update-base): New. (package-get-update-base-from-buffer): Use them. Fix PGP code.
author youngs
date Sun, 02 Dec 2001 07:27:15 +0000
parents 8e8a7b205142
children e558c78d22f8
comparison
equal deleted inserted replaced
680:455cef6481bd 681:c00aa0615465
250 :group 'package-get) 250 :group 'package-get)
251 251
252 ;; #### it may make sense for this to be a list of names. 252 ;; #### it may make sense for this to be a list of names.
253 ;; #### also, should we rename "*base*" to "*index*" or "*db*"? 253 ;; #### also, should we rename "*base*" to "*index*" or "*db*"?
254 ;; "base" is a pretty poor name. 254 ;; "base" is a pretty poor name.
255 (defcustom package-get-base-filename "package-index.LATEST.pgp" 255 (defcustom package-get-base-filename "package-index.LATEST.gpg"
256 "*Name of the default package-get database file. 256 "*Name of the default package-get database file.
257 This may either be a relative path, in which case it is interpreted 257 This may either be a relative path, in which case it is interpreted
258 with respect to `package-get-remote', or an absolute path." 258 with respect to `package-get-remote', or an absolute path."
259 :type 'file 259 :type 'file
260 :group 'package-get) 260 :group 'package-get)
270 :group 'package-get) 270 :group 'package-get)
271 271
272 (defcustom package-get-require-signed-base-updates nil 272 (defcustom package-get-require-signed-base-updates nil
273 "*If set to a non-nil value, require explicit user confirmation for updates 273 "*If set to a non-nil value, require explicit user confirmation for updates
274 to the package-get database which cannot have their signature verified via PGP. 274 to the package-get database which cannot have their signature verified via PGP.
275 When nil, updates which are not PGP signed are allowed without confirmation." 275 When nil, no PGP verification will be done."
276 :type 'boolean 276 :type 'boolean
277 :group 'package-get) 277 :group 'package-get)
278
279 (defvar package-entries-are-signed nil
280 "Non-nil when the package index file has been PGP signed.")
281
282 (defvar package-get-continue-update-base nil
283 "Non-nil update the index even if it hasn't been signed.")
278 284
279 (defvar package-get-was-current nil 285 (defvar package-get-was-current nil
280 "Non-nil we did our best to fetch a current database.") 286 "Non-nil we did our best to fetch a current database.")
281 287
282 288
424 (setq content-end (save-excursion (goto-char (point-max)) (point))) 430 (setq content-end (save-excursion (goto-char (point-max)) (point)))
425 (when (re-search-forward package-get-pgp-signed-begin-line nil t) 431 (when (re-search-forward package-get-pgp-signed-begin-line nil t)
426 (setq beg (match-beginning 0)) 432 (setq beg (match-beginning 0))
427 (setq content-beg (match-end 0))) 433 (setq content-beg (match-end 0)))
428 (when (re-search-forward package-get-pgp-signature-begin-line nil t) 434 (when (re-search-forward package-get-pgp-signature-begin-line nil t)
429 (setq content-end (match-beginning 0))) 435 (setq content-end (match-beginning 0))
436 (setq package-entries-are-signed t))
430 (when (re-search-forward package-get-pgp-signature-end-line nil t) 437 (when (re-search-forward package-get-pgp-signature-end-line nil t)
431 (setq end (point))) 438 (setq end (point)))
432 (if (not (and content-beg content-end beg end)) 439 (setq package-get-continue-update-base t)
433 (or (not package-get-require-signed-base-updates) 440 (if package-get-require-signed-base-updates
434 (yes-or-no-p "Package-get entries not PGP signed, continue? ") 441 (if package-entries-are-signed
435 (error "Package-get database not updated"))) 442 (progn
436 (if (and content-beg content-end beg end) 443 (setq package-get-continue-update-base nil)
437 (if (not (condition-case nil 444 (autoload 'mc-setversion "mc-setversion")
438 (or (fboundp 'mc-pgp-verify-region) 445 (or
439 (load-library "mc-pgp") 446 (cond ((locate-file "gpg" exec-path)
440 (fboundp 'mc-pgp-verify-region)) 447 (mc-setversion "gpg"))
441 (error nil))) 448 ((locate-file "pgpe" exec-path)
442 (or (not package-get-require-signed-base-updates) 449 (mc-setversion "5.0"))
443 (yes-or-no-p 450 ((locate-file "pgp" exec-path)
444 "No mailcrypt; can't verify package-get DB signature, continue? ") 451 (mc-setversion "2.6")))
445 (error "Package-get database not updated")))) 452 (error "Can't find a suitable pgp executable"))
446 (if (and beg end 453 (mc-verify)
447 (fboundp 'mc-pgp-verify-region) 454 (setq package-get-continue-update-base t))
448 (or (not 455 (if (yes-or-no-p
449 (condition-case err 456 "Package Index is not PGP signed. Continue anyway? ")
450 (declare-fboundp (mc-pgp-verify-region beg end)) 457 (setq package-get-continue-update-base t)
451 (file-error 458 (error "Package database not updated")
452 (and (string-match "No such file" (nth 2 err)) 459 (setq package-get-continue-update-base nil))))
453 (or (not package-get-require-signed-base-updates)
454 (yes-or-no-p
455 (concat "Can't find PGP, continue without "
456 "package-get DB verification? ")))))
457 (t nil)))))
458 (error "Package-get PGP signature failed to verify"))
459 ;; ToDo: We should call package-get-maybe-save-index on the region 460 ;; ToDo: We should call package-get-maybe-save-index on the region
460 (package-get-update-base-entries content-beg content-end) 461 (if package-get-continue-update-base
461 (message "Updated package-get database")))) 462 (progn
463 (package-get-update-base-entries content-beg content-end)
464 (message "Updated package-get database"))))))
462 465
463 (defun package-get-update-base-entries (start end) 466 (defun package-get-update-base-entries (start end)
464 "Update the package-get database with the entries found between 467 "Update the package-get database with the entries found between
465 START and END in the current buffer." 468 START and END in the current buffer."
466 (save-excursion 469 (save-excursion