From 5cf01aa53f67a226198cba63fd952a9c9e5aa842 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 17 Oct 2016 22:43:49 +0200 Subject: guix build: Extract '--with-input' replacement spec parsing. * guix/scripts/build.scm (evaluate-replacement-specs): New procedure. (transform-package-inputs)[not-equal]: Remove. [replacements]: Define in terms of 'evaluate-replacement-specs'. --- guix/scripts/build.scm | 40 ++++++++++++++++++++++------------------ 1 file changed, 22 insertions(+), 18 deletions(-) (limited to 'guix') diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm index b64138ec0e..644993101e 100644 --- a/guix/scripts/build.scm +++ b/guix/scripts/build.scm @@ -179,27 +179,31 @@ matching URIs given in SOURCES." (_ obj))))) -(define (transform-package-inputs replacement-specs) - "Return a procedure that, when passed a package, replaces its direct -dependencies according to REPLACEMENT-SPECS. REPLACEMENT-SPECS is a list of -strings like \"guile=guile@2.1\" meaning that, any direct dependency on a -package called \"guile\" must be replaced with a dependency on a version 2.1 -of \"guile\"." +(define (evaluate-replacement-specs specs proc) + "Parse SPECS, a list of strings like \"guile=guile@2.1\", and invoke PROC on +each package pair specified by SPECS. Return the resulting list. Raise an +error if an element of SPECS uses invalid syntax, or if a package it refers to +could not be found." (define not-equal (char-set-complement (char-set #\=))) - (define replacements - ;; List of name/package pairs. - (map (lambda (spec) - (match (string-tokenize spec not-equal) - ((old new) - (cons (specification->package old) - (specification->package new))) - (x - (leave (_ "invalid replacement specification: ~s~%") spec)))) - replacement-specs)) - - (let ((rewrite (package-input-rewriting replacements))) + (map (lambda (spec) + (match (string-tokenize spec not-equal) + ((old new) + (proc (specification->package old) + (specification->package new))) + (x + (leave (_ "invalid replacement specification: ~s~%") spec)))) + specs)) + +(define (transform-package-inputs replacement-specs) + "Return a procedure that, when passed a package, replaces its direct +dependencies according to REPLACEMENT-SPECS. REPLACEMENT-SPECS is a list of +strings like \"guile=guile@2.1\" meaning that, any dependency on a package +called \"guile\" must be replaced with a dependency on a version 2.1 of +\"guile\"." + (let* ((replacements (evaluate-replacement-specs replacement-specs cons)) + (rewrite (package-input-rewriting replacements))) (lambda (store obj) (if (package? obj) (rewrite obj) -- cgit v1.2.3 From 31c2fd1e01d5f95cd1fb873c44f5fa4ac1164e69 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 17 Oct 2016 22:51:38 +0200 Subject: guix build: Factorize transformation option parsing. * guix/scripts/build.scm (%transformation-options): Introduce 'parser' procedure and use it. --- guix/scripts/build.scm | 19 +++++++++---------- 1 file changed, 9 insertions(+), 10 deletions(-) (limited to 'guix') diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm index 644993101e..bd97d56dce 100644 --- a/guix/scripts/build.scm +++ b/guix/scripts/build.scm @@ -219,16 +219,15 @@ called \"guile\" must be replaced with a dependency on a version 2.1 of (define %transformation-options ;; The command-line interface to the above transformations. - (list (option '("with-source") #t #f - (lambda (opt name arg result . rest) - (apply values - (cons (alist-cons 'with-source arg result) - rest)))) - (option '("with-input") #t #f - (lambda (opt name arg result . rest) - (apply values - (cons (alist-cons 'with-input arg result) - rest)))))) + (let ((parser (lambda (symbol) + (lambda (opt name arg result . rest) + (apply values + (alist-cons symbol arg result) + rest))))) + (list (option '("with-source") #t #f + (parser 'with-source)) + (option '("with-input") #t #f + (parser 'with-input))))) (define (show-transformation-options-help) (display (_ " -- cgit v1.2.3 From 645b9df858683dc05ffa04c9eb2fdc45ccef4a65 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 17 Oct 2016 23:40:03 +0200 Subject: guix build: Add '--with-graft'. * guix/scripts/build.scm (transform-package-inputs/graft): New procedure. (%transformations): Add 'with-graft'. (%transformation-options): Likewise. (show-transformation-options-help): Document it. * tests/scripts-build.scm ("options->transformation, with-graft"): New test. * doc/guix.texi (Package Transformation Options): Document it. --- doc/guix.texi | 24 ++++++++++++++++++++++++ guix/scripts/build.scm | 29 ++++++++++++++++++++++++++--- tests/scripts-build.scm | 19 +++++++++++++++++++ 3 files changed, 69 insertions(+), 3 deletions(-) (limited to 'guix') diff --git a/doc/guix.texi b/doc/guix.texi index 47fc199c6c..0c5d641b48 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -4513,6 +4513,30 @@ This is a recursive, deep replacement. So in this example, both This is implemented using the @code{package-input-rewriting} Scheme procedure (@pxref{Defining Packages, @code{package-input-rewriting}}). + +@item --with-graft=@var{package}=@var{replacement} +This is similar to @code{--with-input} but with an important difference: +instead of rebuilding all the dependency chain, @var{replacement} is +built and then @dfn{grafted} onto the binaries that were initially +referring to @var{package}. @xref{Security Updates}, for more +information on grafts. + +For example, the command below grafts version 3.5.4 of GnuTLS onto Wget +and all its dependencies, replacing references to the version of GnuTLS +they currently refer to: + +@example +guix build --with-graft=gnutls=gnutls@@3.5.4 wget +@end example + +This has the advantage of being much faster than rebuilding everything. +But there is a caveat: it works if and only if @var{package} and +@var{replacement} are strictly compatible---for example, if they provide +a library, the application binary interface (ABI) of those libraries +must be compatible. If @var{replacement} is somehow incompatible with +@var{package}, then the resulting package may be unusable. Use with +care! + @end table @node Additional Build Options diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm index bd97d56dce..8c2c4902fc 100644 --- a/guix/scripts/build.scm +++ b/guix/scripts/build.scm @@ -209,13 +209,31 @@ called \"guile\" must be replaced with a dependency on a version 2.1 of (rewrite obj) obj)))) +(define (transform-package-inputs/graft replacement-specs) + "Return a procedure that, when passed a package, replaces its direct +dependencies according to REPLACEMENT-SPECS. REPLACEMENT-SPECS is a list of +strings like \"gnutls=gnutls@3.5.4\" meaning that packages are built using the +current 'gnutls' package, after which version 3.5.4 is grafted onto them." + (define (replacement-pair old new) + (cons old + (package (inherit old) (replacement new)))) + + (let* ((replacements (evaluate-replacement-specs replacement-specs + replacement-pair)) + (rewrite (package-input-rewriting replacements))) + (lambda (store obj) + (if (package? obj) + (rewrite obj) + obj)))) + (define %transformations ;; Transformations that can be applied to things to build. The car is the ;; key used in the option alist, and the cdr is the transformation ;; procedure; it is called with two arguments: the store, and a list of ;; things to build. `((with-source . ,transform-package-source) - (with-input . ,transform-package-inputs))) + (with-input . ,transform-package-inputs) + (with-graft . ,transform-package-inputs/graft))) (define %transformation-options ;; The command-line interface to the above transformations. @@ -227,7 +245,9 @@ called \"guile\" must be replaced with a dependency on a version 2.1 of (list (option '("with-source") #t #f (parser 'with-source)) (option '("with-input") #t #f - (parser 'with-input))))) + (parser 'with-input)) + (option '("with-graft") #t #f + (parser 'with-graft))))) (define (show-transformation-options-help) (display (_ " @@ -235,7 +255,10 @@ called \"guile\" must be replaced with a dependency on a version 2.1 of use SOURCE when building the corresponding package")) (display (_ " --with-input=PACKAGE=REPLACEMENT - replace dependency PACKAGE by REPLACEMENT"))) + replace dependency PACKAGE by REPLACEMENT")) + (display (_ " + --with-graft=PACKAGE=REPLACEMENT + graft REPLACEMENT on packages that refer to PACKAGE"))) (define (options->transformation opts) diff --git a/tests/scripts-build.scm b/tests/scripts-build.scm index e48c8da264..e2610904e2 100644 --- a/tests/scripts-build.scm +++ b/tests/scripts-build.scm @@ -102,4 +102,23 @@ ((("x" dep)) (eq? dep findutils))))))))))) +(test-assert "options->transformation, with-graft" + (let* ((p (dummy-package "guix.scm" + (inputs `(("foo" ,grep) + ("bar" ,(dummy-package "chbouib" + (native-inputs `(("x" ,grep))))))))) + (t (options->transformation '((with-input . "grep=findutils"))))) + (with-store store + (let ((new (t store p))) + (and (not (eq? new p)) + (match (package-inputs new) + ((("foo" dep1) ("bar" dep2)) + (and (string=? (package-full-name dep1) + (package-full-name grep)) + (eq? (package-replacement dep1) findutils) + (string=? (package-name dep2) "chbouib") + (match (package-native-inputs dep2) + ((("x" dep)) + (eq? (package-replacement dep) findutils))))))))))) + (test-end) -- cgit v1.2.3 From 3d47aa81ba4c19b45ce9a9ff0ece0252777ea8ed Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 17 Oct 2016 23:43:33 +0200 Subject: grafts: Apply the right grafts in the presence of multiple outputs. Fixes . * guix/grafts.scm (cumulative-grafts): Add grafts for all the outputs of DRV. * tests/grafts.scm ("graft-derivation, replaced derivation has multiple outputs"): New test. --- guix/grafts.scm | 15 +++++++++++++-- tests/grafts.scm | 48 ++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 61 insertions(+), 2 deletions(-) (limited to 'guix') diff --git a/guix/grafts.scm b/guix/grafts.scm index 80ae27e9b0..dda7c1d235 100644 --- a/guix/grafts.scm +++ b/guix/grafts.scm @@ -280,8 +280,19 @@ derivations to the corresponding set of grafts." (let* ((new (graft-derivation/shallow store drv applicable #:guile guile #:system system)) - (grafts (cons (graft (origin drv) (replacement new)) - grafts))) + + ;; Replace references to any of the outputs of DRV, + ;; even if that's more than needed. This is so that + ;; the result refers only to the outputs of NEW and + ;; not to those of DRV. + (grafts (append (map (lambda (output) + (graft + (origin drv) + (origin-output output) + (replacement new) + (replacement-output output))) + (derivation-output-names drv)) + grafts))) (return/cache cache grafts)))))))))))) (define* (graft-derivation store drv grafts diff --git a/tests/grafts.scm b/tests/grafts.scm index 4eff06b4b3..6454a03b1f 100644 --- a/tests/grafts.scm +++ b/tests/grafts.scm @@ -201,6 +201,54 @@ (and (string=? (readlink one) repl) (string=? (readlink two) one)))))) +(test-assert "graft-derivation, replaced derivation has multiple outputs" + ;; Here we have a replacement just for output "one" of P1 and not for the + ;; other output. Make sure the graft for P1:one correctly applies to the + ;; dependents of P1. See . + (let* ((p1 (build-expression->derivation + %store "p1" + `(let ((one (assoc-ref %outputs "one")) + (two (assoc-ref %outputs "two"))) + (mkdir one) + (mkdir two)) + #:outputs '("one" "two"))) + (p1r (build-expression->derivation + %store "P1" + `(let ((other (assoc-ref %outputs "ONE"))) + (mkdir other) + (call-with-output-file (string-append other "/replacement") + (const #t))) + #:outputs '("ONE"))) + (p2 (build-expression->derivation + %store "p2" + `(let ((out (assoc-ref %outputs "aaa"))) + (mkdir (assoc-ref %outputs "zzz")) + (mkdir out) (chdir out) + (symlink (assoc-ref %build-inputs "p1:one") "one") + (symlink (assoc-ref %build-inputs "p1:two") "two")) + #:outputs '("aaa" "zzz") + #:inputs `(("p1:one" ,p1 "one") + ("p1:two" ,p1 "two")))) + (p3 (build-expression->derivation + %store "p3" + `(symlink (assoc-ref %build-inputs "p2:aaa") + (assoc-ref %outputs "out")) + #:inputs `(("p2:aaa" ,p2 "aaa") + ("p2:zzz" ,p2 "zzz")))) + (p1g (graft + (origin p1) + (origin-output "one") + (replacement p1r) + (replacement-output "ONE"))) + (p3d (graft-derivation %store p3 (list p1g)))) + (and (build-derivations %store (list p3d)) + (let ((out (derivation->output-path (pk 'p2d p3d)))) + (and (not (string=? (readlink out) + (derivation->output-path p2 "aaa"))) + (string=? (derivation->output-path p1 "two") + (readlink (string-append out "/two"))) + (file-exists? (string-append out "/one/replacement"))))))) + (test-assert "graft-derivation, renaming" ; (let* ((build `(begin (use-modules (guix build utils)) -- cgit v1.2.3 From fb3af759ee284fb1cb14c5514ed0432d9cbbfdbf Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 17 Oct 2016 23:55:28 +0200 Subject: grafts: Remove unnecessary 'umask' call. This is a followup to d72267863382041b84a9712eea354882be72ef55. * guix/build/graft.scm (rewrite-directory): Remove 'umask' call. --- guix/build/graft.scm | 5 ----- 1 file changed, 5 deletions(-) (limited to 'guix') diff --git a/guix/build/graft.scm b/guix/build/graft.scm index 7025b72fea..16df169ec7 100644 --- a/guix/build/graft.scm +++ b/guix/build/graft.scm @@ -307,11 +307,6 @@ file name pairs." (else (error "unsupported file type" stat))))) - ;; XXX: Work around occasional "suspicious ownership or permission" daemon - ;; errors that arise when we create the top-level /gnu/store/… directory as - ;; #o777. - (umask #o022) - ;; Use 'exit-on-exception' to force an exit upon I/O errors, given that ;; 'n-par-for-each' silently swallows exceptions. ;; See . -- cgit v1.2.3 From 4bb54cc42ff5653fe59f5a8ebf39515ba1840a6d Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 19 Oct 2016 13:55:25 +0200 Subject: lint: Suggest @code instead of quotes. * guix/scripts/lint.scm (%quoted-identifier-rx): New variable. (check-description-style)[check-quotes]: New procedure. Use it. * tests/lint.scm ("description: suggest ornament instead of quotes"): New test. --- guix/scripts/lint.scm | 15 +++++++++++++++ tests/lint.scm | 8 ++++++++ 2 files changed, 23 insertions(+) (limited to 'guix') diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm index b3ec6d628e..d6281eae64 100644 --- a/guix/scripts/lint.scm +++ b/guix/scripts/lint.scm @@ -142,6 +142,10 @@ monad." "Return #t if S starts with what looks like an abbreviation or acronym." (string-match "^[A-Z][A-Z0-9]+\\>" s)) +(define %quoted-identifier-rx + ;; A quoted identifier, like 'this'. + (make-regexp "['`][[:graph:]]+'")) + (define (check-description-style package) ;; Emit a warning if stylistic issues are found in the description of PACKAGE. (define (check-not-empty description) @@ -173,6 +177,16 @@ trademark sign '~a' at ~d") 'description)) (else #t))) + (define (check-quotes description) + "Check whether DESCRIPTION contains single quotes and suggest @code." + (when (regexp-exec %quoted-identifier-rx description) + (emit-warning package + + ;; TRANSLATORS: '@code' is Texinfo markup and must be kept + ;; as is. + (_ "use @code or similar ornament instead of quotes") + 'description))) + (define (check-proper-start description) (unless (or (properly-starts-sentence? description) (string-prefix-ci? (package-name package) description)) @@ -203,6 +217,7 @@ by two spaces; possible infraction~p at ~{~a~^, ~}") (if (string? description) (begin (check-not-empty description) + (check-quotes description) (check-trademarks description) ;; Use raw description for this because Texinfo rendering ;; automatically fixes end of sentence space. diff --git a/tests/lint.scm b/tests/lint.scm index d692b42f93..fa2d19b2a6 100644 --- a/tests/lint.scm +++ b/tests/lint.scm @@ -218,6 +218,14 @@ string) on HTTP requests." (check-description-style pkg))) "should not contain trademark sign")))) +(test-assert "description: suggest ornament instead of quotes" + (->bool + (string-contains (with-warnings + (let ((pkg (dummy-package "x" + (description "This is a 'quoted' thing.")))) + (check-description-style pkg))) + "use @code"))) + (test-assert "synopsis: not a string" (->bool (string-contains (with-warnings -- cgit v1.2.3 From 2535635f182d6a2aca5689adb5551fdd7c7e2d0a Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 19 Oct 2016 14:28:56 +0200 Subject: Use (ice-9 binary-ports) instead of (rnrs io ports). This reduces the closure of (guix ui) from 123 to 106 modules. * guix/derivations.scm: Use (ice-9 binary-ports) instead of (rnrs io ports). (map-derivation)[substitute-file]: Use 'read-string' instead of 'get-string-all'. * guix/ftp-client.scm: Likewise. * guix/hash.scm: Likewise. * guix/http-client.scm: Likewise. * guix/pki.scm (ensure-acl, current-acl): Likewise. * guix/scripts/archive.scm (authorize-key)[read-key]: Likewise. * guix/scripts/authenticate.scm (read-canonical-sexp) (read-hash-data): Likewise. * guix/scripts/download.scm: Likewise. * guix/scripts/offload.scm (register-gc-root, remove-gc-roots) (send-files): Likewise. * guix/scripts/publish.scm (lazy-read-file-sexp): Likewise. * guix/scripts/refresh.scm: Likewise. * guix/scripts/substitute.scm (check-acl-initialized): Likewise. * guix/serialization.scm (read-maybe-utf8-string): Likewise. * guix/scripts/hash.scm (guix-hash): Use 'force-output' instead of 'flush-output-port'. * guix/store.scm (process-stderr): Likewise. * guix/tests.scm: Likewise. * guix/utils.scm: Use (ice-9 binary-ports) and autoload (rnrs io ports) for 'make-custom-binary-input-port'. --- guix/derivations.scm | 4 ++-- guix/ftp-client.scm | 4 ++-- guix/hash.scm | 4 ++-- guix/http-client.scm | 2 +- guix/pki.scm | 9 +++++---- guix/scripts/archive.scm | 4 ++-- guix/scripts/authenticate.scm | 9 +++++---- guix/scripts/download.scm | 2 +- guix/scripts/hash.scm | 4 ++-- guix/scripts/offload.scm | 11 ++++++----- guix/scripts/publish.scm | 6 +++--- guix/scripts/refresh.scm | 2 +- guix/scripts/substitute.scm | 5 ++--- guix/serialization.scm | 5 +++-- guix/store.scm | 4 ++-- guix/tests.scm | 2 +- guix/utils.scm | 3 ++- 17 files changed, 42 insertions(+), 38 deletions(-) (limited to 'guix') diff --git a/guix/derivations.scm b/guix/derivations.scm index 7f74ed6c77..e378a7cb03 100644 --- a/guix/derivations.scm +++ b/guix/derivations.scm @@ -23,7 +23,7 @@ #:use-module (srfi srfi-26) #:use-module (srfi srfi-34) #:use-module (srfi srfi-35) - #:use-module (rnrs io ports) + #:use-module (ice-9 binary-ports) #:use-module (rnrs bytevectors) #:use-module (ice-9 match) #:use-module (ice-9 rdelim) @@ -885,7 +885,7 @@ recursively." (define (substitute-file file initial replacements) (define contents (with-fluids ((%default-port-encoding #f)) - (call-with-input-file file get-string-all))) + (call-with-input-file file read-string))) (let ((updated (substitute contents initial replacements))) (if (string=? updated contents) diff --git a/guix/ftp-client.scm b/guix/ftp-client.scm index 22d4c7dde2..0a179282ed 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 Ludovic Courtès +;;; Copyright © 2010, 2011, 2012, 2013, 2014, 2015, 2016 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -22,7 +22,7 @@ #:use-module (srfi srfi-11) #:use-module (srfi srfi-26) #:use-module (srfi srfi-31) - #:use-module (rnrs io ports) + #:use-module (ice-9 binary-ports) #:use-module (rnrs bytevectors) #:use-module (ice-9 match) #:use-module (ice-9 regex) diff --git a/guix/hash.scm b/guix/hash.scm index a61dc980e6..44e4472580 100644 --- a/guix/hash.scm +++ b/guix/hash.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès +;;; Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -19,7 +19,7 @@ (define-module (guix hash) #:use-module (guix gcrypt) #:use-module (rnrs bytevectors) - #:use-module (rnrs io ports) + #:use-module (ice-9 binary-ports) #:use-module (system foreign) #:use-module ((guix build utils) #:select (dump-port)) #:use-module (srfi srfi-11) diff --git a/guix/http-client.scm b/guix/http-client.scm index 97a1e26d3e..a8324be09f 100644 --- a/guix/http-client.scm +++ b/guix/http-client.scm @@ -28,7 +28,7 @@ #:use-module (srfi srfi-34) #:use-module (srfi srfi-35) #:use-module (ice-9 match) - #:use-module (rnrs io ports) + #:use-module (ice-9 binary-ports) #:use-module (rnrs bytevectors) #:use-module (guix ui) #:use-module (guix utils) diff --git a/guix/pki.scm b/guix/pki.scm index 3cd9763fdf..1551425c33 100644 --- a/guix/pki.scm +++ b/guix/pki.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014 Ludovic Courtès +;;; Copyright © 2013, 2014, 2016 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -22,7 +22,8 @@ #:use-module ((guix utils) #:select (with-atomic-file-output)) #:use-module ((guix build utils) #:select (mkdir-p)) #:use-module (ice-9 match) - #:use-module (rnrs io ports) + #:use-module (ice-9 rdelim) + #:use-module (ice-9 binary-ports) #:export (%public-key-file %private-key-file %acl-file @@ -80,7 +81,7 @@ element in KEYS must be a canonical sexp with type 'public-key'." (when (file-exists? %public-key-file) (let ((public-key (call-with-input-file %public-key-file (compose string->canonical-sexp - get-string-all)))) + read-string)))) (mkdir-p (dirname %acl-file)) (with-atomic-file-output %acl-file (lambda (port) @@ -99,7 +100,7 @@ element in KEYS must be a canonical sexp with type 'public-key'." (call-with-input-file %acl-file (compose canonical-sexp->sexp string->canonical-sexp - get-string-all)) + read-string)) (public-keys->acl '()))) ; the empty ACL (define (acl->public-keys acl) diff --git a/guix/scripts/archive.scm b/guix/scripts/archive.scm index 8c7322d617..400353247c 100644 --- a/guix/scripts/archive.scm +++ b/guix/scripts/archive.scm @@ -40,7 +40,7 @@ #:use-module (srfi srfi-11) #:use-module (srfi srfi-26) #:use-module (srfi srfi-37) - #:use-module (rnrs io ports) + #:use-module (ice-9 binary-ports) #:export (guix-archive)) @@ -290,7 +290,7 @@ the input port." (define (read-key) (catch 'gcry-error (lambda () - (string->canonical-sexp (get-string-all (current-input-port)))) + (string->canonical-sexp (read-string (current-input-port)))) (lambda (key proc err) (leave (_ "failed to read public key: ~a: ~a~%") (error-source err) (error-string err))))) diff --git a/guix/scripts/authenticate.scm b/guix/scripts/authenticate.scm index eedebb4bac..d9f799df26 100644 --- a/guix/scripts/authenticate.scm +++ b/guix/scripts/authenticate.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015 Ludovic Courtès +;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -22,7 +22,8 @@ #:use-module (guix pk-crypto) #:use-module (guix pki) #:use-module (guix ui) - #:use-module (rnrs io ports) + #:use-module (ice-9 binary-ports) + #:use-module (ice-9 rdelim) #:use-module (ice-9 match) #:export (guix-authenticate)) @@ -36,12 +37,12 @@ (define read-canonical-sexp ;; Read a gcrypt sexp from a port and return it. - (compose string->canonical-sexp get-string-all)) + (compose string->canonical-sexp read-string)) (define (read-hash-data port key-type) "Read sha256 hash data from PORT and return it as a gcrypt sexp. KEY-TYPE is a symbol representing the type of public key algo being used." - (let* ((hex (get-string-all port)) + (let* ((hex (read-string port)) (bv (base16-string->bytevector (string-trim-both hex)))) (bytevector->hash-data bv #:key-type key-type))) diff --git a/guix/scripts/download.scm b/guix/scripts/download.scm index 1648198f6e..bcb4eaa043 100644 --- a/guix/scripts/download.scm +++ b/guix/scripts/download.scm @@ -31,7 +31,7 @@ #:use-module (srfi srfi-1) #:use-module (srfi srfi-37) #:use-module (rnrs bytevectors) - #:use-module (rnrs io ports) + #:use-module (ice-9 binary-ports) #:export (guix-download)) diff --git a/guix/scripts/hash.scm b/guix/scripts/hash.scm index a6eced92fb..b269ead50f 100644 --- a/guix/scripts/hash.scm +++ b/guix/scripts/hash.scm @@ -25,7 +25,7 @@ #:use-module (guix ui) #:use-module (guix scripts) #:use-module (guix utils) - #:use-module (rnrs io ports) + #:use-module (ice-9 binary-ports) #:use-module (rnrs files) #:use-module (ice-9 match) #:use-module (srfi srfi-1) @@ -137,7 +137,7 @@ and 'hexadecimal' can be used as well).\n")) (if (assoc-ref opts 'recursive?) (let-values (((port get-hash) (open-sha256-port))) (write-file file port #:select? select?) - (flush-output-port port) + (force-output port) (get-hash)) (call-with-input-file file port-sha256)))) diff --git a/guix/scripts/offload.scm b/guix/scripts/offload.scm index b278f1e313..33d141e7ef 100644 --- a/guix/scripts/offload.scm +++ b/guix/scripts/offload.scm @@ -21,7 +21,8 @@ #:use-module (guix records) #:use-module (guix store) #:use-module (guix derivations) - #:use-module (guix serialization) + #:use-module ((guix serialization) + #:select (nar-error? nar-error-file)) #:use-module (guix nar) #:use-module (guix utils) #:use-module ((guix build syscalls) #:select (fcntl-flock)) @@ -37,7 +38,7 @@ #:use-module (ice-9 match) #:use-module (ice-9 regex) #:use-module (ice-9 format) - #:use-module (rnrs io ports) + #:use-module (ice-9 binary-ports) #:export (build-machine build-requirements guix-offload)) @@ -336,7 +337,7 @@ hook." (let ((pipe (remote-pipe machine OPEN_READ `("guile" "-c" ,(object->string script))))) - (get-string-all pipe) + (read-string pipe) (let ((status (close-pipe pipe))) (unless (zero? status) ;; Better be safe than sorry: if we ignore the error here, then FILE @@ -368,7 +369,7 @@ hook." (let ((pipe (remote-pipe machine OPEN_READ `("guile" "-c" ,(object->string script))))) - (get-string-all pipe) + (read-string pipe) (close-pipe pipe))) (define* (offload drv machine @@ -462,7 +463,7 @@ success, #f otherwise." '("guix" "archive" "--missing"))) (open-input-string files))) ((result) - (get-string-all missing))) + (read-string missing))) (for-each waitpid pids) (string-tokenize result))) diff --git a/guix/scripts/publish.scm b/guix/scripts/publish.scm index 8404e540f8..1b32f639ea 100644 --- a/guix/scripts/publish.scm +++ b/guix/scripts/publish.scm @@ -23,7 +23,7 @@ #:use-module (ice-9 format) #:use-module (ice-9 match) #:use-module (ice-9 regex) - #:use-module (rnrs io ports) + #:use-module (ice-9 rdelim) #:use-module (rnrs bytevectors) #:use-module (srfi srfi-1) #:use-module (srfi srfi-2) @@ -46,7 +46,7 @@ #:use-module (guix pki) #:use-module (guix pk-crypto) #:use-module (guix store) - #:use-module (guix serialization) + #:use-module ((guix serialization) #:select (write-file)) #:use-module (guix zlib) #:use-module (guix ui) #:use-module (guix scripts) @@ -167,7 +167,7 @@ compression disabled~%")) (delay (call-with-input-file file (compose string->canonical-sexp - get-string-all)))) + read-string)))) (define %private-key (lazy-read-file-sexp %private-key-file)) diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm index 84e2a8f2a6..b81c69f9fe 100644 --- a/guix/scripts/refresh.scm +++ b/guix/scripts/refresh.scm @@ -50,7 +50,7 @@ #:use-module (srfi srfi-11) #:use-module (srfi srfi-26) #:use-module (srfi srfi-37) - #:use-module (rnrs io ports) + #:use-module (ice-9 binary-ports) #:export (guix-refresh %updaters)) diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm index 8f50477801..3d6fde0188 100755 --- a/guix/scripts/substitute.scm +++ b/guix/scripts/substitute.scm @@ -24,7 +24,7 @@ #:use-module (guix combinators) #:use-module (guix config) #:use-module (guix records) - #:use-module (guix serialization) + #:use-module ((guix serialization) #:select (restore-file)) #:use-module (guix hash) #:use-module (guix base32) #:use-module (guix base64) @@ -43,7 +43,6 @@ #:use-module (ice-9 format) #:use-module (ice-9 ftw) #:use-module (ice-9 binary-ports) - #:use-module (rnrs io ports) #:use-module (rnrs bytevectors) #:use-module (srfi srfi-1) #:use-module (srfi srfi-9) @@ -938,7 +937,7 @@ DESTINATION as a nar file. Verify the substitute against ACL." (and (file-exists? %public-key-file) (let ((key (call-with-input-file %public-key-file (compose string->canonical-sexp - get-string-all)))) + read-string)))) (match acl ((thing) (equal? (canonical-sexp->string thing) diff --git a/guix/serialization.scm b/guix/serialization.scm index f17f516c09..5953b84616 100644 --- a/guix/serialization.scm +++ b/guix/serialization.scm @@ -19,11 +19,12 @@ (define-module (guix serialization) #:use-module (guix combinators) #:use-module (rnrs bytevectors) - #:use-module (rnrs io ports) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) #:use-module (srfi srfi-34) #:use-module (srfi srfi-35) + #:use-module (ice-9 binary-ports) + #:use-module ((ice-9 rdelim) #:prefix rdelim:) #:use-module (ice-9 match) #:use-module (ice-9 ftw) #:export (write-int read-int @@ -143,7 +144,7 @@ substitute invalid byte sequences with question marks. This is a (port (open-bytevector-input-port bv))) (set-port-encoding! port "UTF-8") (set-port-conversion-strategy! port 'substitute) - (get-string-all port))) + (rdelim:read-string port))) (define (write-string-list l p) (write-int (length l) p) diff --git a/guix/store.scm b/guix/store.scm index 9f409b4209..43cfda9214 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -25,7 +25,7 @@ #:autoload (guix base32) (bytevector->base32-string) #:autoload (guix build syscalls) (terminal-columns) #:use-module (rnrs bytevectors) - #:use-module (rnrs io ports) + #:use-module (ice-9 binary-ports) #:use-module (srfi srfi-1) #:use-module (srfi srfi-9) #:use-module (srfi srfi-9 gnu) @@ -481,7 +481,7 @@ encoding conversion errors." (let ((s (read-maybe-utf8-string p))) (display s (current-build-output-port)) (when (string-any %newlines s) - (flush-output-port (current-build-output-port))) + (force-output (current-build-output-port))) #f)) ((= k %stderr-error) ;; Report an error. diff --git a/guix/tests.scm b/guix/tests.scm index 3cb4a671af..5110075e7d 100644 --- a/guix/tests.scm +++ b/guix/tests.scm @@ -27,7 +27,7 @@ #:use-module (gnu packages bootstrap) #:use-module (srfi srfi-34) #:use-module (rnrs bytevectors) - #:use-module (rnrs io ports) + #:use-module (ice-9 binary-ports) #:use-module (web uri) #:export (open-connection-for-tests random-text diff --git a/guix/utils.scm b/guix/utils.scm index decadf64a6..65a2baa0a2 100644 --- a/guix/utils.scm +++ b/guix/utils.scm @@ -30,7 +30,8 @@ #:use-module (srfi srfi-39) #:use-module (srfi srfi-60) #:use-module (rnrs bytevectors) - #:use-module (rnrs io ports) + #:use-module (ice-9 binary-ports) + #:autoload (rnrs io ports) (make-custom-binary-input-port) #:use-module ((rnrs bytevectors) #:select (bytevector-u8-set!)) #:use-module (guix combinators) #:use-module ((guix build utils) #:select (dump-port)) -- cgit v1.2.3