Package: guix-patches;
Reported by: Ludovic Courtès <ludo <at> gnu.org>
Date: Sun, 27 Feb 2022 13:41:02 UTC
Severity: normal
Tags: patch
Done: Ludovic Courtès <ludo <at> gnu.org>
Bug is archived. No further changes may be made.
To add a comment to this bug, you must first unarchive it, by sending
a message to control AT debbugs.gnu.org, with unarchive 54180 in the body.
You can then email your comments to 54180 AT debbugs.gnu.org in the normal way.
Toggle the display of automated, internal messages from the tracker.
View this report as an mbox folder, status mbox, maintainer mbox
andrew <at> trop.in, go.wigust <at> gmail.com, public <at> yoctocell.xyz, guix-patches <at> gnu.org:bug#54180; Package guix-patches.
(Sun, 27 Feb 2022 13:41:02 GMT) Full text and rfc822 format available.Ludovic Courtès <ludo <at> gnu.org>:andrew <at> trop.in, go.wigust <at> gmail.com, public <at> yoctocell.xyz, guix-patches <at> gnu.org.
(Sun, 27 Feb 2022 13:41:02 GMT) Full text and rfc822 format available.Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: guix-patches <at> gnu.org Cc: Ludovic Courtès <ludo <at> gnu.org> Subject: [PATCH 00/12] Home: Clarify and better test symlink-manager.scm Date: Sun, 27 Feb 2022 14:40:06 +0100
Hello Guix!
This patch set aims to increase test coverage for ‘guix home reconfigure’,
to make symlink-manager.scm IMO easier to follow, and to have it more
closely follow the project’s conventions.
Functionality is unchanged.
Thoughts?
Thanks,
Ludo’.
Ludovic Courtès (12):
home: symlink-manager: Clarify module imports.
home: symlink-manager: Move helper procedures as top-level defines.
home: symlink-manager: Use 'for-each' when used for effects.
home: symlink-manager: Use 'file-is-directory?'.
home: symlink-manager: Remove 'empty-directory?' and avoid TOCTTOU
race.
home: symlink-manager: Avoid extra 'lstat' call.
tests: Make sure 'guix home reconfigure' backs up files.
tests: Simplify use of 'local-file' in 'tests/guix-home.sh'.
tests: Check 'guix home reconfigure' for a second generation.
home: symlink-manager: 'cleanup-symlinks' uses 'file-system-fold'.
home: symlink-manager: 'create-symlinks' uses 'file-system-fold'.
home: symlink-manager: Rename "path" to "file" where appropriate.
gnu/home/services/symlink-manager.scm | 355 ++++++++++++--------------
tests/guix-home.sh | 44 +++-
2 files changed, 198 insertions(+), 201 deletions(-)
base-commit: 33ce3f1c866231a3015411fdce18a3e72649e2f6
--
2.34.0
guix-patches <at> gnu.org:bug#54180; Package guix-patches.
(Sun, 27 Feb 2022 13:54:02 GMT) Full text and rfc822 format available.Message #8 received at 54180 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: 54180 <at> debbugs.gnu.org Cc: Ludovic Courtès <ludo <at> gnu.org> Subject: [PATCH 01/12] home: symlink-manager: Clarify module imports. Date: Sun, 27 Feb 2022 14:53:31 +0100
* gnu/home/services/symlink-manager.scm (update-symlinks-script): Wrap
body in 'with-imported-modules'. Move (guix build utils) import to the
top. Move #$%initialize-gettext after definitions.
---
gnu/home/services/symlink-manager.scm | 336 +++++++++++++-------------
1 file changed, 170 insertions(+), 166 deletions(-)
diff --git a/gnu/home/services/symlink-manager.scm b/gnu/home/services/symlink-manager.scm
index 314da3ba3e..c60cdcffb7 100644
--- a/gnu/home/services/symlink-manager.scm
+++ b/gnu/home/services/symlink-manager.scm
@@ -20,7 +20,7 @@
(define-module (gnu home services symlink-manager)
#:use-module (gnu home services)
#:use-module (guix gexp)
-
+ #:use-module (guix modules)
#:export (home-symlink-manager-service-type))
;;; Comment:
@@ -37,15 +37,19 @@ (define-module (gnu home services symlink-manager)
(define (update-symlinks-script)
(program-file
"update-symlinks"
- #~(begin
- (use-modules (ice-9 ftw)
- (ice-9 curried-definitions)
- (ice-9 match)
- (srfi srfi-1)
- (guix i18n))
- #$%initialize-gettext
- (define ((simplify-file-tree parent) file)
- "Convert the result produced by `file-system-tree' to less
+ (with-imported-modules (source-module-closure
+ '((guix build utils)
+ (guix i18n)))
+ #~(begin
+ (use-modules (ice-9 ftw)
+ (ice-9 curried-definitions)
+ (ice-9 match)
+ (srfi srfi-1)
+ (guix i18n)
+ (guix build utils))
+
+ (define ((simplify-file-tree parent) file)
+ "Convert the result produced by `file-system-tree' to less
verbose and more suitable for further processing format.
Extract dir/file info from stat and compose a relative path to the
@@ -60,178 +64,178 @@ (define ((simplify-file-tree parent) file)
((dir . \"config/isync\")
(file . \"config/isync/mbsyncrc\"))))
"
- (match file
- ((name stat) `(file . ,(string-append parent name)))
- ((name stat children ...)
- (cons `(dir . ,(string-append parent name))
- (map (simplify-file-tree
- (if (equal? name ".")
- ""
- (string-append parent name "/")))
- children)))))
+ (match file
+ ((name stat) `(file . ,(string-append parent name)))
+ ((name stat children ...)
+ (cons `(dir . ,(string-append parent name))
+ (map (simplify-file-tree
+ (if (equal? name ".")
+ ""
+ (string-append parent name "/")))
+ children)))))
- (define ((file-tree-traverse preordering) node)
- "Traverses the file tree in different orders, depending on PREORDERING.
+ (define ((file-tree-traverse preordering) node)
+ "Traverses the file tree in different orders, depending on PREORDERING.
if PREORDERING is @code{#t} resulting list will contain directories
before files located in those directories, otherwise directory will
appear only after all nested items already listed."
- (let ((prepend (lambda (a b) (append b a))))
- (match node
- (('file . path) (list node))
- ((('dir . path) . rest)
- ((if preordering append prepend)
- (list (cons 'dir path))
- (append-map (file-tree-traverse preordering) rest))))))
-
- (use-modules (guix build utils))
-
- (let* ((config-home (or (getenv "XDG_CONFIG_HOME")
- (string-append (getenv "HOME") "/.config")))
-
- (he-path (string-append (getenv "HOME") "/.guix-home"))
- (new-he-path (string-append he-path ".new"))
- (new-home (getenv "GUIX_NEW_HOME"))
- (old-home (getenv "GUIX_OLD_HOME"))
-
- (new-files-path (string-append new-home "/files"))
- ;; Trailing dot is required, because files itself is symlink and
- ;; to make file-system-tree works it should be a directory.
- (new-files-dir-path (string-append new-files-path "/."))
-
- (home-path (getenv "HOME"))
- (backup-dir (string-append home-path "/"
- (number->string (current-time))
- "-guix-home-legacy-configs-backup"))
-
- (old-tree (if old-home
- ((simplify-file-tree "")
- (file-system-tree
- (string-append old-home "/files/.")))
- #f))
- (new-tree ((simplify-file-tree "")
- (file-system-tree new-files-dir-path)))
-
- (get-source-path
- (lambda (path)
- (readlink (string-append new-files-path "/" path))))
-
- (get-target-path
- (lambda (path)
- (string-append home-path "/." path)))
-
- (get-backup-path
- (lambda (path)
- (string-append backup-dir "/." path)))
-
- (directory?
- (lambda (path)
- (equal? (stat:type (stat path)) 'directory)))
-
- (empty-directory?
- (lambda (dir)
- (equal? (scandir dir) '("." ".."))))
-
- (symlink-to-store?
- (lambda (path)
- (and
- (equal? (stat:type (lstat path)) 'symlink)
- (store-file-name? (readlink path)))))
-
- (backup-file
- (lambda (path)
- (mkdir-p backup-dir)
- (format #t (G_ "Backing up ~a...") (get-target-path path))
- (mkdir-p (dirname (get-backup-path path)))
- (rename-file (get-target-path path) (get-backup-path path))
- (display (G_ " done\n"))))
-
- (cleanup-symlinks
- (lambda ()
- (let ((to-delete ((file-tree-traverse #f) old-tree)))
- (display
- (G_
- "Cleaning up symlinks from previous home-environment.\n\n"))
- (map
- (match-lambda
- (('dir . ".")
- (display (G_ "Cleanup finished.\n\n")))
-
- (('dir . path)
- (if (and
- (file-exists? (get-target-path path))
- (directory? (get-target-path path))
- (empty-directory? (get-target-path path)))
- (begin
- (format #t (G_ "Removing ~a...")
- (get-target-path path))
- (rmdir (get-target-path path))
- (display (G_ " done\n")))
- (format
- #t
- (G_ "Skipping ~a (not an empty directory)... done\n")
- (get-target-path path))))
-
- (('file . path)
- (when (file-exists? (get-target-path path))
- ;; DO NOT remove the file if it is no longer
- ;; a symlink to the store, it will be backed
- ;; up later during create-symlinks phase.
- (if (symlink-to-store? (get-target-path path))
+ (let ((prepend (lambda (a b) (append b a))))
+ (match node
+ (('file . path) (list node))
+ ((('dir . path) . rest)
+ ((if preordering append prepend)
+ (list (cons 'dir path))
+ (append-map (file-tree-traverse preordering) rest))))))
+
+ #$%initialize-gettext
+
+ (let* ((config-home (or (getenv "XDG_CONFIG_HOME")
+ (string-append (getenv "HOME") "/.config")))
+
+ (he-path (string-append (getenv "HOME") "/.guix-home"))
+ (new-he-path (string-append he-path ".new"))
+ (new-home (getenv "GUIX_NEW_HOME"))
+ (old-home (getenv "GUIX_OLD_HOME"))
+
+ (new-files-path (string-append new-home "/files"))
+ ;; Trailing dot is required, because files itself is symlink and
+ ;; to make file-system-tree works it should be a directory.
+ (new-files-dir-path (string-append new-files-path "/."))
+
+ (home-path (getenv "HOME"))
+ (backup-dir (string-append home-path "/"
+ (number->string (current-time))
+ "-guix-home-legacy-configs-backup"))
+
+ (old-tree (if old-home
+ ((simplify-file-tree "")
+ (file-system-tree
+ (string-append old-home "/files/.")))
+ #f))
+ (new-tree ((simplify-file-tree "")
+ (file-system-tree new-files-dir-path)))
+
+ (get-source-path
+ (lambda (path)
+ (readlink (string-append new-files-path "/" path))))
+
+ (get-target-path
+ (lambda (path)
+ (string-append home-path "/." path)))
+
+ (get-backup-path
+ (lambda (path)
+ (string-append backup-dir "/." path)))
+
+ (directory?
+ (lambda (path)
+ (equal? (stat:type (stat path)) 'directory)))
+
+ (empty-directory?
+ (lambda (dir)
+ (equal? (scandir dir) '("." ".."))))
+
+ (symlink-to-store?
+ (lambda (path)
+ (and
+ (equal? (stat:type (lstat path)) 'symlink)
+ (store-file-name? (readlink path)))))
+
+ (backup-file
+ (lambda (path)
+ (mkdir-p backup-dir)
+ (format #t (G_ "Backing up ~a...") (get-target-path path))
+ (mkdir-p (dirname (get-backup-path path)))
+ (rename-file (get-target-path path) (get-backup-path path))
+ (display (G_ " done\n"))))
+
+ (cleanup-symlinks
+ (lambda ()
+ (let ((to-delete ((file-tree-traverse #f) old-tree)))
+ (display
+ (G_
+ "Cleaning up symlinks from previous home-environment.\n\n"))
+ (map
+ (match-lambda
+ (('dir . ".")
+ (display (G_ "Cleanup finished.\n\n")))
+
+ (('dir . path)
+ (if (and
+ (file-exists? (get-target-path path))
+ (directory? (get-target-path path))
+ (empty-directory? (get-target-path path)))
(begin
- (format #t (G_ "Removing ~a...") (get-target-path path))
- (delete-file (get-target-path path))
+ (format #t (G_ "Removing ~a...")
+ (get-target-path path))
+ (rmdir (get-target-path path))
(display (G_ " done\n")))
(format
#t
- (G_ "Skipping ~a (not a symlink to store)... done\n")
- (get-target-path path))))))
- to-delete))))
+ (G_ "Skipping ~a (not an empty directory)... done\n")
+ (get-target-path path))))
- (create-symlinks
- (lambda ()
- (let ((to-create ((file-tree-traverse #t) new-tree)))
- (map
- (match-lambda
- (('dir . ".")
- (display
- (G_ "New symlinks to home-environment will be created soon.\n"))
- (format
- #t (G_ "All conflicting files will go to ~a.\n\n") backup-dir))
+ (('file . path)
+ (when (file-exists? (get-target-path path))
+ ;; DO NOT remove the file if it is no longer
+ ;; a symlink to the store, it will be backed
+ ;; up later during create-symlinks phase.
+ (if (symlink-to-store? (get-target-path path))
+ (begin
+ (format #t (G_ "Removing ~a...") (get-target-path path))
+ (delete-file (get-target-path path))
+ (display (G_ " done\n")))
+ (format
+ #t
+ (G_ "Skipping ~a (not a symlink to store)... done\n")
+ (get-target-path path))))))
+ to-delete))))
- (('dir . path)
- (let ((target-path (get-target-path path)))
- (when (and (file-exists? target-path)
- (not (directory? target-path)))
+ (create-symlinks
+ (lambda ()
+ (let ((to-create ((file-tree-traverse #t) new-tree)))
+ (map
+ (match-lambda
+ (('dir . ".")
+ (display
+ (G_ "New symlinks to home-environment will be created soon.\n"))
+ (format
+ #t (G_ "All conflicting files will go to ~a.\n\n") backup-dir))
+
+ (('dir . path)
+ (let ((target-path (get-target-path path)))
+ (when (and (file-exists? target-path)
+ (not (directory? target-path)))
+ (backup-file path))
+
+ (if (file-exists? target-path)
+ (format
+ #t (G_ "Skipping ~a (directory already exists)... done\n")
+ target-path)
+ (begin
+ (format #t (G_ "Creating ~a...") target-path)
+ (mkdir target-path)
+ (display (G_ " done\n"))))))
+
+ (('file . path)
+ (when (file-exists? (get-target-path path))
(backup-file path))
+ (format #t (G_ "Symlinking ~a -> ~a...")
+ (get-target-path path) (get-source-path path))
+ (symlink (get-source-path path) (get-target-path path))
+ (display (G_ " done\n"))))
+ to-create)))))
- (if (file-exists? target-path)
- (format
- #t (G_ "Skipping ~a (directory already exists)... done\n")
- target-path)
- (begin
- (format #t (G_ "Creating ~a...") target-path)
- (mkdir target-path)
- (display (G_ " done\n"))))))
+ (when old-tree
+ (cleanup-symlinks))
- (('file . path)
- (when (file-exists? (get-target-path path))
- (backup-file path))
- (format #t (G_ "Symlinking ~a -> ~a...")
- (get-target-path path) (get-source-path path))
- (symlink (get-source-path path) (get-target-path path))
- (display (G_ " done\n"))))
- to-create)))))
+ (create-symlinks)
- (when old-tree
- (cleanup-symlinks))
+ (symlink new-home new-he-path)
+ (rename-file new-he-path he-path)
- (create-symlinks)
-
- (symlink new-home new-he-path)
- (rename-file new-he-path he-path)
-
- (display (G_" done\nFinished updating symlinks.\n\n"))))))
+ (display (G_" done\nFinished updating symlinks.\n\n")))))))
(define (update-symlinks-gexp _)
--
2.34.0
guix-patches <at> gnu.org:bug#54180; Package guix-patches.
(Sun, 27 Feb 2022 13:55:02 GMT) Full text and rfc822 format available.Message #11 received at 54180 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: 54180 <at> debbugs.gnu.org Cc: Ludovic Courtès <ludo <at> gnu.org> Subject: [PATCH 02/12] home: symlink-manager: Move helper procedures as top-level defines. Date: Sun, 27 Feb 2022 14:53:32 +0100
* gnu/home/services/symlink-manager.scm (update-symlinks-script): Remove
'config-home', which is unused. Move 'home-path', 'backup-dir',
'get-target-path', 'get-backup-path', 'directory?', 'empty-directory?',
'symlink-to-store?', and 'backup-file' to the top level. Move
'create-symlinks' and 'cleanup-symlinks' to the top level as well, and
add parameters. Adjust callers.
---
gnu/home/services/symlink-manager.scm | 240 +++++++++++++-------------
1 file changed, 116 insertions(+), 124 deletions(-)
diff --git a/gnu/home/services/symlink-manager.scm b/gnu/home/services/symlink-manager.scm
index c60cdcffb7..25470209d1 100644
--- a/gnu/home/services/symlink-manager.scm
+++ b/gnu/home/services/symlink-manager.scm
@@ -88,12 +88,121 @@ (define ((file-tree-traverse preordering) node)
(list (cons 'dir path))
(append-map (file-tree-traverse preordering) rest))))))
+ (define home-path
+ (getenv "HOME"))
+
+ (define backup-dir
+ (string-append home-path "/" (number->string (current-time))
+ "-guix-home-legacy-configs-backup"))
+
+ (define (get-target-path path)
+ (string-append home-path "/." path))
+
+ (define (get-backup-path path)
+ (string-append backup-dir "/." path))
+
+ (define (directory? path)
+ (equal? (stat:type (stat path)) 'directory))
+
+ (define (empty-directory? dir)
+ (equal? (scandir dir) '("." "..")))
+
+ (define (symlink-to-store? path)
+ (and (equal? (stat:type (lstat path)) 'symlink)
+ (store-file-name? (readlink path))))
+
+ (define (backup-file path)
+ (mkdir-p backup-dir)
+ (format #t (G_ "Backing up ~a...") (get-target-path path))
+ (mkdir-p (dirname (get-backup-path path)))
+ (rename-file (get-target-path path) (get-backup-path path))
+ (display (G_ " done\n")))
+
+ (define (cleanup-symlinks old-tree)
+ ;; Delete from directory OLD-TREE symlinks that correspond to a
+ ;; previous generation.
+ (let ((to-delete ((file-tree-traverse #f) old-tree)))
+ (display
+ (G_
+ "Cleaning up symlinks from previous home-environment.\n\n"))
+ (map
+ (match-lambda
+ (('dir . ".")
+ (display (G_ "Cleanup finished.\n\n")))
+
+ (('dir . path)
+ (if (and
+ (file-exists? (get-target-path path))
+ (directory? (get-target-path path))
+ (empty-directory? (get-target-path path)))
+ (begin
+ (format #t (G_ "Removing ~a...")
+ (get-target-path path))
+ (rmdir (get-target-path path))
+ (display (G_ " done\n")))
+ (format
+ #t
+ (G_ "Skipping ~a (not an empty directory)... done\n")
+ (get-target-path path))))
+
+ (('file . path)
+ (when (file-exists? (get-target-path path))
+ ;; DO NOT remove the file if it is no longer a symlink to
+ ;; the store, it will be backed up later during
+ ;; create-symlinks phase.
+ (if (symlink-to-store? (get-target-path path))
+ (begin
+ (format #t (G_ "Removing ~a...") (get-target-path path))
+ (delete-file (get-target-path path))
+ (display (G_ " done\n")))
+ (format
+ #t
+ (G_ "Skipping ~a (not a symlink to store)... done\n")
+ (get-target-path path))))))
+ to-delete)))
+
+ (define (create-symlinks new-tree new-files-path)
+ ;; Create in directory NEW-TREE symlinks to the files under
+ ;; NEW-FILES-PATH, creating backups as needed.
+ (define (get-source-path path)
+ (readlink (string-append new-files-path "/" path)))
+
+ (let ((to-create ((file-tree-traverse #t) new-tree)))
+ (map
+ (match-lambda
+ (('dir . ".")
+ (display
+ (G_ "New symlinks to home-environment will be created soon.\n"))
+ (format
+ #t (G_ "All conflicting files will go to ~a.\n\n") backup-dir))
+
+ (('dir . path)
+ (let ((target-path (get-target-path path)))
+ (when (and (file-exists? target-path)
+ (not (directory? target-path)))
+ (backup-file path))
+
+ (if (file-exists? target-path)
+ (format
+ #t (G_ "Skipping ~a (directory already exists)... done\n")
+ target-path)
+ (begin
+ (format #t (G_ "Creating ~a...") target-path)
+ (mkdir target-path)
+ (display (G_ " done\n"))))))
+
+ (('file . path)
+ (when (file-exists? (get-target-path path))
+ (backup-file path))
+ (format #t (G_ "Symlinking ~a -> ~a...")
+ (get-target-path path) (get-source-path path))
+ (symlink (get-source-path path) (get-target-path path))
+ (display (G_ " done\n"))))
+ to-create)))
+
#$%initialize-gettext
- (let* ((config-home (or (getenv "XDG_CONFIG_HOME")
- (string-append (getenv "HOME") "/.config")))
-
- (he-path (string-append (getenv "HOME") "/.guix-home"))
+ (let* ((he-path (string-append (getenv "HOME") "/.guix-home"))
(new-he-path (string-append he-path ".new"))
(new-home (getenv "GUIX_NEW_HOME"))
(old-home (getenv "GUIX_OLD_HOME"))
@@ -103,141 +212,24 @@ (define ((file-tree-traverse preordering) node)
;; to make file-system-tree works it should be a directory.
(new-files-dir-path (string-append new-files-path "/."))
- (home-path (getenv "HOME"))
- (backup-dir (string-append home-path "/"
- (number->string (current-time))
- "-guix-home-legacy-configs-backup"))
-
(old-tree (if old-home
((simplify-file-tree "")
(file-system-tree
(string-append old-home "/files/.")))
#f))
(new-tree ((simplify-file-tree "")
- (file-system-tree new-files-dir-path)))
-
- (get-source-path
- (lambda (path)
- (readlink (string-append new-files-path "/" path))))
-
- (get-target-path
- (lambda (path)
- (string-append home-path "/." path)))
-
- (get-backup-path
- (lambda (path)
- (string-append backup-dir "/." path)))
-
- (directory?
- (lambda (path)
- (equal? (stat:type (stat path)) 'directory)))
-
- (empty-directory?
- (lambda (dir)
- (equal? (scandir dir) '("." ".."))))
-
- (symlink-to-store?
- (lambda (path)
- (and
- (equal? (stat:type (lstat path)) 'symlink)
- (store-file-name? (readlink path)))))
-
- (backup-file
- (lambda (path)
- (mkdir-p backup-dir)
- (format #t (G_ "Backing up ~a...") (get-target-path path))
- (mkdir-p (dirname (get-backup-path path)))
- (rename-file (get-target-path path) (get-backup-path path))
- (display (G_ " done\n"))))
-
- (cleanup-symlinks
- (lambda ()
- (let ((to-delete ((file-tree-traverse #f) old-tree)))
- (display
- (G_
- "Cleaning up symlinks from previous home-environment.\n\n"))
- (map
- (match-lambda
- (('dir . ".")
- (display (G_ "Cleanup finished.\n\n")))
-
- (('dir . path)
- (if (and
- (file-exists? (get-target-path path))
- (directory? (get-target-path path))
- (empty-directory? (get-target-path path)))
- (begin
- (format #t (G_ "Removing ~a...")
- (get-target-path path))
- (rmdir (get-target-path path))
- (display (G_ " done\n")))
- (format
- #t
- (G_ "Skipping ~a (not an empty directory)... done\n")
- (get-target-path path))))
-
- (('file . path)
- (when (file-exists? (get-target-path path))
- ;; DO NOT remove the file if it is no longer
- ;; a symlink to the store, it will be backed
- ;; up later during create-symlinks phase.
- (if (symlink-to-store? (get-target-path path))
- (begin
- (format #t (G_ "Removing ~a...") (get-target-path path))
- (delete-file (get-target-path path))
- (display (G_ " done\n")))
- (format
- #t
- (G_ "Skipping ~a (not a symlink to store)... done\n")
- (get-target-path path))))))
- to-delete))))
-
- (create-symlinks
- (lambda ()
- (let ((to-create ((file-tree-traverse #t) new-tree)))
- (map
- (match-lambda
- (('dir . ".")
- (display
- (G_ "New symlinks to home-environment will be created soon.\n"))
- (format
- #t (G_ "All conflicting files will go to ~a.\n\n") backup-dir))
-
- (('dir . path)
- (let ((target-path (get-target-path path)))
- (when (and (file-exists? target-path)
- (not (directory? target-path)))
- (backup-file path))
-
- (if (file-exists? target-path)
- (format
- #t (G_ "Skipping ~a (directory already exists)... done\n")
- target-path)
- (begin
- (format #t (G_ "Creating ~a...") target-path)
- (mkdir target-path)
- (display (G_ " done\n"))))))
-
- (('file . path)
- (when (file-exists? (get-target-path path))
- (backup-file path))
- (format #t (G_ "Symlinking ~a -> ~a...")
- (get-target-path path) (get-source-path path))
- (symlink (get-source-path path) (get-target-path path))
- (display (G_ " done\n"))))
- to-create)))))
+ (file-system-tree new-files-dir-path))))
(when old-tree
- (cleanup-symlinks))
+ (cleanup-symlinks old-tree))
- (create-symlinks)
+ (create-symlinks new-tree new-files-path)
(symlink new-home new-he-path)
(rename-file new-he-path he-path)
(display (G_" done\nFinished updating symlinks.\n\n")))))))
-
(define (update-symlinks-gexp _)
#~(primitive-load #$(update-symlinks-script)))
--
2.34.0
guix-patches <at> gnu.org:bug#54180; Package guix-patches.
(Sun, 27 Feb 2022 13:55:03 GMT) Full text and rfc822 format available.Message #14 received at 54180 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: 54180 <at> debbugs.gnu.org Cc: Ludovic Courtès <ludo <at> gnu.org> Subject: [PATCH 06/12] home: symlink-manager: Avoid extra 'lstat' call. Date: Sun, 27 Feb 2022 14:53:36 +0100
* gnu/home/services/symlink-manager.scm (update-symlinks-script)[symlink-to-store?]:
Avoid extra 'lstat' call.
---
gnu/home/services/symlink-manager.scm | 9 +++++++--
1 file changed, 7 insertions(+), 2 deletions(-)
diff --git a/gnu/home/services/symlink-manager.scm b/gnu/home/services/symlink-manager.scm
index 6b3a9de3d1..ba42424e8e 100644
--- a/gnu/home/services/symlink-manager.scm
+++ b/gnu/home/services/symlink-manager.scm
@@ -103,8 +103,13 @@ (define (get-backup-path path)
(string-append backup-dir "/." path))
(define (symlink-to-store? path)
- (and (equal? (stat:type (lstat path)) 'symlink)
- (store-file-name? (readlink path))))
+ (catch 'system-error
+ (lambda ()
+ (store-file-name? (readlink path)))
+ (lambda args
+ (if (= EINVAL (system-error-errno args))
+ #f
+ (apply throw args)))))
(define (backup-file path)
(mkdir-p backup-dir)
--
2.34.0
guix-patches <at> gnu.org:bug#54180; Package guix-patches.
(Sun, 27 Feb 2022 13:55:03 GMT) Full text and rfc822 format available.Message #17 received at 54180 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: 54180 <at> debbugs.gnu.org Cc: Ludovic Courtès <ludo <at> gnu.org> Subject: [PATCH 03/12] home: symlink-manager: Use 'for-each' when used for effects. Date: Sun, 27 Feb 2022 14:53:33 +0100
* gnu/home/services/symlink-manager.scm (update-symlinks-script)[cleanup-symlinks]
[create-symlinks]: Use 'for-each' instead of 'map'.
---
gnu/home/services/symlink-manager.scm | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/gnu/home/services/symlink-manager.scm b/gnu/home/services/symlink-manager.scm
index 25470209d1..a6344c808f 100644
--- a/gnu/home/services/symlink-manager.scm
+++ b/gnu/home/services/symlink-manager.scm
@@ -125,7 +125,7 @@ (define (cleanup-symlinks old-tree)
(display
(G_
"Cleaning up symlinks from previous home-environment.\n\n"))
- (map
+ (for-each
(match-lambda
(('dir . ".")
(display (G_ "Cleanup finished.\n\n")))
@@ -168,7 +168,7 @@ (define (get-source-path path)
(readlink (string-append new-files-path "/" path)))
(let ((to-create ((file-tree-traverse #t) new-tree)))
- (map
+ (for-each
(match-lambda
(('dir . ".")
(display
--
2.34.0
guix-patches <at> gnu.org:bug#54180; Package guix-patches.
(Sun, 27 Feb 2022 13:55:04 GMT) Full text and rfc822 format available.Message #20 received at 54180 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: 54180 <at> debbugs.gnu.org Cc: Ludovic Courtès <ludo <at> gnu.org> Subject: [PATCH 05/12] home: symlink-manager: Remove 'empty-directory?' and avoid TOCTTOU race. Date: Sun, 27 Feb 2022 14:53:35 +0100
This removes three 'stat' syscalls.
* gnu/home/services/symlink-manager.scm (update-symlinks-script)[empty-directory?]:
Remove.
[cleanup-symlinks]: Replace use of 'file-exists?', 'file-is-directory?',
and 'empty-directory?' by a single 'rmdir' call.
---
gnu/home/services/symlink-manager.scm | 35 ++++++++++++++-------------
1 file changed, 18 insertions(+), 17 deletions(-)
diff --git a/gnu/home/services/symlink-manager.scm b/gnu/home/services/symlink-manager.scm
index f133eb17f2..6b3a9de3d1 100644
--- a/gnu/home/services/symlink-manager.scm
+++ b/gnu/home/services/symlink-manager.scm
@@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2021 Andrew Tropin <andrew <at> trop.in>
;;; Copyright © 2021 Xinglu Chen <public <at> yoctocell.xyz>
+;;; Copyright © 2022 Ludovic Courtès <ludo <at> gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -101,9 +102,6 @@ (define (get-target-path path)
(define (get-backup-path path)
(string-append backup-dir "/." path))
- (define (empty-directory? dir)
- (equal? (scandir dir) '("." "..")))
-
(define (symlink-to-store? path)
(and (equal? (stat:type (lstat path)) 'symlink)
(store-file-name? (readlink path))))
@@ -127,20 +125,23 @@ (define (cleanup-symlinks old-tree)
(('dir . ".")
(display (G_ "Cleanup finished.\n\n")))
- (('dir . path)
- (if (and
- (file-exists? (get-target-path path))
- (file-is-directory? (get-target-path path))
- (empty-directory? (get-target-path path)))
- (begin
- (format #t (G_ "Removing ~a...")
- (get-target-path path))
- (rmdir (get-target-path path))
- (display (G_ " done\n")))
- (format
- #t
- (G_ "Skipping ~a (not an empty directory)... done\n")
- (get-target-path path))))
+ (('dir . directory)
+ (let ((directory (get-target-path directory)))
+ (catch 'system-error
+ (lambda ()
+ (rmdir directory)
+ (format #t (G_ "Removed ~a.\n") directory))
+ (lambda args
+ (let ((errno (system-error-errno args)))
+ (cond ((= ENOTEMPTY errno)
+ (format
+ #t
+ (G_ "Skipping ~a (not an empty directory)...\n")
+ directory))
+ ((= ENOTDIR errno)
+ #t)
+ (else
+ (apply throw args))))))))
(('file . path)
(when (file-exists? (get-target-path path))
--
2.34.0
guix-patches <at> gnu.org:bug#54180; Package guix-patches.
(Sun, 27 Feb 2022 13:55:04 GMT) Full text and rfc822 format available.Message #23 received at 54180 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: 54180 <at> debbugs.gnu.org Cc: Ludovic Courtès <ludo <at> gnu.org> Subject: [PATCH 12/12] home: symlink-manager: Rename "path" to "file" where appropriate. Date: Sun, 27 Feb 2022 14:53:42 +0100
* gnu/home/services/symlink-manager.scm (update-symlinks-script):
[home-path]: Rename to...
[home-directory]: ... this. Adjust users.
[backup-dir]: Rename to...
[backup-directory]: ... this. Adjust user.
[get-target-path]: Rename to...
[target-file]: ... this. Adjust users.
[get-backup-path]: Remove.
[backup-file]: Inline it.
[cleanup-symlinks](get-source-path): Rename to...
(source-file): ... this. Adjust users.
Rename 'he-path' to 'home' and 'new-he-path' to 'pivot'.
---
gnu/home/services/symlink-manager.scm | 55 ++++++++++++++-------------
1 file changed, 28 insertions(+), 27 deletions(-)
diff --git a/gnu/home/services/symlink-manager.scm b/gnu/home/services/symlink-manager.scm
index 16e2e7b772..767b1bdc01 100644
--- a/gnu/home/services/symlink-manager.scm
+++ b/gnu/home/services/symlink-manager.scm
@@ -48,33 +48,35 @@ (define (update-symlinks-script)
(guix i18n)
(guix build utils))
- (define home-path
+ (define home-directory
(getenv "HOME"))
- (define backup-dir
- (string-append home-path "/" (number->string (current-time))
+ (define backup-directory
+ (string-append home-directory "/" (number->string (current-time))
"-guix-home-legacy-configs-backup"))
- (define (get-target-path path)
- (string-append home-path "/." path))
+ (define (target-file file)
+ ;; Return the target of FILE, a config file name sans leading dot
+ ;; such as "config/fontconfig/fonts.conf" or "bashrc".
+ (string-append home-directory "/." file))
- (define (get-backup-path path)
- (string-append backup-dir "/." path))
-
- (define (symlink-to-store? path)
+ (define (symlink-to-store? file)
(catch 'system-error
(lambda ()
- (store-file-name? (readlink path)))
+ (store-file-name? (readlink file)))
(lambda args
(if (= EINVAL (system-error-errno args))
#f
(apply throw args)))))
- (define (backup-file path)
- (mkdir-p backup-dir)
- (format #t (G_ "Backing up ~a...") (get-target-path path))
- (mkdir-p (dirname (get-backup-path path)))
- (rename-file (get-target-path path) (get-backup-path path))
+ (define (backup-file file)
+ (define backup
+ (string-append backup-directory "/." file))
+
+ (mkdir-p backup-directory)
+ (format #t (G_ "Backing up ~a...") (target-file file))
+ (mkdir-p (dirname backup))
+ (rename-file (target-file file) backup)
(display (G_ " done\n")))
(define (cleanup-symlinks home-generation)
@@ -95,7 +97,7 @@ (define (strip file)
(file-system-fold
(const #t)
(lambda (file stat _) ;leaf
- (let ((file (get-target-path (strip file))))
+ (let ((file (target-file (strip file))))
(when (file-exists? file)
;; DO NOT remove the file if it is no longer a symlink to
;; the store, it will be backed up later during
@@ -112,7 +114,7 @@ (define (strip file)
(const #t) ;down
(lambda (directory stat _) ;up
(unless (string=? directory config-file-directory)
- (let ((directory (get-target-path (strip directory))))
+ (let ((directory (target-file (strip directory))))
(catch 'system-error
(lambda ()
(rmdir directory)
@@ -145,14 +147,14 @@ (define (strip file)
(string-drop file
(+ 1 (string-length config-file-directory))))
- (define (get-source-path path)
- (readlink (string-append config-file-directory path)))
+ (define (source-file file)
+ (readlink (string-append config-file-directory file)))
(file-system-fold
(const #t) ;enter?
(lambda (file stat result) ;leaf
- (let ((source (get-source-path (strip file)))
- (target (get-target-path (strip file))))
+ (let ((source (source-file (strip file)))
+ (target (target-file (strip file))))
(when (file-exists? target)
(backup-file (strip file)))
(format #t (G_ "Symlinking ~a -> ~a...")
@@ -161,7 +163,7 @@ (define (get-source-path path)
(display (G_ " done\n"))))
(lambda (directory stat result) ;down
(unless (string=? directory config-file-directory)
- (let ((target (get-target-path (strip directory))))
+ (let ((target (target-file (strip directory))))
(when (and (file-exists? target)
(not (file-is-directory? target)))
(backup-file (strip directory)))
@@ -183,18 +185,17 @@ (define (get-source-path path)
#$%initialize-gettext
- (let* ((he-path (string-append (getenv "HOME") "/.guix-home"))
- (new-he-path (string-append he-path ".new"))
+ (let* ((home (string-append (getenv "HOME") "/.guix-home"))
+ (pivot (string-append home ".new"))
(new-home (getenv "GUIX_NEW_HOME"))
(old-home (getenv "GUIX_OLD_HOME")))
-
(when old-home
(cleanup-symlinks old-home))
(create-symlinks new-home)
- (symlink new-home new-he-path)
- (rename-file new-he-path he-path)
+ (symlink new-home pivot)
+ (rename-file pivot home)
(display (G_" done\nFinished updating symlinks.\n\n")))))))
--
2.34.0
guix-patches <at> gnu.org:bug#54180; Package guix-patches.
(Sun, 27 Feb 2022 13:55:05 GMT) Full text and rfc822 format available.Message #26 received at 54180 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: 54180 <at> debbugs.gnu.org Cc: Ludovic Courtès <ludo <at> gnu.org> Subject: [PATCH 09/12] tests: Check 'guix home reconfigure' for a second generation. Date: Sun, 27 Feb 2022 14:53:39 +0100
* tests/guix-home.sh: Invoke "guix home reconfigure" a second time with
a modify config file and check the result.
---
tests/guix-home.sh | 23 +++++++++++++++++++++++
1 file changed, 23 insertions(+)
diff --git a/tests/guix-home.sh b/tests/guix-home.sh
index 3b397649cc..f054d15172 100644
--- a/tests/guix-home.sh
+++ b/tests/guix-home.sh
@@ -108,6 +108,7 @@ EOF
# Make sure preexisting files were backed up.
grep "overridden" "$HOME"/*guix-home*backup/.bashrc
grep "overridden" "$HOME"/*guix-home*backup/.config/test.conf
+ rm -r "$HOME"/*guix-home*backup
#
# Test 'guix home describe'.
@@ -131,6 +132,28 @@ EOF
}
test "$(canonical_file_name)" == "$(readlink "${HOME}/.guix-home")"
+ #
+ # Configure a new generation.
+ #
+
+ # Change the bashrc snippet content and comment out one service.
+ sed -i "home.scm" -e's/the content of/the NEW content of/g'
+ sed -i "home.scm" -e"s/(simple-service 'test-config/#;(simple-service 'test-config/g"
+
+ guix home reconfigure "${test_directory}/home.scm"
+ test "$(tail -n 2 "${HOME}/.bashrc")" == "\
+# dot-bashrc test file for guix home
+# the NEW content of bashrc-test-config.sh"
+
+ # This file must have been removed and not backed up.
+ ! test -e "$HOME/.config/test.conf"
+ ! test -e "$HOME"/*guix-home*backup/.config/test.conf
+
+ test "$(cat "$(configuration_file)")" == "$(cat home.scm)"
+ test "$(canonical_file_name)" == "$(readlink "${HOME}/.guix-home")"
+
+ test $(guix home list-generations | grep "^Generation" | wc -l) -eq 2
+
#
# Test 'guix home search'.
#
--
2.34.0
guix-patches <at> gnu.org:bug#54180; Package guix-patches.
(Sun, 27 Feb 2022 13:55:05 GMT) Full text and rfc822 format available.Message #29 received at 54180 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: 54180 <at> debbugs.gnu.org Cc: Ludovic Courtès <ludo <at> gnu.org> Subject: [PATCH 08/12] tests: Simplify use of 'local-file' in 'tests/guix-home.sh'. Date: Sun, 27 Feb 2022 14:53:38 +0100
* tests/guix-home.sh: Remove 'current-filename' trickery since
'local-file' resolves file names relative to the containing file.
---
tests/guix-home.sh | 5 +----
1 file changed, 1 insertion(+), 4 deletions(-)
diff --git a/tests/guix-home.sh b/tests/guix-home.sh
index ae3e52c9e1..3b397649cc 100644
--- a/tests/guix-home.sh
+++ b/tests/guix-home.sh
@@ -81,10 +81,7 @@ trap 'chmod -Rf +w "$test_directory"; rm -rf "$test_directory"' EXIT
(service home-bash-service-type
(home-bash-configuration
(guix-defaults? #t)
- (bashrc
- (list
- (local-file (string-append (dirname (current-filename))
- "/dot-bashrc"))))))
+ (bashrc (list (local-file "dot-bashrc")))))
(simple-service 'home-bash-service-extension-test
home-bash-service-type
--
2.34.0
guix-patches <at> gnu.org:bug#54180; Package guix-patches.
(Sun, 27 Feb 2022 13:55:05 GMT) Full text and rfc822 format available.Message #32 received at 54180 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: 54180 <at> debbugs.gnu.org Cc: Ludovic Courtès <ludo <at> gnu.org> Subject: [PATCH 10/12] home: symlink-manager: 'cleanup-symlinks' uses 'file-system-fold'. Date: Sun, 27 Feb 2022 14:53:40 +0100
* gnu/home/services/symlink-manager.scm (update-symlinks-script)[cleanup-symlinks]:
Take a home generation and iterate over its config files directly with
'file-system-fold'. Adjuster caller accordingly. Remove 'old-tree'.
---
gnu/home/services/symlink-manager.scm | 107 ++++++++++++++------------
1 file changed, 57 insertions(+), 50 deletions(-)
diff --git a/gnu/home/services/symlink-manager.scm b/gnu/home/services/symlink-manager.scm
index ba42424e8e..4f827c0360 100644
--- a/gnu/home/services/symlink-manager.scm
+++ b/gnu/home/services/symlink-manager.scm
@@ -118,51 +118,63 @@ (define (backup-file path)
(rename-file (get-target-path path) (get-backup-path path))
(display (G_ " done\n")))
- (define (cleanup-symlinks old-tree)
- ;; Delete from directory OLD-TREE symlinks that correspond to a
- ;; previous generation.
- (let ((to-delete ((file-tree-traverse #f) old-tree)))
- (display
- (G_
- "Cleaning up symlinks from previous home-environment.\n\n"))
- (for-each
- (match-lambda
- (('dir . ".")
- (display (G_ "Cleanup finished.\n\n")))
+ (define (cleanup-symlinks home-generation)
+ ;; Delete from $HOME files that originate in HOME-GENERATION, the
+ ;; store item containing a home generation.
+ (define config-file-directory
+ ;; Note: Trailing slash is needed because "files" is a symlink.
+ (string-append home-generation "/files/"))
- (('dir . directory)
- (let ((directory (get-target-path directory)))
- (catch 'system-error
- (lambda ()
- (rmdir directory)
- (format #t (G_ "Removed ~a.\n") directory))
- (lambda args
- (let ((errno (system-error-errno args)))
- (cond ((= ENOTEMPTY errno)
- (format
- #t
- (G_ "Skipping ~a (not an empty directory)...\n")
- directory))
- ((= ENOTDIR errno)
- #t)
- (else
- (apply throw args))))))))
+ (define (strip file)
+ (string-drop file
+ (+ 1 (string-length config-file-directory))))
- (('file . path)
- (when (file-exists? (get-target-path path))
- ;; DO NOT remove the file if it is no longer a symlink to
- ;; the store, it will be backed up later during
- ;; create-symlinks phase.
- (if (symlink-to-store? (get-target-path path))
- (begin
- (format #t (G_ "Removing ~a...") (get-target-path path))
- (delete-file (get-target-path path))
- (display (G_ " done\n")))
- (format
- #t
- (G_ "Skipping ~a (not a symlink to store)... done\n")
- (get-target-path path))))))
- to-delete)))
+ (format #t (G_ "Cleaning up symlinks from previous home at ~a.~%")
+ home-generation)
+ (newline)
+
+ (file-system-fold
+ (const #t)
+ (lambda (file stat _) ;leaf
+ (let ((file (get-target-path (strip file))))
+ (when (file-exists? file)
+ ;; DO NOT remove the file if it is no longer a symlink to
+ ;; the store, it will be backed up later during
+ ;; create-symlinks phase.
+ (if (symlink-to-store? file)
+ (begin
+ (format #t (G_ "Removing ~a...") file)
+ (delete-file file)
+ (display (G_ " done\n")))
+ (format #t
+ (G_ "Skipping ~a (not a symlink to store)... done\n")
+ file)))))
+
+ (const #t) ;down
+ (lambda (directory stat _) ;up
+ (unless (string=? directory config-file-directory)
+ (let ((directory (get-target-path (strip directory))))
+ (catch 'system-error
+ (lambda ()
+ (rmdir directory)
+ (format #t (G_ "Removed ~a.\n") directory))
+ (lambda args
+ (let ((errno (system-error-errno args)))
+ (cond ((= ENOTEMPTY errno)
+ (format
+ #t
+ (G_ "Skipping ~a (not an empty directory)...\n")
+ directory))
+ ((= ENOTDIR errno) #t)
+ (else
+ (apply throw args)))))))))
+ (const #t) ;skip
+ (const #t) ;error
+ #t ;init
+ config-file-directory
+ lstat)
+
+ (display (G_ "Cleanup finished.\n\n")))
(define (create-symlinks new-tree new-files-path)
;; Create in directory NEW-TREE symlinks to the files under
@@ -215,16 +227,11 @@ (define (get-source-path path)
;; to make file-system-tree works it should be a directory.
(new-files-dir-path (string-append new-files-path "/."))
- (old-tree (if old-home
- ((simplify-file-tree "")
- (file-system-tree
- (string-append old-home "/files/.")))
- #f))
(new-tree ((simplify-file-tree "")
(file-system-tree new-files-dir-path))))
- (when old-tree
- (cleanup-symlinks old-tree))
+ (when old-home
+ (cleanup-symlinks old-home))
(create-symlinks new-tree new-files-path)
--
2.34.0
guix-patches <at> gnu.org:bug#54180; Package guix-patches.
(Sun, 27 Feb 2022 13:55:06 GMT) Full text and rfc822 format available.Message #35 received at 54180 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: 54180 <at> debbugs.gnu.org Cc: Ludovic Courtès <ludo <at> gnu.org> Subject: [PATCH 11/12] home: symlink-manager: 'create-symlinks' uses 'file-system-fold'. Date: Sun, 27 Feb 2022 14:53:41 +0100
This removes the need for two intermediate representations of the file
tree.
* gnu/home/services/symlink-manager.scm (update-symlinks-script)
[simplify-file-tree, file-tree-traverse]: Remove.
[create-symlinks]: Rewrite in terms of 'file-system-fold'.
---
gnu/home/services/symlink-manager.scm | 130 +++++++++-----------------
1 file changed, 44 insertions(+), 86 deletions(-)
diff --git a/gnu/home/services/symlink-manager.scm b/gnu/home/services/symlink-manager.scm
index 4f827c0360..16e2e7b772 100644
--- a/gnu/home/services/symlink-manager.scm
+++ b/gnu/home/services/symlink-manager.scm
@@ -43,52 +43,11 @@ (define (update-symlinks-script)
(guix i18n)))
#~(begin
(use-modules (ice-9 ftw)
- (ice-9 curried-definitions)
(ice-9 match)
(srfi srfi-1)
(guix i18n)
(guix build utils))
- (define ((simplify-file-tree parent) file)
- "Convert the result produced by `file-system-tree' to less
-verbose and more suitable for further processing format.
-
-Extract dir/file info from stat and compose a relative path to the
-root of the file tree.
-
-Sample output:
-
-((dir . \".\")
- ((dir . \"config\")
- ((dir . \"config/fontconfig\")
- (file . \"config/fontconfig/fonts.conf\"))
- ((dir . \"config/isync\")
- (file . \"config/isync/mbsyncrc\"))))
-"
- (match file
- ((name stat) `(file . ,(string-append parent name)))
- ((name stat children ...)
- (cons `(dir . ,(string-append parent name))
- (map (simplify-file-tree
- (if (equal? name ".")
- ""
- (string-append parent name "/")))
- children)))))
-
- (define ((file-tree-traverse preordering) node)
- "Traverses the file tree in different orders, depending on PREORDERING.
-
-if PREORDERING is @code{#t} resulting list will contain directories
-before files located in those directories, otherwise directory will
-appear only after all nested items already listed."
- (let ((prepend (lambda (a b) (append b a))))
- (match node
- (('file . path) (list node))
- ((('dir . path) . rest)
- ((if preordering append prepend)
- (list (cons 'dir path))
- (append-map (file-tree-traverse preordering) rest))))))
-
(define home-path
(getenv "HOME"))
@@ -176,64 +135,63 @@ (define (strip file)
(display (G_ "Cleanup finished.\n\n")))
- (define (create-symlinks new-tree new-files-path)
- ;; Create in directory NEW-TREE symlinks to the files under
- ;; NEW-FILES-PATH, creating backups as needed.
+ (define (create-symlinks home-generation)
+ ;; Create in $HOME symlinks for the files in HOME-GENERATION.
+ (define config-file-directory
+ ;; Note: Trailing slash is needed because "files" is a symlink.
+ (string-append home-generation "/files/"))
+
+ (define (strip file)
+ (string-drop file
+ (+ 1 (string-length config-file-directory))))
+
(define (get-source-path path)
- (readlink (string-append new-files-path "/" path)))
+ (readlink (string-append config-file-directory path)))
- (let ((to-create ((file-tree-traverse #t) new-tree)))
- (for-each
- (match-lambda
- (('dir . ".")
- (display
- (G_ "New symlinks to home-environment will be created soon.\n"))
- (format
- #t (G_ "All conflicting files will go to ~a.\n\n") backup-dir))
+ (file-system-fold
+ (const #t) ;enter?
+ (lambda (file stat result) ;leaf
+ (let ((source (get-source-path (strip file)))
+ (target (get-target-path (strip file))))
+ (when (file-exists? target)
+ (backup-file (strip file)))
+ (format #t (G_ "Symlinking ~a -> ~a...")
+ target source)
+ (symlink source target)
+ (display (G_ " done\n"))))
+ (lambda (directory stat result) ;down
+ (unless (string=? directory config-file-directory)
+ (let ((target (get-target-path (strip directory))))
+ (when (and (file-exists? target)
+ (not (file-is-directory? target)))
+ (backup-file (strip directory)))
- (('dir . path)
- (let ((target-path (get-target-path path)))
- (when (and (file-exists? target-path)
- (not (file-is-directory? target-path)))
- (backup-file path))
-
- (if (file-exists? target-path)
- (format
- #t (G_ "Skipping ~a (directory already exists)... done\n")
- target-path)
- (begin
- (format #t (G_ "Creating ~a...") target-path)
- (mkdir target-path)
- (display (G_ " done\n"))))))
-
- (('file . path)
- (when (file-exists? (get-target-path path))
- (backup-file path))
- (format #t (G_ "Symlinking ~a -> ~a...")
- (get-target-path path) (get-source-path path))
- (symlink (get-source-path path) (get-target-path path))
- (display (G_ " done\n"))))
- to-create)))
+ (catch 'system-error
+ (lambda ()
+ (mkdir target))
+ (lambda args
+ (let ((errno (system-error-errno args)))
+ (unless (= EEXIST errno)
+ (format #t (G_ "failed to create directory ~a: ~s~%")
+ target (strerror errno))
+ (apply throw args))))))))
+ (const #t) ;up
+ (const #t) ;skip
+ (const #t) ;error
+ #t ;init
+ config-file-directory))
#$%initialize-gettext
(let* ((he-path (string-append (getenv "HOME") "/.guix-home"))
(new-he-path (string-append he-path ".new"))
(new-home (getenv "GUIX_NEW_HOME"))
- (old-home (getenv "GUIX_OLD_HOME"))
-
- (new-files-path (string-append new-home "/files"))
- ;; Trailing dot is required, because files itself is symlink and
- ;; to make file-system-tree works it should be a directory.
- (new-files-dir-path (string-append new-files-path "/."))
-
- (new-tree ((simplify-file-tree "")
- (file-system-tree new-files-dir-path))))
+ (old-home (getenv "GUIX_OLD_HOME")))
(when old-home
(cleanup-symlinks old-home))
- (create-symlinks new-tree new-files-path)
+ (create-symlinks new-home)
(symlink new-home new-he-path)
(rename-file new-he-path he-path)
--
2.34.0
guix-patches <at> gnu.org:bug#54180; Package guix-patches.
(Sun, 27 Feb 2022 13:55:06 GMT) Full text and rfc822 format available.Message #38 received at 54180 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: 54180 <at> debbugs.gnu.org Cc: Ludovic Courtès <ludo <at> gnu.org> Subject: [PATCH 04/12] home: symlink-manager: Use 'file-is-directory?'. Date: Sun, 27 Feb 2022 14:53:34 +0100
* gnu/home/services/symlink-manager.scm (update-symlinks-script)[directory?]:
Remove.
Change callers to use 'file-is-directory?' instead.
---
gnu/home/services/symlink-manager.scm | 7 ++-----
1 file changed, 2 insertions(+), 5 deletions(-)
diff --git a/gnu/home/services/symlink-manager.scm b/gnu/home/services/symlink-manager.scm
index a6344c808f..f133eb17f2 100644
--- a/gnu/home/services/symlink-manager.scm
+++ b/gnu/home/services/symlink-manager.scm
@@ -101,9 +101,6 @@ (define (get-target-path path)
(define (get-backup-path path)
(string-append backup-dir "/." path))
- (define (directory? path)
- (equal? (stat:type (stat path)) 'directory))
-
(define (empty-directory? dir)
(equal? (scandir dir) '("." "..")))
@@ -133,7 +130,7 @@ (define (cleanup-symlinks old-tree)
(('dir . path)
(if (and
(file-exists? (get-target-path path))
- (directory? (get-target-path path))
+ (file-is-directory? (get-target-path path))
(empty-directory? (get-target-path path)))
(begin
(format #t (G_ "Removing ~a...")
@@ -179,7 +176,7 @@ (define (get-source-path path)
(('dir . path)
(let ((target-path (get-target-path path)))
(when (and (file-exists? target-path)
- (not (directory? target-path)))
+ (not (file-is-directory? target-path)))
(backup-file path))
(if (file-exists? target-path)
--
2.34.0
guix-patches <at> gnu.org:bug#54180; Package guix-patches.
(Sun, 27 Feb 2022 13:55:07 GMT) Full text and rfc822 format available.Message #41 received at 54180 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: 54180 <at> debbugs.gnu.org Cc: Ludovic Courtès <ludo <at> gnu.org> Subject: [PATCH 07/12] tests: Make sure 'guix home reconfigure' backs up files. Date: Sun, 27 Feb 2022 14:53:37 +0100
* tests/guix-home.sh: Create ~/.bashrc and ~/.config/test.conf prior to
'reconfigure' and check whether they were backed up.
---
tests/guix-home.sh | 16 ++++++++++++++--
1 file changed, 14 insertions(+), 2 deletions(-)
diff --git a/tests/guix-home.sh b/tests/guix-home.sh
index e578559c97..ae3e52c9e1 100644
--- a/tests/guix-home.sh
+++ b/tests/guix-home.sh
@@ -1,7 +1,7 @@
-
# GNU Guix --- Functional package management for GNU
# Copyright © 2021 Andrew Tropin <andrew <at> trop.in>
# Copyright © 2021 Oleg Pykhalov <go.wigust <at> gmail.com>
+# Copyright © 2022 Ludovic Courtès <ludo <at> gnu.org>
#
# This file is part of GNU Guix.
#
@@ -54,7 +54,12 @@ trap 'chmod -Rf +w "$test_directory"; rm -rf "$test_directory"' EXIT
# Test 'guix home reconfigure'.
#
- printf "# dot-bashrc test file for guix home" > "dot-bashrc"
+ echo "# This file will be overridden and backed up." > "$HOME/.bashrc"
+ mkdir "$HOME/.config"
+ echo "This file will be overridden too." > "$HOME/.config/test.conf"
+ echo "This file will stay around." > "$HOME/.config/random-file"
+
+ echo -n "# dot-bashrc test file for guix home" > "dot-bashrc"
cat > "home.scm" <<'EOF'
(use-modules (guix gexp)
@@ -100,6 +105,13 @@ EOF
# the content of bashrc-test-config.sh"
grep -q "the content of ~/.config/test.conf" "${HOME}/.config/test.conf"
+ # This one should still be here.
+ grep "stay around" "$HOME/.config/random-file"
+
+ # Make sure preexisting files were backed up.
+ grep "overridden" "$HOME"/*guix-home*backup/.bashrc
+ grep "overridden" "$HOME"/*guix-home*backup/.config/test.conf
+
#
# Test 'guix home describe'.
#
--
2.34.0
guix-patches <at> gnu.org:bug#54180; Package guix-patches.
(Sun, 27 Feb 2022 15:50:02 GMT) Full text and rfc822 format available.Message #44 received at 54180 <at> debbugs.gnu.org (full text, mbox):
From: Maxime Devos <maximedevos <at> telenet.be> To: Ludovic Courtès <ludo <at> gnu.org>, 54180 <at> debbugs.gnu.org Subject: Re: [bug#54180] [PATCH 09/12] tests: Check 'guix home reconfigure' for a second generation. Date: Sun, 27 Feb 2022 16:49:29 +0100
[Message part 1 (text/plain, inline)]
Ludovic Courtès schreef op zo 27-02-2022 om 14:53 [+0100]: > * tests/guix-home.sh: Invoke "guix home reconfigure" a second time with > a modify config file and check the result. Something I don't understand, is why these tests are bash scripts in the first place. Wouldn't Scheme code suffice and be easier to reason about? For example, Scheme code would avoid repeating the complicated code for starting a daemon and making sure it exits in every .sh test. Greetings Maxime.
[signature.asc (application/pgp-signature, inline)]
guix-patches <at> gnu.org:bug#54180; Package guix-patches.
(Sun, 27 Feb 2022 15:53:02 GMT) Full text and rfc822 format available.Message #47 received at 54180 <at> debbugs.gnu.org (full text, mbox):
From: Maxime Devos <maximedevos <at> telenet.be> To: Ludovic Courtès <ludo <at> gnu.org>, 54180 <at> debbugs.gnu.org Subject: Re: [bug#54180] [PATCH 06/12] home: symlink-manager: Avoid extra 'lstat' call. Date: Sun, 27 Feb 2022 16:52:25 +0100
[Message part 1 (text/plain, inline)]
Ludovic Courtès schreef op zo 27-02-2022 om 14:53 [+0100]:
> (define (symlink-to-store? path)
> - (and (equal? (stat:type (lstat path)) 'symlink)
> - (store-file-name? (readlink path))))
> + (catch 'system-error
> + (lambda ()
> + (store-file-name? (readlink path)))
> + (lambda args
> + (if (= EINVAL (system-error-errno args))
> + #f
> + (apply throw args)))))
I think it would be slightly clearer if 'store-file-name?' was moved
outside the catch:
(and=> (catch 'system-error (lambda () (readlink path)) [...])
store-file-name?)
It is 'readlink' that might throw an exception, not 'store-file-name?'.
Greetings,
Maxime.
[signature.asc (application/pgp-signature, inline)]
guix-patches <at> gnu.org:bug#54180; Package guix-patches.
(Sun, 27 Feb 2022 15:55:01 GMT) Full text and rfc822 format available.Message #50 received at 54180 <at> debbugs.gnu.org (full text, mbox):
From: Maxime Devos <maximedevos <at> telenet.be> To: Ludovic Courtès <ludo <at> gnu.org>, 54180 <at> debbugs.gnu.org Subject: Re: [bug#54180] [PATCH 05/12] home: symlink-manager: Remove 'empty-directory?' and avoid TOCTTOU race. Date: Sun, 27 Feb 2022 16:54:56 +0100
[Message part 1 (text/plain, inline)]
Ludovic Courtès schreef op zo 27-02-2022 om 14:53 [+0100]: > + (let ((directory (get-target-path directory))) > + (catch 'system-error > + (lambda () > + (rmdir directory) > + (format #t (G_ "Removed ~a.\n") directory)) > + (lambda args > + (let ((errno (system-error-errno args))) > + (cond ((= ENOTEMPTY errno) > + (format > + #t > + (G_ "Skipping ~a (not an empty directory)...\n") > + directory)) > + ((= ENOTDIR errno) > + #t) > + (else > + (apply throw args)))))))) Like with my comment on ‘Avoid extra 'lstat call.’, I would move the (format #t (G_ "Removed ~a.\n") directory) outside the catch. If 'format' somehow throws a ENOTEMPTY/ENOTDIR system-error, something is very wrong. Greetings, Maxime.
[signature.asc (application/pgp-signature, inline)]
guix-patches <at> gnu.org:bug#54180; Package guix-patches.
(Sun, 27 Feb 2022 15:59:02 GMT) Full text and rfc822 format available.Message #53 received at 54180 <at> debbugs.gnu.org (full text, mbox):
From: Maxime Devos <maximedevos <at> telenet.be> To: Ludovic Courtès <ludo <at> gnu.org>, 54180 <at> debbugs.gnu.org Subject: Re: [bug#54180] [PATCH 02/12] home: symlink-manager: Move helper procedures as top-level defines. Date: Sun, 27 Feb 2022 16:58:09 +0100
[Message part 1 (text/plain, inline)]
Ludovic Courtès schreef op zo 27-02-2022 om 14:53 [+0100]: > (file-exists? (get-target-path path)) > [... other uses of file-exists? ...] 'file-exists?' does not simply check whether the file exists. E.g., when there is some permission error, then it returns #false. I think that in case of an permission error, it would best be reported to the user, so I think a variant of 'file-exists?' may be needed. Greetings, Maxime.
[signature.asc (application/pgp-signature, inline)]
guix-patches <at> gnu.org:bug#54180; Package guix-patches.
(Sun, 27 Feb 2022 16:01:01 GMT) Full text and rfc822 format available.Message #56 received at 54180 <at> debbugs.gnu.org (full text, mbox):
From: Maxime Devos <maximedevos <at> telenet.be> To: Ludovic Courtès <ludo <at> gnu.org>, 54180 <at> debbugs.gnu.org Subject: Re: [bug#54180] [PATCH 11/12] home: symlink-manager: 'create-symlinks' uses 'file-system-fold'. Date: Sun, 27 Feb 2022 17:00:28 +0100
[Message part 1 (text/plain, inline)]
Ludovic Courtès schreef op zo 27-02-2022 om 14:53 [+0100]: > > + (catch 'system-error > + (lambda () > + (mkdir target)) > + (lambda args > + (let ((errno (system-error-errno args))) > + (unless (= EEXIST errno) > + (format #t (G_ "failed to create directory ~a: ~s~%") > + target (strerror errno)) > + (apply throw args)))))))) This error reporting seems new, perhaps something for a separate commit? Greetings, Maxime.
[signature.asc (application/pgp-signature, inline)]
guix-patches <at> gnu.org:bug#54180; Package guix-patches.
(Mon, 28 Feb 2022 07:54:01 GMT) Full text and rfc822 format available.Message #59 received at 54180 <at> debbugs.gnu.org (full text, mbox):
From: Andrew Tropin <andrew <at> trop.in> To: Ludovic Courtès <ludo <at> gnu.org>, 54180 <at> debbugs.gnu.org Cc: Oleg Pykhalov <go.wigust <at> gmail.com>, Ludovic Courtès <ludo <at> gnu.org>, Xinglu Chen <public <at> yoctocell.xyz> Subject: Re: [bug#54180] [PATCH 00/12] Home: Clarify and better test symlink-manager.scm Date: Mon, 28 Feb 2022 10:53:18 +0300
[Message part 1 (text/plain, inline)]
On 2022-02-27 14:40, Ludovic Courtès wrote: > Hello Guix! > > This patch set aims to increase test coverage for ‘guix home reconfigure’, > to make symlink-manager.scm IMO easier to follow, and to have it more > closely follow the project’s conventions. > > Functionality is unchanged. > > Thoughts? That's great! symlink-manager was a little messy for sure. I took a brief look; On first glance patches seems good. I'll take a deep look later, when will be updating patch for bug#52808 and will report or make a separate patch if something pop up. Thank you very much for working on this :) > > Thanks, > Ludo’. > > Ludovic Courtès (12): > home: symlink-manager: Clarify module imports. > home: symlink-manager: Move helper procedures as top-level defines. > home: symlink-manager: Use 'for-each' when used for effects. > home: symlink-manager: Use 'file-is-directory?'. > home: symlink-manager: Remove 'empty-directory?' and avoid TOCTTOU > race. > home: symlink-manager: Avoid extra 'lstat' call. > tests: Make sure 'guix home reconfigure' backs up files. > tests: Simplify use of 'local-file' in 'tests/guix-home.sh'. > tests: Check 'guix home reconfigure' for a second generation. > home: symlink-manager: 'cleanup-symlinks' uses 'file-system-fold'. > home: symlink-manager: 'create-symlinks' uses 'file-system-fold'. > home: symlink-manager: Rename "path" to "file" where appropriate. > > gnu/home/services/symlink-manager.scm | 355 ++++++++++++-------------- > tests/guix-home.sh | 44 +++- > 2 files changed, 198 insertions(+), 201 deletions(-) > > > base-commit: 33ce3f1c866231a3015411fdce18a3e72649e2f6 -- Best regards, Andrew Tropin
[signature.asc (application/pgp-signature, inline)]
guix-patches <at> gnu.org:bug#54180; Package guix-patches.
(Sat, 05 Mar 2022 22:20:02 GMT) Full text and rfc822 format available.Message #62 received at 54180 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: Maxime Devos <maximedevos <at> telenet.be> Cc: 54180 <at> debbugs.gnu.org Subject: Re: bug#54180: [PATCH 00/12] Home: Clarify and better test symlink-manager.scm Date: Sat, 05 Mar 2022 23:19:25 +0100
Maxime Devos <maximedevos <at> telenet.be> skribis: > Ludovic Courtès schreef op zo 27-02-2022 om 14:53 [+0100]: >> + (let ((directory (get-target-path directory))) >> + (catch 'system-error >> + (lambda () >> + (rmdir directory) >> + (format #t (G_ "Removed ~a.\n") directory)) >> + (lambda args >> + (let ((errno (system-error-errno args))) >> + (cond ((= ENOTEMPTY errno) >> + (format >> + #t >> + (G_ "Skipping ~a (not an empty directory)...\n") >> + directory)) >> + ((= ENOTDIR errno) >> + #t) >> + (else >> + (apply throw args)))))))) > > Like with my comment on ‘Avoid extra 'lstat call.’, I would move the > (format #t (G_ "Removed ~a.\n") directory) outside the catch. > > If 'format' somehow throws a ENOTEMPTY/ENOTDIR system-error, something > is very wrong. Precisely: we can keep the ‘format’ call after ‘rmdir’ because we know (1) it’s only going to be called if ‘rmdir’ succeeds, and (2) it won’t throw to ‘system-error’.
guix-patches <at> gnu.org:bug#54180; Package guix-patches.
(Sat, 05 Mar 2022 22:21:02 GMT) Full text and rfc822 format available.Message #65 received at 54180 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: Maxime Devos <maximedevos <at> telenet.be> Cc: 54180 <at> debbugs.gnu.org Subject: Re: bug#54180: [PATCH 00/12] Home: Clarify and better test symlink-manager.scm Date: Sat, 05 Mar 2022 23:20:31 +0100
Maxime Devos <maximedevos <at> telenet.be> skribis: > Ludovic Courtès schreef op zo 27-02-2022 om 14:53 [+0100]: >> * tests/guix-home.sh: Invoke "guix home reconfigure" a second time with >> a modify config file and check the result. > > Something I don't understand, is why these tests are bash scripts in > the first place. > > Wouldn't Scheme code suffice and be easier to reason about? For > example, Scheme code would avoid repeating the complicated code for > starting a daemon and making sure it exits in every .sh test. It’s useful to have integration tests that exercise the commands; unit tests would also be welcome, but that’s what we have so far.
guix-patches <at> gnu.org:bug#54180; Package guix-patches.
(Sat, 05 Mar 2022 22:28:01 GMT) Full text and rfc822 format available.Message #68 received at 54180 <at> debbugs.gnu.org (full text, mbox):
From: Maxime Devos <maximedevos <at> telenet.be> To: Ludovic Courtès <ludo <at> gnu.org> Cc: 54180 <at> debbugs.gnu.org Subject: Re: bug#54180: [PATCH 00/12] Home: Clarify and better test symlink-manager.scm Date: Sat, 05 Mar 2022 23:27:46 +0100
[Message part 1 (text/plain, inline)]
Ludovic Courtès schreef op za 05-03-2022 om 23:20 [+0100]: > It’s useful to have integration tests that exercise the commands; unit > tests would also be welcome, but that’s what we have so far. Integreation tests don't have to be in bash. We can have integration tests in Scheme, by running the 'guix-FOO' procedures from (guix scripts ...), like tests/substitute.scm and tests/publish.scm do. Greetings, Maxime.
[signature.asc (application/pgp-signature, inline)]
guix-patches <at> gnu.org:bug#54180; Package guix-patches.
(Sat, 05 Mar 2022 22:38:02 GMT) Full text and rfc822 format available.Message #71 received at 54180 <at> debbugs.gnu.org (full text, mbox):
From: Maxime Devos <maximedevos <at> telenet.be> To: Ludovic Courtès <ludo <at> gnu.org> Cc: 54180 <at> debbugs.gnu.org Subject: Re: bug#54180: [PATCH 00/12] Home: Clarify and better test symlink-manager.scm Date: Sat, 05 Mar 2022 23:37:31 +0100
[Message part 1 (text/plain, inline)]
Ludovic Courtès schreef op za 05-03-2022 om 23:19 [+0100]:
> > Like with my comment on ‘Avoid extra 'lstat call.’, I would move
> > the
> > (format #t (G_ "Removed ~a.\n") directory) outside the catch.
> >
> > If 'format' somehow throws a ENOTEMPTY/ENOTDIR system-error,
> > something
> > is very wrong.
>
> Precisely: we can keep the ‘format’ call after ‘rmdir’ because we
> know (1) it’s only going to be called if ‘rmdir’ succeeds, and (2) it
> won’t throw to ‘system-error’.
Yes, we could keep it inside the 'catch', but that doesn't it's a good
idea, because if format throws a ENOTEMPTY/ENOTDIR, shouldn't that be
reported because that seems very wrong?
WDYT of
(define (delete-if-empty file)
;; Returns #t if deleted, #f if skipped because empty
(catch ... (lambda () (rmdir directory) #t)
(lambda ...
(cond ((= ENOTEMPTY ...) #false)
((= ENOTDIR ...)
[TODO: if it was a regular file, shouldn't it still be deleted?])
(#true (throw ...))))))
(if (delete-if-empty)
(format ... "removed ...")
(format ... "skipped ..."))
?
[signature.asc (application/pgp-signature, inline)]
guix-patches <at> gnu.org:bug#54180; Package guix-patches.
(Sat, 05 Mar 2022 22:39:01 GMT) Full text and rfc822 format available.Message #74 received at 54180 <at> debbugs.gnu.org (full text, mbox):
From: Maxime Devos <maximedevos <at> telenet.be> To: Ludovic Courtès <ludo <at> gnu.org> Cc: 54180 <at> debbugs.gnu.org Subject: Re: [bug#54180] [PATCH 00/12] Home: Clarify and better test symlink-manager.scm Date: Sat, 05 Mar 2022 23:38:34 +0100
[Message part 1 (text/plain, inline)]
p.s., I'm getting ‘Undelivered Mail Returned to Sender’:
This is the mail system at host taslin.fdn.fr.
I'm sorry to have to inform you that your message could not
be delivered to one or more recipients. It's attached below.
For further assistance, please send mail to postmaster.
If you do so, please include this problem report. You can
delete your own text from the attached returned message.
The mail system
<lcourtes <at> fdn.fr> (expanded from <ludovic.courtes <at> fdn.fr>): host
taslin.fdn.fr[private/dovecot-lmtp] said: 552 5.2.2
<lcourtes <at> fdn.fr> Quota
exceeded, please contact vlp. (in reply to end of DATA command)
[signature.asc (application/pgp-signature, inline)]
guix-patches <at> gnu.org:bug#54180; Package guix-patches.
(Thu, 10 Mar 2022 10:24:01 GMT) Full text and rfc822 format available.Message #77 received at 54180 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: Maxime Devos <maximedevos <at> telenet.be> Cc: 54180 <at> debbugs.gnu.org Subject: Re: bug#54180: [PATCH 00/12] Home: Clarify and better test symlink-manager.scm Date: Thu, 10 Mar 2022 11:23:01 +0100
Hi Maxime, Maxime Devos <maximedevos <at> telenet.be> skribis: > Ludovic Courtès schreef op za 05-03-2022 om 23:20 [+0100]: >> It’s useful to have integration tests that exercise the commands; unit >> tests would also be welcome, but that’s what we have so far. > > Integreation tests don't have to be in bash. We can have integration > tests in Scheme, by running the 'guix-FOO' procedures from (guix > scripts ...), like tests/substitute.scm and tests/publish.scm do. Yes, you’re right, but this patch series is not about rewriting the integration tests. :-) The way I see it, we can choose and combine different strategies: Bash tests (the good thing is that they’re as close as can be to what users run), Scheme integration tests like you write when more fine-grain control is needed, and of course unit tests. Ludo’.
guix-patches <at> gnu.org:bug#54180; Package guix-patches.
(Thu, 10 Mar 2022 10:26:01 GMT) Full text and rfc822 format available.Message #80 received at 54180 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: Maxime Devos <maximedevos <at> telenet.be> Cc: 54180 <at> debbugs.gnu.org Subject: Re: bug#54180: [PATCH 00/12] Home: Clarify and better test symlink-manager.scm Date: Thu, 10 Mar 2022 11:24:57 +0100
Maxime Devos <maximedevos <at> telenet.be> skribis: > p.s., I'm getting ‘Undelivered Mail Returned to Sender’: I think that’s solved, but my mail setup is still in flux… Don’t hesitate to ping me on IRC or something if you think I might have missed a message of yours. Ludo’.
guix-patches <at> gnu.org:bug#54180; Package guix-patches.
(Thu, 10 Mar 2022 10:29:02 GMT) Full text and rfc822 format available.Message #83 received at 54180 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: Maxime Devos <maximedevos <at> telenet.be> Cc: 54180 <at> debbugs.gnu.org Subject: Re: bug#54180: [PATCH 00/12] Home: Clarify and better test symlink-manager.scm Date: Thu, 10 Mar 2022 11:28:15 +0100
Maxime Devos <maximedevos <at> telenet.be> skribis: > Ludovic Courtès schreef op zo 27-02-2022 om 14:53 [+0100]: >> (file-exists? (get-target-path path)) >> [... other uses of file-exists? ...] Note that this patch just shuffles code around; it does not introduce new ‘file-exists?’ calls. > 'file-exists?' does not simply check whether the file exists. > E.g., when there is some permission error, then it returns #false. > > I think that in case of an permission error, it would best be reported > to the user, so I think a variant of 'file-exists?' may be needed. I believe later patches mostly address this by avoiding separate ‘stat’ calls (‘file-exists?’ is a thin wrapper around ‘stat’). Ludo’.
Ludovic Courtès <ludo <at> gnu.org>:Ludovic Courtès <ludo <at> gnu.org>:Message #88 received at 54180-done <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: 54180-done <at> debbugs.gnu.org Cc: Oleg Pykhalov <go.wigust <at> gmail.com>, Xinglu Chen <public <at> yoctocell.xyz>, Maxime Devos <maximedevos <at> telenet.be>, Andrew Tropin <andrew <at> trop.in> Subject: Re: bug#54180: [PATCH 00/12] Home: Clarify and better test symlink-manager.scm Date: Thu, 10 Mar 2022 11:45:45 +0100
Hi! I went ahead and pushed this series: 2a55f99aff home: symlink-manager: Rename "path" to "file" where appropriate. 1fb6ef0473 home: symlink-manager: 'create-symlinks' uses 'file-system-fold'. 5fa188e92e home: symlink-manager: 'cleanup-symlinks' uses 'file-system-fold'. 5fabaf1128 tests: Check 'guix home reconfigure' for a second generation. 26e67e0280 tests: Simplify use of 'local-file' in 'tests/guix-home.sh'. 7b7e32d5ad tests: Make sure 'guix home reconfigure' backs up files. a3a76a8384 home: symlink-manager: Avoid extra 'lstat' call. a81bb1e4bb home: symlink-manager: Remove 'empty-directory?' and avoid TOCTTOU race. e1b38046a6 home: symlink-manager: Use 'file-is-directory?'. cf803b71c7 home: symlink-manager: Use 'for-each' when used for effects. 7a8856f540 home: symlink-manager: Move helper procedures as top-level defines. 66bf60a4cd home: symlink-manager: Clarify module imports. Thanks Maxime for taking a look. Ludo’.
Debbugs Internal Request <help-debbugs <at> gnu.org>
to internal_control <at> debbugs.gnu.org.
(Thu, 07 Apr 2022 11:24:06 GMT) Full text and rfc822 format available.
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.