diff options
Diffstat (limited to 'guix')
| -rw-r--r-- | guix/http-client.scm | 27 | ||||
| -rw-r--r-- | guix/scripts/lint.scm | 24 | ||||
| -rw-r--r-- | guix/scripts/offload.scm | 12 | ||||
| -rw-r--r-- | guix/ui.scm | 1 | ||||
| -rw-r--r-- | guix/utils.scm | 21 |
5 files changed, 55 insertions, 30 deletions
diff --git a/guix/http-client.scm b/guix/http-client.scm index 5cfe05f2e0..9861ec80cb 100644 --- a/guix/http-client.scm +++ b/guix/http-client.scm @@ -25,6 +25,7 @@ #:use-module (srfi srfi-11) #:use-module (srfi srfi-34) #:use-module (srfi srfi-35) + #:use-module (ice-9 match) #:use-module (rnrs io ports) #:use-module (rnrs bytevectors) #:use-module (guix ui) @@ -66,7 +67,8 @@ (when-guile<=2.0.5-or-otherwise-broken ;; Backport of Guile commits 312e79f8 ("Add HTTP Chunked Encoding support to - ;; web modules.") and 00d3ecf2 ("http: Do not buffer HTTP chunks.") + ;; web modules."), 00d3ecf2 ("http: Do not buffer HTTP chunks."), and 53b8d5f + ;; ("web: Gracefully handle premature EOF when reading chunk header.") (use-modules (ice-9 rdelim)) @@ -75,14 +77,21 @@ ;; Chunked Responses (define (read-chunk-header port) - (let* ((str (read-line port)) - (extension-start (string-index str (lambda (c) (or (char=? c #\;) - (char=? c #\return))))) - (size (string->number (if extension-start ; unnecessary? - (substring str 0 extension-start) - str) - 16))) - size)) + "Read a chunk header from PORT and return the size in bytes of the + upcoming chunk." + (match (read-line port) + ((? eof-object?) + ;; Connection closed prematurely: there's nothing left to read. + 0) + (str + (let ((extension-start (string-index str + (lambda (c) + (or (char=? c #\;) + (char=? c #\return)))))) + (string->number (if extension-start ; unnecessary? + (substring str 0 extension-start) + str) + 16))))) (define* (make-chunked-input-port port #:key (keep-alive? #f)) "Returns a new port which translates HTTP chunked transfer encoded diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm index 8224f540bb..0adb3bf179 100644 --- a/guix/scripts/lint.scm +++ b/guix/scripts/lint.scm @@ -129,7 +129,7 @@ monad." (exit 0)) (define (properly-starts-sentence? s) - (string-match "^[(\"'[:upper:][:digit:]]" s)) + (string-match "^[(\"'`[:upper:][:digit:]]" s)) (define (starts-with-abbreviation? s) "Return #t if S starts with what looks like an abbreviation or acronym." @@ -143,12 +143,14 @@ monad." (_ "description should not be empty") 'description))) - (define (check-texinfo-markup package) - "Check that PACKAGE description can be parsed as a Texinfo fragment." - (catch 'parser-error - (lambda () (package-description-string package)) - (lambda (keys . args) - (emit-warning package (_ "Texinfo markup in description is invalid"))))) + (define (check-texinfo-markup description) + "Check that DESCRIPTION can be parsed as a Texinfo fragment. If the +markup is valid return a plain-text version of DESCRIPTION, otherwise #f." + (unless (false-if-exception (texi->plain-text description)) + (emit-warning package + (_ "Texinfo markup in description is invalid") + 'description) + #f)) (define (check-proper-start description) (unless (or (properly-starts-sentence? description) @@ -179,9 +181,11 @@ by two spaces; possible infraction~p at ~{~a~^, ~}") (let ((description (package-description package))) (when (string? description) (check-not-empty description) - (check-texinfo-markup package) - (check-proper-start description) - (check-end-of-sentence-space description)))) + ;; Use raw description for this because Texinfo rendering automatically + ;; fixes end of sentence space. + (check-end-of-sentence-space description) + (and=> (check-texinfo-markup description) + check-proper-start)))) (define (check-inputs-should-be-native package) ;; Emit a warning if some inputs of PACKAGE are likely to belong to its diff --git a/guix/scripts/offload.scm b/guix/scripts/offload.scm index c0df03b98f..d594be18e5 100644 --- a/guix/scripts/offload.scm +++ b/guix/scripts/offload.scm @@ -474,14 +474,19 @@ success, #f otherwise." ;; Compute the subset of FILES missing on MACHINE, and send them in ;; topologically sorted order so that they can actually be imported. + ;; + ;; To reduce load on the machine that's offloading (since it's typically + ;; already quite busy, see hydra.gnu.org), compress with gzip rather + ;; than xz: For a compression ratio 2 times larger, it is 20 times + ;; faster. (let* ((files (missing-files (topologically-sorted store files))) (pipe (remote-pipe machine OPEN_WRITE - '("xz" "-dc" "|" + '("gzip" "-dc" "|" "guix" "archive" "--import") #:quote? #f))) (format #t (_ "sending ~a store files to '~a'...~%") (length files) (build-machine-name machine)) - (call-with-compressed-output-port 'xz pipe + (call-with-compressed-output-port 'gzip pipe (lambda (compressed) (catch 'system-error (lambda () @@ -489,7 +494,8 @@ success, #f otherwise." (lambda args (warning (_ "failed while exporting files to '~a': ~a~%") (build-machine-name machine) - (strerror (system-error-errno args))))))) + (strerror (system-error-errno args)))))) + #:options '("--fast")) ;; Wait for the 'lsh' process to complete. (zero? (close-pipe pipe)))))) diff --git a/guix/ui.scm b/guix/ui.scm index 67dd062a34..fb8121c213 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -75,6 +75,7 @@ switch-symlinks config-directory fill-paragraph + texi->plain-text package-description-string string->recutils package->recutils diff --git a/guix/utils.scm b/guix/utils.scm index 4bfd88fbb3..b6df5d9cc9 100644 --- a/guix/utils.scm +++ b/guix/utils.scm @@ -284,22 +284,27 @@ data is lost." (close-port in) (values out (list child))))))) -(define (compressed-output-port compression output) +(define* (compressed-output-port compression output + #:key (options '())) "Return an output port whose input is compressed according to COMPRESSION, a symbol such as 'xz, and then written to OUTPUT. In addition return a list -of PIDs to wait for." +of PIDs to wait for. OPTIONS is a list of strings passed to the compression +program--e.g., '(\"--fast\")." (match compression ((or #f 'none) (values output '())) - ('bzip2 (filtered-output-port `(,%bzip2 "-c") output)) - ('xz (filtered-output-port `(,%xz "-c") output)) - ('gzip (filtered-output-port `(,%gzip "-c") output)) + ('bzip2 (filtered-output-port `(,%bzip2 "-c" ,@options) output)) + ('xz (filtered-output-port `(,%xz "-c" ,@options) output)) + ('gzip (filtered-output-port `(,%gzip "-c" ,@options) output)) (else (error "unsupported compression scheme" compression)))) -(define (call-with-compressed-output-port compression port proc) +(define* (call-with-compressed-output-port compression port proc + #:key (options '())) "Call PROC with a wrapper around PORT, a file port, that compresses data -that goes to PORT according to COMPRESSION, a symbol such as 'xz." +that goes to PORT according to COMPRESSION, a symbol such as 'xz. OPTIONS is +a list of command-line arguments passed to the compression program." (let-values (((compressed pids) - (compressed-output-port compression port))) + (compressed-output-port compression port + #:options options))) (dynamic-wind (const #f) (lambda () |