aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2013-07-12 22:59:33 +0200
committerLudovic Courtès <ludo@gnu.org>2013-07-12 22:59:33 +0200
commite3ccdf9e963c1ec00f8dcf8cc859ab4615b978c4 (patch)
treef149fa15037b8db4b0af8a537161333ec0443cd4
parent1f495e04c16836c825618af815d4b17f93a6193a (diff)
downloadpatches-e3ccdf9e963c1ec00f8dcf8cc859ab4615b978c4.tar
patches-e3ccdf9e963c1ec00f8dcf8cc859ab4615b978c4.tar.gz
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.
-rw-r--r--guix/gnu-maintenance.scm6
-rw-r--r--guix/scripts/package.scm11
2 files changed, 14 insertions, 3 deletions
diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm
index 178d26ef57..06baa1e97b 100644
--- a/guix/gnu-maintenance.scm
+++ b/guix/gnu-maintenance.scm
@@ -252,8 +252,10 @@ pairs. Example: (\"mit-scheme-9.0.1\" . \"/gnu/mit-scheme/stable.pkg/9.0.1\").
files)
result))))))))
-(define (latest-release project)
- "Return (\"FOO-X.Y\" . \"/bar/foo\") or #f."
+(define* (latest-release project
+ #: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)
(if (version>? a b) a b))
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 11301ccff2..25ff008246 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -26,6 +26,7 @@
#:use-module (guix utils)
#:use-module (guix config)
#: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 format)
#:use-module (ice-9 match)
@@ -323,6 +324,12 @@ return its return value."
(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."
@@ -333,7 +340,9 @@ it."
(when (false-if-exception (gnu-package? package))
(let ((name (package-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)
((latest-version . _)
(when (version>? latest-version full-name)