Do not check package freshness during upgrade.
Fixes <http://bugs.gnu.org/22740>. Reported by Andreas Enge <andreas@enge.fr>. * gnu/packages.scm (waiting, ftp-open*, check-package-freshness): Remove. * guix/scripts/package.scm (options->installable): Adjust accordingly. * emacs/guix-main.scm (package->manifest-entry*): Likewise.
This commit is contained in:
parent
4d459d8734
commit
6caa4dfa37
|
@ -856,9 +856,7 @@ parameter/value pairs."
|
|||
|
||||
(define* (package->manifest-entry* package #:optional output)
|
||||
(and package
|
||||
(begin
|
||||
(check-package-freshness package)
|
||||
(package->manifest-entry package output))))
|
||||
(package->manifest-entry package output)))
|
||||
|
||||
(define* (make-install-manifest-entries id #:optional output)
|
||||
(package->manifest-entry* (package-by-id id) output))
|
||||
|
|
|
@ -2,6 +2,7 @@
|
|||
;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2013 Mark H Weaver <mhw@netris.org>
|
||||
;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
|
||||
;;; Copyright © 2016 Alex Kost <alezost@gmail.com>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
|
@ -22,9 +23,6 @@
|
|||
#:use-module (guix packages)
|
||||
#:use-module (guix ui)
|
||||
#:use-module (guix utils)
|
||||
#:use-module ((guix ftp-client) #:select (ftp-open))
|
||||
#:use-module (guix gnu-maintenance)
|
||||
#:use-module (guix upstream)
|
||||
#:use-module (ice-9 ftw)
|
||||
#:use-module (ice-9 vlist)
|
||||
#:use-module (ice-9 match)
|
||||
|
@ -46,8 +44,6 @@
|
|||
find-best-packages-by-name
|
||||
find-newest-available-packages
|
||||
|
||||
check-package-freshness
|
||||
|
||||
specification->package
|
||||
specification->package+output))
|
||||
|
||||
|
@ -280,69 +276,6 @@ return its return value."
|
|||
(lambda (k signum)
|
||||
(handler signum))))
|
||||
|
||||
(define-syntax-rule (waiting exp fmt rest ...)
|
||||
"Display the given message while EXP is being evaluated."
|
||||
(let* ((message (format #f fmt rest ...))
|
||||
(blank (make-string (string-length message) #\space)))
|
||||
(display message (current-error-port))
|
||||
(force-output (current-error-port))
|
||||
(call-with-sigint-handler
|
||||
(lambda ()
|
||||
(dynamic-wind
|
||||
(const #f)
|
||||
(lambda () exp)
|
||||
(lambda ()
|
||||
;; Clear the line.
|
||||
(display #\cr (current-error-port))
|
||||
(display blank (current-error-port))
|
||||
(display #\cr (current-error-port))
|
||||
(force-output (current-error-port)))))
|
||||
(lambda (signum)
|
||||
(format (current-error-port) " interrupted by signal ~a~%" SIGINT)
|
||||
#f))))
|
||||
|
||||
(define ftp-open*
|
||||
;; Memoizing version of `ftp-open'. The goal is to avoid initiating a new
|
||||
;; FTP connection for each package, esp. since most of them are to the same
|
||||
;; server. This has a noticeable impact when doing "guix upgrade -u".
|
||||
(memoize ftp-open))
|
||||
|
||||
(define (check-package-freshness package)
|
||||
"Check whether PACKAGE has a newer version available upstream, and report
|
||||
it."
|
||||
;; TODO: Automatically inject the upstream version when desired.
|
||||
|
||||
(catch #t
|
||||
(lambda ()
|
||||
(when (false-if-exception (gnu-package? package))
|
||||
(let ((name (package-name package))
|
||||
(full-name (package-full-name package)))
|
||||
;; XXX: This could work with non-GNU packages as well. However,
|
||||
;; GNU's FTP-based updater would be too slow if it weren't memoized,
|
||||
;; and the generic interface in (guix upstream) doesn't support
|
||||
;; that.
|
||||
(match (waiting (latest-release name
|
||||
#:ftp-open ftp-open*
|
||||
#:ftp-close (const #f))
|
||||
(_ "looking for the latest release of GNU ~a...") name)
|
||||
((? upstream-source? source)
|
||||
(let ((latest-version
|
||||
(string-append (upstream-source-package source) "-"
|
||||
(upstream-source-version source))))
|
||||
(when (version>? latest-version full-name)
|
||||
(format (current-error-port)
|
||||
(_ "~a: note: using ~a \
|
||||
but ~a is available upstream~%")
|
||||
(location->string (package-location package))
|
||||
full-name latest-version))))
|
||||
(_ #t)))))
|
||||
(lambda (key . args)
|
||||
;; Silently ignore networking errors rather than preventing
|
||||
;; installation.
|
||||
(case key
|
||||
((getaddrinfo-error ftp-error) #f)
|
||||
(else (apply throw key args))))))
|
||||
|
||||
(define (specification->package spec)
|
||||
"Return a package matching SPEC. SPEC may be a package name, or a package
|
||||
name followed by a hyphen and a version number. If the version number is not
|
||||
|
|
|
@ -2,7 +2,7 @@
|
|||
;;; Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
|
||||
;;; Copyright © 2013, 2015 Mark H Weaver <mhw@netris.org>
|
||||
;;; Copyright © 2014 Alex Kost <alezost@gmail.com>
|
||||
;;; Copyright © 2014, 2016 Alex Kost <alezost@gmail.com>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
|
@ -551,10 +551,6 @@ upgrading, #f otherwise."
|
|||
(define (options->installable opts manifest)
|
||||
"Given MANIFEST, the current manifest, and OPTS, the result of 'args-fold',
|
||||
return the new list of manifest entries."
|
||||
(define (package->manifest-entry* package output)
|
||||
(check-package-freshness package)
|
||||
(package->manifest-entry package output))
|
||||
|
||||
(define upgrade?
|
||||
(options->upgrade-predicate opts))
|
||||
|
||||
|
@ -567,7 +563,7 @@ return the new list of manifest entries."
|
|||
(call-with-values
|
||||
(lambda ()
|
||||
(specification->package+output name output))
|
||||
package->manifest-entry*))))
|
||||
package->manifest-entry))))
|
||||
(_ #f))
|
||||
(manifest-entries manifest)))
|
||||
|
||||
|
@ -576,13 +572,13 @@ return the new list of manifest entries."
|
|||
(('install . (? package? p))
|
||||
;; When given a package via `-e', install the first of its
|
||||
;; outputs (XXX).
|
||||
(package->manifest-entry* p "out"))
|
||||
(package->manifest-entry p "out"))
|
||||
(('install . (? string? spec))
|
||||
(if (store-path? spec)
|
||||
(store-item->manifest-entry spec)
|
||||
(let-values (((package output)
|
||||
(specification->package+output spec)))
|
||||
(package->manifest-entry* package output))))
|
||||
(package->manifest-entry package output))))
|
||||
(_ #f))
|
||||
opts))
|
||||
|
||||
|
|
Loading…
Reference in New Issue