diff options
Diffstat (limited to 'guix/scripts')
| -rw-r--r-- | guix/scripts/archive.scm | 4 | ||||
| -rw-r--r-- | guix/scripts/authenticate.scm | 9 | ||||
| -rw-r--r-- | guix/scripts/build.scm | 82 | ||||
| -rw-r--r-- | guix/scripts/download.scm | 2 | ||||
| -rw-r--r-- | guix/scripts/hash.scm | 4 | ||||
| -rw-r--r-- | guix/scripts/lint.scm | 15 | ||||
| -rw-r--r-- | guix/scripts/offload.scm | 11 | ||||
| -rw-r--r-- | guix/scripts/publish.scm | 6 | ||||
| -rw-r--r-- | guix/scripts/refresh.scm | 2 | ||||
| -rwxr-xr-x | guix/scripts/substitute.scm | 5 |
10 files changed, 91 insertions, 49 deletions
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 <ludo@gnu.org> +;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org> ;;; ;;; 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/build.scm b/guix/scripts/build.scm index b64138ec0e..8c2c4902fc 100644 --- a/guix/scripts/build.scm +++ b/guix/scripts/build.scm @@ -179,27 +179,48 @@ matching URIs given in SOURCES." (_ obj))))) +(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 #\=))) + + (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 direct dependency on a -package called \"guile\" must be replaced with a dependency on a version 2.1 -of \"guile\"." - (define not-equal - (char-set-complement (char-set #\=))) +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) + obj)))) - (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)) +(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 ((rewrite (package-input-rewriting replacements))) + (let* ((replacements (evaluate-replacement-specs replacement-specs + replacement-pair)) + (rewrite (package-input-rewriting replacements))) (lambda (store obj) (if (package? obj) (rewrite obj) @@ -211,20 +232,22 @@ of \"guile\"." ;; 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. - (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)) + (option '("with-graft") #t #f + (parser 'with-graft))))) (define (show-transformation-options-help) (display (_ " @@ -232,7 +255,10 @@ of \"guile\"." 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/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/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/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) |