From a4cfdab56a09edf24c6a338a4752e7a70d235b35 Mon Sep 17 00:00:00 2001 From: Maxim Cournoyer Date: Thu, 12 Nov 2020 15:16:06 -0500 Subject: gnu: python-flask-basicauth: Fix build. * gnu/packages/python-web.scm (python-flask-basicauth)[phases]: Add a 'fix-imports phase. --- gnu/packages/python-web.scm | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) (limited to 'gnu') diff --git a/gnu/packages/python-web.scm b/gnu/packages/python-web.scm index cf71a64e7c..fccb7603ac 100644 --- a/gnu/packages/python-web.scm +++ b/gnu/packages/python-web.scm @@ -26,7 +26,7 @@ ;;; Copyright © 2018 Tomáš Čech ;;; Copyright © 2018, 2019 Nicolas Goaziou ;;; Copyright © 2018 Mathieu Othacehe -;;; Copyright © 2018 Maxim Cournoyer +;;; Copyright © 2018, 2020 Maxim Cournoyer ;;; Copyright © 2019 Vagrant Cascadian ;;; Copyright © 2019 Brendan Tildesley ;;; Copyright © 2019 Pierre Langlois @@ -2895,6 +2895,17 @@ pretty printer and a tree visitor.") (base32 "1zq1spkjr4sjdnalpp8wl242kdqyk6fhbnhr8hi4r4f0km4bspnz")))) (build-system python-build-system) + (arguments + `(#:phases (modify-phases %standard-phases + (add-after 'unpack 'fix-imports + (lambda _ + (substitute* '("docs/index.rst" + "docs/conf.py" + "flask_basicauth.py" + "test_basicauth.py") + (("flask\\.ext\\.basicauth") + "flask_basicauth")) + #t))))) (propagated-inputs `(("python-flask" ,python-flask))) (home-page -- cgit 1.4.1 From c410e9e531b999546f033d35266f8ac488dee7e0 Mon Sep 17 00:00:00 2001 From: Maxim Cournoyer Date: Thu, 12 Nov 2020 15:17:57 -0500 Subject: gnu: python-flask-basicauth: Fix indentation. * gnu/packages/python-web.scm (python-flask-basicauth): Fix indentation. --- gnu/packages/python-web.scm | 20 +++++++++----------- 1 file changed, 9 insertions(+), 11 deletions(-) (limited to 'gnu') diff --git a/gnu/packages/python-web.scm b/gnu/packages/python-web.scm index fccb7603ac..b05de077d2 100644 --- a/gnu/packages/python-web.scm +++ b/gnu/packages/python-web.scm @@ -2888,12 +2888,12 @@ pretty printer and a tree visitor.") (name "python-flask-basicauth") (version "0.2.0") (source - (origin - (method url-fetch) - (uri (pypi-uri "Flask-BasicAuth" version)) - (sha256 - (base32 - "1zq1spkjr4sjdnalpp8wl242kdqyk6fhbnhr8hi4r4f0km4bspnz")))) + (origin + (method url-fetch) + (uri (pypi-uri "Flask-BasicAuth" version)) + (sha256 + (base32 + "1zq1spkjr4sjdnalpp8wl242kdqyk6fhbnhr8hi4r4f0km4bspnz")))) (build-system python-build-system) (arguments `(#:phases (modify-phases %standard-phases @@ -2908,12 +2908,10 @@ pretty printer and a tree visitor.") #t))))) (propagated-inputs `(("python-flask" ,python-flask))) - (home-page - "https://github.com/jpvanhal/flask-basicauth") - (synopsis - "HTTP basic access authentication for Flask") + (home-page "https://github.com/jpvanhal/flask-basicauth") + (synopsis "HTTP basic access authentication for Flask") (description - "This package provides HTTP basic access authentication for Flask.") + "This package provides HTTP basic access authentication for Flask.") (license license:bsd-3))) (define-public python-flask-htpasswd -- cgit 1.4.1 From ae10ec441aa524bf267f9cefd4a319b44d0b8b44 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 12 Nov 2020 16:35:24 +0100 Subject: gnu: glib: Graft patch to detect changes to the installed applications. Fixes . Reported by sirgazil and others. * gnu/packages/patches/glib-appinfo-watch.patch: New file. * gnu/local.mk (dist_patch_DATA): Add it. * gnu/packages/glib.scm (glib)[replacement]: New field. (glib-with-gio-patch): New variable. (glib-with-documentation): Use 'package/inherit'. --- gnu/local.mk | 1 + gnu/packages/glib.scm | 14 +++- gnu/packages/patches/glib-appinfo-watch.patch | 92 +++++++++++++++++++++++++++ 3 files changed, 105 insertions(+), 2 deletions(-) create mode 100644 gnu/packages/patches/glib-appinfo-watch.patch (limited to 'gnu') diff --git a/gnu/local.mk b/gnu/local.mk index d5a13cbdbd..2301a04d2f 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -1050,6 +1050,7 @@ dist_patch_DATA = \ %D%/packages/patches/ghostscript-no-header-id.patch \ %D%/packages/patches/ghostscript-no-header-uuid.patch \ %D%/packages/patches/ghostscript-no-header-creationdate.patch \ + %D%/packages/patches/glib-appinfo-watch.patch \ %D%/packages/patches/glib-tests-timer.patch \ %D%/packages/patches/glibc-CVE-2018-11236.patch \ %D%/packages/patches/glibc-CVE-2018-11237.patch \ diff --git a/gnu/packages/glib.scm b/gnu/packages/glib.scm index 901222476a..43523e516d 100644 --- a/gnu/packages/glib.scm +++ b/gnu/packages/glib.scm @@ -181,6 +181,7 @@ shared NFS home directories.") (package (name "glib") (version "2.62.6") + (replacement glib-with-gio-patch) (source (origin (method url-fetch) (uri (string-append "mirror://gnome/sources/" @@ -387,11 +388,20 @@ dynamic loading, and an object system.") (home-page "https://developer.gnome.org/glib/") (license license:lgpl2.1+))) +(define glib-with-gio-patch + ;; GLib with a fix for . + ;; TODO: Fold into 'glib' above in the next rebuild cycle. + (package + (inherit glib) + (source (origin + (inherit (package-source glib)) + (patches (cons (search-patch "glib-appinfo-watch.patch") + (origin-patches (package-source glib)))))))) + (define-public glib-with-documentation ;; glib's doc must be built in a separate package since it requires gtk-doc, ;; which in turn depends on glib. - (package - (inherit glib) + (package/inherit glib (properties (alist-delete 'hidden? (package-properties glib))) (outputs (cons "doc" (package-outputs glib))) ; 20 MiB of GTK-Doc reference (native-inputs diff --git a/gnu/packages/patches/glib-appinfo-watch.patch b/gnu/packages/patches/glib-appinfo-watch.patch new file mode 100644 index 0000000000..638a5e0949 --- /dev/null +++ b/gnu/packages/patches/glib-appinfo-watch.patch @@ -0,0 +1,92 @@ +This patch lets GLib's GDesktopAppInfo API watch and notice changes +to the Guix user and system profiles. That way, the list of available +applications shown by the desktop environment is immediately updated +when the user runs "guix install", "guix remove", or "guix system +reconfigure" (see ). + +It does so by monitoring /var/guix/profiles (for changes to the system +profile) and /var/guix/profiles/per-user/USER (for changes to the user +profile) and crawling their share/applications sub-directory when +changes happen. + +diff --git a/gio/gdesktopappinfo.c b/gio/gdesktopappinfo.c +index f1e2fdd..095c110 100644 +--- a/gio/gdesktopappinfo.c ++++ b/gio/gdesktopappinfo.c +@@ -148,6 +148,7 @@ typedef struct + gchar *alternatively_watching; + gboolean is_config; + gboolean is_setup; ++ gchar *guix_profile_watch_dir; + GFileMonitor *monitor; + GHashTable *app_names; + GHashTable *mime_tweaks; +@@ -180,6 +181,7 @@ desktop_file_dir_unref (DesktopFileDir *dir) + { + desktop_file_dir_reset (dir); + g_free (dir->path); ++ g_free (dir->guix_profile_watch_dir); + g_free (dir); + } + } +@@ -204,6 +206,13 @@ desktop_file_dir_get_alternative_dir (DesktopFileDir *dir) + { + gchar *parent; + ++ /* If DIR is a profile, watch the specified directory--e.g., ++ * /var/guix/profiles/per-user/$USER/ for the user profile. Do not watch ++ * ~/.guix-profile or /run/current-system/profile because GFileMonitor does ++ * not pass IN_DONT_FOLLOW and thus cannot notice any change. */ ++ if (dir->guix_profile_watch_dir != NULL) ++ return g_strdup (dir->guix_profile_watch_dir); ++ + /* If the directory itself exists then we need no alternative. */ + if (g_access (dir->path, R_OK | X_OK) == 0) + return NULL; +@@ -249,11 +258,11 @@ desktop_file_dir_changed (GFileMonitor *monitor, + * + * If this is a notification for a parent directory (because the + * desktop directory didn't exist) then we shouldn't fire the signal +- * unless something actually changed. ++ * unless something actually changed or it's in /var/guix/profiles. + */ + g_mutex_lock (&desktop_file_dir_lock); + +- if (dir->alternatively_watching) ++ if (dir->alternatively_watching && dir->guix_profile_watch_dir == NULL) + { + gchar *alternative_dir; + +@@ -1555,6 +1564,32 @@ desktop_file_dirs_lock (void) + for (i = 0; dirs[i]; i++) + g_ptr_array_add (desktop_file_dirs, desktop_file_dir_new (dirs[i])); + ++ { ++ /* Monitor the system and user profile under /var/guix/profiles and ++ * treat modifications to them as if they were modifications to their ++ * /share sub-directory. */ ++ const gchar *user; ++ DesktopFileDir *system_profile_dir, *user_profile_dir; ++ ++ system_profile_dir = ++ desktop_file_dir_new ("/var/guix/profiles/system/profile/share"); ++ system_profile_dir->guix_profile_watch_dir = g_strdup ("/var/guix/profiles"); ++ g_ptr_array_add (desktop_file_dirs, desktop_file_dir_ref (system_profile_dir)); ++ ++ user = g_get_user_name (); ++ if (user != NULL) ++ { ++ gchar *profile_dir, *user_data_dir; ++ ++ profile_dir = g_build_filename ("/var/guix/profiles/per-user", user, NULL); ++ user_data_dir = g_build_filename (profile_dir, "guix-profile", "share", NULL); ++ user_profile_dir = desktop_file_dir_new (user_data_dir); ++ user_profile_dir->guix_profile_watch_dir = profile_dir; ++ g_ptr_array_add (desktop_file_dirs, desktop_file_dir_ref (user_profile_dir)); ++ g_free (user_data_dir); ++ } ++ } ++ + /* The list of directories will never change after this, unless + * g_get_user_config_dir() changes due to %G_TEST_OPTION_ISOLATE_DIRS. */ + desktop_file_dirs_config_dir = user_config_dir; -- cgit 1.4.1 From 3ba6ffd0dd092ae879d014e4971989f231eaa56d Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 13 Nov 2020 14:40:28 +0100 Subject: gnu: guix: Update to 1.2.0rc1. --- gnu/packages/package-management.scm | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) (limited to 'gnu') diff --git a/gnu/packages/package-management.scm b/gnu/packages/package-management.scm index 93bc4d7ee6..48b75fc96b 100644 --- a/gnu/packages/package-management.scm +++ b/gnu/packages/package-management.scm @@ -130,9 +130,9 @@ ;; Latest version of Guix, which may or may not correspond to a release. ;; Note: the 'update-guix-package.scm' script expects this definition to ;; start precisely like this. - (let ((version "1.1.0") - (commit "5e7cf66fb35780f930ad0bc5fe21ac330df4411d") - (revision 32)) + (let ((version "1.2.0rc1") + (commit "1e272d42f6217b70c9801b93e46b144e9ab27664") + (revision 0)) (package (name "guix") @@ -148,7 +148,7 @@ (commit commit))) (sha256 (base32 - "15clfjp845gvl0p6qw0b1gdibqfq20zwzr6dbxvq8l9fgzj1kb6b")) + "05g5l7bm2fpzwp1rbffv4pc0snjxl8b5z9fzjb1vyh775gqwj0ph")) (file-name (string-append "guix-" version "-checkout")))) (build-system gnu-build-system) (arguments -- cgit 1.4.1 From 4b2ce77ca0f71f23ec68da1f3a1f5b643a26ca98 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 13 Nov 2020 15:01:25 +0100 Subject: gnu: guix: Update to 3ba6ffd. --- gnu/packages/package-management.scm | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'gnu') diff --git a/gnu/packages/package-management.scm b/gnu/packages/package-management.scm index 48b75fc96b..86e3f2bf00 100644 --- a/gnu/packages/package-management.scm +++ b/gnu/packages/package-management.scm @@ -131,8 +131,8 @@ ;; Note: the 'update-guix-package.scm' script expects this definition to ;; start precisely like this. (let ((version "1.2.0rc1") - (commit "1e272d42f6217b70c9801b93e46b144e9ab27664") - (revision 0)) + (commit "3ba6ffd0dd092ae879d014e4971989f231eaa56d") + (revision 1)) (package (name "guix") @@ -148,7 +148,7 @@ (commit commit))) (sha256 (base32 - "05g5l7bm2fpzwp1rbffv4pc0snjxl8b5z9fzjb1vyh775gqwj0ph")) + "1wa67gdipmzqr400hp0cw5ih0rlfvj345h65rqbk9s4g3bkg38hm")) (file-name (string-append "guix-" version "-checkout")))) (build-system gnu-build-system) (arguments -- cgit 1.4.1 From 4e01bc440a4f20bf1597db2ed852e541da45efce Mon Sep 17 00:00:00 2001 From: Maxim Cournoyer Date: Fri, 13 Nov 2020 09:39:36 -0500 Subject: gnu: python-pysam: Update to version 0.16.0.1. The check phase was failing with: starting phase `check' make: Entering directory '...drv-0/python-pysam-0.15.1-checkout/tests/pysam_data' samtools faidx ex1.fa samtools import ex1.fa.fai ex1.sam.gz ex1.bam [main] "samtools import" has been removed. Please use "samtools view" instead. make: *** [Makefile:56: ex1.bam] Error 1 * gnu/packages/bioinformatics.scm (python-pysam): Update to version 0.16.0.1. [phases]{check}: Delete a couple more failing test files. [native-inputs]: Add python-pytest. --- gnu/packages/bioinformatics.scm | 16 +++++++++++----- 1 file changed, 11 insertions(+), 5 deletions(-) (limited to 'gnu') diff --git a/gnu/packages/bioinformatics.scm b/gnu/packages/bioinformatics.scm index 4c49b00252..f63ae5f324 100644 --- a/gnu/packages/bioinformatics.scm +++ b/gnu/packages/bioinformatics.scm @@ -12,7 +12,7 @@ ;;; Copyright © 2018 Joshua Sierles, Nextjournal ;;; Copyright © 2018 Gábor Boskovits ;;; Copyright © 2018, 2019, 2020 Mădălin Ionel Patrașcu -;;; Copyright © 2019 Maxim Cournoyer +;;; Copyright © 2019, 2020 Maxim Cournoyer ;;; Copyright © 2019 Brian Leung ;;; Copyright © 2019 Brett Gilio ;;; Copyright © 2020 Björn Höfling @@ -1894,7 +1894,7 @@ multiple sequence alignments.") (define-public python-pysam (package (name "python-pysam") - (version "0.15.1") + (version "0.16.0.1") (source (origin (method git-fetch) ;; Test data is missing on PyPi. @@ -1904,7 +1904,7 @@ multiple sequence alignments.") (file-name (git-file-name name version)) (sha256 (base32 - "1vj367w6xbn9bpmksm162l1aipf7cj97h1q83y7jcpm33ihwpf7x")) + "168bwwm8c2k22m7paip8q0yajyl7xdxgnik0bgjl7rhqg0majz0f")) (modules '((guix build utils))) (snippet '(begin ;; Drop bundled htslib. TODO: Also remove samtools @@ -1934,8 +1934,13 @@ multiple sequence alignments.") ;; This file contains tests that require a connection to the ;; internet. (delete-file "tests/tabix_test.py") - ;; FIXME: This test fails + ;; These tests fail (see: + ;; https://github.com/pysam-developers/pysam/issues/939). + (delete-file "tests/compile_test.py") (delete-file "tests/AlignmentFile_test.py") + (delete-file "tests/AlignmentFileHeader_test.py") + (delete-file "tests/StreamFiledescriptors_test.py") + (delete-file "tests/VariantRecord_test.py") ;; Add first subdirectory of "build" directory to PYTHONPATH. (setenv "PYTHONPATH" (string-append @@ -1965,7 +1970,8 @@ multiple sequence alignments.") ;; Dependencies below are are for tests only. ("samtools" ,samtools) ("bcftools" ,bcftools) - ("python-nose" ,python-nose))) + ("python-nose" ,python-nose) + ("python-pytest" ,python-pytest))) (home-page "https://github.com/pysam-developers/pysam") (synopsis "Python bindings to the SAMtools C API") (description -- cgit 1.4.1 From 977eb5d023cfdf8e336f1896480eea9cef5c04e9 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 16 Nov 2020 11:03:19 +0100 Subject: Properly deal with build directories containing '~'. Fixes . Reported by Vagrant Cascadian . * tests/build-utils.scm ("wrap-script, simple case"): Pass SCRIPT-CONTENTS to 'display' rather than 'format'. * gnu/services/base.scm (file-system->shepherd-service-name) [valid-characters, mount-point]: New variables. Filter out invalid store file name characters from the mount point of FILE-SYSTEM. --- gnu/services/base.scm | 15 +++++++++++++-- tests/build-utils.scm | 4 ++-- 2 files changed, 15 insertions(+), 4 deletions(-) (limited to 'gnu') diff --git a/gnu/services/base.scm b/gnu/services/base.scm index 499e50bfd7..712b3a018f 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -285,8 +285,19 @@ This service must be the root of the service dependency graph so that its (define (file-system->shepherd-service-name file-system) "Return the symbol that denotes the service mounting and unmounting FILE-SYSTEM." - (symbol-append 'file-system- - (string->symbol (file-system-mount-point file-system)))) + (define valid-characters + ;; Valid store characters; see 'checkStoreName' in the daemon. + (string->char-set + "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz+-._?=")) + + (define mount-point + (string-map (lambda (chr) + (if (char-set-contains? valid-characters chr) + chr + #\-)) + (file-system-mount-point file-system))) + + (symbol-append 'file-system- (string->symbol mount-point))) (define (mapped-device->shepherd-service-name md) "Return the symbol that denotes the shepherd service of MD, a ." diff --git a/tests/build-utils.scm b/tests/build-utils.scm index 47a57a984b..654b480ed9 100644 --- a/tests/build-utils.scm +++ b/tests/build-utils.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2015, 2016, 2019 Ludovic Courtès +;;; Copyright © 2012, 2015, 2016, 2019, 2020 Ludovic Courtès ;;; Copyright © 2019 Ricardo Wurmus ;;; ;;; This file is part of GNU Guix. @@ -174,7 +174,7 @@ echo hello world")) (let ((script-file-name (string-append directory "/foo"))) (call-with-output-file script-file-name (lambda (port) - (format port script-contents))) + (display script-contents port))) (chmod script-file-name #o777) (wrap-script script-file-name `("GUIX_FOO" prefix ("/some/path" -- cgit 1.4.1 From 6cad3f6966e056c4d8a32cb85446040f56929c50 Mon Sep 17 00:00:00 2001 From: Marius Bakke Date: Mon, 16 Nov 2020 18:26:55 +0100 Subject: services: mingetty: Export configuration accessors. * gnu/services/base: Export configuration accessors for mingetty. --- gnu/services/base.scm | 6 ++++++ 1 file changed, 6 insertions(+) (limited to 'gnu') diff --git a/gnu/services/base.scm b/gnu/services/base.scm index 712b3a018f..55d8c91cb5 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -106,6 +106,12 @@ agetty-service-type mingetty-configuration + mingetty-configuration-tty + mingetty-configuration-auto-login + mingetty-configuration-login-program + mingetty-configuration-login-pause? + mingetty-configuration-clear-on-logout? + mingetty-configuration-mingetty mingetty-configuration? mingetty-service mingetty-service-type -- cgit 1.4.1 From 37c21b130c0072f23bb735ca6903d8711416d5d9 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 16 Nov 2020 23:05:49 +0100 Subject: gnu: guix: Use libexec/guix/guile in the 'guix' shebang. This is a followup to 880fe019ae64df37815bbdb1a22305f99dae759d. * gnu/packages/package-management.scm (guix)[arguments]: Delete 'patch-shebangs' phase. --- gnu/packages/package-management.scm | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) (limited to 'gnu') diff --git a/gnu/packages/package-management.scm b/gnu/packages/package-management.scm index 86e3f2bf00..512f1950a3 100644 --- a/gnu/packages/package-management.scm +++ b/gnu/packages/package-management.scm @@ -336,7 +336,13 @@ $(prefix)/etc/init.d\n"))) (let ((bash (assoc-ref inputs "bash"))) (substitute* (string-append out "/bin/guix") (("^#!.*/bash") (string-append "#! " bash "/bin/bash"))))) - #t)))))) + #t))) + + ;; The 'guix' executable has 'OUT/libexec/guix/guile' has + ;; its shebang; that should remain unchanged, thus remove + ;; the 'patch-shebangs' phase, which would otherwise + ;; change it to 'GUILE/bin/guile'. + (delete 'patch-shebangs)))) (native-inputs `(("pkg-config" ,pkg-config) ;; Guile libraries are needed here for -- cgit 1.4.1 From 9113de2ca2db195908e3262b3752f8392ada8630 Mon Sep 17 00:00:00 2001 From: Mathieu Othacehe Date: Tue, 17 Nov 2020 09:50:01 +0100 Subject: installer: Fix device synchronization. Reported by Florian Pelz: https://lists.gnu.org/archive/html/guix-devel/2020-11/msg00326.html. * gnu/installer/utils.scm (call-with-time): New procedure, (let/time): new macro. * gnu/installer/parted.scm (with-delay-device-in-use?): Increase the retry count to 16. (non-install-devices): Remove the call to with-delay-device-in-use? as it doesn't return the expected result, and would block much longer now. (free-parted): Log the time required to sync each device. --- gnu/installer/parted.scm | 27 ++++++++++++++------------- gnu/installer/utils.scm | 14 ++++++++++++++ 2 files changed, 28 insertions(+), 13 deletions(-) (limited to 'gnu') diff --git a/gnu/installer/parted.scm b/gnu/installer/parted.scm index f592d315f5..9ef263d1f9 100644 --- a/gnu/installer/parted.scm +++ b/gnu/installer/parted.scm @@ -41,6 +41,7 @@ #:use-module (ice-9 regex) #:use-module (rnrs io ports) #:use-module (srfi srfi-1) + #:use-module (srfi srfi-19) #:use-module (srfi srfi-26) #:use-module (srfi srfi-34) #:use-module (srfi srfi-35) @@ -318,7 +319,7 @@ PARTED-OBJECT field equals PARTITION, return #f if not found." fail. See rereadpt function in wipefs.c of util-linux for an explanation." ;; Kernel always return EINVAL for BLKRRPART on loopdevices. (and (not (string-match "/dev/loop*" file-name)) - (let loop ((try 4)) + (let loop ((try 16)) (usleep 250000) (let ((in-use? (device-in-use? file-name))) (if (and in-use? (> try 0)) @@ -339,15 +340,12 @@ fail. See rereadpt function in wipefs.c of util-linux for an explanation." (define (non-install-devices) "Return all the available devices, except the busy one, allegedly the install device. DEVICE-IS-BUSY? is a parted call, checking if the device is -mounted. The install image uses an overlayfs so the install device does not -appear as mounted and won't be considered as busy. So use also DEVICE-IN-USE? -from (guix build syscalls) module, who will try to re-read the device's -partition table to determine whether or not it is already used (like sfdisk -from util-linux)." +mounted." + ;; FIXME: The install image uses an overlayfs so the install device does not + ;; appear as mounted and won't be considered as busy. (remove (lambda (device) (let ((file-name (device-path device))) - (or (device-is-busy? device) - (with-delay-device-in-use? file-name)))) + (device-is-busy? device))) (devices))) @@ -1390,9 +1388,12 @@ the devices not to be used before returning." (let ((device-file-names (map device-path devices))) (for-each force-device-sync devices) (for-each (lambda (file-name) - (let ((in-use? (with-delay-device-in-use? file-name))) - (and in-use? - (error - (format #f (G_ "Device ~a is still in use.") - file-name))))) + (let/time ((time in-use? + (with-delay-device-in-use? file-name))) + (if in-use? + (error + (format #f (G_ "Device ~a is still in use.") + file-name)) + (syslog "Syncing ~a took ~a seconds.~%" + file-name (time-second time))))) device-file-names))) diff --git a/gnu/installer/utils.scm b/gnu/installer/utils.scm index 5f8fe8ca01..a7fa66a199 100644 --- a/gnu/installer/utils.scm +++ b/gnu/installer/utils.scm @@ -22,6 +22,7 @@ #:use-module (guix build utils) #:use-module (guix i18n) #:use-module (srfi srfi-1) + #:use-module (srfi srfi-19) #:use-module (srfi srfi-34) #:use-module (ice-9 match) #:use-module (ice-9 rdelim) @@ -36,6 +37,8 @@ syslog-port syslog + call-with-time + let/time with-server-socket current-server-socket @@ -117,6 +120,17 @@ COMMAND exited successfully, #f otherwise." ;;; Logging. ;;; +(define (call-with-time thunk kont) + "Call THUNK and pass KONT the elapsed time followed by THUNK's return +values." + (let* ((start (current-time time-monotonic)) + (result (call-with-values thunk list)) + (end (current-time time-monotonic))) + (apply kont (time-difference end start) result))) + +(define-syntax-rule (let/time ((time result exp)) body ...) + (call-with-time (lambda () exp) (lambda (time result) body ...))) + (define (open-syslog-port) "Return an open port (a socket) to /dev/log or #f if that wasn't possible." (let ((sock (socket AF_UNIX SOCK_DGRAM 0))) -- cgit 1.4.1