summary refs log tree commit diff
diff options
context:
space:
mode:
-rw-r--r--Makefile.am1
-rw-r--r--guix/narinfo.scm326
-rw-r--r--guix/scripts/challenge.scm1
-rwxr-xr-xguix/scripts/substitute.scm284
-rw-r--r--guix/scripts/weather.scm1
-rw-r--r--po/guix/POTFILES.in1
-rw-r--r--tests/challenge.scm2
-rw-r--r--tests/substitute.scm1
8 files changed, 334 insertions, 283 deletions
diff --git a/Makefile.am b/Makefile.am
index 99bdcfa346..5dcd3c6fd3 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -103,6 +103,7 @@ MODULES =					\
   guix/profiles.scm				\
   guix/serialization.scm			\
   guix/nar.scm					\
+  guix/narinfo.scm				\
   guix/derivations.scm				\
   guix/grafts.scm				\
   guix/repl.scm					\
diff --git a/guix/narinfo.scm b/guix/narinfo.scm
new file mode 100644
index 0000000000..241090ec98
--- /dev/null
+++ b/guix/narinfo.scm
@@ -0,0 +1,326 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014 Nikita Karetnikov <nikita@karetnikov.org>
+;;; Copyright © 2018 Kyle Meyer <kyle@kyleam.com>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix narinfo)
+  #:use-module (guix pki)
+  #:use-module (guix i18n)
+  #:use-module (guix base32)
+  #:use-module (guix base64)
+  #:use-module (guix records)
+  #:use-module (guix diagnostics)
+  #:use-module (guix scripts substitute)
+  #:use-module (gcrypt hash)
+  #:use-module (gcrypt pk-crypto)
+  #:use-module (rnrs bytevectors)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-9)
+  #:use-module (srfi srfi-26)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 binary-ports)
+  #:use-module (web uri)
+  #:export (narinfo-signature->canonical-sexp
+
+            narinfo?
+            narinfo-path
+            narinfo-uris
+            narinfo-uri-base
+            narinfo-compressions
+            narinfo-file-hashes
+            narinfo-file-sizes
+            narinfo-hash
+            narinfo-size
+            narinfo-references
+            narinfo-deriver
+            narinfo-system
+            narinfo-signature
+
+            narinfo-hash-algorithm+value
+
+            narinfo-hash->sha256
+            narinfo-best-uri
+
+            valid-narinfo?
+
+            read-narinfo
+            write-narinfo
+
+            string->narinfo
+            narinfo->string
+
+            equivalent-narinfo?))
+
+(define-record-type <narinfo>
+  (%make-narinfo path uri-base uris compressions file-sizes file-hashes
+                 nar-hash nar-size references deriver system
+                 signature contents)
+  narinfo?
+  (path         narinfo-path)
+  (uri-base     narinfo-uri-base)        ;URI of the cache it originates from
+  (uris         narinfo-uris)            ;list of strings
+  (compressions narinfo-compressions)    ;list of strings
+  (file-sizes   narinfo-file-sizes)      ;list of (integers | #f)
+  (file-hashes  narinfo-file-hashes)
+  (nar-hash     narinfo-hash)
+  (nar-size     narinfo-size)
+  (references   narinfo-references)
+  (deriver      narinfo-deriver)
+  (system       narinfo-system)
+  (signature    narinfo-signature)      ; canonical sexp
+  ;; The original contents of a narinfo file.  This field is needed because we
+  ;; want to preserve the exact textual representation for verification purposes.
+  ;; See <https://lists.gnu.org/archive/html/guix-devel/2014-02/msg00340.html>
+  ;; for more information.
+  (contents     narinfo-contents))
+
+(define (narinfo-hash-algorithm+value narinfo)
+  "Return two values: the hash algorithm used by NARINFO and its value as a
+bytevector."
+  (match (string-tokenize (narinfo-hash narinfo)
+                          (char-set-complement (char-set #\:)))
+    ((algorithm base32)
+     (values (lookup-hash-algorithm (string->symbol algorithm))
+             (nix-base32-string->bytevector base32)))
+    (_
+     (raise (formatted-message
+             (G_ "invalid narinfo hash: ~s") (narinfo-hash narinfo))))))
+
+(define (narinfo-hash->sha256 hash)
+  "If the string HASH denotes a sha256 hash, return it as a bytevector.
+Otherwise return #f."
+  (and (string-prefix? "sha256:" hash)
+       (nix-base32-string->bytevector (string-drop hash 7))))
+
+(define (narinfo-signature->canonical-sexp str)
+  "Return the value of a narinfo's 'Signature' field as a canonical sexp."
+  (match (string-split str #\;)
+    ((version host-name sig)
+     (let ((maybe-number (string->number version)))
+       (cond ((not (number? maybe-number))
+              (leave (G_ "signature version must be a number: ~s~%")
+                     version))
+             ;; Currently, there are no other versions.
+             ((not (= 1 maybe-number))
+              (leave (G_ "unsupported signature version: ~a~%")
+                     maybe-number))
+             (else
+              (let ((signature (utf8->string (base64-decode sig))))
+                (catch 'gcry-error
+                  (lambda ()
+                    (string->canonical-sexp signature))
+                  (lambda (key proc err)
+                    (leave (G_ "signature is not a valid \
+s-expression: ~s~%")
+                           signature))))))))
+    (x
+     (leave (G_ "invalid format of the signature field: ~a~%") x))))
+
+(define (narinfo-maker str cache-url)
+  "Return a narinfo constructor for narinfos originating from CACHE-URL.  STR
+must contain the original contents of a narinfo file."
+  (lambda (path urls compressions file-hashes file-sizes
+                nar-hash nar-size references deriver system
+                signature)
+    "Return a new <narinfo> object."
+    (define len (length urls))
+    (%make-narinfo path cache-url
+                   ;; Handle the case where URL is a relative URL.
+                   (map (lambda (url)
+                          (or (string->uri url)
+                              (string->uri
+                               (string-append cache-url "/" url))))
+                        urls)
+                   compressions
+                   (match file-sizes
+                     (()        (make-list len #f))
+                     ((lst ...) (map string->number lst)))
+                   (match file-hashes
+                     (()        (make-list len #f))
+                     ((lst ...) (map string->number lst)))
+                   nar-hash
+                   (and=> nar-size string->number)
+                   (string-tokenize references)
+                   (match deriver
+                     ((or #f "") #f)
+                     (_ deriver))
+                   system
+                   (false-if-exception
+                    (and=> signature narinfo-signature->canonical-sexp))
+                   str)))
+
+(define fields->alist
+  ;; The narinfo format is really just like recutils.
+  recutils->alist)
+
+(define* (read-narinfo port #:optional url
+                       #:key size)
+  "Read a narinfo from PORT.  If URL is true, it must be a string used to
+build full URIs from relative URIs found while reading PORT.  When SIZE is
+true, read at most SIZE bytes from PORT; otherwise, read as much as possible.
+
+No authentication and authorization checks are performed here!"
+  (let ((str (utf8->string (if size
+                               (get-bytevector-n port size)
+                               (get-bytevector-all port)))))
+    (alist->record (call-with-input-string str fields->alist)
+                   (narinfo-maker str url)
+                   '("StorePath" "URL" "Compression"
+                     "FileHash" "FileSize" "NarHash" "NarSize"
+                     "References" "Deriver" "System"
+                     "Signature")
+                   '("URL" "Compression" "FileSize" "FileHash"))))
+
+(define (narinfo-sha256 narinfo)
+  "Return the sha256 hash of NARINFO as a bytevector, or #f if NARINFO lacks a
+'Signature' field."
+  (define %mandatory-fields
+    ;; List of fields that must be signed.  If they are not signed, the
+    ;; narinfo is considered unsigned.
+    '("StorePath" "NarHash" "References"))
+
+  (let ((contents (narinfo-contents narinfo)))
+    (match (string-contains contents "Signature:")
+      (#f #f)
+      (index
+       (let* ((above-signature (string-take contents index))
+              (signed-fields (match (call-with-input-string above-signature
+                                      fields->alist)
+                               (((fields . values) ...) fields))))
+         (and (every (cut member <> signed-fields) %mandatory-fields)
+              (sha256 (string->utf8 above-signature))))))))
+
+(define* (valid-narinfo? narinfo #:optional (acl (current-acl))
+                         #:key verbose?)
+  "Return #t if NARINFO's signature is not valid."
+  (let ((hash      (narinfo-sha256 narinfo))
+        (signature (narinfo-signature narinfo))
+        (uri       (uri->string (first (narinfo-uris narinfo)))))
+    (and hash signature
+         (signature-case (signature hash acl)
+           (valid-signature #t)
+           (invalid-signature
+            (when verbose?
+              (format (current-error-port)
+                      "invalid signature for substitute at '~a'~%"
+                      uri))
+            #f)
+           (hash-mismatch
+            (when verbose?
+              (format (current-error-port)
+                      "hash mismatch for substitute at '~a'~%"
+                      uri))
+            #f)
+           (unauthorized-key
+            (when verbose?
+              (format (current-error-port)
+                      "substitute at '~a' is signed by an \
+unauthorized party~%"
+                      uri))
+            #f)
+           (corrupt-signature
+            (when verbose?
+              (format (current-error-port)
+                      "corrupt signature for substitute at '~a'~%"
+                      uri))
+            #f)))))
+
+(define (write-narinfo narinfo port)
+  "Write NARINFO to PORT."
+  (put-bytevector port (string->utf8 (narinfo-contents narinfo))))
+
+(define (narinfo->string narinfo)
+  "Return the external representation of NARINFO."
+  (call-with-output-string (cut write-narinfo narinfo <>)))
+
+(define (string->narinfo str cache-uri)
+  "Return the narinfo represented by STR.  Assume CACHE-URI as the base URI of
+the cache STR originates form."
+  (call-with-input-string str (cut read-narinfo <> cache-uri)))
+
+(define (equivalent-narinfo? narinfo1 narinfo2)
+  "Return true if NARINFO1 and NARINFO2 are equivalent--i.e., if they describe
+the same store item.  This ignores unnecessary metadata such as the Nar URL."
+  (and (string=? (narinfo-hash narinfo1)
+                 (narinfo-hash narinfo2))
+
+       ;; The following is not needed if all we want is to download a valid
+       ;; nar, but it's necessary if we want valid narinfo.
+       (string=? (narinfo-path narinfo1)
+                 (narinfo-path narinfo2))
+       (equal? (narinfo-references narinfo1)
+               (narinfo-references narinfo2))
+
+       (= (narinfo-size narinfo1)
+          (narinfo-size narinfo2))))
+
+(define %compression-methods
+  ;; Known compression methods and a thunk to determine whether they're
+  ;; supported.  See 'decompressed-port' in (guix utils).
+  `(("gzip"  . ,(const #t))
+    ("lzip"  . ,(const #t))
+    ("zstd"  . ,(lambda ()
+                  (resolve-module '(zstd) #t #f #:ensure #f)))
+    ("xz"    . ,(const #t))
+    ("bzip2" . ,(const #t))
+    ("none"  . ,(const #t))))
+
+(define (supported-compression? compression)
+  "Return true if COMPRESSION, a string, denotes a supported compression
+method."
+  (match (assoc-ref %compression-methods compression)
+    (#f         #f)
+    (supported? (supported?))))
+
+(define (compresses-better? compression1 compression2)
+  "Return true if COMPRESSION1 generally compresses better than COMPRESSION2;
+this is a rough approximation."
+  (match compression1
+    ("none" #f)
+    ("gzip" (string=? compression2 "none"))
+    ("lzip" #t)
+    (_      (or (string=? compression2 "none")
+                (string=? compression2 "gzip")))))
+
+(define (narinfo-best-uri narinfo)
+  "Select the \"best\" URI to download NARINFO's nar, and return three values:
+the URI, its compression method (a string), and the compressed file size."
+  (define choices
+    (filter (match-lambda
+              ((uri compression file-size)
+               (supported-compression? compression)))
+            (zip (narinfo-uris narinfo)
+                 (narinfo-compressions narinfo)
+                 (narinfo-file-sizes narinfo))))
+
+  (define (file-size<? c1 c2)
+    (match c1
+      ((uri1 compression1 (? integer? file-size1))
+       (match c2
+         ((uri2 compression2 (? integer? file-size2))
+          (< file-size1 file-size2))
+         (_ #t)))
+      ((uri compression1 #f)
+       (match c2
+         ((uri2 compression2 _)
+          (compresses-better? compression1 compression2))))
+      (_ #f)))                                    ;we can't tell
+
+  (match (sort choices file-size<?)
+    (((uri compression file-size) _ ...)
+     (values uri compression file-size))))
diff --git a/guix/scripts/challenge.scm b/guix/scripts/challenge.scm
index d0a456ac1d..cc9cbe6f27 100644
--- a/guix/scripts/challenge.scm
+++ b/guix/scripts/challenge.scm
@@ -28,6 +28,7 @@
   #:use-module ((guix progress) #:hide (dump-port*))
   #:use-module (guix serialization)
   #:use-module (guix scripts substitute)
+  #:use-module (guix narinfo)
   #:use-module (rnrs bytevectors)
   #:autoload   (guix http-client) (http-fetch)
   #:use-module ((guix build syscalls) #:select (terminal-columns))
diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index 601946277f..2eefdb79d8 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -22,6 +22,7 @@
 (define-module (guix scripts substitute)
   #:use-module (guix ui)
   #:use-module (guix scripts)
+  #:use-module (guix narinfo)
   #:use-module (guix store)
   #:use-module (guix utils)
   #:use-module (guix combinators)
@@ -68,29 +69,8 @@
   #:use-module (web request)
   #:use-module (web response)
   #:use-module (guix http-client)
-  #:export (narinfo-signature->canonical-sexp
-
-            narinfo?
-            narinfo-path
-            narinfo-uris
-            narinfo-uri-base
-            narinfo-compressions
-            narinfo-file-hashes
-            narinfo-file-sizes
-            narinfo-hash
-            narinfo-size
-            narinfo-references
-            narinfo-deriver
-            narinfo-system
-            narinfo-signature
-
-            narinfo-hash->sha256
-            narinfo-best-uri
-
-            lookup-narinfos
+  #:export (lookup-narinfos
             lookup-narinfos/diverse
-            read-narinfo
-            write-narinfo
 
             %allow-unauthenticated-substitutes?
             %error-to-file-descriptor-4?
@@ -150,10 +130,6 @@ disabled!~%"))
   ;; How often we want to remove files corresponding to expired cache entries.
   (* 7 24 3600))
 
-(define fields->alist
-  ;; The narinfo format is really just like recutils.
-  recutils->alist)
-
 (define %fetch-timeout
   ;; Number of seconds after which networking is considered "slow".
   5)
@@ -237,190 +213,6 @@ connection (typically PORT) is kept open once data has been fetched from URI."
      (leave (G_ "unsupported substitute URI scheme: ~a~%")
             (uri->string uri)))))
 
-
-(define-record-type <narinfo>
-  (%make-narinfo path uri-base uris compressions file-sizes file-hashes
-                 nar-hash nar-size references deriver system
-                 signature contents)
-  narinfo?
-  (path         narinfo-path)
-  (uri-base     narinfo-uri-base)        ;URI of the cache it originates from
-  (uris         narinfo-uris)            ;list of strings
-  (compressions narinfo-compressions)    ;list of strings
-  (file-sizes   narinfo-file-sizes)      ;list of (integers | #f)
-  (file-hashes  narinfo-file-hashes)
-  (nar-hash     narinfo-hash)
-  (nar-size     narinfo-size)
-  (references   narinfo-references)
-  (deriver      narinfo-deriver)
-  (system       narinfo-system)
-  (signature    narinfo-signature)      ; canonical sexp
-  ;; The original contents of a narinfo file.  This field is needed because we
-  ;; want to preserve the exact textual representation for verification purposes.
-  ;; See <https://lists.gnu.org/archive/html/guix-devel/2014-02/msg00340.html>
-  ;; for more information.
-  (contents     narinfo-contents))
-
-(define (narinfo-hash-algorithm+value narinfo)
-  "Return two values: the hash algorithm used by NARINFO and its value as a
-bytevector."
-  (match (string-tokenize (narinfo-hash narinfo)
-                          (char-set-complement (char-set #\:)))
-    ((algorithm base32)
-     (values (lookup-hash-algorithm (string->symbol algorithm))
-             (nix-base32-string->bytevector base32)))
-    (_
-     (raise (formatted-message
-             (G_ "invalid narinfo hash: ~s") (narinfo-hash narinfo))))))
-
-(define (narinfo-hash->sha256 hash)
-  "If the string HASH denotes a sha256 hash, return it as a bytevector.
-Otherwise return #f."
-  (and (string-prefix? "sha256:" hash)
-       (nix-base32-string->bytevector (string-drop hash 7))))
-
-(define (narinfo-signature->canonical-sexp str)
-  "Return the value of a narinfo's 'Signature' field as a canonical sexp."
-  (match (string-split str #\;)
-    ((version host-name sig)
-     (let ((maybe-number (string->number version)))
-       (cond ((not (number? maybe-number))
-              (leave (G_ "signature version must be a number: ~s~%")
-                     version))
-             ;; Currently, there are no other versions.
-             ((not (= 1 maybe-number))
-              (leave (G_ "unsupported signature version: ~a~%")
-                     maybe-number))
-             (else
-              (let ((signature (utf8->string (base64-decode sig))))
-                (catch 'gcry-error
-                  (lambda ()
-                    (string->canonical-sexp signature))
-                  (lambda (key proc err)
-                    (leave (G_ "signature is not a valid \
-s-expression: ~s~%")
-                           signature))))))))
-    (x
-     (leave (G_ "invalid format of the signature field: ~a~%") x))))
-
-(define (narinfo-maker str cache-url)
-  "Return a narinfo constructor for narinfos originating from CACHE-URL.  STR
-must contain the original contents of a narinfo file."
-  (lambda (path urls compressions file-hashes file-sizes
-                nar-hash nar-size references deriver system
-                signature)
-    "Return a new <narinfo> object."
-    (define len (length urls))
-    (%make-narinfo path cache-url
-                   ;; Handle the case where URL is a relative URL.
-                   (map (lambda (url)
-                          (or (string->uri url)
-                              (string->uri
-                               (string-append cache-url "/" url))))
-                        urls)
-                   compressions
-                   (match file-sizes
-                     (()        (make-list len #f))
-                     ((lst ...) (map string->number lst)))
-                   (match file-hashes
-                     (()        (make-list len #f))
-                     ((lst ...) (map string->number lst)))
-                   nar-hash
-                   (and=> nar-size string->number)
-                   (string-tokenize references)
-                   (match deriver
-                     ((or #f "") #f)
-                     (_ deriver))
-                   system
-                   (false-if-exception
-                    (and=> signature narinfo-signature->canonical-sexp))
-                   str)))
-
-(define* (read-narinfo port #:optional url
-                       #:key size)
-  "Read a narinfo from PORT.  If URL is true, it must be a string used to
-build full URIs from relative URIs found while reading PORT.  When SIZE is
-true, read at most SIZE bytes from PORT; otherwise, read as much as possible.
-
-No authentication and authorization checks are performed here!"
-  (let ((str (utf8->string (if size
-                               (get-bytevector-n port size)
-                               (get-bytevector-all port)))))
-    (alist->record (call-with-input-string str fields->alist)
-                   (narinfo-maker str url)
-                   '("StorePath" "URL" "Compression"
-                     "FileHash" "FileSize" "NarHash" "NarSize"
-                     "References" "Deriver" "System"
-                     "Signature")
-                   '("URL" "Compression" "FileSize" "FileHash"))))
-
-(define (narinfo-sha256 narinfo)
-  "Return the sha256 hash of NARINFO as a bytevector, or #f if NARINFO lacks a
-'Signature' field."
-  (define %mandatory-fields
-    ;; List of fields that must be signed.  If they are not signed, the
-    ;; narinfo is considered unsigned.
-    '("StorePath" "NarHash" "References"))
-
-  (let ((contents (narinfo-contents narinfo)))
-    (match (string-contains contents "Signature:")
-      (#f #f)
-      (index
-       (let* ((above-signature (string-take contents index))
-              (signed-fields (match (call-with-input-string above-signature
-                                      fields->alist)
-                               (((fields . values) ...) fields))))
-         (and (every (cut member <> signed-fields) %mandatory-fields)
-              (sha256 (string->utf8 above-signature))))))))
-
-(define* (valid-narinfo? narinfo #:optional (acl (current-acl))
-                         #:key verbose?)
-  "Return #t if NARINFO's signature is not valid."
-  (let ((hash      (narinfo-sha256 narinfo))
-        (signature (narinfo-signature narinfo))
-        (uri       (uri->string (first (narinfo-uris narinfo)))))
-    (and hash signature
-         (signature-case (signature hash acl)
-           (valid-signature #t)
-           (invalid-signature
-            (when verbose?
-              (format (current-error-port)
-                      "invalid signature for substitute at '~a'~%"
-                      uri))
-            #f)
-           (hash-mismatch
-            (when verbose?
-              (format (current-error-port)
-                      "hash mismatch for substitute at '~a'~%"
-                      uri))
-            #f)
-           (unauthorized-key
-            (when verbose?
-              (format (current-error-port)
-                      "substitute at '~a' is signed by an \
-unauthorized party~%"
-                      uri))
-            #f)
-           (corrupt-signature
-            (when verbose?
-              (format (current-error-port)
-                      "corrupt signature for substitute at '~a'~%"
-                      uri))
-            #f)))))
-
-(define (write-narinfo narinfo port)
-  "Write NARINFO to PORT."
-  (put-bytevector port (string->utf8 (narinfo-contents narinfo))))
-
-(define (narinfo->string narinfo)
-  "Return the external representation of NARINFO."
-  (call-with-output-string (cut write-narinfo narinfo <>)))
-
-(define (string->narinfo str cache-uri)
-  "Return the narinfo represented by STR.  Assume CACHE-URI as the base URI of
-the cache STR originates form."
-  (call-with-input-string str (cut read-narinfo <> cache-uri)))
-
 (define (narinfo-cache-file cache-url path)
   "Return the name of the local file that contains an entry for PATH.  The
 entry is stored in a sub-directory specific to CACHE-URL."
@@ -741,22 +533,6 @@ information is available locally."
         (let ((missing (fetch-narinfos cache missing)))
           (append cached (or missing '()))))))
 
-(define (equivalent-narinfo? narinfo1 narinfo2)
-  "Return true if NARINFO1 and NARINFO2 are equivalent--i.e., if they describe
-the same store item.  This ignores unnecessary metadata such as the Nar URL."
-  (and (string=? (narinfo-hash narinfo1)
-                 (narinfo-hash narinfo2))
-
-       ;; The following is not needed if all we want is to download a valid
-       ;; nar, but it's necessary if we want valid narinfo.
-       (string=? (narinfo-path narinfo1)
-                 (narinfo-path narinfo2))
-       (equal? (narinfo-references narinfo1)
-               (narinfo-references narinfo2))
-
-       (= (narinfo-size narinfo1)
-          (narinfo-size narinfo2))))
-
 (define (lookup-narinfos/diverse caches paths authorized?)
   "Look up narinfos for PATHS on all of CACHES, a list of URLS, in that order.
 That is, when a cache lacks an AUTHORIZED? narinfo, look it up in the next
@@ -942,62 +718,6 @@ authorized substitutes."
     (wtf
      (error "unknown `--query' command" wtf))))
 
-(define %compression-methods
-  ;; Known compression methods and a thunk to determine whether they're
-  ;; supported.  See 'decompressed-port' in (guix utils).
-  `(("gzip"  . ,(const #t))
-    ("lzip"  . ,(const #t))
-    ("zstd"  . ,(lambda ()
-                  (resolve-module '(zstd) #t #f #:ensure #f)))
-    ("xz"    . ,(const #t))
-    ("bzip2" . ,(const #t))
-    ("none"  . ,(const #t))))
-
-(define (supported-compression? compression)
-  "Return true if COMPRESSION, a string, denotes a supported compression
-method."
-  (match (assoc-ref %compression-methods compression)
-    (#f         #f)
-    (supported? (supported?))))
-
-(define (compresses-better? compression1 compression2)
-  "Return true if COMPRESSION1 generally compresses better than COMPRESSION2;
-this is a rough approximation."
-  (match compression1
-    ("none" #f)
-    ("gzip" (string=? compression2 "none"))
-    ("lzip" #t)
-    (_      (or (string=? compression2 "none")
-                (string=? compression2 "gzip")))))
-
-(define (narinfo-best-uri narinfo)
-  "Select the \"best\" URI to download NARINFO's nar, and return three values:
-the URI, its compression method (a string), and the compressed file size."
-  (define choices
-    (filter (match-lambda
-              ((uri compression file-size)
-               (supported-compression? compression)))
-            (zip (narinfo-uris narinfo)
-                 (narinfo-compressions narinfo)
-                 (narinfo-file-sizes narinfo))))
-
-  (define (file-size<? c1 c2)
-    (match c1
-      ((uri1 compression1 (? integer? file-size1))
-       (match c2
-         ((uri2 compression2 (? integer? file-size2))
-          (< file-size1 file-size2))
-         (_ #t)))
-      ((uri compression1 #f)
-       (match c2
-         ((uri2 compression2 _)
-          (compresses-better? compression1 compression2))))
-      (_ #f)))                                    ;we can't tell
-
-  (match (sort choices file-size<?)
-    (((uri compression file-size) _ ...)
-     (values uri compression file-size))))
-
 (define %max-cached-connections
   ;; Maximum number of connections kept in cache by
   ;; 'open-connection-for-uri/cached'.
diff --git a/guix/scripts/weather.scm b/guix/scripts/weather.scm
index f28070ddc4..97e4a73802 100644
--- a/guix/scripts/weather.scm
+++ b/guix/scripts/weather.scm
@@ -33,6 +33,7 @@
   #:use-module ((guix build syscalls) #:select (terminal-columns))
   #:use-module ((guix build utils) #:select (every*))
   #:use-module (guix scripts substitute)
+  #:use-module (guix narinfo)
   #:use-module (guix http-client)
   #:use-module (guix ci)
   #:use-module (guix sets)
diff --git a/po/guix/POTFILES.in b/po/guix/POTFILES.in
index 1aec3bef3c..666e630adf 100644
--- a/po/guix/POTFILES.in
+++ b/po/guix/POTFILES.in
@@ -87,6 +87,7 @@ guix/ui.scm
 guix/status.scm
 guix/http-client.scm
 guix/nar.scm
+guix/narinfo.scm
 guix/channels.scm
 guix/profiles.scm
 guix/git.scm
diff --git a/tests/challenge.scm b/tests/challenge.scm
index 9c6d6e0d58..fdd5fd238e 100644
--- a/tests/challenge.scm
+++ b/tests/challenge.scm
@@ -27,8 +27,8 @@
   #:use-module (guix packages)
   #:use-module (guix gexp)
   #:use-module (guix base32)
+  #:use-module (guix narinfo)
   #:use-module (guix scripts challenge)
-  #:use-module (guix scripts substitute)
   #:use-module ((guix build utils) #:select (find-files))
   #:use-module (gnu packages bootstrap)
   #:use-module (srfi srfi-1)
diff --git a/tests/substitute.scm b/tests/substitute.scm
index 542aaf603f..697abc4684 100644
--- a/tests/substitute.scm
+++ b/tests/substitute.scm
@@ -19,6 +19,7 @@
 
 (define-module (test-substitute)
   #:use-module (guix scripts substitute)
+  #:use-module (guix narinfo)
   #:use-module (guix base64)
   #:use-module (gcrypt hash)
   #:use-module (guix serialization)