summaryrefslogtreecommitdiff
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)