diff options
| -rw-r--r-- | guix/gnu-maintenance.scm | 6 | ||||
| -rw-r--r-- | guix/scripts/package.scm | 11 |
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) |