Mercurial > hg > xemacs-beta

comparison lisp/package-get.el @ 4160:f35582fa32a9

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2007-09-03 13:16:39 by viteno] Steve Youngs' commit 'bot
author viteno
date Mon, 03 Sep 2007 13:16:44 +0000
parents ebc64fb494fe
children 1b16ec86578c
comparison
equal deleted inserted replaced
4159:bccd25cf2f5c 4160:f35582fa32a9
393 "*If Non-nil always make sure we are using the latest package index (base). 393 "*If Non-nil always make sure we are using the latest package index (base).
394 Otherwise respect the `force-current' argument of `package-get-require-base'." 394 Otherwise respect the `force-current' argument of `package-get-require-base'."
395 :type 'boolean 395 :type 'boolean
396 :group 'package-get) 396 :group 'package-get)
397 397
398 (defun package-get-pgp-available-p ()
399 "Checks the availability of Mailcrypt and PGP executable.
400
401 Returns t if both are found, nil otherwise. As a side effect, set
402 `mc-default-scheme' dependent on the PGP executable found."
403 (let (result)
404 (when (featurep 'mailcrypt-autoloads)
405 (autoload 'mc-setversion "mc-setversion"))
406 (when-fboundp 'mc-setversion
407 (cond ((locate-file "gpg" exec-path
408 '("" ".btm" ".bat" ".cmd" ".exe" ".com")
409 'executable)
410 (mc-setversion "gpg")
411 (setq result t))
412 ((locate-file "pgpe" exec-path
413 '("" ".btm" ".bat" ".cmd" ".exe" ".com")
414 'executable)
415 (mc-setversion "5.0")
416 (setq result t))
417 ((locate-file "pgp" exec-path
418 '("" ".btm" ".bat" ".cmd" ".exe" ".com")
419 'executable)
420 (mc-setversion "2.6")
421 (setq result t))))
422 (if result
423 result
424 nil)))
425
426 (defcustom package-get-require-signed-base-updates (package-get-pgp-available-p)
427 "*If non-nil, try to verify the package index database via PGP.
428
429 If nil, no PGP verification is done. If the package index database
430 entries are not PGP signed and this variable is non-nil, require user
431 confirmation to continue with the package-get procedure.
432
433 The default for this variable is the return value of
434 `package-get-pgp-available-p', non-nil if both the \"Mailcrypt\"
435 package and a suitable PGP executable are available, nil otherwise."
436 :type 'boolean
437 :group 'package-get)
438
439 (defvar package-entries-are-signed nil
440 "Non-nil when the package index file has been PGP signed.")
441
442 (defvar package-get-continue-update-base nil 398 (defvar package-get-continue-update-base nil
443 "Non-nil update the index even if it hasn't been signed.") 399 "Non-nil update the index even if it hasn't been signed.")
444 400
445 (defvar package-get-was-current nil 401 (defvar package-get-was-current nil
446 "Non-nil we did our best to fetch a current database.") 402 "Non-nil we did our best to fetch a current database.")
463 (if (or (not (boundp 'package-get-base)) 419 (if (or (not (boundp 'package-get-base))
464 (not package-get-base)) 420 (not package-get-base))
465 (error 'void-variable 421 (error 'void-variable
466 "Package-get database not loaded") 422 "Package-get database not loaded")
467 (setq package-get-was-current force-current))) 423 (setq package-get-was-current force-current)))
468
469 (defconst package-get-pgp-signed-begin-line "^-----BEGIN PGP SIGNED MESSAGE-----"
470 "Text for start of PGP signed messages.")
471 (defconst package-get-pgp-signature-begin-line "^-----BEGIN PGP SIGNATURE-----"
472 "Text for beginning of PGP signature.")
473 (defconst package-get-pgp-signature-end-line "^-----END PGP SIGNATURE-----"
474 "Text for end of PGP signature.")
475 424
476 ;;;###autoload 425 ;;;###autoload
477 (defun package-get-update-base-entry (entry) 426 (defun package-get-update-base-entry (entry)
478 "Update an entry in `package-get-base'." 427 "Update an entry in `package-get-base'."
479 (let ((existing (assq (car entry) package-get-base))) 428 (let ((existing (assq (car entry) package-get-base)))
598 (save-excursion 547 (save-excursion
599 (set-buffer buf) 548 (set-buffer buf)
600 (goto-char (point-min)) 549 (goto-char (point-min))
601 (setq content-beg (point)) 550 (setq content-beg (point))
602 (setq content-end (save-excursion (goto-char (point-max)) (point))) 551 (setq content-end (save-excursion (goto-char (point-max)) (point)))
603 (when (re-search-forward package-get-pgp-signed-begin-line nil t) 552 (package-get-update-base-entries content-beg content-end)
604 (setq content-beg (match-end 0))) 553 (message "Updated package database"))))
605 (when (re-search-forward package-get-pgp-signature-begin-line nil t)
606 (setq content-end (match-beginning 0))
607 (setq package-entries-are-signed t))
608 (re-search-forward package-get-pgp-signature-end-line nil t)
609 (setq package-get-continue-update-base t)
610 ;; This is a little overkill because the default value of
611 ;; `package-get-require-signed-base-updates' is the return of
612 ;; `package-get-pgp-available-p', but we have to allow for
613 ;; someone explicitly setting
614 ;; `package-get-require-signed-base-updates' to t. --SY
615 (when (and package-get-require-signed-base-updates
616 (package-get-pgp-available-p))
617 (if package-entries-are-signed
618 (let (good-sig)
619 (setq package-get-continue-update-base nil)
620 (autoload 'mc-verify "mc-toplev")
621 (when (declare-fboundp (mc-verify))
622 (setq good-sig t))
623 (if good-sig
624 (setq package-get-continue-update-base t)
625 (error 'process-error
626 "GnuPG error. Package database not updated")))
627 (if (yes-or-no-p
628 "Package Index is not PGP signed. Continue anyway? ")
629 (setq package-get-continue-update-base t)
630 (setq package-get-continue-update-base nil)
631 (warn "Package database not updated"))))
632 ;; ToDo: We should call package-get-maybe-save-index on the region
633 (when package-get-continue-update-base
634 (package-get-update-base-entries content-beg content-end)
635 (message "Updated package database")))))
636 554
637 (defun package-get-update-base-entries (start end) 555 (defun package-get-update-base-entries (start end)
638 "Update the package-get database with the entries found between 556 "Update the package-get database with the entries found between
639 START and END in the current buffer." 557 START and END in the current buffer."
640 (save-excursion 558 (save-excursion