From c9405c461b1b37740bc0bb33c7043313978c0014 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 5 Nov 2017 12:49:57 +0100 Subject: compile: Fix VPATH builds. Fixes . Reported by Eric Bavier . * guix/build/compile.scm (relative-file): New procedure. (load-files): Use it before calling 'file-name->module-name'. (compile-files): Likewise before calling 'scm->go'. * guix/build/pull.scm (build-guix): Remove 'with-directory-excursion' and file name hack from ce33c3af76b0e5c68cc42dddf2b9c4b017386fd8. Pass OUT to 'all-scheme-files'. --- guix/build/compile.scm | 28 ++++++++++++++--------- guix/build/pull.scm | 61 +++++++++++++++++++++----------------------------- 2 files changed, 44 insertions(+), 45 deletions(-) (limited to 'guix/build') diff --git a/guix/build/compile.scm b/guix/build/compile.scm index ea0c36fa33..8b5a2faf84 100644 --- a/guix/build/compile.scm +++ b/guix/build/compile.scm @@ -77,6 +77,12 @@ (define (scm->go file) "Strip the \".scm\" suffix from FILE, and append \".go\"." (string-append (string-drop-right file 4) ".go")) +(define (relative-file directory file) + "Return FILE relative to DIRECTORY, if possible." + (if (string-prefix? (string-append directory "/") file) + (string-drop file (+ 1 (string-length directory))) + file)) + (define* (load-files directory files #:key (report-load (const #f)) @@ -93,13 +99,14 @@ (define total (report-load #f total completed)) *unspecified*) ((file files ...) - (report-load file total completed) - (format debug-port "~%loading '~a'...~%" file) + (let ((file (relative-file directory file))) + (report-load file total completed) + (format debug-port "~%loading '~a'...~%" file) - (parameterize ((current-warning-port debug-port)) - (resolve-interface (file-name->module-name file))) + (parameterize ((current-warning-port debug-port)) + (resolve-interface (file-name->module-name file))) - (loop files (+ 1 completed)))))) + (loop files (+ 1 completed))))))) (define-syntax-rule (with-augmented-search-path path item body ...) "Within the dynamic extent of BODY, augment PATH by adding ITEM to the @@ -135,11 +142,12 @@ (define (build file) (with-fluids ((*current-warning-prefix* "")) (with-target host (lambda () - (compile-file file - #:output-file (string-append build-directory "/" - (scm->go file)) - #:opts (append warning-options - (optimization-options file)))))) + (let ((relative (relative-file source-directory file))) + (compile-file file + #:output-file (string-append build-directory "/" + (scm->go relative)) + #:opts (append warning-options + (optimization-options relative))))))) (with-mutex progress-lock (set! completed (+ 1 completed)))) diff --git a/guix/build/pull.scm b/guix/build/pull.scm index 3573241a7e..a011e366f6 100644 --- a/guix/build/pull.scm +++ b/guix/build/pull.scm @@ -121,41 +121,32 @@ (define* (build-guix out source ;; Compile the .scm files. Hide warnings. (parameterize ((current-warning-port (%make-void-port "w"))) - (with-directory-excursion out - ;; Filter out files depending on Guile-SSH when Guile-SSH is missing. - (let ((files (filter has-all-its-dependencies? - (all-scheme-files ".")))) - (compile-files out out - - ;; XXX: 'compile-files' except ready-to-use relative - ;; file names. - (map (lambda (file) - (if (string-prefix? "./" file) - (string-drop file 2) - file)) - files) - - #:workers (parallel-job-count) - - ;; Disable warnings. - #:warning-options '() - - #:report-load - (lambda (file total completed) - (display #\cr log-port) - (format log-port - "loading...\t~5,1f% of ~d files" ;FIXME: i18n - (* 100. (/ completed total)) total) - (force-output log-port) - (format debug-port "~%loading '~a'...~%" file)) - - #:report-compilation - (lambda (file total completed) - (display #\cr log-port) - (format log-port "compiling...\t~5,1f% of ~d files" ;FIXME: i18n - (* 100. (/ completed total)) total) - (force-output log-port) - (format debug-port "~%compiling '~a'...~%" file))))))) + ;; Filter out files depending on Guile-SSH when Guile-SSH is missing. + (let ((files (filter has-all-its-dependencies? + (all-scheme-files out)))) + (compile-files out out files + + #:workers (parallel-job-count) + + ;; Disable warnings. + #:warning-options '() + + #:report-load + (lambda (file total completed) + (display #\cr log-port) + (format log-port + "loading...\t~5,1f% of ~d files" ;FIXME: i18n + (* 100. (/ completed total)) total) + (force-output log-port) + (format debug-port "~%loading '~a'...~%" file)) + + #:report-compilation + (lambda (file total completed) + (display #\cr log-port) + (format log-port "compiling...\t~5,1f% of ~d files" ;FIXME: i18n + (* 100. (/ completed total)) total) + (force-output log-port) + (format debug-port "~%compiling '~a'...~%" file)))))) (newline) #t) -- cgit v1.2.3 From 59da6f04f45b36696a9385babab3080d7d854fba Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 10 Nov 2017 23:07:49 +0100 Subject: download: Work around bogus HTTP handling in Guile 2.2 <= 2.2.2. Reported by Konrad Hinsen at . * guix/build/download.scm (write-request-line) [guile-2.2]: New procedure. --- guix/build/download.scm | 50 +++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 50 insertions(+) (limited to 'guix/build') diff --git a/guix/build/download.scm b/guix/build/download.scm index 61c9c6d3f1..790576b235 100644 --- a/guix/build/download.scm +++ b/guix/build/download.scm @@ -513,6 +513,56 @@ (define (parse-rfc-822-date str space zone-offset) (let ((declare-relative-uri-header! (variable-ref var))) (declare-relative-uri-header! "Location"))))) +;; XXX: Work around broken proxy handling on Guile 2.2 <= 2.2.2, fixed in +;; Guile commit 7d0d9e2c25c1e872cfc7d14ab5139915f1813d56. See bug report at +;; . +(cond-expand + (guile-2.2 + (when (<= (string->number (micro-version)) 2) + (let () + (define put-symbol (@@ (web http) put-symbol)) + (define put-non-negative-integer + (@@ (web http) put-non-negative-integer)) + (define write-http-version + (@@ (web http) write-http-version)) + + (define (write-request-line method uri version port) + "Write the first line of an HTTP request to PORT." + (put-symbol port method) + (put-char port #\space) + (when (http-proxy-port? port) + (let ((scheme (uri-scheme uri)) + (host (uri-host uri)) + (host-port (uri-port uri))) + (when (and scheme host) + (put-symbol port scheme) + (put-string port "://") + (cond + ((string-index host #\:) ;<---- The fix is here! + (put-char #\[ port) + (put-string port host + (put-char port #\]))) + (else + (put-string port host))) + (unless ((@@ (web uri) default-port?) scheme host-port) + (put-char port #\:) + (put-non-negative-integer port host-port))))) + (let ((path (uri-path uri)) + (query (uri-query uri))) + (if (string-null? path) + (put-string port "/") + (put-string port path)) + (when query + (put-string port "?") + (put-string port query))) + (put-char port #\space) + (write-http-version version port) + (put-string port "\r\n")) + + (module-set! (resolve-module '(web http)) 'write-request-line + write-request-line)))) + (else #t)) + (define (resolve-uri-reference ref base) "Resolve the URI reference REF, interpreted relative to the BASE URI, into a target URI, according to the algorithm specified in RFC 3986 section 5.2.2. -- cgit v1.2.3 From 65a19abf3fad2dee86cc3585124ca2f85cf115b7 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 11 Nov 2017 15:17:52 +0100 Subject: download: Work around more bogus HTTP handling in Guile 2.2 <= 2.2.2. Reported by Mark H Weaver at . * guix/build/download.scm (guile-2.2) [write-request-line]: Backport Guile commit 6ad28ae3bc6a6d9e95ab7d70510d12c97673a143. --- guix/build/download.scm | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) (limited to 'guix/build') diff --git a/guix/build/download.scm b/guix/build/download.scm index 790576b235..a65c7b9964 100644 --- a/guix/build/download.scm +++ b/guix/build/download.scm @@ -514,7 +514,8 @@ (define (parse-rfc-822-date str space zone-offset) (declare-relative-uri-header! "Location"))))) ;; XXX: Work around broken proxy handling on Guile 2.2 <= 2.2.2, fixed in -;; Guile commit 7d0d9e2c25c1e872cfc7d14ab5139915f1813d56. See bug report at +;; Guile commits 7d0d9e2c25c1e872cfc7d14ab5139915f1813d56 and +;; 6ad28ae3bc6a6d9e95ab7d70510d12c97673a143. See bug report at ;; . (cond-expand (guile-2.2 @@ -539,9 +540,9 @@ (define (write-request-line method uri version port) (put-string port "://") (cond ((string-index host #\:) ;<---- The fix is here! - (put-char #\[ port) - (put-string port host - (put-char port #\]))) + (put-char port #\[) ;<---- And here! + (put-string port host) + (put-char port #\])) (else (put-string port host))) (unless ((@@ (web uri) default-port?) scheme host-port) -- cgit v1.2.3 From 412716eff2d898f28636f68cb8761862f416cac3 Mon Sep 17 00:00:00 2001 From: Leo Famulari Date: Tue, 14 Nov 2017 16:29:13 -0500 Subject: grafts: Clarify the status of the workaround for . * guix/build/graft.scm (mkdir-p*): Annotate. --- guix/build/graft.scm | 1 + 1 file changed, 1 insertion(+) (limited to 'guix/build') diff --git a/guix/build/graft.scm b/guix/build/graft.scm index 3dce486adf..e567bff4f4 100644 --- a/guix/build/graft.scm +++ b/guix/build/graft.scm @@ -214,6 +214,7 @@ (define (exit-on-exception proc) (print-exception port #f key args) (primitive-exit 1)))))) +;; We need this as long as we support Guile < 2.0.13. (define* (mkdir-p* dir #:optional (mode #o755)) "This is a variant of 'mkdir-p' that works around by passing MODE explicitly in each 'mkdir' call." -- cgit v1.2.3 From 9f8605958ef86a0054a04297917ca32ed58d9d56 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 14 Nov 2017 09:51:50 +0100 Subject: download: Pass the timeout to 'ftp-retr'. This ensures the timeout applies when connecting to the port returned by PASV. * guix/ftp-client.scm (ftp-list): Add #:timeout parameter. Use 'connect*' instead of 'connect' and pass TIMEOUT. (ftp-retr): Likewise. * guix/build/download.scm (ftp-fetch): Pass TIMEOUT to 'ftp-retr'. --- guix/build/download.scm | 3 ++- guix/ftp-client.scm | 11 ++++++----- 2 files changed, 8 insertions(+), 6 deletions(-) (limited to 'guix/build') diff --git a/guix/build/download.scm b/guix/build/download.scm index a65c7b9964..90de269f9b 100644 --- a/guix/build/download.scm +++ b/guix/build/download.scm @@ -130,7 +130,8 @@ (define* (ftp-fetch uri file #:key timeout) (_ (ftp-open (uri-host uri) #:timeout timeout)))) (size (false-if-exception (ftp-size conn (uri-path uri)))) (in (ftp-retr conn (basename (uri-path uri)) - (dirname (uri-path uri))))) + (dirname (uri-path uri)) + #:timeout timeout))) (call-with-output-file file (lambda (out) (dump-port* in out diff --git a/guix/ftp-client.scm b/guix/ftp-client.scm index 054a00ad7f..0b8f61c276 100644 --- a/guix/ftp-client.scm +++ b/guix/ftp-client.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2010, 2011, 2012, 2013, 2014, 2015, 2016 Ludovic Courtès +;;; Copyright © 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -228,7 +228,7 @@ (define (address-with-port sa port) (sockaddr:scopeid sa))) (else #f)))) -(define* (ftp-list conn #:optional directory) +(define* (ftp-list conn #:optional directory #:key timeout) (if directory (ftp-chdir conn directory)) @@ -236,7 +236,7 @@ (define* (ftp-list conn #:optional directory) (ai (ftp-connection-addrinfo conn)) (s (socket (addrinfo:fam ai) (addrinfo:socktype ai) (addrinfo:protocol ai)))) - (connect s (address-with-port (addrinfo:addr ai) port)) + (connect* s (address-with-port (addrinfo:addr ai) port) timeout) (setvbuf s _IOLBF) (dynamic-wind @@ -270,7 +270,8 @@ (define* (ftp-list conn #:optional directory) (or (eqv? code 226) (throw 'ftp-error conn "LIST" code message))))))) -(define* (ftp-retr conn file #:optional directory) +(define* (ftp-retr conn file #:optional directory + #:key timeout) "Retrieve FILE from DIRECTORY (or, if omitted, the current directory) from FTP connection CONN. Return a binary port to that file. The returned port must be closed before CONN can be used for other purposes." @@ -291,7 +292,7 @@ (define (terminate) (or (eqv? code 226) (throw 'ftp-error conn "LIST" code message)))) - (connect s (address-with-port (addrinfo:addr ai) port)) + (connect* s (address-with-port (addrinfo:addr ai) port) timeout) (setvbuf s _IOLBF) (%ftp-command (string-append "RETR " file) -- cgit v1.2.3 From 866f37fb7e4f3e0bd695a951071383cdff3da8cd Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 15 Nov 2017 09:59:29 +0100 Subject: download: Improve efficiency of 'write-request' over TLS. This is another instance of . The Microsoft-IIS/7.5 server at static.nvd.nist.gov would sometimes hang when receiving our requests byte by byte. * guix/build/download.scm (tls-wrap) [!guile-2.0]: Add 'setvbuf' call. --- guix/build/download.scm | 7 +++++++ 1 file changed, 7 insertions(+) (limited to 'guix/build') diff --git a/guix/build/download.scm b/guix/build/download.scm index 90de269f9b..4490d225e6 100644 --- a/guix/build/download.scm +++ b/guix/build/download.scm @@ -306,6 +306,13 @@ (define (log level str) ;; never be closed. So we use `fileno', but keep a weak reference to ;; PORT, so the file descriptor gets closed when RECORD is GC'd. (register-tls-record-port record port) + + ;; Write HTTP requests line by line rather than byte by byte: + ;; . This is not possible on Guile 2.0. + (cond-expand + (guile-2.0 #f) + (else (setvbuf record 'line))) + record))) (define (ensure-uri uri-or-string) ;XXX: copied from (web http) -- cgit v1.2.3 From d8e257113c48b3b748de43458295331f120d04c3 Mon Sep 17 00:00:00 2001 From: Leo Famulari Date: Tue, 14 Nov 2017 11:46:22 -0500 Subject: build-system/go: Don't let Go executables refer to the Go compiler. * guix/build/go-build-system.scm (remove-store-reference, remove-go-references): New procedures. (%standard-phases): Add 'remove-go-references' phase. * guix/build-system/go.scm (go-build): Add allow-go-reference? key. --- guix/build-system/go.scm | 2 ++ guix/build/go-build-system.scm | 60 ++++++++++++++++++++++++++++++++++++++++-- 2 files changed, 60 insertions(+), 2 deletions(-) (limited to 'guix/build') diff --git a/guix/build-system/go.scm b/guix/build-system/go.scm index ec447d2a28..cf91163275 100644 --- a/guix/build-system/go.scm +++ b/guix/build-system/go.scm @@ -82,6 +82,7 @@ (define* (go-build store name inputs (import-path "") (unpack-path "") (tests? #t) + (allow-go-reference? #f) (system (%current-system)) (guile #f) (imported-modules %go-build-system-modules) @@ -107,6 +108,7 @@ (define builder #:import-path ,import-path #:unpack-path ,unpack-path #:tests? ,tests? + #:allow-go-reference? ,allow-go-reference? #:inputs %build-inputs))) (define guile-for-build diff --git a/guix/build/go-build-system.scm b/guix/build/go-build-system.scm index d175f3b76a..eaad9d8751 100644 --- a/guix/build/go-build-system.scm +++ b/guix/build/go-build-system.scm @@ -22,6 +22,8 @@ (define-module (guix build go-build-system) #:use-module (guix build utils) #:use-module (ice-9 match) #:use-module (srfi srfi-1) + #:use-module (rnrs io ports) + #:use-module (rnrs bytevectors) #:export (%standard-phases go-build)) @@ -197,13 +199,66 @@ (define* (check #:key tests? import-path #:allow-other-keys) (define* (install #:key outputs #:allow-other-keys) "Install the compiled libraries. `go install` installs these files to -$GOPATH/pkg, so we have to copy them into the output direcotry manually. +$GOPATH/pkg, so we have to copy them into the output directory manually. Compiled executable files should have already been installed to the store based on $GOBIN in the build phase." (when (file-exists? "pkg") (copy-recursively "pkg" (string-append (assoc-ref outputs "out") "/pkg"))) #t) +(define* (remove-store-reference file file-name + #:optional (store (%store-directory))) + "Remove from FILE occurrences of FILE-NAME in STORE; return #t when FILE-NAME +is encountered in FILE, #f otherwise. This implementation reads FILE one byte at +a time, which is slow. Instead, we should use the Boyer-Moore string search +algorithm; there is an example in (guix build grafts)." + (define pattern + (string-take file-name + (+ 34 (string-length (%store-directory))))) + + (with-fluids ((%default-port-encoding #f)) + (with-atomic-file-replacement file + (lambda (in out) + ;; We cannot use `regexp-exec' here because it cannot deal with + ;; strings containing NUL characters. + (format #t "removing references to `~a' from `~a'...~%" file-name file) + (setvbuf in 'block 65536) + (setvbuf out 'block 65536) + (fold-port-matches (lambda (match result) + (put-bytevector out (string->utf8 store)) + (put-u8 out (char->integer #\/)) + (put-bytevector out + (string->utf8 + "eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee-")) + #t) + #f + pattern + in + (lambda (char result) + (put-u8 out (char->integer char)) + result)))))) + +(define* (remove-go-references #:key allow-go-reference? + inputs outputs #:allow-other-keys) + "Remove any references to the Go compiler from the compiled Go executable +files in OUTPUTS." +;; We remove this spurious reference to save bandwidth when installing Go +;; executables. It would be better to not embed the reference in the first +;; place, but I'm not sure how to do that. The subject was discussed at: +;; + (if allow-go-reference? + #t + (let ((go (assoc-ref inputs "go")) + (bin "/bin")) + (for-each (lambda (output) + (when (file-exists? (string-append (cdr output) + bin)) + (for-each (lambda (file) + (remove-store-reference file go)) + (find-files (string-append (cdr output) bin))))) + outputs) + #t))) + (define %standard-phases (modify-phases gnu:%standard-phases (delete 'configure) @@ -213,7 +268,8 @@ (define %standard-phases (add-before 'build 'setup-environment setup-environment) (replace 'build build) (replace 'check check) - (replace 'install install))) + (replace 'install install) + (add-after 'install 'remove-go-references remove-go-references))) (define* (go-build #:key inputs (phases %standard-phases) #:allow-other-keys #:rest args) -- cgit v1.2.3 From 82af2c2f0f9eaaa1408c4e36d8a4273bf6f05ea1 Mon Sep 17 00:00:00 2001 From: Ricardo Wurmus Date: Sat, 18 Nov 2017 11:16:34 +0100 Subject: build-system: texlive: Only make a union of directories. * guix/build/texlive-build-system.scm (configure): Filter the input directories to ensure that source tarballs are excluded. --- guix/build/texlive-build-system.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'guix/build') diff --git a/guix/build/texlive-build-system.scm b/guix/build/texlive-build-system.scm index c0f262a5c0..f6b9b96b87 100644 --- a/guix/build/texlive-build-system.scm +++ b/guix/build/texlive-build-system.scm @@ -46,7 +46,7 @@ (define* (configure #:key inputs #:allow-other-keys) ;; Build a modifiable union of all inputs (but exclude bash) (match inputs (((names . directories) ...) - (union-build out directories + (union-build out (filter directory-exists? directories) #:create-all-directories? #t #:log-port (%make-void-port "w")))) -- cgit v1.2.3