From b5f05283548d1329672d23bf0cd9a9d31b9b364c Mon Sep 17 00:00:00 2001 From: Maxim Cournoyer Date: Thu, 4 Apr 2019 23:24:57 -0400 Subject: build: go-build-system: Re-ident. * guix/build/go-build-system.scm (unpack): Fix indentation. --- guix/build/go-build-system.scm | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) (limited to 'guix/build') diff --git a/guix/build/go-build-system.scm b/guix/build/go-build-system.scm index 282df19f24..973ee6e251 100644 --- a/guix/build/go-build-system.scm +++ b/guix/build/go-build-system.scm @@ -161,12 +161,12 @@ (define* (unpack #:key source import-path unpack-path #:allow-other-keys) (let ((dest (string-append (getenv "GOPATH") "/src/" unpack-path))) (mkdir-p dest) (if (file-is-directory? source) - (begin - (copy-recursively source dest #:keep-mtime? #t) - #t) - (if (string-suffix? ".zip" source) - (invoke "unzip" "-d" dest source) - (invoke "tar" "-C" dest "-xvf" source))))) + (begin + (copy-recursively source dest #:keep-mtime? #t) + #t) + (if (string-suffix? ".zip" source) + (invoke "unzip" "-d" dest source) + (invoke "tar" "-C" dest "-xvf" source))))) (define (go-package? name) (string-prefix? "go-" name)) -- cgit v1.2.3 From 7e84d3eef724ef18f8e1c1b0932b6f74d3ae3e35 Mon Sep 17 00:00:00 2001 From: Maxim Cournoyer Date: Thu, 4 Apr 2019 23:26:04 -0400 Subject: build: go-build-system: Use WHEN for side-effect conditionals. * guix/build/go-build-system.scm (unpack): Replace single branch `if' by `when'. --- guix/build/go-build-system.scm | 4 ++++ 1 file changed, 4 insertions(+) (limited to 'guix/build') diff --git a/guix/build/go-build-system.scm b/guix/build/go-build-system.scm index 973ee6e251..92a5c86d6c 100644 --- a/guix/build/go-build-system.scm +++ b/guix/build/go-build-system.scm @@ -158,6 +158,10 @@ (define* (unpack #:key source import-path unpack-path #:allow-other-keys) ((display "WARNING: The Go import path is unset.\n"))) (if (string-null? unpack-path) (set! unpack-path import-path)) + (when (string-null? import-path) + ((display "WARNING: The Go import path is unset.\n"))) + (when (string-null? unpack-path) + (set! unpack-path import-path)) (let ((dest (string-append (getenv "GOPATH") "/src/" unpack-path))) (mkdir-p dest) (if (file-is-directory? source) -- cgit v1.2.3 From f42e4ebb56fe4f16991ca6c6e060c8f3535865cb Mon Sep 17 00:00:00 2001 From: Maxim Cournoyer Date: Fri, 5 Apr 2019 00:00:08 -0400 Subject: build: go-build-system: Ensure uniform unpacking directory. Depending on whether the source is a directory or an archive, we strip the source directory or preserve it, respectively. This change makes it so that whether the type of the source, it is unpacked at the expected location given by the IMPORT-PATH of the Go build system. * guix/build/go-build-system.scm: Add the (ice-9 ftw) module. (unpack): Add inner procedure to maybe strip the top level directory of an archive, document it and use it. --- guix/build/go-build-system.scm | 36 +++++++++++++++++++++++++++--------- 1 file changed, 27 insertions(+), 9 deletions(-) (limited to 'guix/build') diff --git a/guix/build/go-build-system.scm b/guix/build/go-build-system.scm index 92a5c86d6c..d106e70d35 100644 --- a/guix/build/go-build-system.scm +++ b/guix/build/go-build-system.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2016 Petter ;;; Copyright © 2017, 2019 Leo Famulari +;;; Copyright © 2019 Maxim Cournoyer ;;; ;;; This file is part of GNU Guix. ;;; @@ -22,6 +23,7 @@ (define-module (guix build go-build-system) #:use-module (guix build union) #:use-module (guix build utils) #:use-module (ice-9 match) + #:use-module (ice-9 ftw) #:use-module (srfi srfi-1) #:use-module (rnrs io ports) #:use-module (rnrs bytevectors) @@ -151,13 +153,31 @@ (define* (setup-go-environment #:key inputs outputs #:allow-other-keys) #t) (define* (unpack #:key source import-path unpack-path #:allow-other-keys) - "Relative to $GOPATH, unpack SOURCE in the UNPACK-PATH, or the IMPORT-PATH is -the UNPACK-PATH is unset. When SOURCE is a directory, copy it instead of + "Relative to $GOPATH, unpack SOURCE in UNPACK-PATH, or IMPORT-PATH when +UNPACK-PATH is unset. If the SOURCE archive has a single top level directory, +it is stripped so that the sources appear directly under UNPACK-PATH. When +SOURCE is a directory, copy its content into UNPACK-PATH instead of unpacking." - (if (string-null? import-path) - ((display "WARNING: The Go import path is unset.\n"))) - (if (string-null? unpack-path) - (set! unpack-path import-path)) + (define (unpack-maybe-strip source dest) + (let* ((scratch-dir (string-append (or (getenv "TMPDIR") "/tmp") + "/scratch-dir")) + (out (mkdir-p scratch-dir))) + (with-directory-excursion scratch-dir + (if (string-suffix? ".zip" source) + (invoke "unzip" source) + (invoke "tar" "-xvf" source)) + (let ((top-level-files (remove (lambda (x) + (member x '("." ".."))) + (scandir ".")))) + (match top-level-files + ((top-level-file) + (when (file-is-directory? top-level-file) + (copy-recursively top-level-file dest #:keep-mtime? #t))) + (_ + (copy-recursively "." dest #:keep-mtime? #t))) + #t)) + (delete-file-recursively scratch-dir))) + (when (string-null? import-path) ((display "WARNING: The Go import path is unset.\n"))) (when (string-null? unpack-path) @@ -168,9 +188,7 @@ (define* (unpack #:key source import-path unpack-path #:allow-other-keys) (begin (copy-recursively source dest #:keep-mtime? #t) #t) - (if (string-suffix? ".zip" source) - (invoke "unzip" "-d" dest source) - (invoke "tar" "-C" dest "-xvf" source))))) + (unpack-maybe-strip source dest)))) (define (go-package? name) (string-prefix? "go-" name)) -- cgit v1.2.3 From 2edec51c5eabeef6d7d9e1cbae2b2be379aaa6b8 Mon Sep 17 00:00:00 2001 From: Maxim Cournoyer Date: Sun, 5 May 2019 22:41:11 -0400 Subject: build: go-build-system: Follow-up commit. There was an extraneous pair of parens in commit 7e84d3eef7. Thanks for Mark Weaver for reporting the issue. * guix/build/go-build-system.scm (unpack): Remove the extraneous pair of parentheses surrounding the `display' function call. --- guix/build/go-build-system.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'guix/build') diff --git a/guix/build/go-build-system.scm b/guix/build/go-build-system.scm index d106e70d35..22427a80b3 100644 --- a/guix/build/go-build-system.scm +++ b/guix/build/go-build-system.scm @@ -179,7 +179,7 @@ (define (unpack-maybe-strip source dest) (delete-file-recursively scratch-dir))) (when (string-null? import-path) - ((display "WARNING: The Go import path is unset.\n"))) + (display "WARNING: The Go import path is unset.\n")) (when (string-null? unpack-path) (set! unpack-path import-path)) (let ((dest (string-append (getenv "GOPATH") "/src/" unpack-path))) -- cgit v1.2.3 From a321312e3aec8f2884ab3f3cb35e2020195b5a08 Mon Sep 17 00:00:00 2001 From: Maxim Cournoyer Date: Sun, 5 May 2019 23:01:03 -0400 Subject: build: go-build-system: Follow-up to commit f42e4ebb56. This follows commit f42e4ebb56, which made it so that the unpack phase return value could be left unspecified. * guix/build/go-build-system.scm (unpack): Ensure that the value returned upon a successful completion of the phase is #t. --- guix/build/go-build-system.scm | 10 ++++------ 1 file changed, 4 insertions(+), 6 deletions(-) (limited to 'guix/build') diff --git a/guix/build/go-build-system.scm b/guix/build/go-build-system.scm index 22427a80b3..858068ba98 100644 --- a/guix/build/go-build-system.scm +++ b/guix/build/go-build-system.scm @@ -174,8 +174,7 @@ (define (unpack-maybe-strip source dest) (when (file-is-directory? top-level-file) (copy-recursively top-level-file dest #:keep-mtime? #t))) (_ - (copy-recursively "." dest #:keep-mtime? #t))) - #t)) + (copy-recursively "." dest #:keep-mtime? #t))))) (delete-file-recursively scratch-dir))) (when (string-null? import-path) @@ -185,10 +184,9 @@ (define (unpack-maybe-strip source dest) (let ((dest (string-append (getenv "GOPATH") "/src/" unpack-path))) (mkdir-p dest) (if (file-is-directory? source) - (begin - (copy-recursively source dest #:keep-mtime? #t) - #t) - (unpack-maybe-strip source dest)))) + (copy-recursively source dest #:keep-mtime? #t) + (unpack-maybe-strip source dest))) + #t) (define (go-package? name) (string-prefix? "go-" name)) -- cgit v1.2.3 From 4ac69ea10f54384ac893313ef738e5ad554ac328 Mon Sep 17 00:00:00 2001 From: Maxim Cournoyer Date: Tue, 20 Nov 2018 23:11:29 -0500 Subject: Add (guix bzr-download). * guix/bzr-download.scm, guix/build/bzr.scm, etc/snippets/scheme-mode/guix-bzr-reference: New files. * Makefile.am (MODULES): Add them. * etc/snippets/scheme-mode/guix-origin: Add "bzr-fetch" to the origin choices. --- Makefile.am | 2 + etc/snippets/scheme-mode/guix-bzr-reference | 7 +++ etc/snippets/scheme-mode/guix-origin | 6 +- guix/build/bzr.scm | 44 +++++++++++++++ guix/bzr-download.scm | 85 +++++++++++++++++++++++++++++ 5 files changed, 142 insertions(+), 2 deletions(-) create mode 100644 etc/snippets/scheme-mode/guix-bzr-reference create mode 100644 guix/build/bzr.scm create mode 100644 guix/bzr-download.scm (limited to 'guix/build') diff --git a/Makefile.am b/Makefile.am index 9539fef1b1..5cb062ead0 100644 --- a/Makefile.am +++ b/Makefile.am @@ -78,6 +78,7 @@ MODULES = \ guix/modules.scm \ guix/download.scm \ guix/discovery.scm \ + guix/bzr-download.scm \ guix/git-download.scm \ guix/hg-download.scm \ guix/swh.scm \ @@ -160,6 +161,7 @@ MODULES = \ guix/build/font-build-system.scm \ guix/build/go-build-system.scm \ guix/build/asdf-build-system.scm \ + guix/build/bzr.scm \ guix/build/git.scm \ guix/build/hg.scm \ guix/build/glib-or-gtk-build-system.scm \ diff --git a/etc/snippets/scheme-mode/guix-bzr-reference b/etc/snippets/scheme-mode/guix-bzr-reference new file mode 100644 index 0000000000..a801cc36f2 --- /dev/null +++ b/etc/snippets/scheme-mode/guix-bzr-reference @@ -0,0 +1,7 @@ +# -*- mode: snippet -*- +# name: guix-bzr-reference +# key: bzr-reference... +# -- +(bzr-reference + (url "$1") + (revision ${2:ref})) \ No newline at end of file diff --git a/etc/snippets/scheme-mode/guix-origin b/etc/snippets/scheme-mode/guix-origin index 1a068f8859..2820a369f3 100644 --- a/etc/snippets/scheme-mode/guix-origin +++ b/etc/snippets/scheme-mode/guix-origin @@ -9,15 +9,17 @@ "cvs-fetch" "git-fetch" "hg-fetch" - "svn-fetch")}) + "svn-fetch" + "bzr-fetch")}) (uri ${1:$(cond ((equal yas-text "git-fetch") "git-reference...") ((equal yas-text "svn-fetch") "svn-reference...") ((equal yas-text "hg-fetch") "hg-reference...") ((equal yas-text "cvs-fetch") "cvs-reference...") + ((equal yas-text "bzr-fetch") "bzr-reference...") (t "(string-append \\"https://\\" version \\".tar.gz\\")"))}$0) ${1:$(cond ((equal yas-text "git-fetch") "(file-name (git-file-name name version))") - ((member yas-text '("svn-fetch" "hg-fetch" "cvs-fetch")) + ((member yas-text '("svn-fetch" "hg-fetch" "cvs-fetch" "bzr-fetch")) "(file-name (string-append name \\"-\\" version \\"-checkout\\"))") (t ""))} (sha256 diff --git a/guix/build/bzr.scm b/guix/build/bzr.scm new file mode 100644 index 0000000000..86ee11391d --- /dev/null +++ b/guix/build/bzr.scm @@ -0,0 +1,44 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2018 Maxim Cournoyer +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see . + +(define-module (guix build bzr) + #:use-module (guix build utils) + #:export (bzr-fetch)) + +;;; Commentary: +;;; +;;; This is the build-side support code of (guix bzr-download). It allows a +;;; Bazaar repository to be branched at a specific revision. +;;; +;;; Code: + +(define* (bzr-fetch url revision directory + #:key (bzr-command "bzr")) + "Fetch REVISION from URL into DIRECTORY. REVISION must be a valid Bazaar +revision identifier. Return #t on success, else throw an exception." + ;; Do not attempt to write .bzr.log to $HOME, which doesn't exist. + (setenv "BZR_LOG" "/dev/null") + ;; Disable SSL certificate verification; we rely on the hash instead. + (invoke bzr-command "-Ossl.cert_reqs=none" "checkout" + "--lightweight" "-r" revision url directory) + (with-directory-excursion directory + (begin + (delete-file-recursively ".bzr") + #t))) + +;;; bzr.scm ends here diff --git a/guix/bzr-download.scm b/guix/bzr-download.scm new file mode 100644 index 0000000000..d30833c5d7 --- /dev/null +++ b/guix/bzr-download.scm @@ -0,0 +1,85 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2017 Maxim Cournoyer +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see . + +(define-module (guix bzr-download) + #:use-module (guix gexp) + #:use-module (guix modules) ;for 'source-module-closure' + #:use-module (guix monads) + #:use-module (guix packages) + #:use-module (guix records) + #:use-module (guix store) + + #:export (bzr-reference + bzr-reference? + bzr-reference-url + bzr-reference-revision + + bzr-fetch)) + +;;; Commentary: +;;; +;;; An method that fetches a specific revision from a Bazaar +;;; repository. The repository URL and revision identifier are specified with +;;; a object. +;;; +;;; Code: + +(define-record-type* + bzr-reference make-bzr-reference + bzr-reference? + (url bzr-reference-url) + (revision bzr-reference-revision)) + +(define (bzr-package) + "Return the default Bazaar package." + (let ((distro (resolve-interface '(gnu packages version-control)))) + (module-ref distro 'bazaar))) + +(define* (bzr-fetch ref hash-algo hash + #:optional name + #:key (system (%current-system)) (guile (default-guile)) + (bzr (bzr-package))) + "Return a fixed-output derivation that fetches REF, a +object. The output is expected to have recursive hash HASH of type +HASH-ALGO (a symbol). Use NAME as the file name, or a generic name if #f." + (define build + (with-imported-modules (source-module-closure + '((guix build bzr))) + #~(begin + (use-modules (guix build bzr)) + (bzr-fetch + (getenv "bzr url") (getenv "bzr reference") #$output + #:bzr-command (string-append #+bzr "/bin/bzr"))))) + + (mlet %store-monad ((guile (package->derivation guile system))) + (gexp->derivation (or name "bzr-branch") build + ;; Use environment variables and a fixed script name so + ;; there's only one script in store for all the + ;; downloads. + #:script-name "bzr-download" + #:env-vars + `(("bzr url" . ,(bzr-reference-url ref)) + ("bzr reference" . ,(bzr-reference-revision ref))) + #:system system + #:local-build? #t ;don't offload repo branching + #:hash-algo hash-algo + #:hash hash + #:recursive? #t + #:guile-for-build guile))) + +;;; bzr-download.scm ends here -- cgit v1.2.3 From 5f5499d684058b2a359e9a3e8e6738bbd0c77834 Mon Sep 17 00:00:00 2001 From: Marius Bakke Date: Thu, 9 May 2019 17:03:03 +0200 Subject: syscalls: Add 'arp-network-interface?'. * guix/build/syscalls.scm (IFF_NOARP): New variable. (arp-network-interface?): New public procedure. --- guix/build/syscalls.scm | 9 +++++++++ 1 file changed, 9 insertions(+) (limited to 'guix/build') diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm index 749616ceb1..3abe65bc4f 100644 --- a/guix/build/syscalls.scm +++ b/guix/build/syscalls.scm @@ -104,6 +104,7 @@ (define-module (guix build syscalls) network-interface-netmask network-interface-running? loopback-network-interface? + arp-network-interface? network-interface-address set-network-interface-netmask set-network-interface-up @@ -1160,6 +1161,7 @@ (define-as-needed IFF_UP #x1) ;Interface is up (define-as-needed IFF_BROADCAST #x2) ;Broadcast address valid. (define-as-needed IFF_LOOPBACK #x8) ;Is a loopback net. (define-as-needed IFF_RUNNING #x40) ;interface RFC2863 OPER_UP +(define-as-needed IFF_NOARP #x80) ;ARP disabled or unsupported (define IF_NAMESIZE 16) ;maximum interface name size @@ -1341,6 +1343,13 @@ (define (network-interface-running? name) (close-port sock) (not (zero? (logand flags IFF_RUNNING))))) +(define (arp-network-interface? name) + "Return true if NAME supports the Address Resolution Protocol." + (let* ((sock (socket SOCK_STREAM AF_INET 0)) + (flags (network-interface-flags sock name))) + (close-port sock) + (zero? (logand flags IFF_NOARP)))) + (define-as-needed (set-network-interface-flags socket name flags) "Set the flag of network interface NAME to FLAGS." (let ((req (make-bytevector ifreq-struct-size))) -- cgit v1.2.3 From e88735b45fcfb0c40c6ba4d4076411b7241547f3 Mon Sep 17 00:00:00 2001 From: Ivan Petkov Date: Sat, 27 Apr 2019 21:39:48 -0700 Subject: build/cargo-utils: Remove "src-name" parameter. * gnu/packages/gnuzilla.scm (icecat)[arguments]<#:phases> [patch-cargo-checksums]: Delete "null-file" variable. * gnu/packages/rust.scm (%cargo-reference-project-file): Delete variable. * gnu/packages/rust.scm (rust-1.19): Remove reference to "%cargo-reference-project-file". * guix/build/cargo-utils.scm (generate-checksums): Remove "src-name" parameter. Signed-off-by: Danny Milosavljevic --- gnu/packages/gnuzilla.scm | 5 ++--- gnu/packages/rust.scm | 5 ++--- guix/build/cargo-build-system.scm | 2 +- guix/build/cargo-utils.scm | 11 ++++++----- 4 files changed, 11 insertions(+), 12 deletions(-) (limited to 'guix/build') diff --git a/gnu/packages/gnuzilla.scm b/gnu/packages/gnuzilla.scm index e36927fc6a..e62f532a0c 100644 --- a/gnu/packages/gnuzilla.scm +++ b/gnu/packages/gnuzilla.scm @@ -844,8 +844,7 @@ (define-public icecat (add-after 'patch-source-shebangs 'patch-cargo-checksums (lambda _ (use-modules (guix build cargo-utils)) - (let ((null-file "/dev/null") - (null-hash "e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855")) + (let ((null-hash "e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855")) (substitute* '("Cargo.lock" "servo/Cargo.lock") (("(\"checksum .* = )\".*\"" all name) (string-append name "\"" null-hash "\""))) @@ -856,7 +855,7 @@ (define-public icecat (display (string-append "patch-cargo-checksums: generate-checksums for " dir "\n")) - (generate-checksums dir null-file))) + (generate-checksums dir))) (find-files "third_party/rust" ".cargo-checksum.json"))) #t)) (add-before 'configure 'augment-CPLUS_INCLUDE_PATH diff --git a/gnu/packages/rust.scm b/gnu/packages/rust.scm index 61fc0d46ac..27388d307e 100644 --- a/gnu/packages/rust.scm +++ b/gnu/packages/rust.scm @@ -55,7 +55,6 @@ (define-module (gnu packages rust) #:use-module (ice-9 match) #:use-module (srfi srfi-26)) -(define %cargo-reference-project-file "/dev/null") (define %cargo-reference-hash "e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855") @@ -320,7 +319,7 @@ (define rust-1.19 (display (string-append "patch-cargo-checksums: generate-checksums for " dir "\n")) - (generate-checksums dir ,%cargo-reference-project-file))) + (generate-checksums dir))) (find-files "src/vendor" ".cargo-checksum.json")) #t)) ;; This phase is overridden by newer versions. @@ -973,7 +972,7 @@ (define-public rust-1.32 (display (string-append "patch-cargo-checksums: generate-checksums for " dir "\n")) - (generate-checksums dir ,%cargo-reference-project-file))) + (generate-checksums dir))) (find-files "vendor" ".cargo-checksum.json")) #t)) (add-after 'enable-codegen-tests 'override-jemalloc diff --git a/guix/build/cargo-build-system.scm b/guix/build/cargo-build-system.scm index b68a1f90d2..9f44bd6ee9 100644 --- a/guix/build/cargo-build-system.scm +++ b/guix/build/cargo-build-system.scm @@ -131,7 +131,7 @@ (define* (install-source #:key inputs outputs #:allow-other-keys) ;; to store paths. (copy-recursively "." rsrc) (touch (string-append rsrc "/.cargo-ok")) - (generate-checksums rsrc "/dev/null") + (generate-checksums rsrc) (install-file "Cargo.toml" rsrc) #t)) diff --git a/guix/build/cargo-utils.scm b/guix/build/cargo-utils.scm index 6af572e611..79e5440378 100644 --- a/guix/build/cargo-utils.scm +++ b/guix/build/cargo-utils.scm @@ -41,12 +41,10 @@ (define (file-sha256 file-name) (close-pipe port) result))) -(define (generate-checksums dir-name src-name) +(define (generate-checksums dir-name) "Given DIR-NAME, a store directory, checksum all the files in it one by one and put the result into the file \".cargo-checksum.json\" in -the same directory. Also includes the checksum of an extra file -SRC-NAME as if it was part of the directory DIR-NAME with name -\"package\"." +the same directory." (let* ((file-names (find-files dir-name ".")) (dir-prefix-name (string-append dir-name "/")) (dir-prefix-name-len (string-length dir-prefix-name)) @@ -62,6 +60,9 @@ (define (generate-checksums dir-name src-name) (write file-relative-name port) (display ":" port) (write (file-sha256 file-name) port))) file-names)) + ;; NB: cargo requires the "package" field in order to check if the Cargo.lock + ;; file needs to be regenerated when the value changes. However, it doesn't + ;; appear to care what the value is to begin with... (display "},\"package\":" port) - (write (file-sha256 src-name) port) + (write (file-sha256 "/dev/null") port) (display "}" port))))) -- cgit v1.2.3 From 9bc8175cfa6b23c31f6c43531377d266456e430e Mon Sep 17 00:00:00 2001 From: 宋文武 Date: Fri, 10 May 2019 21:27:40 +0800 Subject: download: Support 'https_proxy'. * guix/build/download.scm (setup-http-tunnel): New procedure. (open-connection-for-uri): Honor the 'https_proxy' environment variable. --- guix/build/download.scm | 28 ++++++++++++++++++++++------ 1 file changed, 22 insertions(+), 6 deletions(-) (limited to 'guix/build') diff --git a/guix/build/download.scm b/guix/build/download.scm index a64e0f0bd3..0c9c61de4b 100644 --- a/guix/build/download.scm +++ b/guix/build/download.scm @@ -380,6 +380,20 @@ (define addresses (apply throw args) (loop (cdr addresses)))))))) +(define (setup-http-tunnel port uri) + "Establish over PORT an HTTP tunnel to the destination server of URI." + (define target + (string-append (uri-host uri) ":" + (number->string + (or (uri-port uri) + (match (uri-scheme uri) + ('http 80) + ('https 443)))))) + (format port "CONNECT ~a HTTP/1.1\r\n" target) + (format port "Host: ~a\r\n\r\n" target) + (force-output port) + (read-response port)) + (define* (open-connection-for-uri uri #:key timeout @@ -393,21 +407,20 @@ (define* (open-connection-for-uri uri (define https? (eq? 'https (uri-scheme uri))) + (define https-proxy (let ((proxy (getenv "https_proxy"))) + (and (not (equal? proxy "")) + proxy))) + (let-syntax ((with-https-proxy (syntax-rules () ((_ exp) ;; For HTTPS URIs, honor 'https_proxy', not 'http_proxy'. - ;; FIXME: Proxying is not supported for https. (let ((thunk (lambda () exp))) (if (and https? (module-variable (resolve-interface '(web client)) 'current-http-proxy)) - (parameterize ((current-http-proxy #f)) - (when (and=> (getenv "https_proxy") - (negate string-null?)) - (format (current-error-port) - "warning: 'https_proxy' is ignored~%")) + (parameterize ((current-http-proxy https-proxy)) (thunk)) (thunk))))))) (with-https-proxy @@ -415,6 +428,9 @@ (define https? ;; Buffer input and output on this port. (setvbuf s 'block %http-receive-buffer-size) + (when (and https? https-proxy) + (setup-http-tunnel s uri)) + (if https? (tls-wrap s (uri-host uri) #:verify-certificate? verify-certificate?) -- cgit v1.2.3