From 5dc876231bc990650a558aeaa1823b0da3b84ab8 Mon Sep 17 00:00:00 2001 From: David Thompson Date: Mon, 7 Sep 2015 22:58:05 -0400 Subject: build: ruby: Add support for tarball and directory sources. Previously, the Ruby build system only knew how to work with gem archives, which made it difficult to build unreleased gems from a Git repository or released gems in tarball form. * gnu/build/ruby-build-system.scm (gnu:unpack, gem-archive?): New procedures. (unpack): Use GNU build system unpack phase for non-gem sources. (build): Rebuild the gemspec iff the source is a gem archive. * guix.texi ("ruby-build-system"): Mention that tarballs and directories are acceptable. --- guix/build/ruby-build-system.scm | 86 ++++++++++++++++++++++------------------ 1 file changed, 48 insertions(+), 38 deletions(-) (limited to 'guix/build') diff --git a/guix/build/ruby-build-system.scm b/guix/build/ruby-build-system.scm index 4184ccc9ac..2685da1a72 100644 --- a/guix/build/ruby-build-system.scm +++ b/guix/build/ruby-build-system.scm @@ -41,53 +41,63 @@ (define (first-matching-file pattern) ((file-name . _) file-name) (() (error "No files matching pattern: " pattern)))) +(define gnu:unpack (assq-ref gnu:%standard-phases 'unpack)) + +(define (gem-archive? file-name) + (string-match "^.*\\.gem$" file-name)) + (define* (unpack #:key source #:allow-other-keys) "Unpack the gem SOURCE and enter the resulting directory." - (and (zero? (system* "gem" "unpack" source)) - ;; The unpacked gem directory is named the same as the archive, sans - ;; the ".gem" extension. It is renamed to simply "gem" in an effort to - ;; keep file names shorter to avoid UNIX-domain socket file names and - ;; shebangs that exceed the system's fixed maximum length when running - ;; test suites. - (let ((dir (match:substring (string-match "^(.*)\\.gem$" - (basename source)) - 1))) - (rename-file dir "gem") - (chdir "gem") - #t))) + (if (gem-archive? source) + (and (zero? (system* "gem" "unpack" source)) + ;; The unpacked gem directory is named the same as the archive, + ;; sans the ".gem" extension. It is renamed to simply "gem" in an + ;; effort to keep file names shorter to avoid UNIX-domain socket + ;; file names and shebangs that exceed the system's fixed maximum + ;; length when running test suites. + (let ((dir (match:substring (string-match "^(.*)\\.gem$" + (basename source)) + 1))) + (rename-file dir "gem") + (chdir "gem") + #t)) + ;; Use GNU unpack strategy for things that aren't gem archives. + (gnu:unpack #:source source))) (define* (build #:key source #:allow-other-keys) "Build a new gem using the gemspec from the SOURCE gem." + (define (first-gemspec) + (first-matching-file "\\.gemspec$")) ;; Remove the original gemspec, if present, and replace it with a new one. ;; This avoids issues with upstream gemspecs requiring tools such as git to ;; generate the files list. - (let ((gemspec (or (false-if-exception - (first-matching-file "\\.gemspec$")) - ;; Make new gemspec if one wasn't shipped. - ".gemspec"))) - - (when (file-exists? gemspec) (delete-file gemspec)) - - ;; Extract gemspec from source gem. - (let ((pipe (open-pipe* OPEN_READ "gem" "spec" "--ruby" source))) - (dynamic-wind - (const #t) - (lambda () - (call-with-output-file gemspec - (lambda (out) - ;; 'gem spec' writes to stdout, but 'gem build' only reads - ;; gemspecs from a file, so we redirect the output to a file. - (while (not (eof-object? (peek-char pipe))) - (write-char (read-char pipe) out)))) - #t) - (lambda () - (close-pipe pipe)))) - - ;; Build a new gem from the current working directory. This also allows any - ;; dynamic patching done in previous phases to be present in the installed - ;; gem. - (zero? (system* "gem" "build" gemspec)))) + (when (gem-archive? source) + (let ((gemspec (or (false-if-exception (first-gemspec)) + ;; Make new gemspec if one wasn't shipped. + ".gemspec"))) + + (when (file-exists? gemspec) (delete-file gemspec)) + + ;; Extract gemspec from source gem. + (let ((pipe (open-pipe* OPEN_READ "gem" "spec" "--ruby" source))) + (dynamic-wind + (const #t) + (lambda () + (call-with-output-file gemspec + (lambda (out) + ;; 'gem spec' writes to stdout, but 'gem build' only reads + ;; gemspecs from a file, so we redirect the output to a file. + (while (not (eof-object? (peek-char pipe))) + (write-char (read-char pipe) out)))) + #t) + (lambda () + (close-pipe pipe)))))) + + ;; Build a new gem from the current working directory. This also allows any + ;; dynamic patching done in previous phases to be present in the installed + ;; gem. + (zero? (system* "gem" "build" (first-gemspec)))) (define* (check #:key tests? test-target #:allow-other-keys) "Run the gem's test suite rake task TEST-TARGET. Skip the tests if TESTS? -- cgit v1.2.3 From eb95ace9f191a7291e6daf9c4af8759237408696 Mon Sep 17 00:00:00 2001 From: Steve Sprang Date: Wed, 9 Sep 2015 13:59:52 -0700 Subject: download: Avoid type errors when formatting download progress output. * guix/build/download.scm (nearest-exact-integer): New procedure. (seconds->string, byte-count->string): Use it. --- guix/build/download.scm | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) (limited to 'guix/build') diff --git a/guix/build/download.scm b/guix/build/download.scm index 6e85174bc9..31d60fbcda 100644 --- a/guix/build/download.scm +++ b/guix/build/download.scm @@ -49,6 +49,11 @@ (define %http-receive-buffer-size ;; Size of the HTTP receive buffer. 65536) +(define (nearest-exact-integer x) + "Given a real number X, return the nearest exact integer, with ties going to +the nearest exact even integer." + (inexact->exact (round x))) + (define (duration->seconds duration) "Return the number of seconds represented by DURATION, a 'time-duration' object, as an inexact number." @@ -60,7 +65,7 @@ (define (seconds->string duration) format." (if (not (number? duration)) "00:00:00" - (let* ((total-seconds (inexact->exact (round duration))) + (let* ((total-seconds (nearest-exact-integer duration)) (extra-seconds (modulo total-seconds 3600)) (hours (quotient total-seconds 3600)) (mins (quotient extra-seconds 60)) @@ -75,8 +80,8 @@ (define (byte-count->string size) (GiB (expt 1024. 3)) (TiB (expt 1024. 4))) (cond - ((< size KiB) (format #f "~dB" (inexact->exact size))) - ((< size MiB) (format #f "~dKiB" (inexact->exact (round (/ size KiB))))) + ((< size KiB) (format #f "~dB" (nearest-exact-integer size))) + ((< size MiB) (format #f "~dKiB" (nearest-exact-integer (/ size KiB)))) ((< size GiB) (format #f "~,1fMiB" (/ size MiB))) ((< size TiB) (format #f "~,2fGiB" (/ size GiB))) (else (format #f "~,3fTiB" (/ size TiB)))))) -- cgit v1.2.3 From a8be7b9a7a73abdd9bf91a989dc10865800a0270 Mon Sep 17 00:00:00 2001 From: Steve Sprang Date: Mon, 14 Sep 2015 22:31:11 -0700 Subject: substitute: Improve readability of download progress report. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * guix/build/download.scm (string-pad-middle, store-url-abbreviation, store-path-abbreviation): New procedures. (progress-proc): Add #:abbreviation parameter and use it. Generate a better indeterminate progress string. * guix/scripts/substitute.scm (assert-valid-narinfo): Add newlines to output. (process-substitution): Use byte-count->string and store-path-abbreviation. Co-authored-by: Ludovic Courtès --- guix/build/download.scm | 61 ++++++++++++++++++++++++++++++++------------- guix/scripts/substitute.scm | 17 +++++++------ 2 files changed, 53 insertions(+), 25 deletions(-) (limited to 'guix/build') diff --git a/guix/build/download.scm b/guix/build/download.scm index 31d60fbcda..9b72e8f795 100644 --- a/guix/build/download.scm +++ b/guix/build/download.scm @@ -36,8 +36,10 @@ (define-module (guix build download) resolve-uri-reference maybe-expand-mirrors url-fetch + byte-count->string progress-proc - uri-abbreviation)) + uri-abbreviation + store-path-abbreviation)) ;;; Commentary: ;;; @@ -96,10 +98,33 @@ (define* (progress-bar % #:optional (bar-width 20)) (make-string filled #\#) (make-string empty #\space)))) -(define* (progress-proc file size #:optional (log-port (current-output-port))) +(define (string-pad-middle left right len) + "Combine LEFT and RIGHT with enough padding in the middle so that the +resulting string has length at least LEN. This right justifies RIGHT." + (string-append left + (string-pad right (max 0 (- len (string-length left)))))) + +(define (store-url-abbreviation url) + "Return a friendlier version of URL for display." + (let ((store-path (string-append (%store-directory) "/" (basename url)))) + ;; Take advantage of the implementation for store paths. + (store-path-abbreviation store-path))) + +(define* (store-path-abbreviation store-path #:optional (prefix-length 6)) + "Return an abbreviation of STORE-PATH for display, showing PREFIX-LENGTH +characters of the hash." + (let ((base (basename store-path))) + (string-append (string-take base prefix-length) + "…" + (string-drop base 32)))) + +(define* (progress-proc file size + #:optional (log-port (current-output-port)) + #:key (abbreviation identity)) "Return a procedure to show the progress of FILE's download, which is SIZE bytes long. The returned procedure is suitable for use as an argument to -`dump-port'. The progress report is written to LOG-PORT." +`dump-port'. The progress report is written to LOG-PORT, with ABBREVIATION +used to shorten FILE for display." ;; XXX: Because of this procedure is often not ;; called as frequently as we'd like too; this is especially bad with Nginx ;; on hydra.gnu.org, which returns whole nars as a single chunk. @@ -123,31 +148,31 @@ (define* (progress-proc file size #:optional (log-port (current-output-port))) (/ transferred elapsed) 0)) (left (format #f " ~a ~a" - (basename file) + (abbreviation file) (byte-count->string size))) (right (format #f "~a/s ~a ~a~6,1f%" (byte-count->string throughput) (seconds->string elapsed) - (progress-bar %) %)) - ;; TODO: Make this adapt to the actual terminal width. - (cols 80) - (num-spaces (max 1 (- cols (+ (string-length left) - (string-length right))))) - (gap (make-string num-spaces #\space))) - (format log-port "~a~a~a" left gap right) + (progress-bar %) %))) + ;; TODO: Make this adapt to the actual terminal width. + (display (string-pad-middle left right 80) log-port) (display #\cr log-port) (flush-output-port log-port) (cont)))) (lambda (transferred cont) (with-elapsed-time elapsed - (let ((throughput (if elapsed - (/ transferred elapsed) - 0))) + (let* ((throughput (if elapsed + (/ transferred elapsed) + 0)) + (left (format #f " ~a" + (abbreviation file))) + (right (format #f "~a/s ~a | ~a transferred" + (byte-count->string throughput) + (seconds->string elapsed) + (byte-count->string transferred)))) + ;; TODO: Make this adapt to the actual terminal width. + (display (string-pad-middle left right 80) log-port) (display #\cr log-port) - (format log-port "~a\t~a transferred (~a/s)" - file - (byte-count->string transferred) - (byte-count->string throughput)) (flush-output-port log-port) (cont)))))))) diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm index e908bc997e..ec8e6244af 100755 --- a/guix/scripts/substitute.scm +++ b/guix/scripts/substitute.scm @@ -31,7 +31,8 @@ (define-module (guix scripts substitute) #:use-module (guix pki) #:use-module ((guix build utils) #:select (mkdir-p dump-port)) #:use-module ((guix build download) - #:select (progress-proc uri-abbreviation)) + #:select (progress-proc uri-abbreviation + store-path-abbreviation byte-count->string)) #:use-module (ice-9 rdelim) #:use-module (ice-9 regex) #:use-module (ice-9 match) @@ -337,8 +338,9 @@ (define* (assert-valid-narinfo narinfo (unless %allow-unauthenticated-substitutes? (assert-valid-signature narinfo signature hash acl) (when verbose? + ;; Visually separate substitutions with a newline. (format (current-error-port) - "found valid signature for '~a', from '~a'~%" + "~%Found valid signature for ~a~%From ~a~%" (narinfo-path narinfo) (uri->string (narinfo-uri narinfo))))) narinfo)))) @@ -753,13 +755,12 @@ (define* (process-substitution store-item destination ;; Tell the daemon what the expected hash of the Nar itself is. (format #t "~a~%" (narinfo-hash narinfo)) - (format (current-error-port) "downloading `~a'~:[~*~; (~,1f MiB installed)~]...~%" - store-item - + (format (current-error-port) "Downloading ~a~:[~*~; (~a installed)~]...~%" + (store-path-abbreviation store-item) ;; Use the Nar size as an estimate of the installed size. (narinfo-size narinfo) (and=> (narinfo-size narinfo) - (cute / <> (expt 2. 20)))) + (cute byte-count->string <>))) (let*-values (((raw download-size) ;; Note that Hydra currently generates Nars on the fly ;; and doesn't specify a Content-Length, so @@ -772,7 +773,9 @@ (define* (process-substitution store-item destination (narinfo-size narinfo)))) (progress (progress-proc (uri-abbreviation uri) dl-size - (current-error-port)))) + (current-error-port) + #:abbreviation + store-path-abbreviation))) (progress-report-port progress raw))) ((input pids) (decompressed-port (and=> (narinfo-compression narinfo) -- cgit v1.2.3 From 47770296d2343a8f3bcd3082d09fbfbcef0857ae Mon Sep 17 00:00:00 2001 From: Steve Sprang Date: Wed, 16 Sep 2015 20:43:58 -0700 Subject: download: Only show hours in the elapsed time if necessary. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * guix/build/download.scm (seconds->string): Conditionally include hours in timestamp. Signed-off-by: Ludovic Courtès --- guix/build/download.scm | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) (limited to 'guix/build') diff --git a/guix/build/download.scm b/guix/build/download.scm index 9b72e8f795..d362fc1f26 100644 --- a/guix/build/download.scm +++ b/guix/build/download.scm @@ -63,16 +63,17 @@ (define (duration->seconds duration) (/ (time-nanosecond duration) 1e9))) (define (seconds->string duration) - "Given DURATION in seconds, return a string representing it in 'hh:mm:ss' -format." + "Given DURATION in seconds, return a string representing it in 'mm:ss' or +'hh:mm:ss' format, as needed." (if (not (number? duration)) - "00:00:00" + "00:00" (let* ((total-seconds (nearest-exact-integer duration)) (extra-seconds (modulo total-seconds 3600)) - (hours (quotient total-seconds 3600)) + (num-hours (quotient total-seconds 3600)) + (hours (and (positive? num-hours) num-hours)) (mins (quotient extra-seconds 60)) (secs (modulo extra-seconds 60))) - (format #f "~2,'0d:~2,'0d:~2,'0d" hours mins secs)))) + (format #f "~@[~2,'0d:~]~2,'0d:~2,'0d" hours mins secs)))) (define (byte-count->string size) "Given SIZE in bytes, return a string representing it in a human-readable -- cgit v1.2.3