From c6903e156fff67ea43bf11443562a8e4f780a54d Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 11 Dec 2021 16:03:57 +0100 Subject: challenge: Use SRFI-71 instead of SRFI-11. * guix/scripts/challenge.scm (port-sha256*, call-with-nar): Use SRFI-71. --- guix/scripts/challenge.scm | 10 ++++------ 1 file changed, 4 insertions(+), 6 deletions(-) (limited to 'guix') diff --git a/guix/scripts/challenge.scm b/guix/scripts/challenge.scm index 69c2781abb..57ffe88235 100644 --- a/guix/scripts/challenge.scm +++ b/guix/scripts/challenge.scm @@ -35,10 +35,10 @@ #:use-module (gcrypt hash) #:use-module (srfi srfi-1) #:use-module (srfi srfi-9) - #:use-module (srfi srfi-11) #:use-module (srfi srfi-26) #:use-module (srfi srfi-34) #:use-module (srfi srfi-37) + #:use-module (srfi srfi-71) #:use-module (ice-9 match) #:use-module (ice-9 vlist) #:use-module (ice-9 format) @@ -196,7 +196,7 @@ taken since we do not import the archives." (define (port-sha256* port size) ;; Like 'port-sha256', but limited to SIZE bytes. - (let-values (((out get) (open-sha256-port))) + (let ((out get (open-sha256-port))) (dump-port* port out size) (close-port out) (get))) @@ -251,10 +251,8 @@ taken since we do not import the archives." (define (call-with-nar narinfo proc) "Call PROC with an input port from which it can read the nar pointed to by NARINFO." - (let*-values (((uri compression size) - (narinfo-best-uri narinfo)) - ((port actual-size) - (http-fetch uri))) + (let* ((uri compression size (narinfo-best-uri narinfo)) + (port actual-size (http-fetch uri))) (define reporter (progress-reporter/file (narinfo-path narinfo) (and size -- cgit v1.2.3 From 4dca1bae2767b049532e7434151686fdb7fab256 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 11 Dec 2021 16:10:08 +0100 Subject: challenge: Store item contents are returned in canonical order. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This allows the 'delete-duplicates' call in 'differing-files' to have the intended effect. Before that, a "guix challenge" invocation with three builds of a store item, two of which are identical, would lead 'differing-files' to not print anything, as in this example: $ ./pre-inst-env guix challenge python-numpy /gnu/store/…-python-numpy-1.17.3 contents differ: local hash: 07var0wn8fywxchldz5pjqpnlavrlbc8s81aqwsqyi0i7qlh6ka7 https://ci.guix.gnu.org/nar/lzip/…-python-numpy-1.17.3: 07var0wn8fywxchldz5pjqpnlavrlbc8s81aqwsqyi0i7qlh6ka7 https://bordeaux.guix.gnu.org/nar/lzip/…-python-numpy-1.17.3: 0cbl3q19bshb6ddz8xkcrjzkcmillsqii4z852ybzixyp7rg40qa 1 store items were analyzed: - 0 (0.0%) were identical - 1 (100.0%) differed - 0 (0.0%) were inconclusive With this change, 'differing-files' prints additional info as intended: differing file: /lib/python3.8/site-packages/numpy/distutils/fcompiler/__pycache__/vast.cpython-38.pyc * guix/scripts/challenge.scm (archive-contents): Add tail call to 'reverse'. (store-item-contents): Rewrite to use 'scandir' and recursive calls instead of 'file-system-fold'. --- guix/scripts/challenge.scm | 87 ++++++++++++++++++++++++---------------------- 1 file changed, 46 insertions(+), 41 deletions(-) (limited to 'guix') diff --git a/guix/scripts/challenge.scm b/guix/scripts/challenge.scm index 57ffe88235..c29d5105ae 100644 --- a/guix/scripts/challenge.scm +++ b/guix/scripts/challenge.scm @@ -202,51 +202,56 @@ taken since we do not import the archives." (get))) (define (archive-contents port) - "Return a list representing the files contained in the nar read from PORT." - (fold-archive (lambda (file type contents result) - (match type - ((or 'regular 'executable) - (match contents - ((port . size) - (cons `(,file ,type ,(port-sha256* port size)) - result)))) - ('directory result) - ('directory-complete result) - ('symlink - (cons `(,file ,type ,contents) result)))) - '() - port - "")) + "Return a list representing the files contained in the nar read from PORT. +The list is sorted in canonical order--i.e., the order in which entries appear +in the nar." + (reverse + (fold-archive (lambda (file type contents result) + (match type + ((or 'regular 'executable) + (match contents + ((port . size) + (cons `(,file ,type ,(port-sha256* port size)) + result)))) + ('directory result) + ('directory-complete result) + ('symlink + (cons `(,file ,type ,contents) result)))) + '() + port + ""))) (define (store-item-contents item) "Return a list of files and contents for ITEM in the same format as 'archive-contents'." - (file-system-fold (const #t) ;enter? - (lambda (file stat result) ;leaf - (define short - (string-drop file (string-length item))) - - (match (stat:type stat) - ('regular - (let ((size (stat:size stat)) - (type (if (zero? (logand (stat:mode stat) - #o100)) - 'regular - 'executable))) - (cons `(,short ,type - ,(call-with-input-file file - (cut port-sha256* <> size))) - result))) - ('symlink - (cons `(,short symlink ,(readlink file)) - result)))) - (lambda (directory stat result) result) ;down - (lambda (directory stat result) result) ;up - (lambda (file stat result) result) ;skip - (lambda (file stat errno result) result) ;error - '() - item - lstat)) + (let loop ((file item)) + (define stat + (lstat file)) + + (define short + (string-drop file (string-length item))) + + (match (stat:type stat) + ('regular + (let ((size (stat:size stat)) + (type (if (zero? (logand (stat:mode stat) + #o100)) + 'regular + 'executable))) + `((,short ,type + ,(call-with-input-file file + (cut port-sha256* <> size)))))) + ('symlink + `((,short symlink ,(readlink file)))) + ('directory + (append-map (match-lambda + ((or "." "..") + '()) + (entry + (loop (string-append file "/" entry)))) + ;; Traverse entries in canonical order, the same as the + ;; order of entries in nars. + (scandir file (const #t) string Date: Sat, 11 Dec 2021 23:22:47 +0100 Subject: substitutes: Build correct narinfo URLs for cache URLs without trailing slash. Fixes . Reported by Z572 <873216071@qq.com> and Peng Mei Yu . Previously, passing '--substitute-urls=https://mirror.sjtu.edu.cn/guix', without a trailing slash, would fail due to incorrectly constructed narinfo URLs. Users would have to explicitly add a trailing slash. * guix/substitutes.scm (narinfo-request): Ensure BASE has a trailing slash. --- guix/substitutes.scm | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) (limited to 'guix') diff --git a/guix/substitutes.scm b/guix/substitutes.scm index a5c554acff..9014cf61ec 100644 --- a/guix/substitutes.scm +++ b/guix/substitutes.scm @@ -156,7 +156,11 @@ indicates that PATH is unavailable at CACHE-URL." (define (narinfo-request cache-url path) "Return an HTTP request for the narinfo of PATH at CACHE-URL." - (let* ((base (string->uri cache-url)) + ;; Ensure BASE has a trailing slash so that REF is correct regardless of + ;; whether the user-provided CACHE-URL has a trailing slash. + (let* ((base (string->uri (if (string-suffix? "/" cache-url) + cache-url + (string-append cache-url "/")))) (ref (build-relative-ref #:path (string-append (store-path-hash-part path) ".narinfo"))) (url (resolve-uri-reference ref base)) -- cgit v1.2.3 From cba0395c99005f94e4ccd6c058362af7443dab12 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 11 Dec 2021 23:26:06 +0100 Subject: narinfo: Do not repeat slash when building nar URLs. * guix/narinfo.scm (narinfo-maker): When one of URLS is relative, do not repeat trailing slash if it's already present in CACHE-URL. --- guix/narinfo.scm | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'guix') diff --git a/guix/narinfo.scm b/guix/narinfo.scm index 72e0f75fda..4fc550aa6c 100644 --- a/guix/narinfo.scm +++ b/guix/narinfo.scm @@ -144,7 +144,9 @@ must contain the original contents of a narinfo file." (map (lambda (url) (or (string->uri url) (string->uri - (string-append cache-url "/" url)))) + (if (string-suffix? "/" cache-url) + (string-append cache-url url) + (string-append cache-url "/" url))))) urls) compressions (match file-sizes -- cgit v1.2.3 From 604880ae22e1a7662acb1d3f282242470de0cd03 Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Fri, 17 Sep 2021 11:15:56 +0100 Subject: progress: Rate limit drawing in the progress-reporter/bar. This helps smooth the output in cases where the bar is updated very quickly, for example in guix weather where it's computing derivations. * guix/progress.scm (progress-reporter/bar): Wrap the drawing code with the rate-limited procedure. --- guix/progress.scm | 26 ++++++++++++++++---------- 1 file changed, 16 insertions(+), 10 deletions(-) (limited to 'guix') diff --git a/guix/progress.scm b/guix/progress.scm index 0cbc804ec1..4f8e98edc0 100644 --- a/guix/progress.scm +++ b/guix/progress.scm @@ -270,19 +270,25 @@ ABBREVIATION used to shorten FILE for display." tasks is performed. Write PREFIX at the beginning of the line." (define done 0) + (define (draw-bar) + (let* ((ratio (* 100. (/ done total)))) + (erase-current-line port) + (if (string-null? prefix) + (display (progress-bar ratio (current-terminal-columns)) port) + (let ((width (- (current-terminal-columns) + (string-length prefix) 3))) + (display prefix port) + (display " " port) + (display (progress-bar ratio width) port))) + (force-output port))) + + (define draw-bar/rate-limited + (rate-limited draw-bar %progress-interval)) + (define (report-progress) (set! done (+ 1 done)) (unless (> done total) - (let* ((ratio (* 100. (/ done total)))) - (erase-current-line port) - (if (string-null? prefix) - (display (progress-bar ratio (current-terminal-columns)) port) - (let ((width (- (current-terminal-columns) - (string-length prefix) 3))) - (display prefix port) - (display " " port) - (display (progress-bar ratio width) port))) - (force-output port)))) + (draw-bar/rate-limited))) (progress-reporter (start (lambda () -- cgit v1.2.3