From b02469d298d84c665a1970f6462fe241cb4d2150 Mon Sep 17 00:00:00 2001 From: Mathieu Othacehe Date: Sat, 1 Jul 2017 12:14:05 +0200 Subject: guix: git: Stop using libgit2-shutdown. * guix/git.scm (with-libgit2): Stop calling (libgit2-shutdown) to prevent segfaults when pointer finalizers are run. --- guix/git.scm | 13 ++++++------- 1 file changed, 6 insertions(+), 7 deletions(-) (limited to 'guix') diff --git a/guix/git.scm b/guix/git.scm index 17a6784aef..406c817341 100644 --- a/guix/git.scm +++ b/guix/git.scm @@ -34,13 +34,12 @@ (make-parameter "/var/cache/guix/checkouts")) (define-syntax-rule (with-libgit2 thunk ...) - (dynamic-wind - (lambda () - (libgit2-init!)) - (lambda () - thunk ...) - (lambda () - (libgit2-shutdown)))) + (begin + ;; XXX: The right thing to do would be to call (libgit2-shutdown) here, + ;; but pointer finalizers used in guile-git may be called after shutdown, + ;; resulting in a segfault. Hence, let's skip shutdown call for now. + (libgit2-init!) + thunk ...)) (define* (url-cache-directory url #:optional (cache-directory -- cgit v1.2.3 From 2633bd324b4333168518511030f227ee9664e65f Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 2 Jul 2017 00:20:23 +0200 Subject: store: 'references/substitutes' save an RPC is the trivial case. * guix/store.scm (references/substitutes): Save a 'substitutable-path-info' call when MISSING is empty. --- guix/store.scm | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'guix') diff --git a/guix/store.scm b/guix/store.scm index d1a4c67ae8..afd26d3fec 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -1023,7 +1023,9 @@ information for one of ITEMS is missing." ;; Query all the substitutes at once to minimize the cost of ;; launching 'guix substitute' and making HTTP requests. - (substs (substitutable-path-info store missing))) + (substs (if (null? missing) + '() + (substitutable-path-info store missing)))) (when (< (length substs) (length missing)) (raise (condition (&nix-protocol-error (message "cannot determine \ -- cgit v1.2.3 From b2fde4800d39863d9260509ac0b174b459d42840 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 2 Jul 2017 00:37:49 +0200 Subject: store: 'references/substitutes' really caches its result. Until now the cache was always empty because 'for-each' was passed ITEMS as its second argument, and ITEMS was the empty list at that point. * guix/store.scm (references/substitutes): Add 'requested' variable. Use it as second argument of 'for-each' in base case. --- guix/store.scm | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) (limited to 'guix') diff --git a/guix/store.scm b/guix/store.scm index afd26d3fec..a207d478e6 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -1009,7 +1009,8 @@ error if there is no such root." length as ITEMS. Query substitute information for any item missing from the store at once. Raise a '&nix-protocol-error' exception if reference information for one of ITEMS is missing." - (let* ((local-refs (map (lambda (item) + (let* ((requested items) + (local-refs (map (lambda (item) (or (hash-ref %reference-cache item) (guard (c ((nix-protocol-error? c) #f)) (references store item)))) @@ -1040,7 +1041,7 @@ the list of references") (() (let ((result (reverse result))) (for-each (cut hash-set! %reference-cache <> <>) - items result) + requested result) result)) ((item items ...) (match local-refs -- cgit v1.2.3 From dbde386ee315a88503980bc40095765288f15d0a Mon Sep 17 00:00:00 2001 From: 宋文武 Date: Sun, 2 Jul 2017 13:14:16 +0800 Subject: ui: package->recutlis: Remove duplicated package names in dependencies. * guix/ui.scm (package->recutils): Add call to 'delete-duplicates' in 'dependencies->recutils'. --- guix/ui.scm | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) (limited to 'guix') diff --git a/guix/ui.scm b/guix/ui.scm index c141880316..4bad00e8cf 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -983,8 +983,9 @@ WIDTH columns. EXTRA-FIELDS is a list of symbol/value pairs to emit." (if (> width 2) (- width 2) width)) (define (dependencies->recutils packages) - (let ((list (string-join (map package-full-name - (sort packages packagerecutils (fill-paragraph list width* (string-length "dependencies: "))))) -- cgit v1.2.3 From 3f4d8a7f66060e93a247797a9bbd2fcbee6922a3 Mon Sep 17 00:00:00 2001 From: Danny Milosavljevic Date: Mon, 3 Jul 2017 12:34:07 +0200 Subject: guix system: Add "--file-system-type" option. * guix/scripts/system.scm (process-action): Pass file-system-type to ... (perform-action): ... here. Add new keyword argument. Pass new value to ... (system-derivation-for-action): ... here. Add new keyword argument. Pass new value to system-disk-image. * doc/guix.texi (disk-image): Document new option. --- doc/guix.texi | 16 ++++++++++++++++ guix/scripts/system.scm | 23 +++++++++++++++++++---- 2 files changed, 35 insertions(+), 4 deletions(-) (limited to 'guix') diff --git a/doc/guix.texi b/doc/guix.texi index d61a5b7514..811031697c 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -16190,6 +16190,9 @@ in @var{file} that stands alone. By default, @command{guix system} estimates the size of the image needed to store the system, but you can use the @option{--image-size} option to specify a value. +You can specify the root file system type by using the +@option{--file-system-type} option. It defaults to "ext4". + When using @code{vm-image}, the returned image is in qcow2 format, which the QEMU emulator can efficiently use. @xref{Running GuixSD in a VM}, for more information on how to run the image in a virtual machine. @@ -16245,6 +16248,19 @@ This works as per @command{guix build} (@pxref{Invoking guix build}). Return the derivation file name of the given operating system without building anything. +@item --file-system-type=@var{type} +@itemx -t @var{type} +For the @code{disk-image} action, create a file system of the given +@var{type} on the image. + +When this option is omitted, @command{guix system} uses @code{ext4}. + +@cindex ISO-9660 format +@cindex CD image format +@cindex DVD image format +@code{--file-system-type=iso9660} produces an ISO-9660 image, suitable +for burning on CDs and DVDs. + @item --image-size=@var{size} For the @code{vm-image} and @code{disk-image} actions, create an image of the given @var{size}. @var{size} may be a number of bytes, or it may diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index 7e20b10dad..65dd92e8b7 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -560,7 +560,8 @@ PATTERN, a string. When PATTERN is #f, display all the system generations." ;;; (define* (system-derivation-for-action os action - #:key image-size full-boot? mappings) + #:key image-size file-system-type + full-boot? mappings) "Return as a monadic value the derivation for OS according to ACTION." (case action ((build init reconfigure) @@ -578,7 +579,8 @@ PATTERN, a string. When PATTERN is #f, display all the system generations." (* 70 (expt 2 20))) #:mappings mappings)) ((disk-image) - (system-disk-image os #:disk-image-size image-size)))) + (system-disk-image os #:disk-image-size image-size + #:file-system-type file-system-type)))) (define (maybe-suggest-running-guix-pull) "Suggest running 'guix pull' if this has never been done before." @@ -610,13 +612,15 @@ and TARGET arguments." #:key install-bootloader? dry-run? derivations-only? use-substitutes? device target - image-size full-boot? + image-size file-system-type full-boot? (mappings '()) (gc-root #f)) "Perform ACTION for OS. INSTALL-BOOTLOADER? specifies whether to install bootloader; DEVICE is the target devices for bootloader; TARGET is the target root directory; IMAGE-SIZE is the size of the image to be built, for the -'vm-image' and 'disk-image' actions. FULL-BOOT? is used for the 'vm' action; +'vm-image' and 'disk-image' actions. +The root filesystem is created as a FILE-SYSTEM-TYPE filesystem. +FULL-BOOT? is used for the 'vm' action; it determines whether to boot directly to the kernel or to the bootloader. When DERIVATIONS-ONLY? is true, print the derivation file name(s) without @@ -632,6 +636,7 @@ output when building a system derivation, such as a disk image." (mlet* %store-monad ((sys (system-derivation-for-action os action + #:file-system-type file-system-type #:image-size image-size #:full-boot? full-boot? #:mappings mappings)) @@ -774,6 +779,10 @@ Some ACTIONS support additional ARGS.\n")) (display (G_ " --on-error=STRATEGY apply STRATEGY when an error occurs while reading FILE")) + (display (G_ " + --file-system-type=TYPE + for 'disk-image', produce a root file system of TYPE + (one of 'ext4', 'iso9660')")) (display (G_ " --image-size=SIZE for 'vm-image', produce an image of SIZE")) (display (G_ " @@ -812,6 +821,10 @@ Some ACTIONS support additional ARGS.\n")) (lambda (opt name arg result) (alist-cons 'on-error (string->symbol arg) result))) + (option '(#\t "file-system-type") #t #f + (lambda (opt name arg result) + (alist-cons 'file-system-type arg + result))) (option '("image-size") #t #f (lambda (opt name arg result) (alist-cons 'image-size (size->number arg) @@ -854,6 +867,7 @@ Some ACTIONS support additional ARGS.\n")) (build-hook? . #t) (max-silent-time . 3600) (verbosity . 0) + (file-system-type . "ext4") (image-size . guess) (install-bootloader? . #t))) @@ -906,6 +920,7 @@ resulting from command-line parsing." #:derivations-only? (assoc-ref opts 'derivations-only?) #:use-substitutes? (assoc-ref opts 'substitutes?) + #:file-system-type (assoc-ref opts 'file-system-type) #:image-size (assoc-ref opts 'image-size) #:full-boot? (assoc-ref opts 'full-boot?) #:mappings (filter-map (match-lambda -- cgit v1.2.3 From 85cfbd46cea30891db5585e2a8d63d3a585df5e6 Mon Sep 17 00:00:00 2001 From: 宋文武 Date: Mon, 3 Jul 2017 23:11:13 +0800 Subject: profiles: xdg-desktop-database: Run the hook when GLib is referenced. This will pull the latest 'desktop-file-utils' package into the profile closure, as the 'xdg-mime-database' hook already does. * guix/profiles.scm (xdg-desktop-database): Run the hook when 'glib' is referenced. --- guix/profiles.scm | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) (limited to 'guix') diff --git a/guix/profiles.scm b/guix/profiles.scm index 056406e303..85c1722d62 100644 --- a/guix/profiles.scm +++ b/guix/profiles.scm @@ -967,9 +967,13 @@ for both major versions of GTK+." "Return a derivation that builds the @file{mimeinfo.cache} database from desktop files. It's used to query what applications can handle a given MIME type." - (mlet %store-monad ((desktop-file-utils + (define desktop-file-utils ; lazy reference + (module-ref (resolve-interface '(gnu packages freedesktop)) + 'desktop-file-utils)) + + (mlet %store-monad ((glib (manifest-lookup-package - manifest "desktop-file-utils"))) + manifest "glib"))) (define build (with-imported-modules '((guix build utils) (guix build union)) @@ -990,8 +994,8 @@ MIME type." #:log-port (%make-void-port "w")) (exit (zero? (system* update-desktop-database destdir))))))) - ;; Don't run the hook when 'desktop-file-utils' is not referenced. - (if desktop-file-utils + ;; Don't run the hook when 'glib' is not referenced. + (if glib (gexp->derivation "xdg-desktop-database" build #:local-build? #t #:substitutable? #f) -- cgit v1.2.3 From d5ec5ed7197d121130af6953378bcfd8929a9754 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 3 Jul 2017 12:07:23 +0200 Subject: packages: Mark 'replacement' as an "innate" field. Suggested by Mark H Weaver at . * guix/packages.scm ()[replacement]: Mark as "innate". * gnu/packages/base.scm (glibc-2.25-patched, glibc-2.24) (glibc-2.23, glibc-2.22, glibc-2.21, glibc-locales): Remove 'replacement' field, which was set to #f. * gnu/packages/commencement.scm (perl-boot0): Likewise. * gnu/packages/fontutils.scm (graphite2/fixed): Likewise. * gnu/packages/ghostscript.scm (ghostscript/fixed): Likewise. * gnu/packages/gnupg.scm (libgcrypt-1.7.8): Likewise. * gnu/packages/guile.scm (guile-2.0/fixed, guile-2.2): Likewise. * gnu/packages/icu4c.scm (icu4c/fixed): Likewise. * gnu/packages/image.scm (libpng-apng): Likewise. * gnu/packages/make-bootstrap.scm (%guile-static): Likewise. * gnu/packages/pcre.scm (pcre/fixed): Likewise. * gnu/packages/perl.scm (perl/fixed): Likewise. * gnu/packages/ruby.scm (ruby-2.3, ruby-2.2, ruby-2.1) (ruby-1.8): Likewise. * gnu/packages/tls.scm (gnutls-3.5.13, gnutls/guile-2.2): Likewise. * gnu/packages/xml.scm (expat-2.2.1): Likewise. --- gnu/packages/base.scm | 6 ------ gnu/packages/commencement.scm | 1 - gnu/packages/fontutils.scm | 1 - gnu/packages/ghostscript.scm | 1 - gnu/packages/gnupg.scm | 2 -- gnu/packages/guile.scm | 4 +--- gnu/packages/icu4c.scm | 1 - gnu/packages/image.scm | 1 - gnu/packages/make-bootstrap.scm | 1 - gnu/packages/pcre.scm | 1 - gnu/packages/perl.scm | 1 - gnu/packages/ruby.scm | 4 ---- gnu/packages/tls.scm | 2 -- gnu/packages/xml.scm | 1 - guix/packages.scm | 5 ++++- 15 files changed, 5 insertions(+), 27 deletions(-) (limited to 'guix') diff --git a/gnu/packages/base.scm b/gnu/packages/base.scm index 979d657957..81f8b3c8d6 100644 --- a/gnu/packages/base.scm +++ b/gnu/packages/base.scm @@ -905,7 +905,6 @@ GLIBC/HURD for a Hurd host" (define glibc-2.25-patched (package (inherit glibc) - (replacement #f) (source (origin (inherit (package-source glibc)) (patches (search-patches "glibc-ldd-x86_64.patch" @@ -923,7 +922,6 @@ GLIBC/HURD for a Hurd host" (package (inherit glibc) (version "2.24") - (replacement #f) (source (origin (inherit (package-source glibc)) (uri (string-append "mirror://gnu/glibc/glibc-" @@ -943,7 +941,6 @@ GLIBC/HURD for a Hurd host" (package (inherit glibc) (version "2.23") - (replacement #f) (source (origin (inherit (package-source glibc)) (uri (string-append "mirror://gnu/glibc/glibc-" @@ -963,7 +960,6 @@ GLIBC/HURD for a Hurd host" (package (inherit glibc) (version "2.22") - (replacement #f) (source (origin (inherit (package-source glibc)) (uri (string-append "mirror://gnu/glibc/glibc-" @@ -991,7 +987,6 @@ GLIBC/HURD for a Hurd host" (package (inherit glibc-2.22) (version "2.21") - (replacement #f) (source (origin (inherit (package-source glibc-2.22)) (uri (string-append "mirror://gnu/glibc/glibc-" @@ -1004,7 +999,6 @@ GLIBC/HURD for a Hurd host" (package (inherit glibc) (name "glibc-locales") - (replacement #f) (source (origin (inherit (package-source glibc)) (patches (cons (search-patch "glibc-locales.patch") (origin-patches (package-source glibc)))))) diff --git a/gnu/packages/commencement.scm b/gnu/packages/commencement.scm index 069ffba888..54cf89bf47 100644 --- a/gnu/packages/commencement.scm +++ b/gnu/packages/commencement.scm @@ -294,7 +294,6 @@ (let ((perl (package (inherit perl) (name "perl-boot0") - (replacement #f) (arguments ;; At the very least, this must not depend on GCC & co. (let ((args `(#:disallowed-references diff --git a/gnu/packages/fontutils.scm b/gnu/packages/fontutils.scm index efea81dc11..75736a73d0 100644 --- a/gnu/packages/fontutils.scm +++ b/gnu/packages/fontutils.scm @@ -415,7 +415,6 @@ and returns a sequence of positioned glyphids from the font.") (package (inherit graphite2) (name "graphite2") - (replacement #f) (source (origin (method url-fetch) diff --git a/gnu/packages/ghostscript.scm b/gnu/packages/ghostscript.scm index 1cb651c96b..dc5dbcc856 100644 --- a/gnu/packages/ghostscript.scm +++ b/gnu/packages/ghostscript.scm @@ -219,7 +219,6 @@ output file formats and printers.") (define ghostscript/fixed (package (inherit ghostscript) - (replacement #f) (source (origin (inherit (package-source ghostscript)) diff --git a/gnu/packages/gnupg.scm b/gnu/packages/gnupg.scm index 4ddf13dccf..e71ec8dce6 100644 --- a/gnu/packages/gnupg.scm +++ b/gnu/packages/gnupg.scm @@ -119,7 +119,6 @@ generation.") (define libgcrypt-1.7.8 (package (inherit libgcrypt) - (replacement #f) (version "1.7.8") (source (origin (method url-fetch) @@ -131,7 +130,6 @@ generation.") (define-public libgcrypt-1.5 (package (inherit libgcrypt) - (replacement #f) (version "1.5.6") (source (origin diff --git a/gnu/packages/guile.scm b/gnu/packages/guile.scm index 6bff343429..d79094e1ee 100644 --- a/gnu/packages/guile.scm +++ b/gnu/packages/guile.scm @@ -217,14 +217,12 @@ without requiring the source code to be rewritten.") ;; in the `base' module, and thus changing it entails a full rebuild. (package (inherit guile-2.0) - (properties '((hidden? . #t))) ;people should install 'guile-2.0' - (replacement #f))) + (properties '((hidden? . #t))))) ;people should install 'guile-2.0' (define-public guile-2.2 (package (inherit guile-2.0) (name "guile") (version "2.2.2") - (replacement #f) (source (origin (method url-fetch) (uri (string-append "mirror://gnu/guile/guile-" version diff --git a/gnu/packages/icu4c.scm b/gnu/packages/icu4c.scm index 3e96520054..224319f84f 100644 --- a/gnu/packages/icu4c.scm +++ b/gnu/packages/icu4c.scm @@ -71,7 +71,6 @@ C/C++ part.") (define icu4c/fixed (package (inherit icu4c) - (replacement #f) (source (origin (inherit (package-source icu4c)) (patches diff --git a/gnu/packages/image.scm b/gnu/packages/image.scm index 504df60fb5..8a03cbc3c7 100644 --- a/gnu/packages/image.scm +++ b/gnu/packages/image.scm @@ -94,7 +94,6 @@ library. It supports almost all PNG features and is extensible.") (define-public libpng-apng (package (inherit libpng) - (replacement #f) ;libpng's replacement doesn't apply here (name "libpng-apng") (version (package-version libpng)) (arguments diff --git a/gnu/packages/make-bootstrap.scm b/gnu/packages/make-bootstrap.scm index 9efe338a19..844b110eb1 100644 --- a/gnu/packages/make-bootstrap.scm +++ b/gnu/packages/make-bootstrap.scm @@ -509,7 +509,6 @@ for `sh' in $PATH, and without nscd, and with static NSS modules." (patches patches))) (guile (package (inherit guile-2.0) (name (string-append (package-name guile-2.0) "-static")) - (replacement #f) (source source) (synopsis "Statically-linked and relocatable Guile") diff --git a/gnu/packages/pcre.scm b/gnu/packages/pcre.scm index 58beab0a96..67a8db1c73 100644 --- a/gnu/packages/pcre.scm +++ b/gnu/packages/pcre.scm @@ -75,7 +75,6 @@ POSIX regular expression API.") (define pcre/fixed (package (inherit pcre) - (replacement #f) (source (origin (inherit (package-source pcre)) (patches (search-patches "pcre-CVE-2017-7186.patch")))))) diff --git a/gnu/packages/perl.scm b/gnu/packages/perl.scm index 6da4bb13fd..6a59e6bf86 100644 --- a/gnu/packages/perl.scm +++ b/gnu/packages/perl.scm @@ -151,7 +151,6 @@ (define perl/fixed (package (inherit perl) - (replacement #f) (source (origin (inherit (package-source perl)) diff --git a/gnu/packages/ruby.scm b/gnu/packages/ruby.scm index 7680f4eae0..7eba684440 100644 --- a/gnu/packages/ruby.scm +++ b/gnu/packages/ruby.scm @@ -106,7 +106,6 @@ a focus on simplicity and productivity.") (package (inherit ruby) (version "2.3.4") - (replacement #f) (source (origin (method url-fetch) @@ -124,7 +123,6 @@ a focus on simplicity and productivity.") (define-public ruby-2.2 (package (inherit ruby) - (replacement #f) (version "2.2.7") (source (origin @@ -138,7 +136,6 @@ a focus on simplicity and productivity.") (define-public ruby-2.1 (package (inherit ruby) - (replacement #f) (version "2.1.10") (source (origin @@ -172,7 +169,6 @@ a focus on simplicity and productivity.") (define-public ruby-1.8 (package (inherit ruby) - (replacement #f) (version "1.8.7-p374") (source (origin diff --git a/gnu/packages/tls.scm b/gnu/packages/tls.scm index 9198bae026..f80f7d3bcd 100644 --- a/gnu/packages/tls.scm +++ b/gnu/packages/tls.scm @@ -222,7 +222,6 @@ required structures.") ;; We use 'D' instead of '13' here to keep the store file name at ;; the same length. See . (version "3.5.D") - (replacement #f) (source (origin (method url-fetch) (uri @@ -240,7 +239,6 @@ required structures.") ;; GnuTLS for Guile 2.2. This is supported by GnuTLS >= 3.5.5. (package (inherit gnutls) - (replacement #f) (source (package-source gnutls-3.5.13)) (name "guile2.2-gnutls") (arguments diff --git a/gnu/packages/xml.scm b/gnu/packages/xml.scm index 2b471e80db..67d6c8e8df 100644 --- a/gnu/packages/xml.scm +++ b/gnu/packages/xml.scm @@ -79,7 +79,6 @@ things the parser might find in the XML document (like start tags).") (package (inherit expat) (version "2.2.1") - (replacement #f) (source (origin (method url-fetch) (uri (string-append "mirror://sourceforge/expat/expat/" diff --git a/guix/packages.scm b/guix/packages.scm index 464fc433b2..f60303404f 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -269,8 +269,11 @@ name of its URI." ; inputs (native-search-paths package-native-search-paths (default '())) (search-paths package-search-paths (default '())) + + ;; The 'replacement' field is marked as "innate" because it never makes + ;; sense to inherit a replacement as is. See the 'package/inherit' macro. (replacement package-replacement ; package | #f - (default #f) (thunked)) + (default #f) (thunked) (innate)) (synopsis package-synopsis) ; one-line description (description package-description) ; one or two paragraphs -- cgit v1.2.3 From cc1dfc202f2fefb6c2eb9467d1fc90a9154550c9 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 3 Jul 2017 23:17:29 +0200 Subject: copy: Default to port 22. Failing to do that, "%p" would be "0" when using "ProxyCommand" in ~/.ssh/config. * guix/scripts/copy.scm (send-to-remote-host): Default to port 22. (retrieve-from-remote-host): Likewise. --- guix/scripts/copy.scm | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) (limited to 'guix') diff --git a/guix/scripts/copy.scm b/guix/scripts/copy.scm index 45f7cbbad5..32438b99d9 100644 --- a/guix/scripts/copy.scm +++ b/guix/scripts/copy.scm @@ -75,7 +75,8 @@ package names, build the underlying packages before sending them." (and (or (assoc-ref opts 'dry-run?) (build-derivations local drv)) - (let* ((session (open-ssh-session host #:user user #:port port)) + (let* ((session (open-ssh-session host #:user user + #:port (or port 22))) (sent (send-files local items (connect-to-remote-daemon session) #:recursive? #t))) @@ -88,7 +89,7 @@ package names, build the underlying packages before sending them." (let*-values (((user host port) (ssh-spec->user+host+port source)) ((session) - (open-ssh-session host #:user user #:port port)) + (open-ssh-session host #:user user #:port (or port 22))) ((remote) (connect-to-remote-daemon session))) (set-build-options-from-command-line local opts) -- cgit v1.2.3 From 960c6ce96d746cf19829ad26e092ec5dad2a5c62 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 3 Jul 2017 23:35:56 +0200 Subject: discovery: Recurse into directories pointed to by a symlink. Reported by Christopher Baines and Alex Kost at . * guix/discovery.scm (scheme-files): When ENTRY is a symlink that doesn't end in '.scm', call 'stat' and recurse if it points to a directory. * tests/discovery.scm ("scheme-modules recurses in symlinks to directories"): New test. --- guix/discovery.scm | 14 ++++++++++++-- tests/discovery.scm | 14 ++++++++++++++ 2 files changed, 26 insertions(+), 2 deletions(-) (limited to 'guix') diff --git a/guix/discovery.scm b/guix/discovery.scm index 292df2bd9c..2741725b9d 100644 --- a/guix/discovery.scm +++ b/guix/discovery.scm @@ -60,11 +60,21 @@ DIRECTORY is not accessible." (case (entry-type absolute properties) ((directory) (append (scheme-files absolute) result)) - ((regular symlink) - ;; XXX: We don't recurse if we find a symlink. + ((regular) (if (string-suffix? ".scm" name) (cons absolute result) result)) + ((symlink) + (cond ((string-suffix? ".scm" name) + (cons absolute result)) + ((stat absolute #f) + => + (match-lambda + (#f result) + ((= stat:type 'directory) + (append (scheme-files absolute) + result)) + (_ result))))) (else result)))))) '() diff --git a/tests/discovery.scm b/tests/discovery.scm index 04de83f085..753e6a8979 100644 --- a/tests/discovery.scm +++ b/tests/discovery.scm @@ -19,6 +19,7 @@ (define-module (test-discovery) #:use-module (guix discovery) #:use-module (guix build-system) + #:use-module (guix utils) #:use-module (srfi srfi-64) #:use-module (ice-9 match)) @@ -32,6 +33,19 @@ ((('guix 'import _ ...) ..1) #t))) +(test-assert "scheme-modules recurses in symlinks to directories" + (call-with-temporary-directory + (lambda (directory) + (mkdir (string-append directory "/guix")) + (symlink (string-append %top-srcdir "/guix/import") + (string-append directory "/guix/import")) + + ;; DIRECTORY/guix/import is a symlink but we want to make sure + ;; 'scheme-modules' recurses into it. + (match (map module-name (scheme-modules directory)) + ((('guix 'import _ ...) ..1) + #t))))) + (test-equal "scheme-modules, non-existent directory" '() (scheme-modules "/does/not/exist")) -- cgit v1.2.3 From 1678be097bb3f6403bbc4ab8414f3e7f02c70e44 Mon Sep 17 00:00:00 2001 From: Ricardo Wurmus Date: Sun, 2 Jul 2017 15:19:47 +0200 Subject: build-system: texlive: Only build packages in the current directory. * guix/build/texlive-build-system.scm (build): Use scandir instead of find-files. --- guix/build/texlive-build-system.scm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'guix') diff --git a/guix/build/texlive-build-system.scm b/guix/build/texlive-build-system.scm index c1fd9fd9af..7b10198fd2 100644 --- a/guix/build/texlive-build-system.scm +++ b/guix/build/texlive-build-system.scm @@ -20,6 +20,7 @@ #:use-module ((guix build gnu-build-system) #:prefix gnu:) #:use-module (guix build utils) #:use-module (ice-9 match) + #:use-module (ice-9 ftw) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) #:export (%standard-phases @@ -62,7 +63,7 @@ (mkdir "build") (every (cut compile-with-latex tex-format <>) (if build-targets build-targets - (find-files "." "\\.ins$")))) + (scandir "." (cut string-suffix? ".ins" <>))))) (define* (install #:key outputs tex-directory #:allow-other-keys) (let* ((out (assoc-ref outputs "out")) -- cgit v1.2.3 From bb3b35975c61db3d1cb0d8522f80d139009e11a9 Mon Sep 17 00:00:00 2001 From: Ricardo Wurmus Date: Sun, 2 Jul 2017 15:21:52 +0200 Subject: build-system: texlive: Build union in configure phase. This allows us to use texmf.cnf instead of having to set all required environment variables manually. * guix/build/texlive-build-system.scm (configure): New procedure. (build): Simplify. (%standard-phases): Add configure phase. * guix/build-system/texlive.scm (texlive-build): Include (guix build union) in modules. (%texlive-build-system-modules): Likewise. --- guix/build-system/texlive.scm | 2 ++ guix/build/texlive-build-system.scm | 48 ++++++++++++++++++++----------------- 2 files changed, 28 insertions(+), 22 deletions(-) (limited to 'guix') diff --git a/guix/build-system/texlive.scm b/guix/build-system/texlive.scm index 0357c47a47..80882b144b 100644 --- a/guix/build-system/texlive.scm +++ b/guix/build-system/texlive.scm @@ -55,6 +55,7 @@ given Texlive COMPONENT." (define %texlive-build-system-modules ;; Build-side modules imported by default. `((guix build texlive-build-system) + (guix build union) ,@%gnu-build-system-modules)) (define (default-texlive-bin) @@ -114,6 +115,7 @@ given Texlive COMPONENT." (substitutable? #t) (imported-modules %texlive-build-system-modules) (modules '((guix build texlive-build-system) + (guix build union) (guix build utils)))) "Build SOURCE with INPUTS." (define builder diff --git a/guix/build/texlive-build-system.scm b/guix/build/texlive-build-system.scm index 7b10198fd2..c0f262a5c0 100644 --- a/guix/build/texlive-build-system.scm +++ b/guix/build/texlive-build-system.scm @@ -19,6 +19,7 @@ (define-module (guix build texlive-build-system) #:use-module ((guix build gnu-build-system) #:prefix gnu:) #:use-module (guix build utils) + #:use-module (guix build union) #:use-module (ice-9 match) #:use-module (ice-9 ftw) #:use-module (srfi srfi-1) @@ -39,28 +40,31 @@ (string-append "&" format) file))) -(define* (build #:key inputs build-targets tex-format #:allow-other-keys) - ;; Find additional tex and sty files - (setenv "TEXINPUTS" - (string-append - (getcwd) ":" (getcwd) "/build:" - (string-join - (append-map (match-lambda - ((_ . dir) - (find-files dir - (lambda (_ stat) - (eq? 'directory (stat:type stat))) - #:directories? #t - #:stat stat))) - inputs) - ":"))) - (setenv "TEXFORMATS" - (string-append (assoc-ref inputs "texlive-latex-base") - "/share/texmf-dist/web2c/")) - (setenv "LUAINPUTS" - (string-append (assoc-ref inputs "texlive-latex-base") - "/share/texmf-dist/tex/latex/base/")) +(define* (configure #:key inputs #:allow-other-keys) + (let* ((out (string-append (getcwd) "/.texlive-union")) + (texmf.cnf (string-append out "/share/texmf-dist/web2c/texmf.cnf"))) + ;; Build a modifiable union of all inputs (but exclude bash) + (match inputs + (((names . directories) ...) + (union-build out directories + #:create-all-directories? #t + #:log-port (%make-void-port "w")))) + + ;; The configuration file "texmf.cnf" is provided by the + ;; "texlive-bin" package. We take it and override only the + ;; setting for TEXMFROOT and TEXMF. This file won't be consulted + ;; by default, though, so we still need to set TEXMFCNF. + (substitute* texmf.cnf + (("^TEXMFROOT = .*") + (string-append "TEXMFROOT = " out "/share\n")) + (("^TEXMF = .*") + "TEXMF = $TEXMFROOT/share/texmf-dist\n")) + (setenv "TEXMFCNF" (dirname texmf.cnf)) + (setenv "TEXMF" (string-append out "/share/texmf-dist"))) (mkdir "build") + #t) + +(define* (build #:key inputs build-targets tex-format #:allow-other-keys) (every (cut compile-with-latex tex-format <>) (if build-targets build-targets (scandir "." (cut string-suffix? ".ins" <>))))) @@ -77,7 +81,7 @@ (define %standard-phases (modify-phases gnu:%standard-phases - (delete 'configure) + (replace 'configure configure) (replace 'build build) (delete 'check) (replace 'install install))) -- cgit v1.2.3 From 1ab9e483391f8b62b873833ea71cb0074efa03e7 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 10 Jul 2017 00:04:09 +0200 Subject: syscalls: Adjust 'dirent64' struct for GNU/Hurd. Reported by rennes@openmailbox.org. * guix/build/syscalls.scm (file-type->symbol): New procedure. (%struct-dirent-header): Rename to... (%struct-dirent-header/linux): ... this. Rename introduced bindings as well. (%struct-dirent-header/hurd): New C struct. (define-generic-identifier): New macro. (read-dirent-header, %struct-dirent-header, sizeof-dirent-header): Define in terms of 'define-generic-identifier'. --- guix/build/syscalls.scm | 78 +++++++++++++++++++++++++++++++++++++++---------- 1 file changed, 63 insertions(+), 15 deletions(-) (limited to 'guix') diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm index 9c082b4352..549612fa3c 100644 --- a/guix/build/syscalls.scm +++ b/guix/build/syscalls.scm @@ -21,6 +21,7 @@ (define-module (guix build syscalls) #:use-module (system foreign) + #:use-module (system base target) ;for cross-compilation support #:use-module (rnrs bytevectors) #:autoload (ice-9 binary-ports) (get-bytevector-n) #:use-module (srfi srfi-1) @@ -824,28 +825,75 @@ system to PUT-OLD." ;;; Opendir & co. ;;; -(define-c-struct %struct-dirent-header - sizeof-dirent-header +(define (file-type->symbol type) + ;; Convert TYPE to symbols like 'stat:type' does. + (cond ((= type DT_REG) 'regular) + ((= type DT_LNK) 'symlink) + ((= type DT_DIR) 'directory) + ((= type DT_FIFO) 'fifo) + ((= type DT_CHR) 'char-special) + ((= type DT_BLK) 'block-special) + ((= type DT_SOCK) 'socket) + (else 'unknown))) + +;; 'struct dirent64' for GNU/Linux. +(define-c-struct %struct-dirent-header/linux + sizeof-dirent-header/linux (lambda (inode offset length type name) - ;; Convert TYPE to symbols like 'stat:type' does. - (let ((type (cond ((= type DT_REG) 'regular) - ((= type DT_LNK) 'symlink) - ((= type DT_DIR) 'directory) - ((= type DT_FIFO) 'fifo) - ((= type DT_CHR) 'char-special) - ((= type DT_BLK) 'block-special) - ((= type DT_SOCK) 'socket) - (else 'unknown)))) - `((type . ,type) - (inode . ,inode)))) - read-dirent-header - write-dirent-header! + `((type . ,(file-type->symbol type)) + (inode . ,inode))) + read-dirent-header/linux + write-dirent-header!/linux (inode int64) (offset int64) (length unsigned-short) (type uint8) (name uint8)) ;first byte of 'd_name' +;; 'struct dirent64' for GNU/Hurd. +(define-c-struct %struct-dirent-header/hurd + sizeof-dirent-header/hurd + (lambda (inode length type name-length name) + `((type . ,(file-type->symbol type)) + (inode . ,inode))) + read-dirent-header/hurd + write-dirent-header!/hurd + (inode int64) + (length unsigned-short) + (type uint8) + (namelen uint8) + (name uint8)) + +(define-syntax define-generic-identifier + (syntax-rules (gnu/linux gnu/hurd =>) + "Define a generic identifier that adjust to the current GNU variant." + ((_ id (gnu/linux => linux) (gnu/hurd => hurd)) + (define-syntax id + (lambda (s) + (syntax-case s () + ((_ args (... ...)) + (if (string-contains (or (target-type) %host-type) + "linux") + #'(linux args (... ...)) + #'(hurd args (... ...)))) + (_ + (if (string-contains (or (target-type) %host-type) + "linux") + #'linux + #'hurd)))))))) + +(define-generic-identifier read-dirent-header + (gnu/linux => read-dirent-header/linux) + (gnu/hurd => read-dirent-header/hurd)) + +(define-generic-identifier %struct-dirent-header + (gnu/linux => %struct-dirent-header/linux) + (gnu/hurd => %struct-dirent-header/hurd)) + +(define-generic-identifier sizeof-dirent-header + (gnu/linux => sizeof-dirent-header/linux) + (gnu/hurd => sizeof-dirent-header/hurd)) + ;; Constants for the 'type' field, from . (define DT_UNKNOWN 0) (define DT_FIFO 1) -- cgit v1.2.3