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.

2 files changed, 14 insertions, 3 deletions

diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm
index 178d26ef57b..06baa1e97ba 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 11301ccff28..25ff008246a 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)