ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-25 05:48:07 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

Do not check package freshness during upgrade.

Browse source 
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:
Alex Kost 2016-02-23 11:38:00 +03:00
parent 4d459d8734
commit 6caa4dfa37
3 changed files with 6 additions and 79 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
emacs/guix-main.scm
View file

@ -856,9 +856,7 @@ (define (entries profile params entry-type search-type search-vals)
(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))

69
gnu/packages.scm
View file

@ -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 @@ (define-module (gnu packages)
#: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 @@ (define-module (gnu packages)
find-best-packages-by-name
find-newest-available-packages
check-package-freshness
specification->package
specification->package+output))
@ -280,69 +276,6 @@ (define (call-with-sigint-handler thunk handler)
(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

12
guix/scripts/package.scm
View file

@ -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 @@ (define (store-item->manifest-entry item)
(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 @@ (define to-upgrade
(call-with-values
(lambda ()
(specification->package+output name output))
package->manifest-entry*))))
package->manifest-entry))))
(_ #f))
(manifest-entries manifest)))
@ -576,13 +572,13 @@ (define to-install
(('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))