From 4dd53a83b5292d4e90ca221d6bcf03350ed8dc45 Mon Sep 17 00:00:00 2001 From: Chris Marusich Date: Mon, 30 Jul 2018 22:47:43 -0700 Subject: marionette: Add support for QEMU's "quit" command. * gnu/build/marionette.scm (marionette-control): Don't wait for the monitor prompt when the command was "quit". --- gnu/build/marionette.scm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'gnu/build') diff --git a/gnu/build/marionette.scm b/gnu/build/marionette.scm index bb018fc9c1..61284b8980 100644 --- a/gnu/build/marionette.scm +++ b/gnu/build/marionette.scm @@ -222,7 +222,8 @@ pcsys_monitor\")." (($ _ _ monitor) (display command monitor) (newline monitor) - (wait-for-monitor-prompt monitor)))) + ;; The "quit" command terminates QEMU immediately, with no output. + (unless (string=? command "quit") (wait-for-monitor-prompt monitor))))) (define* (marionette-screen-text marionette #:key -- cgit v1.2.3 From cb29343940dfffe8863c0a6b1e2b3494c7836b53 Mon Sep 17 00:00:00 2001 From: Chris Marusich Date: Mon, 30 Jul 2018 22:50:16 -0700 Subject: marionette: Add wait-for-unix-socket. * gnu/build/marionette.scm (wait-for-unix-socket): New variable. --- gnu/build/marionette.scm | 25 +++++++++++++++++++++++++ 1 file changed, 25 insertions(+) (limited to 'gnu/build') diff --git a/gnu/build/marionette.scm b/gnu/build/marionette.scm index 61284b8980..f94eab5cc0 100644 --- a/gnu/build/marionette.scm +++ b/gnu/build/marionette.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2016, 2017, 2018 Ludovic Courtès +;;; Copyright © 2018 Chris Marusich ;;; ;;; This file is part of GNU Guix. ;;; @@ -27,6 +28,7 @@ marionette-eval wait-for-file wait-for-tcp-port + wait-for-unix-socket marionette-control marionette-screen-text wait-for-screen-text @@ -214,6 +216,29 @@ MARIONETTE. Raise an error on failure." ('failure (error "nobody's listening on port" port)))) +(define* (wait-for-unix-socket file-name marionette + #:key (timeout 20)) + "Wait for up to TIMEOUT seconds for FILE-NAME, a Unix domain socket, to +accept connections in MARIONETTE. Raise an error on failure." + (match (marionette-eval + `(begin + (let ((sock (socket PF_UNIX SOCK_STREAM 0))) + (let loop ((i 0)) + (catch 'system-error + (lambda () + (connect sock AF_UNIX ,file-name) + 'success) + (lambda args + (if (< i ,timeout) + (begin + (sleep 1) + (loop (+ 1 i))) + 'failure)))))) + marionette) + ('success #t) + ('failure + (error "nobody's listening on unix domain socket" file-name)))) + (define (marionette-control command marionette) "Run COMMAND in the QEMU monitor of MARIONETTE. COMMAND is a string such as \"sendkey ctrl-alt-f1\" or \"screendump foo.ppm\" (info \"(qemu-doc) -- cgit v1.2.3 From 4db7a9dc663c5b26e45ec35538bf68ff87acdf7b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Wed, 29 Aug 2018 23:29:03 +0200 Subject: linux-modules: Raise an error when a kernel module cannot be found. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Previously we'd get an unhelpful backtrace like this: In gnu/build/linux-modules.scm: 184:47 4 (recursive-module-dependencies _ #:lookup-module _) 98:14 3 (module-dependencies _) 85:18 2 (modinfo-section-contents _) In ice-9/ports.scm: 439:11 1 (call-with-input-file #f # ?) In unknown file: 0 (open-file #f "r" #:encoding #f #:guess-encoding #f) ERROR: In procedure open-file: Wrong type (expecting string): #f builder for `/gnu/store/…-linux-modules.drv' failed with exit code 1 * gnu/build/linux-modules.scm (find-module-file): When MODULE cannot be found, raise an error instead of returning #f. This is more useful to the user. --- gnu/build/linux-modules.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'gnu/build') diff --git a/gnu/build/linux-modules.scm b/gnu/build/linux-modules.scm index ae141b6f54..2d81175041 100644 --- a/gnu/build/linux-modules.scm +++ b/gnu/build/linux-modules.scm @@ -136,7 +136,7 @@ and normalizing it." (define (find-module-file directory module) "Lookup module NAME under DIRECTORY, and return its absolute file name. NAME can be a file name with or without '.ko', or it can be a module name. -Return #f if it could not be found. +Raise an error if it could not be found. Module names can differ from file names in interesting ways; for instance, module names usually (always?) use underscores as the inter-word separator, @@ -162,7 +162,7 @@ whereas file names often, but not always, use hyphens. Examples: ((file) file) (() - #f) + (error "kernel module not found" module directory)) ((_ ...) (error "several modules by that name" module directory)))) -- cgit v1.2.3 From aff38cb199fc847f97059600a6c9c99ee754fc07 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sat, 20 Oct 2018 17:39:53 +0200 Subject: =?UTF-8?q?install:=20Make=20/var/guix/=E2=80=A6/guix-profile=20a?= =?UTF-8?q?=20relative=20symlink.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * gnu/build/install.scm (populate-single-profile-directory): Make /var/guix/profiles/per-user/root/guix-profile a relative symlink. --- gnu/build/install.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'gnu/build') diff --git a/gnu/build/install.scm b/gnu/build/install.scm index 5a5e703872..c602d69489 100644 --- a/gnu/build/install.scm +++ b/gnu/build/install.scm @@ -199,7 +199,7 @@ This is used to create the self-contained tarballs with 'guix pack'." (mkdir-p* %root-profile) (symlink* profile (string-append %root-profile "/guix-profile-1-link")) - (symlink* (string-append %root-profile "/guix-profile-1-link") + (symlink* "guix-profile-1-link" (string-append %root-profile "/guix-profile")) (mkdir-p* "/root") -- cgit v1.2.3 From ab3c60ace3bdd376255463c6475b62f6d17e5978 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sat, 20 Oct 2018 17:51:58 +0200 Subject: install: Parameterize the profile name for 'populate-single-profile-directory'. * gnu/build/install.scm (populate-single-profile-directory): Add #:profile-name. Replace hard-coded occurrences of "guix-profile" with PROFILE-NAME. Make the symlink part under /root a function of PROFILE-NAME. --- gnu/build/install.scm | 26 +++++++++++++++++++------- 1 file changed, 19 insertions(+), 7 deletions(-) (limited to 'gnu/build') diff --git a/gnu/build/install.scm b/gnu/build/install.scm index c602d69489..98c547f2e4 100644 --- a/gnu/build/install.scm +++ b/gnu/build/install.scm @@ -160,6 +160,7 @@ deduplicates files common to CLOSURE and the rest of PREFIX." (define* (populate-single-profile-directory directory #:key profile closure + (profile-name "guix-profile") deduplicate? register? schema) "Populate DIRECTORY with a store containing PROFILE, whose closure is given @@ -169,6 +170,9 @@ When REGISTER? is true, initialize DIRECTORY/var/guix/db to reflect the contents of the store; DEDUPLICATE? determines whether to deduplicate files in the store. +PROFILE-NAME is the name of the profile being created under +/var/guix/profiles, typically either \"guix-profile\" or \"current-guix\". + This is used to create the self-contained tarballs with 'guix pack'." (define (scope file) (string-append directory "/" file)) @@ -198,12 +202,20 @@ This is used to create the self-contained tarballs with 'guix pack'." ;; Make root's profile, which makes it a GC root. (mkdir-p* %root-profile) (symlink* profile - (string-append %root-profile "/guix-profile-1-link")) - (symlink* "guix-profile-1-link" - (string-append %root-profile "/guix-profile")) - - (mkdir-p* "/root") - (symlink* (string-append %root-profile "/guix-profile") - "/root/.guix-profile")) + (string-append %root-profile "/" profile-name "-1-link")) + (symlink* (string-append profile-name "-1-link") + (string-append %root-profile "/" profile-name)) + + (match profile-name + ("guix-profile" + (mkdir-p* "/root") + (symlink* (string-append %root-profile "/guix-profile") + "/root/.guix-profile")) + ("current-guix" + (mkdir-p* "/root/.config/guix") + (symlink* (string-append %root-profile "/current-guix") + "/root/.config/guix/current")) + (_ + #t))) ;;; install.scm ends here -- cgit v1.2.3 From ec4c81fe32a90890a6190443248078ce7366503f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sat, 27 Oct 2018 23:47:59 +0200 Subject: pack: Move store database creation to a separate derivation. * guix/scripts/pack.scm (store-database): New procedure. (self-contained-tarball): Use it when LOCALSTATEDIR? is true. Remove 'schema' and add 'database'. [build]: Pass DATABASE to 'populate-single-profile-directory'. (squashfs-image): Remove #:deduplicate? parameter. [build]: Remove (gnu build install) and (guix config) from the imported modules. Remove 'with-extensions'. * gnu/build/install.scm (populate-single-profile-directory): Remove #:deduplicate?, #:register?, and #:schema; add #:database. Remove call to 'register-closure' and simply copy DATABASE instead. --- gnu/build/install.scm | 17 +++++++---------- 1 file changed, 7 insertions(+), 10 deletions(-) (limited to 'gnu/build') diff --git a/gnu/build/install.scm b/gnu/build/install.scm index 98c547f2e4..9f9a6aba0f 100644 --- a/gnu/build/install.scm +++ b/gnu/build/install.scm @@ -161,14 +161,13 @@ deduplicates files common to CLOSURE and the rest of PREFIX." (define* (populate-single-profile-directory directory #:key profile closure (profile-name "guix-profile") - deduplicate? - register? schema) + database) "Populate DIRECTORY with a store containing PROFILE, whose closure is given in the file called CLOSURE (as generated by #:references-graphs.) DIRECTORY is initialized to contain a single profile under /root pointing to PROFILE. -When REGISTER? is true, initialize DIRECTORY/var/guix/db to reflect the -contents of the store; DEDUPLICATE? determines whether to deduplicate files in -the store. + +When DATABASE is true, copy it to DIRECTORY/var/guix/db and create +DIRECTORY/var/guix/gcroots and friends. PROFILE-NAME is the name of the profile being created under /var/guix/profiles, typically either \"guix-profile\" or \"current-guix\". @@ -189,11 +188,9 @@ This is used to create the self-contained tarballs with 'guix pack'." ;; Populate the store. (populate-store (list closure) directory) - (when register? - (register-closure (canonicalize-path directory) closure - #:deduplicate? deduplicate? - #:schema schema) - + (when database + (install-file database (scope "/var/guix/db/")) + (chmod (scope "/var/guix/db/db.sqlite") #o644) (mkdir-p* "/var/guix/profiles") (mkdir-p* "/var/guix/gcroots") (symlink* "/var/guix/profiles" -- cgit v1.2.3 From b27ef1d46cfdc3c994b106241f99cd7142083d13 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sun, 28 Oct 2018 00:17:08 +0200 Subject: pack: Import (guix store database) only when '--localstatedir' is passed. This is another way to address , which was previously addressed in commit 19c924af4f3726688ca155a905ebf1cb9acdfca2. * gnu/build/install.scm (register-closure): Move to... * gnu/build/vm.scm (register-closure): ... here. New procedure. * guix/scripts/pack.scm (self-contained-tarball)[build]: Remove now unneeded 'with-extensions' form and custom (guix config) module. * tests/guix-pack.sh: Revert the strategy from commit 19c924af4f3726688ca155a905ebf1cb9acdfca2. * tests/pack.scm ("self-contained-tarball"): Likewise. --- gnu/build/install.scm | 18 ------------------ gnu/build/vm.scm | 19 ++++++++++++++++++- 2 files changed, 18 insertions(+), 19 deletions(-) (limited to 'gnu/build') diff --git a/gnu/build/install.scm b/gnu/build/install.scm index 9f9a6aba0f..a31e1945d6 100644 --- a/gnu/build/install.scm +++ b/gnu/build/install.scm @@ -18,7 +18,6 @@ ;;; along with GNU Guix. If not, see . (define-module (gnu build install) - #:use-module (guix store database) #:use-module (guix build utils) #:use-module (guix build store-copy) #:use-module (srfi srfi-26) @@ -141,23 +140,6 @@ includes /etc, /var, /run, /bin/sh, etc., and all the symlinks to SYSTEM." (try)) (apply throw args))))))) -(define* (register-closure prefix closure - #:key - (deduplicate? #t) (reset-timestamps? #t) - (schema (sql-schema))) - "Register CLOSURE in PREFIX, where PREFIX is the directory name of the -target store and CLOSURE is the name of a file containing a reference graph as -produced by #:references-graphs.. As a side effect, if RESET-TIMESTAMPS? is -true, reset timestamps on store files and, if DEDUPLICATE? is true, -deduplicates files common to CLOSURE and the rest of PREFIX." - (let ((items (call-with-input-file closure read-reference-graph))) - (register-items items - #:prefix prefix - #:deduplicate? deduplicate? - #:reset-timestamps? reset-timestamps? - #:registration-time %epoch - #:schema schema))) - (define* (populate-single-profile-directory directory #:key profile closure (profile-name "guix-profile") diff --git a/gnu/build/vm.scm b/gnu/build/vm.scm index 5579886264..746808515f 100644 --- a/gnu/build/vm.scm +++ b/gnu/build/vm.scm @@ -25,7 +25,7 @@ #:use-module (guix build utils) #:use-module (guix build store-copy) #:use-module (guix build syscalls) - #:use-module ((guix store database) #:select (reset-timestamps)) + #:use-module (guix store database) #:use-module (gnu build linux-boot) #:use-module (gnu build install) #:use-module (gnu system uuid) @@ -191,6 +191,23 @@ the #:references-graphs parameter of 'derivation'." (mkdir output) (copy-recursively "xchg" output))))) +(define* (register-closure prefix closure + #:key + (deduplicate? #t) (reset-timestamps? #t) + (schema (sql-schema))) + "Register CLOSURE in PREFIX, where PREFIX is the directory name of the +target store and CLOSURE is the name of a file containing a reference graph as +produced by #:references-graphs.. As a side effect, if RESET-TIMESTAMPS? is +true, reset timestamps on store files and, if DEDUPLICATE? is true, +deduplicates files common to CLOSURE and the rest of PREFIX." + (let ((items (call-with-input-file closure read-reference-graph))) + (register-items items + #:prefix prefix + #:deduplicate? deduplicate? + #:reset-timestamps? reset-timestamps? + #:registration-time %epoch + #:schema schema))) + ;;; ;;; Partitions. -- cgit v1.2.3 From c5ce2db56909e7dd3fdcd30fa453272d56b07451 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sat, 3 Nov 2018 23:01:44 +0100 Subject: install: Add 'install-database-and-gc-roots'. * gnu/build/install.scm (%root-profile): New variable. (install-database-and-gc-roots): New procedure. (populate-single-profile-directory): Replace inline code with a call to 'install-database-and-gc-roots'. --- gnu/build/install.scm | 48 ++++++++++++++++++++++++++++++++---------------- 1 file changed, 32 insertions(+), 16 deletions(-) (limited to 'gnu/build') diff --git a/gnu/build/install.scm b/gnu/build/install.scm index a31e1945d6..c9ebe124fe 100644 --- a/gnu/build/install.scm +++ b/gnu/build/install.scm @@ -26,6 +26,7 @@ evaluate-populate-directive populate-root-file-system register-closure + install-database-and-gc-roots populate-single-profile-directory)) ;;; Commentary: @@ -140,6 +141,35 @@ includes /etc, /var, /run, /bin/sh, etc., and all the symlinks to SYSTEM." (try)) (apply throw args))))))) +(define %root-profile + "/var/guix/profiles/per-user/root") + +(define* (install-database-and-gc-roots root database profile + #:key (profile-name "guix-profile")) + "Install DATABASE, the store database, under directory ROOT. Create +PROFILE-NAME and have it link to PROFILE, a store item." + (define (scope file) + (string-append root "/" file)) + + (define (mkdir-p* dir) + (mkdir-p (scope dir))) + + (define (symlink* old new) + (symlink old (scope new))) + + (install-file database (scope "/var/guix/db/")) + (chmod (scope "/var/guix/db/db.sqlite") #o644) + (mkdir-p* "/var/guix/profiles") + (mkdir-p* "/var/guix/gcroots") + (symlink* "/var/guix/profiles" "/var/guix/gcroots/profiles") + + ;; Make root's profile, which makes it a GC root. + (mkdir-p* %root-profile) + (symlink* profile + (string-append %root-profile "/" profile-name "-1-link")) + (symlink* (string-append profile-name "-1-link") + (string-append %root-profile "/" profile-name))) + (define* (populate-single-profile-directory directory #:key profile closure (profile-name "guix-profile") @@ -158,9 +188,6 @@ This is used to create the self-contained tarballs with 'guix pack'." (define (scope file) (string-append directory "/" file)) - (define %root-profile - "/var/guix/profiles/per-user/root") - (define (mkdir-p* dir) (mkdir-p (scope dir))) @@ -171,19 +198,8 @@ This is used to create the self-contained tarballs with 'guix pack'." (populate-store (list closure) directory) (when database - (install-file database (scope "/var/guix/db/")) - (chmod (scope "/var/guix/db/db.sqlite") #o644) - (mkdir-p* "/var/guix/profiles") - (mkdir-p* "/var/guix/gcroots") - (symlink* "/var/guix/profiles" - "/var/guix/gcroots/profiles")) - - ;; Make root's profile, which makes it a GC root. - (mkdir-p* %root-profile) - (symlink* profile - (string-append %root-profile "/" profile-name "-1-link")) - (symlink* (string-append profile-name "-1-link") - (string-append %root-profile "/" profile-name)) + (install-database-and-gc-roots directory database profile + #:profile-name profile-name)) (match profile-name ("guix-profile" -- cgit v1.2.3 From 970c9993f124789cb181f399d4981cdcf5d3fc26 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Wed, 7 Nov 2018 15:51:38 +0100 Subject: linux-initrd: Make sure 'build-initrd' can delete files. Fixes . Reported by Mark H Weaver . This fixes a regression introduced in 72dc64f8f720268930eed448abfc15d2a0eca3cf, which made files read-only. * gnu/build/linux-initrd.scm (build-initrd): Call 'make-file-writable' on all the files under contents/. --- gnu/build/linux-initrd.scm | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) (limited to 'gnu/build') diff --git a/gnu/build/linux-initrd.scm b/gnu/build/linux-initrd.scm index c65b5aacfa..fb8a1f5b2b 100644 --- a/gnu/build/linux-initrd.scm +++ b/gnu/build/linux-initrd.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015 Ludovic Courtès +;;; Copyright © 2013, 2014, 2015, 2018 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -139,6 +139,12 @@ REFERENCES-GRAPHS." (write-cpio-archive output "." #:gzip gzip)) + ;; Make sure directories are writable so we can delete files. + (for-each make-file-writable + (find-files "contents" + (lambda (file stat) + (eq? 'directory (stat:type stat))) + #:directories? #t)) (delete-file-recursively "contents")) ;;; linux-initrd.scm ends here -- cgit v1.2.3 From b297934437932de730432629b361fcb422accbb7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sun, 18 Nov 2018 23:34:19 +0100 Subject: activation: Aways pass '-d HOME' to 'useradd'. Fixes . Reported by fps. * gnu/build/activation.scm (add-user): Always pass "-d HOME" when HOME is true. Pass "--create-home" only when HOME, CREATE-HOME?, and SYSTEM? are true. (activate-users+groups): Pass #:create-home? create-home? to 'ensure-user'. * gnu/tests/base.scm (run-basic-test)["accounts"]: Test 'passwd:dir' as well. --- gnu/build/activation.scm | 17 +++++++++-------- 1 file changed, 9 insertions(+), 8 deletions(-) (limited to 'gnu/build') diff --git a/gnu/build/activation.scm b/gnu/build/activation.scm index 68ecd6bc71..0e77677de1 100644 --- a/gnu/build/activation.scm +++ b/gnu/build/activation.scm @@ -148,11 +148,15 @@ properties. Return #t on success." `("-G" ,(string-join supplementary-groups ",")) '()) ,@(if comment `("-c" ,comment) '()) - ,@(if (and home create-home?) - (if (file-exists? home) - `("-d" ,home) ; avoid warning from 'useradd' - `("-d" ,home "--create-home")) + ,@(if home `("-d" ,home) '()) + + ;; Home directories of non-system accounts are created by + ;; 'activate-user-home'. + ,@(if (and home create-home? system? + (not (file-exists? home))) + '("--create-home") '()) + ,@(if shell `("-s" ,shell) '()) ,@(if password `("-p" ,password) '()) ,@(if system? '("--system") '()) @@ -229,10 +233,7 @@ numeric gid or #f." #:supplementary-groups supplementary-groups #:comment comment #:home home - - ;; Home directories of non-system accounts are created by - ;; 'activate-user-home'. - #:create-home? (and create-home? system?) + #:create-home? create-home? #:shell shell #:password password) -- cgit v1.2.3 From d422cbb3d6a1cc7e4553a2335b113475a05d68ad Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Wed, 21 Nov 2018 16:19:09 +0100 Subject: linux-initrd: 'expression->initrd' returns the complete file name. Previously 'expression->initrd' would return the directory that contains the 'initrd' file; now it returns the complete file name for that file. * gnu/system/linux-initrd.scm (expression->initrd)[builder]: Change output file name to "initrd.cpio.gz". Tail-call 'file-append' to return the complete file name. * gnu/system.scm (operating-system-initrd-file): Remove 'file-append' call. * gnu/build/linux-initrd.scm (write-cpio-archive): Check whether OUTPUT already has the ".gz" suffix; rename if before invoking GZIP if it does, and otherwise after. * gnu/system/vm.scm (expression->derivation-in-linux-vm)[builder]: Do not append "/initrd" to #$initrd. --- gnu/build/linux-initrd.scm | 22 +++++++++++++++++----- 1 file changed, 17 insertions(+), 5 deletions(-) (limited to 'gnu/build') diff --git a/gnu/build/linux-initrd.scm b/gnu/build/linux-initrd.scm index fb8a1f5b2b..3aaa06d3a0 100644 --- a/gnu/build/linux-initrd.scm +++ b/gnu/build/linux-initrd.scm @@ -72,11 +72,23 @@ COMPRESS? is true, compress it using GZIP. On success, return OUTPUT." #:file->header cpio:file->cpio-header*))) (or (not compress?) - ;; Use '--no-name' so that gzip records neither a file name nor a time - ;; stamp in its output. - (and (zero? (system* gzip "--best" "--no-name" output)) - (rename-file (string-append output ".gz") - output)) + + ;; Gzip insists on adding a '.gz' suffix and does nothing if the input + ;; file already has that suffix. Shuffle files around to placate it. + (let* ((gz-suffix? (string-suffix? ".gz" output)) + (sans-gz (if gz-suffix? + (string-drop-right output 3) + output))) + (when gz-suffix? + (rename-file output sans-gz)) + ;; Use '--no-name' so that gzip records neither a file name nor a time + ;; stamp in its output. + (and (zero? (system* gzip "--best" "--no-name" sans-gz)) + (begin + (unless gz-suffix? + (rename-file (string-append output ".gz") output)) + output))) + output)) (define (cache-compiled-file-name file) -- cgit v1.2.3