diff options
author | Marius Bakke <marius@gnu.org> | 2020-11-15 23:45:34 +0100 |
---|---|---|
committer | Marius Bakke <marius@gnu.org> | 2020-11-15 23:45:34 +0100 |
commit | 4e5e05d40908e9f1336ffc5a6c4928ab61ad034c (patch) | |
tree | ad6d6be0ece396ba3353871a5691e514253508f8 /guix | |
parent | 2c400ae94207b3b84fcdcaa21c122076c050d307 (diff) | |
parent | e1fa3ea9fe8d01dd124c5e304bde9243876378ba (diff) | |
download | guix-patches-4e5e05d40908e9f1336ffc5a6c4928ab61ad034c.tar guix-patches-4e5e05d40908e9f1336ffc5a6c4928ab61ad034c.tar.gz |
Merge branch 'master' into staging
Diffstat (limited to 'guix')
-rw-r--r-- | guix/hg-download.scm | 38 | ||||
-rw-r--r-- | guix/lint.scm | 14 | ||||
-rw-r--r-- | guix/scripts/archive.scm | 11 | ||||
-rw-r--r-- | guix/scripts/publish.scm | 2 | ||||
-rw-r--r-- | guix/ui.scm | 3 |
5 files changed, 56 insertions, 12 deletions
diff --git a/guix/hg-download.scm b/guix/hg-download.scm index 694105ceba..bd55946523 100644 --- a/guix/hg-download.scm +++ b/guix/hg-download.scm @@ -26,12 +26,14 @@ #:use-module (guix packages) #:autoload (guix build-system gnu) (standard-packages) #:use-module (ice-9 match) + #:use-module (ice-9 popen) + #:use-module (ice-9 rdelim) #:export (hg-reference hg-reference? hg-reference-url hg-reference-changeset hg-reference-recursive? - + hg-predicate hg-fetch)) ;;; Commentary: @@ -93,4 +95,38 @@ HASH-ALGO (a symbol). Use NAME as the file name, or a generic name if #f." #:recursive? #t #:guile-for-build guile))) +(define (hg-file-list directory) + "Evaluates to a list of files contained in the repository at path + @var{directory}" + (let* ((port (open-input-pipe (format #f "hg files --repository ~s" directory))) + (files (let loop ((files '())) + (let ((line (read-line port))) + (cond + ((eof-object? line) files) + (else + (loop (cons line files)))))))) + (close-pipe port) + (map canonicalize-path files))) + +(define (should-select? path-list candidate) + "Returns #t in case that @var{candidate} is a file that is part of the given +@var{path-list}." + (let ((canon-candidate (canonicalize-path candidate))) + (let loop ((xs path-list)) + (cond + ((null? xs) + ;; Directories are not part of `hg files', but `local-file' will not + ;; recurse if we don't return #t for directories. + (equal? (array-ref (lstat candidate) 13) 'directory)) + ((string-contains candidate (car xs)) #t) + (else (loop (cdr xs))))))) + +(define (hg-predicate directory) + "This procedure evaluates to a predicate that reports back whether a given +@var{file} - @var{stat} combination is part of the files tracked by +Mercurial." + (let ((files (hg-file-list directory))) + (lambda (file stat) + (should-select? files file)))) + ;;; hg-download.scm ends here diff --git a/guix/lint.scm b/guix/lint.scm index e1a77e8ac7..91dbc806dc 100644 --- a/guix/lint.scm +++ b/guix/lint.scm @@ -663,17 +663,11 @@ from ~a") (define (check-patch-file-names package) "Emit a warning if the patches requires by PACKAGE are badly named or if the patch could not be found." - (guard (c ((message-condition? c) ;raised by 'search-patch' - (list - ;; Use %make-warning, as condition-mesasge is already - ;; translated. - (%make-warning package (condition-message c) - #:field 'patch-file-names))) - ((formatted-message? c) + (guard (c ((formatted-message? c) ;raised by 'search-patch' (list (%make-warning package - (apply format #f - (G_ (formatted-message-string c)) - (formatted-message-arguments c)))))) + (formatted-message-string c) + (formatted-message-arguments c) + #:field 'source)))) (define patches (match (package-source package) ((? origin? origin) (origin-patches origin)) diff --git a/guix/scripts/archive.scm b/guix/scripts/archive.scm index 02557ce454..c04baf9784 100644 --- a/guix/scripts/archive.scm +++ b/guix/scripts/archive.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2019, 2020 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2020 Tobias Geerinckx-Rice <me@tobias.gr> ;;; ;;; This file is part of GNU Guix. ;;; @@ -310,6 +311,16 @@ the input port." (leave (G_ "failed to read public key: ~a: ~a~%") (error-source err) (error-string err))))) + ;; Warn about potentially volatile ACLs, but continue: system reconfiguration + ;; might not be possible without (newly-authorized) substitutes. + (let ((stat (false-if-exception (lstat %acl-file)))) + (when (and stat (eq? 'symlink (stat:type (lstat %acl-file)))) + (warning (G_ "replacing symbolic link ~a with a regular file~%") + %acl-file) + (when (string-prefix? (%store-prefix) (readlink %acl-file)) + (display-hint (G_ "On Guix System, add public keys to the +@code{authorized-keys} field of your @code{operating-system} instead."))))) + (let ((key (read-key)) (acl (current-acl))) (unless (eq? 'public-key (canonical-sexp-nth-data key 0)) diff --git a/guix/scripts/publish.scm b/guix/scripts/publish.scm index e3c8711f5b..a976a9ac60 100644 --- a/guix/scripts/publish.scm +++ b/guix/scripts/publish.scm @@ -891,6 +891,8 @@ blocking." client)) (port (begin (force-output client) + (setsockopt client SOL_SOCKET + SO_SNDBUF (* 128 1024)) (nar-response-port response compression)))) ;; XXX: Given our ugly workaround for <http://bugs.gnu.org/21093> in ;; 'render-nar', BODY here is just the file name of the store item. diff --git a/guix/ui.scm b/guix/ui.scm index 8d7bc238bc..4e686297e8 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -435,6 +435,7 @@ exiting. ARGS is the list of arguments received by the 'throw' handler." (gettext (condition-message obj) %gettext-domain))) ((formatted-message? obj) (warning (G_ "failed to load '~a': ~a~%") + file (apply format #f (gettext (formatted-message-string obj) %gettext-domain) @@ -717,7 +718,7 @@ evaluating the tests and bodies of CLAUSES." (package-full-name package) (build-system-name system)))) ((gexp-input-error? c) - (let ((input (package-error-invalid-input c))) + (let ((input (gexp-error-invalid-input c))) (leave (G_ "~s: invalid G-expression input~%") (gexp-error-invalid-input c)))) ((profile-not-found-error? c) |