nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

guix package: Reuse FTP connections for subsequent `latest-release' calls. 

* guix/gnu-maintenance.scm (latest-release): Add `ftp-close' and
  `ftp-open' keyword parameters.
* guix/scripts/package.scm (ftp-open*): New variable.
  (check-package-freshness): Call `latest-release' with `ftp-open*' and
  a no-op procedure.
This commit is contained in:
Ludovic Courtès 2013-07-12 22:59:33 +02:00
parent 1f495e04c1
commit e3ccdf9e96
2 changed files with 14 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
guix/gnu-maintenance.scm
View File

@ -252,8 +252,10 @@ pairs. Example: (\"mit-scheme-9.0.1\" . \"/gnu/mit-scheme/stable.pkg/9.0.1\").
files) files)
result)))))))) result))))))))
(define (latest-release project) (define* (latest-release project
"Return (\"FOO-X.Y\" . \"/bar/foo\") or #f." #:key (ftp-open ftp-open) (ftp-close ftp-close))
"Return (\"FOO-X.Y\" . \"/bar/foo\") or #f. Use FTP-OPEN and FTP-CLOSE to
open (resp. close) FTP connections; this can be useful to reuse connections."
(define (latest a b) (define (latest a b)
(if (version>? a b) a b)) (if (version>? a b) a b))

11
guix/scripts/package.scm
View File

@ -26,6 +26,7 @@
#:use-module (guix utils) #:use-module (guix utils)
#:use-module (guix config) #:use-module (guix config)
#:use-module ((guix build utils) #:select (directory-exists? mkdir-p)) #:use-module ((guix build utils) #:select (directory-exists? mkdir-p))
#:use-module ((guix ftp-client) #:select (ftp-open))
#:use-module (ice-9 ftw) #:use-module (ice-9 ftw)
#:use-module (ice-9 format) #:use-module (ice-9 format)
#:use-module (ice-9 match) #:use-module (ice-9 match)
@ -323,6 +324,12 @@ return its return value."
(format (current-error-port) " interrupted by signal ~a~%" SIGINT) (format (current-error-port) " interrupted by signal ~a~%" SIGINT)
#f)))) #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) (define (check-package-freshness package)
"Check whether PACKAGE has a newer version available upstream, and report "Check whether PACKAGE has a newer version available upstream, and report
it." it."
@ -333,7 +340,9 @@ it."
(when (false-if-exception (gnu-package? package)) (when (false-if-exception (gnu-package? package))
(let ((name (package-name package)) (let ((name (package-name package))
(full-name (package-full-name package))) (full-name (package-full-name package)))
(match (waiting (latest-release name) (match (waiting (latest-release name
#:ftp-open ftp-open*
#:ftp-close (const #f))
(_ "looking for the latest release of GNU ~a...") name) (_ "looking for the latest release of GNU ~a...") name)
((latest-version . _) ((latest-version . _)
(when (version>? latest-version full-name) (when (version>? latest-version full-name)