From e8c6644af1cea3223ec72dc3c734f686d3ecba61 Mon Sep 17 00:00:00 2001 From: Efraim Flashner Date: Wed, 27 Nov 2019 22:37:33 +0200 Subject: lint: Check for more packages which should be native. * guix/lint.scm (check-inputs-should-be-native): Add yasm, nasm, fasm. --- guix/lint.scm | 1 + 1 file changed, 1 insertion(+) (limited to 'guix') diff --git a/guix/lint.scm b/guix/lint.scm index 03a8e88225..629604e0e9 100644 --- a/guix/lint.scm +++ b/guix/lint.scm @@ -292,6 +292,7 @@ of a package, and INPUT-NAMES, a list of package specifications such as "intltool" "itstool" "qttools" + "yasm" "nasm" "fasm" "python-coverage" "python2-coverage" "python-cython" "python2-cython" "python-docutils" "python2-docutils" -- cgit v1.2.3 From 9e3f9ac3c00906f5bc647ea8398e4ed5a370614e Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 28 Nov 2019 11:41:32 +0100 Subject: substitute: 'http-multiple-get' no longer drops requests above 1,000. Previously, in the unlikely case 'http-multiple-get' was passed more than 1,000 requests, it could have dropped all those above 1,000. * guix/scripts/substitute.scm (http-multiple-get): Define 'batch'. Use that for the 'write-request' loop. Add 'processed' parameter to 'loop' and use that to compute the remaining requests and call 'connect' in the recursion base case. --- guix/scripts/substitute.scm | 26 ++++++++++++++++++-------- 1 file changed, 18 insertions(+), 8 deletions(-) (limited to 'guix') diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm index ba2fb291d8..421561a4ea 100755 --- a/guix/scripts/substitute.scm +++ b/guix/scripts/substitute.scm @@ -526,6 +526,9 @@ initial connection on which HTTP requests are sent." (let connect ((port port) (requests requests) (result seed)) + (define batch + (at-most 1000 requests)) + ;; (format (current-error-port) "connecting (~a requests left)..." ;; (length requests)) (let ((p (or port (guix:open-connection-for-uri @@ -536,7 +539,7 @@ initial connection on which HTTP requests are sent." (when (file-port? p) (setvbuf p 'block (expt 2 16))) - ;; Send REQUESTS, up to a certain number, in a row. + ;; Send BATCH in a row. ;; XXX: Do our own caching to work around inefficiencies when ;; communicating over TLS: . (let-values (((buffer get) (open-bytevector-output-port))) @@ -544,16 +547,21 @@ initial connection on which HTTP requests are sent." (set-http-proxy-port?! buffer (http-proxy-port? p)) (for-each (cut write-request <> buffer) - (at-most 1000 requests)) + batch) (put-bytevector p (get)) (force-output p)) ;; Now start processing responses. - (let loop ((requests requests) - (result result)) - (match requests + (let loop ((sent batch) + (processed 0) + (result result)) + (match sent (() - (reverse result)) + (match (drop requests processed) + (() + (reverse result)) + (remainder + (connect port remainder result)))) ((head tail ...) (let* ((resp (read-response p)) (body (response-body-port resp)) @@ -564,9 +572,11 @@ initial connection on which HTTP requests are sent." (match (assq 'connection (response-headers resp)) (('connection 'close) (close-connection p) - (connect #f tail result)) ;try again + (connect #f ;try again + (append tail (drop requests processed)) + result)) (_ - (loop tail result)))))))))) ;keep going + (loop tail (+ 1 processed) result)))))))))) ;keep going (define (read-to-eof port) "Read from PORT until EOF is reached. The data are discarded." -- cgit v1.2.3 From fa983b825748bedb795a8105fad53c8548ca57d3 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 28 Nov 2019 13:08:49 +0100 Subject: ui: Add 'file-hyperlink'. * guix/ui.scm (file-hyperlink): New procedure. (location->hyperlink): Use it. --- guix/ui.scm | 13 +++++++++---- 1 file changed, 9 insertions(+), 4 deletions(-) (limited to 'guix') diff --git a/guix/ui.scm b/guix/ui.scm index 12611cb2bc..afa6d94829 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -111,6 +111,7 @@ package-specification->name+version+output supports-hyperlinks? + file-hyperlink location->hyperlink relevance @@ -1255,6 +1256,13 @@ documented at (and (isatty?* port) (not (getenv "INSIDE_EMACS")))) +(define* (file-hyperlink file #:optional (text file)) + "Return TEXT with escapes for a hyperlink to FILE." + (hyperlink (string-append "file://" (gethostname) + (encode-and-join-uri-path + (string-split file #\/))) + text)) + (define (location->hyperlink location) "Return a string corresponding to LOCATION, with escapes for a hyperlink." (let ((str (location->string location)) @@ -1262,10 +1270,7 @@ documented at (location-file location) (search-path %load-path (location-file location))))) (if file - (hyperlink (string-append "file://" (gethostname) - (encode-and-join-uri-path - (string-split file #\/))) - str) + (file-hyperlink file str) str))) (define* (package->recutils p port #:optional (width (%text-width)) -- cgit v1.2.3 From 055f052574c440aab5c9235c8277c5348c969c24 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 28 Nov 2019 13:12:39 +0100 Subject: ui: 'display-generation' emits a hyperlink for the generation. * guix/ui.scm (supports-hyperlinks?): Make 'port' optional. (display-generation): Use 'file-hyperlink' for the heading when 'supports-hyperlinks?' returns true. --- guix/ui.scm | 29 +++++++++++++++++------------ 1 file changed, 17 insertions(+), 12 deletions(-) (limited to 'guix') diff --git a/guix/ui.scm b/guix/ui.scm index afa6d94829..e31db33d3b 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -1247,7 +1247,7 @@ documented at (string-append "\x1b]8;;" uri "\x1b\\" text "\x1b]8;;\x1b\\")) -(define (supports-hyperlinks? port) +(define* (supports-hyperlinks? #:optional (port (current-output-port))) "Return true if PORT is a terminal that supports hyperlink escapes." ;; Note that terminals are supposed to ignore OSC escapes they don't ;; understand (this is the case of xterm as of version 349, for instance.) @@ -1613,17 +1613,22 @@ DURATION-RELATION with the current time." (define (display-generation profile number) "Display a one-line summary of generation NUMBER of PROFILE." (unless (zero? number) - (let ((header (format #f (highlight (G_ "Generation ~a\t~a")) number - (date->string - (time-utc->date - (generation-time profile number)) - ;; TRANSLATORS: This is a format-string for date->string. - ;; Please choose a format that corresponds to the - ;; usual way of presenting dates in your locale. - ;; See https://www.gnu.org/software/guile/manual/html_node/SRFI_002d19-Date-to-string.html - ;; for details. - (G_ "~b ~d ~Y ~T")))) - (current (generation-number profile))) + (let* ((file (generation-file-name profile number)) + (link (if (supports-hyperlinks?) + (cut file-hyperlink file <>) + identity)) + (header (format #f (link (highlight (G_ "Generation ~a\t~a"))) + number + (date->string + (time-utc->date + (generation-time profile number)) + ;; TRANSLATORS: This is a format-string for date->string. + ;; Please choose a format that corresponds to the + ;; usual way of presenting dates in your locale. + ;; See https://www.gnu.org/software/guile/manual/html_node/SRFI_002d19-Date-to-string.html + ;; for details. + (G_ "~b ~d ~Y ~T")))) + (current (generation-number profile))) (if (= number current) ;; TRANSLATORS: The word "current" here is an adjective for ;; "Generation", as in "current generation". Use the appropriate -- cgit v1.2.3