From 6330db4d55bf9be3702cc03145470c970fb7ae9b Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 1 Nov 2019 12:21:26 +0100 Subject: pull: Gracefully handle invalid Texinfo markup in news. Reported by Oleg Pykhalov . * guix/scripts/pull.scm (display-news-entry-title) (display-news-entry): Catch 'parser-error' around call to 'texi->plain-text', and return Texinfo as-is when an exception is caught. --- guix/scripts/pull.scm | 40 ++++++++++++++++++++++++++-------------- 1 file changed, 26 insertions(+), 14 deletions(-) (limited to 'guix') diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm index 80d070652b..92aac6066e 100644 --- a/guix/scripts/pull.scm +++ b/guix/scripts/pull.scm @@ -235,12 +235,18 @@ purposes." (define title (channel-news-entry-title entry)) - (format port " ~a~%" - (highlight - (string-trim-right - (texi->plain-text (or (assoc-ref title language) - (assoc-ref title (%default-message-language)) - "")))))) + (let ((title (or (assoc-ref title language) + (assoc-ref title (%default-message-language)) + ""))) + (format port " ~a~%" + (highlight + (string-trim-right + (catch 'parser-error + (lambda () + (texi->plain-text title)) + + ;; When Texinfo markup is invalid, display it as-is. + (const title))))))) (define (display-news-entry entry language port) "Display ENTRY, a , in LANGUAGE, a language code, to @@ -252,14 +258,20 @@ PORT." (format port (dim (G_ " commit ~a~%")) (channel-news-entry-commit entry)) (newline port) - (format port " ~a~%" - (indented-string - (parameterize ((%text-width (- (%text-width) 4))) - (string-trim-right - (texi->plain-text (or (assoc-ref body language) - (assoc-ref body (%default-message-language)) - "")))) - 4))) + (let ((body (or (assoc-ref body language) + (assoc-ref body (%default-message-language)) + ""))) + (format port " ~a~%" + (indented-string + (parameterize ((%text-width (- (%text-width) 4))) + (string-trim-right + (catch 'parser-error + (lambda () + (texi->plain-text body)) + (lambda _ + ;; When Texinfo markup is invalid, display it as-is. + (fill-paragraph body (%text-width)))))) + 4)))) (define* (display-channel-specific-news new old #:key (port (current-output-port)) -- cgit v1.2.3 From 665467767577172db40eea510583dbf2faf56a58 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 6 Nov 2019 22:02:34 +0100 Subject: derivations: Use a regular hash table for the module cache. The hit rate of the 'add-data-to-store' cache goes from 10% to 4% on: guix build -e '(@@ (gnu packages libreoffice) libreoffice)' -nd * guix/derivations.scm (%module-cache): Turn into a regular hash table. It didn't make sense to use a weak-value hash table given that values are pairs. --- guix/derivations.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'guix') diff --git a/guix/derivations.scm b/guix/derivations.scm index bde937044a..6cdf55b1fe 100644 --- a/guix/derivations.scm +++ b/guix/derivations.scm @@ -1208,7 +1208,7 @@ they can refer to each other." (define %module-cache ;; Map a list of modules to its 'imported+compiled-modules' result. - (make-weak-value-hash-table)) + (make-hash-table)) (define* (imported+compiled-modules store modules #:key (system (%current-system)) -- cgit v1.2.3 From 3e962e59d849e4300e447d94487684102d9d412e Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 7 Nov 2019 18:15:55 +0100 Subject: graph: Support package transformation options. * guix/scripts/graph.scm (%options): Append %TRANSFORMATION-OPTIONS. (show-help): Call 'show-transformation-options-help'. (guix-graph): Call 'options->transformation' and use it. * tests/guix-graph.sh: Add test. * doc/guix.texi (Invoking guix graph): Document it. --- doc/guix.texi | 11 ++++++ guix/scripts/graph.scm | 105 ++++++++++++++++++++++++++++--------------------- tests/guix-graph.sh | 8 +++- 3 files changed, 78 insertions(+), 46 deletions(-) (limited to 'guix') diff --git a/doc/guix.texi b/doc/guix.texi index 3a9d206b9f..3b8e5935bb 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -9907,7 +9907,18 @@ The package dependency graph is largely architecture-independent, but there are some architecture-dependent bits that this option allows you to visualize. @end table +On top of that, @command{guix graph} supports all the usual package +transformation options (@pxref{Package Transformation Options}). This +makes it easy to view the effect of a graph-rewriting transformation +such as @option{--with-input}. For example, the command below outputs +the graph of @code{git} once @code{openssl} has been replaced by +@code{libressl} everywhere in the graph: +@example +guix graph git --with-input=openssl=libressl +@end example + +So many possibilities, so much fun! @node Invoking guix publish @section Invoking @command{guix publish} diff --git a/guix/scripts/graph.scm b/guix/scripts/graph.scm index 2e14857f1e..7558cb1e85 100644 --- a/guix/scripts/graph.scm +++ b/guix/scripts/graph.scm @@ -32,6 +32,10 @@ #:use-module (gnu packages) #:use-module (guix sets) #:use-module ((guix utils) #:select (location-file)) + #:use-module ((guix scripts build) + #:select (show-transformation-options-help + options->transformation + %transformation-options)) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) #:use-module (srfi srfi-34) @@ -446,36 +450,38 @@ package modules, while attempting to retain user package modules." ;;; (define %options - (list (option '(#\t "type") #t #f - (lambda (opt name arg result) - (alist-cons 'node-type (lookup-node-type arg) - result))) - (option '("list-types") #f #f - (lambda (opt name arg result) - (list-node-types) - (exit 0))) - (option '(#\b "backend") #t #f - (lambda (opt name arg result) - (alist-cons 'backend (lookup-backend arg) - result))) - (option '("list-backends") #f #f - (lambda (opt name arg result) - (list-backends) - (exit 0))) - (option '(#\e "expression") #t #f - (lambda (opt name arg result) - (alist-cons 'expression arg result))) - (option '(#\s "system") #t #f - (lambda (opt name arg result) - (alist-cons 'system arg - (alist-delete 'system result eq?)))) - (option '(#\h "help") #f #f - (lambda args - (show-help) - (exit 0))) - (option '(#\V "version") #f #f - (lambda args - (show-version-and-exit "guix edit"))))) + (cons* (option '(#\t "type") #t #f + (lambda (opt name arg result) + (alist-cons 'node-type (lookup-node-type arg) + result))) + (option '("list-types") #f #f + (lambda (opt name arg result) + (list-node-types) + (exit 0))) + (option '(#\b "backend") #t #f + (lambda (opt name arg result) + (alist-cons 'backend (lookup-backend arg) + result))) + (option '("list-backends") #f #f + (lambda (opt name arg result) + (list-backends) + (exit 0))) + (option '(#\e "expression") #t #f + (lambda (opt name arg result) + (alist-cons 'expression arg result))) + (option '(#\s "system") #t #f + (lambda (opt name arg result) + (alist-cons 'system arg + (alist-delete 'system result eq?)))) + (option '(#\h "help") #f #f + (lambda args + (show-help) + (exit 0))) + (option '(#\V "version") #f #f + (lambda args + (show-version-and-exit "guix graph"))) + + %transformation-options)) (define (show-help) ;; TRANSLATORS: Here 'dot' is the name of a program; it must not be @@ -495,6 +501,8 @@ Emit a representation of the dependency graph of PACKAGE...\n")) (display (G_ " -s, --system=SYSTEM consider the graph for SYSTEM--e.g., \"i686-linux\"")) (newline) + (show-transformation-options-help) + (newline) (display (G_ " -h, --help display this help and exit")) (display (G_ " @@ -514,21 +522,28 @@ Emit a representation of the dependency graph of PACKAGE...\n")) (define (guix-graph . args) (with-error-handling - (let* ((opts (parse-command-line args %options - (list %default-options) - #:build-options? #f)) - (backend (assoc-ref opts 'backend)) - (type (assoc-ref opts 'node-type)) - (items (filter-map (match-lambda - (('argument . (? store-path? item)) - item) - (('argument . spec) - (specification->package spec)) - (('expression . exp) - (read/eval-package-expression exp)) - (_ #f)) - opts))) - (with-store store + (define opts + (parse-command-line args %options + (list %default-options) + #:build-options? #f)) + (define backend + (assoc-ref opts 'backend)) + (define type + (assoc-ref opts 'node-type)) + + (with-store store + (let* ((transform (options->transformation opts)) + (items (filter-map (match-lambda + (('argument . (? store-path? item)) + item) + (('argument . spec) + (transform store + (specification->package spec))) + (('expression . exp) + (transform store + (read/eval-package-expression exp))) + (_ #f)) + opts))) ;; Ask for absolute file names so that .drv file names passed from the ;; user to 'read-derivation' are absolute when it returns. (with-fluids ((%file-port-name-canonicalization 'absolute)) diff --git a/tests/guix-graph.sh b/tests/guix-graph.sh index 1ec99706fd..2d4b3fac3f 100644 --- a/tests/guix-graph.sh +++ b/tests/guix-graph.sh @@ -1,5 +1,5 @@ # GNU Guix --- Functional package management for GNU -# Copyright © 2015, 2016 Ludovic Courtès +# Copyright © 2015, 2016, 2019 Ludovic Courtès # # This file is part of GNU Guix. # @@ -53,3 +53,9 @@ cmp "$tmpfile1" "$tmpfile2" guix graph -t derivation coreutils > "$tmpfile1" guix graph -t derivation `guix build -d coreutils` > "$tmpfile2" cmp "$tmpfile1" "$tmpfile2" + +# Try package transformation options. +guix graph git | grep 'label = "openssl' +guix graph git --with-input=openssl=libressl | grep 'label = "libressl' +if guix graph git --with-input=openssl=libressl | grep 'label = "openssl' +then false; else true; fi -- cgit v1.2.3 From f49e9131889775a74a85c1f9b29f108030337b8b Mon Sep 17 00:00:00 2001 From: Julien Lepiller Date: Thu, 7 Nov 2019 21:50:54 +0100 Subject: guix: Add file-locking with no wait. * guix/build/syscalls.scm (with-file-lock/no-wait): New procedure. (lock-file): Take a #:wait? key. --- guix/build/syscalls.scm | 35 +++++++++++++++++++++++++++++++++-- 1 file changed, 33 insertions(+), 2 deletions(-) (limited to 'guix') diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm index bbf2531c79..a5a9c92a42 100644 --- a/guix/build/syscalls.scm +++ b/guix/build/syscalls.scm @@ -80,6 +80,7 @@ lock-file unlock-file with-file-lock + with-file-lock/no-wait set-thread-name thread-name @@ -1087,10 +1088,10 @@ exception if it's already taken." ;; Presumably we got EAGAIN or so. (throw 'flock-error err)))))) -(define (lock-file file) +(define* (lock-file file #:key (wait? #t)) "Wait and acquire an exclusive lock on FILE. Return an open port." (let ((port (open-file file "w0"))) - (fcntl-flock port 'write-lock) + (fcntl-flock port 'write-lock #:wait? wait?) port)) (define (unlock-file port) @@ -1119,10 +1120,40 @@ exception if it's already taken." (when port (unlock-file port)))))) +(define (call-with-file-lock/no-wait file thunk handler) + (let ((port (catch #t + (lambda () + (lock-file file #:wait? #f)) + (lambda (key . args) + (match key + ('flock-error + (handler args)) + ('system-error + ;; When using the statically-linked Guile in the initrd, + ;; 'fcntl-flock' returns ENOSYS unconditionally. Ignore + ;; that error since we're typically the only process running + ;; at this point. + (if (= ENOSYS (system-error-errno (cons key args))) + #f + (apply throw args))) + (_ (apply throw key args))))))) + (dynamic-wind + (lambda () + #t) + thunk + (lambda () + (when port + (unlock-file port)))))) + (define-syntax-rule (with-file-lock file exp ...) "Wait to acquire a lock on FILE and evaluate EXP in that context." (call-with-file-lock file (lambda () exp ...))) +(define-syntax-rule (with-file-lock/no-wait file handler exp ...) + "Try to acquire a lock on FILE and evaluate EXP in that context. Execute +handler if the lock is already held by another process." + (call-with-file-lock/no-wait file (lambda () exp ...) handler)) + ;;; ;;; Miscellaneous, aka. 'prctl'. -- cgit v1.2.3 From b1fb663404894268b5ee92c040f12c52c0bee425 Mon Sep 17 00:00:00 2001 From: Julien Lepiller Date: Fri, 25 Oct 2019 21:39:21 +0200 Subject: guix: package: lock profiles when processing them. * guix/scripts/package.scm (process-actions): Get a per-profile lock to prevent concurrent actions on profiles. * tests/guix-package.sh: Add test. --- guix/scripts/package.scm | 70 +++++++++++++++++++++++++++--------------------- tests/guix-package.sh | 10 ++++++- 2 files changed, 49 insertions(+), 31 deletions(-) (limited to 'guix') diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index 1a58d43e5c..bcd03a1df9 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -42,6 +42,8 @@ #:autoload (guix store roots) (gc-roots) #:use-module ((guix build utils) #:select (directory-exists? mkdir-p)) + #:use-module ((guix build syscalls) + #:select (with-file-lock/no-wait)) #:use-module (ice-9 format) #:use-module (ice-9 match) #:use-module (ice-9 regex) @@ -876,36 +878,44 @@ processed, #f otherwise." (package-version item) (manifest-entry-version entry)))))) - ;; First, process roll-backs, generation removals, etc. - (for-each (match-lambda - ((key . arg) - (and=> (assoc-ref %actions key) - (lambda (proc) - (proc store profile arg opts - #:dry-run? dry-run?))))) - opts) - - ;; Then, process normal package removal/installation/upgrade. - (let* ((manifest (profile-manifest profile)) - (step1 (options->removable opts manifest - (manifest-transaction))) - (step2 (options->installable opts manifest step1)) - (step3 (manifest-transaction - (inherit step2) - (install (map transform-entry - (manifest-transaction-install step2))))) - (new (manifest-perform-transaction manifest step3))) - - (warn-about-old-distro) - - (unless (manifest-transaction-null? step3) - (show-manifest-transaction store manifest step3 - #:dry-run? dry-run?) - (build-and-use-profile store profile new - #:allow-collisions? allow-collisions? - #:bootstrap? bootstrap? - #:use-substitutes? substitutes? - #:dry-run? dry-run?)))) + + ;; First, acquire a lock on the profile, to ensure only one guix process + ;; is modifying it at a time. + (with-file-lock/no-wait (string-append profile ".lock") + (lambda (key . args) + (leave (G_ "profile ~a is locked by another process~%") + profile)) + + ;; Then, process roll-backs, generation removals, etc. + (for-each (match-lambda + ((key . arg) + (and=> (assoc-ref %actions key) + (lambda (proc) + (proc store profile arg opts + #:dry-run? dry-run?))))) + opts) + + ;; Then, process normal package removal/installation/upgrade. + (let* ((manifest (profile-manifest profile)) + (step1 (options->removable opts manifest + (manifest-transaction))) + (step2 (options->installable opts manifest step1)) + (step3 (manifest-transaction + (inherit step2) + (install (map transform-entry + (manifest-transaction-install step2))))) + (new (manifest-perform-transaction manifest step3))) + + (warn-about-old-distro) + + (unless (manifest-transaction-null? step3) + (show-manifest-transaction store manifest step3 + #:dry-run? dry-run?) + (build-and-use-profile store profile new + #:allow-collisions? allow-collisions? + #:bootstrap? bootstrap? + #:use-substitutes? substitutes? + #:dry-run? dry-run?))))) ;;; diff --git a/tests/guix-package.sh b/tests/guix-package.sh index 0de30bf6c1..7ad0699380 100644 --- a/tests/guix-package.sh +++ b/tests/guix-package.sh @@ -33,7 +33,7 @@ profile="t-profile-$$" tmpfile="t-guix-package-file-$$" rm -f "$profile" "$tmpfile" -trap 'rm -f "$profile" "$profile-"[0-9]* "$tmpfile"; rm -rf "$module_dir" t-home-'"$$" EXIT +trap 'rm -f "$profile" "$profile.lock" "$profile-"[0-9]* "$tmpfile"; rm -rf "$module_dir" t-home-'"$$" EXIT # Use `-e' with a non-package expression. if guix package --bootstrap -e +; @@ -452,3 +452,11 @@ rm -rf "$module_dir" # Make sure we can see user profiles. guix package --list-profiles | grep "$profile" guix package --list-profiles | grep '\.guix-profile' + +# Make sure we can properly lock a profile. +mkdir "$module_dir" +echo '(sleep 60)' > "$module_dir/manifest.scm" +guix package -m "$module_dir/manifest.scm" -p "$module_dir/profile" & +pid=$! +if guix install emacs -p "$module_dir/profile"; then kill $pid; false; else true; fi +kill $pid -- cgit v1.2.3 From 7f0f38b54c98f13fed4cec1ee4785d493f29abee Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 8 Nov 2019 23:19:07 +0100 Subject: ui: Produce hyperlinks for the 'location' field of search results. This affects the output of 'guix show', 'guix search', and 'guix system search'. * guix/ui.scm (hyperlink, supports-hyperlinks?, location->hyperlink): New procedures. (package->recutils): Add #:hyperlinks? and honor it. (display-search-results): Pass #:hyperlinks? to PRINT. * guix/scripts/system/search.scm (service-type->recutils): Add #:hyperlinks? and honor it. --- guix/scripts/system/search.scm | 10 +++++--- guix/ui.scm | 55 ++++++++++++++++++++++++++++++++++++------ 2 files changed, 54 insertions(+), 11 deletions(-) (limited to 'guix') diff --git a/guix/scripts/system/search.scm b/guix/scripts/system/search.scm index 5278062edd..d2eac06cca 100644 --- a/guix/scripts/system/search.scm +++ b/guix/scripts/system/search.scm @@ -65,9 +65,12 @@ provided TYPE has a default value." (define* (service-type->recutils type port #:optional (width (%text-width)) - #:key (extra-fields '())) + #:key + (extra-fields '()) + (hyperlinks? (supports-hyperlinks? port))) "Write to PORT a recutils record of TYPE, arranging to fit within WIDTH -columns." +columns. When HYPERLINKS? is true, emit hyperlink escape sequences when +appropriate." (define width* ;; The available number of columns once we've taken into account space for ;; the initial "+ " prefix. @@ -84,7 +87,8 @@ columns." ;; Note: Don't i18n field names so that people can post-process it. (format port "name: ~a~%" (service-type-name type)) (format port "location: ~a~%" - (or (and=> (service-type-location type) location->string) + (or (and=> (service-type-location type) + (if hyperlinks? location->hyperlink location->string)) (G_ "unknown"))) (format port "extends: ~a~%" diff --git a/guix/ui.scm b/guix/ui.scm index 3e4bd5787e..bce0df5e8f 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -69,6 +69,7 @@ #:autoload (system base compile) (compile-file) #:autoload (system repl repl) (start-repl) #:autoload (system repl debug) (make-debug stack->vector) + #:autoload (web uri) (encode-and-join-uri-path) #:use-module (texinfo) #:use-module (texinfo plain-text) #:use-module (texinfo string-utils) @@ -108,6 +109,9 @@ package->recutils package-specification->name+version+output + supports-hyperlinks? + location->hyperlink + relevance package-relevance display-search-results @@ -1234,10 +1238,42 @@ followed by \"+ \", which makes for a valid multi-line field value in the '() str))) +(define (hyperlink uri text) + "Return a string that denotes a hyperlink using an OSC escape sequence as +documented at +." + (string-append "\x1b]8;;" uri "\x1b\\" + text "\x1b]8;;\x1b\\")) + +(define (supports-hyperlinks? port) + "Return true if PORT is a terminal that supports hyperlink escapes." + ;; Note that terminals are supposed to ignore OSC escapes they don't + ;; understand (this is the case of xterm as of version 349, for instance.) + ;; However, Emacs comint as of 26.3 does not ignore it and instead lets it + ;; through, hence the 'INSIDE_EMACS' special case below. + (and (isatty?* port) + (not (getenv "INSIDE_EMACS")))) + +(define (location->hyperlink location) + "Return a string corresponding to LOCATION, with escapes for a hyperlink." + (let ((str (location->string location)) + (file (if (string-prefix? "/" (location-file location)) + (location-file location) + (search-path %load-path (location-file location))))) + (if file + (hyperlink (string-append "file://" (gethostname) + (encode-and-join-uri-path + (string-split file #\/))) + str) + str))) + (define* (package->recutils p port #:optional (width (%text-width)) - #:key (extra-fields '())) + #:key + (hyperlinks? (supports-hyperlinks? port)) + (extra-fields '())) "Write to PORT a `recutils' record of package P, arranging to fit within -WIDTH columns. EXTRA-FIELDS is a list of symbol/value pairs to emit." +WIDTH columns. EXTRA-FIELDS is a list of symbol/value pairs to emit. When +HYPERLINKS? is true, emit hyperlink escape sequences when appropriate." (define width* ;; The available number of columns once we've taken into account space for ;; the initial "+ " prefix. @@ -1265,7 +1301,8 @@ WIDTH columns. EXTRA-FIELDS is a list of symbol/value pairs to emit." (((labels inputs . _) ...) (dependencies->recutils (filter package? inputs))))) (format port "location: ~a~%" - (or (and=> (package-location p) location->string) + (or (and=> (package-location p) + (if hyperlinks? location->hyperlink location->string)) (G_ "unknown"))) ;; Note: Starting from version 1.6 or recutils, hyphens are not allowed in @@ -1398,11 +1435,13 @@ them. If PORT is a terminal, print at most a full screen of results." (let loop ((matches matches)) (match matches (((package . score) rest ...) - (let ((text (call-with-output-string - (lambda (port) - (print package port - #:extra-fields - `((relevance . ,score))))))) + (let* ((links? (supports-hyperlinks? port)) + (text (call-with-output-string + (lambda (port) + (print package port + #:hyperlinks? links? + #:extra-fields + `((relevance . ,score))))))) (if (and max-rows (> (port-line port) first-line) ;print at least one result (> (+ 4 (line-count text) (port-line port)) -- cgit v1.2.3 From edd25a8caca7ff7184c98823845ee0d49c16916c Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 8 Nov 2019 23:23:01 +0100 Subject: ui: Emit hyperlinks for 'license' in package search results. * guix/ui.scm (package->recutils): When HYPERLINKS is true, call 'hyperlink' for the 'license' field. --- guix/ui.scm | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) (limited to 'guix') diff --git a/guix/ui.scm b/guix/ui.scm index bce0df5e8f..eb17d274c8 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -44,7 +44,8 @@ #:use-module (guix derivations) #:use-module (guix build-system) #:use-module (guix serialization) - #:use-module ((guix licenses) #:select (license? license-name)) + #:use-module ((guix licenses) + #:select (license? license-name license-uri)) #:use-module ((guix build syscalls) #:select (free-disk-space terminal-columns terminal-rows)) @@ -1315,7 +1316,11 @@ HYPERLINKS? is true, emit hyperlink escape sequences when appropriate." (string-join (map license-name licenses) ", ")) ((? license? license) - (license-name license)) + (let ((text (license-name license)) + (uri (license-uri license))) + (if (and hyperlinks? uri (string-prefix? "http" uri)) + (hyperlink uri text) + text))) (x (G_ "unknown")))) (format port "synopsis: ~a~%" -- cgit v1.2.3 From 277ba1d4f841dcc57a259caeed298567d5143eae Mon Sep 17 00:00:00 2001 From: Julien Lepiller Date: Mon, 21 Oct 2019 21:48:31 +0200 Subject: guix: svn: Allow dropping externals. * guix/build/svn.scm (svn-fetch): Allow to ignore externals. * guix/svn-download.scm (svn-reference, svn-multi-reference): Add recursive? field. --- guix/build/svn.scm | 4 ++++ guix/svn-download.scm | 15 +++++++++++---- 2 files changed, 15 insertions(+), 4 deletions(-) (limited to 'guix') diff --git a/guix/build/svn.scm b/guix/build/svn.scm index e3188add3e..33783f3056 100644 --- a/guix/build/svn.scm +++ b/guix/build/svn.scm @@ -31,6 +31,7 @@ (define* (svn-fetch url revision directory #:key (svn-command "svn") + (recursive? #t) (user-name #f) (password #f)) "Fetch REVISION from URL into DIRECTORY. REVISION must be an integer, and a @@ -45,6 +46,9 @@ valid Subversion revision. Return #t on success, #f otherwise." (list (string-append "--username=" user-name) (string-append "--password=" password)) '()) + ,@(if recursive? + '() + (list "--ignore-externals")) ,url ,directory)) #t) diff --git a/guix/svn-download.scm b/guix/svn-download.scm index 4139cbc2e2..59e2eb8d07 100644 --- a/guix/svn-download.scm +++ b/guix/svn-download.scm @@ -31,6 +31,7 @@ svn-reference? svn-reference-url svn-reference-revision + svn-reference-recursive? svn-fetch download-svn-to-store @@ -39,6 +40,7 @@ svn-multi-reference-url svn-multi-reference-revision svn-multi-reference-locations + svn-multi-reference-recursive? svn-multi-fetch)) ;;; Commentary: @@ -52,10 +54,11 @@ (define-record-type* svn-reference make-svn-reference svn-reference? - (url svn-reference-url) ; string - (revision svn-reference-revision) ; number - (user-name svn-reference-user-name (default #f)) - (password svn-reference-password (default #f))) + (url svn-reference-url) ; string + (revision svn-reference-revision) ; number + (recursive? svn-reference-recursive? (default #t)) + (user-name svn-reference-user-name (default #f)) + (password svn-reference-password (default #f))) (define (subversion-package) "Return the default Subversion package." @@ -78,6 +81,7 @@ HASH-ALGO (a symbol). Use NAME as the file name, or a generic name if #f." '#$(svn-reference-revision ref) #$output #:svn-command (string-append #+svn "/bin/svn") + #:recursive? #$(svn-reference-recursive? ref) #:user-name #$(svn-reference-user-name ref) #:password #$(svn-reference-password ref))))) @@ -96,6 +100,7 @@ HASH-ALGO (a symbol). Use NAME as the file name, or a generic name if #f." (url svn-multi-reference-url) ; string (revision svn-multi-reference-revision) ; number (locations svn-multi-reference-locations) ; list of strings + (recursive? svn-multi-reference-recursive? (default #t)) (user-name svn-multi-reference-user-name (default #f)) (password svn-multi-reference-password (default #f))) @@ -125,6 +130,8 @@ HASH-ALGO (a symbol). Use NAME as the file name, or a generic name if #f." (string-append #$output "/" location) (string-append #$output "/" (dirname location))) #:svn-command (string-append #+svn "/bin/svn") + #:recursive? + #$(svn-multi-reference-recursive? ref) #:user-name #$(svn-multi-reference-user-name ref) #:password #$(svn-multi-reference-password ref))) '#$(svn-multi-reference-locations ref))))) -- cgit v1.2.3 From cda79c7cc938ae3d9e77d09e8ebd7cbdf7f4d20c Mon Sep 17 00:00:00 2001 From: Efraim Flashner Date: Tue, 5 Nov 2019 14:55:05 +0200 Subject: make-bootstrap: Adjust copied linux headers. * guix/build/make-bootstrap.scm (copy-linux-headers): Remove header file 'a.out.h' is no longer part of the linux kernel headers. --- guix/build/make-bootstrap.scm | 1 - 1 file changed, 1 deletion(-) (limited to 'guix') diff --git a/guix/build/make-bootstrap.scm b/guix/build/make-bootstrap.scm index e5ef1d6d2b..0d29338ce3 100644 --- a/guix/build/make-bootstrap.scm +++ b/guix/build/make-bootstrap.scm @@ -47,7 +47,6 @@ bootstrap libc." (install-file (pk 'src (string-append kernel-headers "/include/linux/" file)) (pk 'dest (string-append incdir "/linux")))) '( - "a.out.h" ; for 2.2.5 "atalk.h" ; for 2.2.5 "errno.h" "falloc.h" -- cgit v1.2.3