[PATCH 00/12] Home: Clarify and better test symlink-manager.scm

  • Done
  • quality assurance status badge
Details
3 participants
  • Andrew Tropin
  • Ludovic Courtès
  • Maxime Devos
Owner
unassigned
Submitted by
Ludovic Courtès
Severity
normal
L
L
Ludovic Courtès wrote on 27 Feb 2022 14:40
(address . guix-patches@gnu.org)(name . Ludovic Courtès)(address . ludo@gnu.org)
20220227134006.9860-1-ludo@gnu.org
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
L
L
Ludovic Courtès wrote on 27 Feb 2022 14:53
[PATCH 01/12] home: symlink-manager: Clarify module imports.
(address . 54180@debbugs.gnu.org)(name . Ludovic Courtès)(address . ludo@gnu.org)
20220227135342.10296-1-ludo@gnu.org
* 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(-)

Toggle diff (379 lines)
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
L
L
Ludovic Courtès wrote on 27 Feb 2022 14:53
[PATCH 02/12] home: symlink-manager: Move helper procedures as top-level defines.
(address . 54180@debbugs.gnu.org)(name . Ludovic Courtès)(address . ludo@gnu.org)
20220227135342.10296-2-ludo@gnu.org
* 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(-)

Toggle diff (277 lines)
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
L
L
Ludovic Courtès wrote on 27 Feb 2022 14:53
[PATCH 06/12] home: symlink-manager: Avoid extra 'lstat' call.
(address . 54180@debbugs.gnu.org)(name . Ludovic Courtès)(address . ludo@gnu.org)
20220227135342.10296-6-ludo@gnu.org
* 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(-)

Toggle diff (22 lines)
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
L
L
Ludovic Courtès wrote on 27 Feb 2022 14:53
[PATCH 03/12] home: symlink-manager: Use 'for-each' when used for effects.
(address . 54180@debbugs.gnu.org)(name . Ludovic Courtès)(address . ludo@gnu.org)
20220227135342.10296-3-ludo@gnu.org
* 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(-)

Toggle diff (24 lines)
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
L
L
Ludovic Courtès wrote on 27 Feb 2022 14:53
[PATCH 05/12] home: symlink-manager: Remove 'empty-directory?' and avoid TOCTTOU race.
(address . 54180@debbugs.gnu.org)(name . Ludovic Courtès)(address . ludo@gnu.org)
20220227135342.10296-5-ludo@gnu.org
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(-)

Toggle diff (62 lines)
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@trop.in>
;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
+;;; Copyright © 2022 Ludovic Courtès <ludo@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
L
L
Ludovic Courtès wrote on 27 Feb 2022 14:53
[PATCH 12/12] home: symlink-manager: Rename "path" to "file" where appropriate.
(address . 54180@debbugs.gnu.org)(name . Ludovic Courtès)(address . ludo@gnu.org)
20220227135342.10296-12-ludo@gnu.org
* 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(-)

Toggle diff (126 lines)
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
L
L
Ludovic Courtès wrote on 27 Feb 2022 14:53
[PATCH 09/12] tests: Check 'guix home reconfigure' for a second generation.
(address . 54180@debbugs.gnu.org)(name . Ludovic Courtès)(address . ludo@gnu.org)
20220227135342.10296-9-ludo@gnu.org
* 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(+)

Toggle diff (43 lines)
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
L
L
Ludovic Courtès wrote on 27 Feb 2022 14:53
[PATCH 08/12] tests: Simplify use of 'local-file' in 'tests/guix-home.sh'.
(address . 54180@debbugs.gnu.org)(name . Ludovic Courtès)(address . ludo@gnu.org)
20220227135342.10296-8-ludo@gnu.org
* 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(-)

Toggle diff (18 lines)
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
L
L
Ludovic Courtès wrote on 27 Feb 2022 14:53
[PATCH 10/12] home: symlink-manager: 'cleanup-symlinks' uses 'file-system-fold'.
(address . 54180@debbugs.gnu.org)(name . Ludovic Courtès)(address . ludo@gnu.org)
20220227135342.10296-10-ludo@gnu.org
* 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(-)

Toggle diff (132 lines)
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
L
L
Ludovic Courtès wrote on 27 Feb 2022 14:53
[PATCH 11/12] home: symlink-manager: 'create-symlinks' uses 'file-system-fold'.
(address . 54180@debbugs.gnu.org)(name . Ludovic Courtès)(address . ludo@gnu.org)
20220227135342.10296-11-ludo@gnu.org
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(-)

Toggle diff (168 lines)
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
L
L
Ludovic Courtès wrote on 27 Feb 2022 14:53
[PATCH 04/12] home: symlink-manager: Use 'file-is-directory?'.
(address . 54180@debbugs.gnu.org)(name . Ludovic Courtès)(address . ludo@gnu.org)
20220227135342.10296-4-ludo@gnu.org
* 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(-)

Toggle diff (34 lines)
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
L
L
Ludovic Courtès wrote on 27 Feb 2022 14:53
[PATCH 07/12] tests: Make sure 'guix home reconfigure' backs up files.
(address . 54180@debbugs.gnu.org)(name . Ludovic Courtès)(address . ludo@gnu.org)
20220227135342.10296-7-ludo@gnu.org
* 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(-)

Toggle diff (43 lines)
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@trop.in>
# Copyright © 2021 Oleg Pykhalov <go.wigust@gmail.com>
+# Copyright © 2022 Ludovic Courtès <ludo@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
M
M
Maxime Devos wrote on 27 Feb 2022 16:49
Re: [bug#54180] [PATCH 09/12] tests: Check 'guix home reconfigure' for a second generation.
c96598045a20f8bca1c9eefbbcc28ffd1b24955c.camel@telenet.be
Ludovic Courtès schreef op zo 27-02-2022 om 14:53 [+0100]:
Toggle quote (3 lines)
> * 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.
-----BEGIN PGP SIGNATURE-----

iI0EABYKADUWIQTB8z7iDFKP233XAR9J4+4iGRcl7gUCYhudiRccbWF4aW1lZGV2
b3NAdGVsZW5ldC5iZQAKCRBJ4+4iGRcl7q+iAP9B5gMixK+bbCJVsJHFqQMvQB8D
n2yvBg/s4K2zWOkGAAEAxDjHMuHEGj+tkFTzB/5yKBQpgb4OLu9pkqLUyuFECQk=
=bEX3
-----END PGP SIGNATURE-----


M
M
Maxime Devos wrote on 27 Feb 2022 16:52
Re: [bug#54180] [PATCH 06/12] home: symlink-manager: Avoid extra 'lstat' call.
20596558fd7521908095e3c10369bd050efc40a4.camel@telenet.be
Ludovic Courtès schreef op zo 27-02-2022 om 14:53 [+0100]:
Toggle quote (11 lines)
>           (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.
-----BEGIN PGP SIGNATURE-----

iI0EABYKADUWIQTB8z7iDFKP233XAR9J4+4iGRcl7gUCYhueORccbWF4aW1lZGV2
b3NAdGVsZW5ldC5iZQAKCRBJ4+4iGRcl7sAqAP9MWTtllzlc25dMqP7XBK+HAnC+
LmTcUudzYKkACffetAD/f/K95IG1ssZzMy/cSlSaKPgLD6NOX9UZYHNTBck6kAc=
=Csaj
-----END PGP SIGNATURE-----


M
M
Maxime Devos wrote on 27 Feb 2022 16:54
Re: [bug#54180] [PATCH 05/12] home: symlink-manager: Remove 'empty-directory?' and avoid TOCTTOU race.
df49ff0ba7ad97945644630e2b12fc24d2f4b52c.camel@telenet.be
Ludovic Courtès schreef op zo 27-02-2022 om 14:53 [+0100]:
Toggle quote (17 lines)
> +                 (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.
-----BEGIN PGP SIGNATURE-----

iI0EABYKADUWIQTB8z7iDFKP233XAR9J4+4iGRcl7gUCYhue0BccbWF4aW1lZGV2
b3NAdGVsZW5ldC5iZQAKCRBJ4+4iGRcl7j6iAQCsICNSwFBXqofjC2nbCBKZRCx0
BbWT9jCPAVGKmw8apQEAjgJSHkNL9WJDEGvj+RZGSJ423J1ECdfaqBv1pl7j2g4=
=0lGV
-----END PGP SIGNATURE-----


M
M
Maxime Devos wrote on 27 Feb 2022 16:58
Re: [bug#54180] [PATCH 02/12] home: symlink-manager: Move helper procedures as top-level defines.
66bb9a617542057fe6c536631927d94c530dc173.camel@telenet.be
Ludovic Courtès schreef op zo 27-02-2022 om 14:53 [+0100]:
Toggle quote (3 lines)
> (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.
-----BEGIN PGP SIGNATURE-----

iI0EABYKADUWIQTB8z7iDFKP233XAR9J4+4iGRcl7gUCYhufkRccbWF4aW1lZGV2
b3NAdGVsZW5ldC5iZQAKCRBJ4+4iGRcl7vhKAQCO8mJ4cSzAmzZVN2RmVm7bmSpG
CZNdU1OdgDo2Q7r5bAD8DtN8h6+aiRKMFVxmqIwTgkqpCo1N6hLUowDqrc+h8Qs=
=Euq0
-----END PGP SIGNATURE-----


M
M
Maxime Devos wrote on 27 Feb 2022 17:00
Re: [bug#54180] [PATCH 11/12] home: symlink-manager: 'create-symlinks' uses 'file-system-fold'.
0091dbaa43a26d44aca034f83ed79eb5658a8b38.camel@telenet.be
Ludovic Courtès schreef op zo 27-02-2022 om 14:53 [+0100]:
Toggle quote (11 lines)
>
> + (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.
-----BEGIN PGP SIGNATURE-----

iI0EABYKADUWIQTB8z7iDFKP233XAR9J4+4iGRcl7gUCYhugHBccbWF4aW1lZGV2
b3NAdGVsZW5ldC5iZQAKCRBJ4+4iGRcl7vXLAP9NaxXulnHpjyUpJW8IWpfIuc90
SYWI576zM2iRHHZBdgEA1hmih2gWgOxOpT4eO9LLbsgaEnWyPTsbOY846eMuWws=
=8zwp
-----END PGP SIGNATURE-----


A
A
Andrew Tropin wrote on 28 Feb 2022 08:53
Re: [bug#54180] [PATCH 00/12] Home: Clarify and better test symlink-manager.scm
87czj7e8b5.fsf@trop.in
On 2022-02-27 14:40, Ludovic Courtès wrote:

Toggle quote (10 lines)
> 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 :)

Toggle quote (26 lines)
>
> 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
-----BEGIN PGP SIGNATURE-----

iQJDBAEBCgAtFiEEKEGaxlA4dEDH6S/6IgjSCVjB3rAFAmIcf24PHGFuZHJld0B0
cm9wLmluAAoJECII0glYwd6wyBcP/jal9rPsArKVIVsXYpAaqrwDEf1h/lYEu62i
rIhdKKrgKtu8Mg3PMvR1uoG7sUib53NbSrySWAkZN7BpLK8R7oDWbMTc7AkrHFWK
GebcDh+bkT/YfmZeiKzgCZI0zFLUaClFZH2KYMg27k4WJJJDCGOSqjQcJOqL2tA7
ijzTLVI+PX456eaOV3DE0utTuJ8QrNtiBz4elqAEKsBFqQcryfvybM1RgWd0jQ78
Q5J64KLykWmZo2rPoKVxliyRA4RchcUe+BDoiTC4cowDBXQXuh6gPf2fv+XvH2qJ
qWe4ACVdhRIjiuJb+87u62M5Q+LO4LNpIL2Qrwtm7tB2G0q9Wkg8Kru/Aos8Zqcw
3LnKryRfH+CpyyGS6ZuVhfrOsTHFT1PSmBfT8GxwrqA+RLzqcjeDFzCwM6n2DKOz
KQYEGngduWg3PhGJ88cLwzFIHzKRCdleQnOn2m9i6HeaeqFtl+i980XpowPjsAfA
j/lY8/4uJ5+OOMSGNrFQNxrm+yyN1J/6xGudsisazSCWlEVXTz0Sot7ZBP6Sn6KO
9S58b3vkkOvLX/Hfbg2UY4x6qqyxziubdxXAPfKeWSmPcKpoimolZppgwhLpkdR9
OYp5BGaybCMRxD6HALMDIBf9krdjkwaub4oS6IqEabIrVFnxRlUqfc/JqDiBsioZ
ND8n2v/T
=j+X6
-----END PGP SIGNATURE-----

L
L
Ludovic Courtès wrote on 5 Mar 2022 23:19
Re: bug#54180: [PATCH 00/12] Home: Clarify and better test symlink-manager.scm
(name . Maxime Devos)(address . maximedevos@telenet.be)(address . 54180@debbugs.gnu.org)
87ee3gm49e.fsf_-_@gnu.org
Maxime Devos <maximedevos@telenet.be> skribis:
Toggle quote (23 lines)
> 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’.
L
L
Ludovic Courtès wrote on 5 Mar 2022 23:20
(name . Maxime Devos)(address . maximedevos@telenet.be)(address . 54180@debbugs.gnu.org)
87a6e4m47k.fsf_-_@gnu.org
Maxime Devos <maximedevos@telenet.be> skribis:

Toggle quote (11 lines)
> 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.
M
M
Maxime Devos wrote on 5 Mar 2022 23:27
(name . Ludovic Courtès)(address . ludo@gnu.org)(address . 54180@debbugs.gnu.org)
df30f91a25ea6d9c814c634df1149e0b0da24809.camel@telenet.be
Ludovic Courtès schreef op za 05-03-2022 om 23:20 [+0100]:
Toggle quote (3 lines)
> 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.
-----BEGIN PGP SIGNATURE-----

iI0EABYKADUWIQTB8z7iDFKP233XAR9J4+4iGRcl7gUCYiPj4hccbWF4aW1lZGV2
b3NAdGVsZW5ldC5iZQAKCRBJ4+4iGRcl7rP1AP9Al6Ggh5aUcJGqrj77s1uwr1lU
DpJpBhU9nScWIcLxwQD/aILKuMjpDQVRi8ehhmih8TtY9wjwHF+U/gXxz0Ysvw4=
=VXdD
-----END PGP SIGNATURE-----


M
M
Maxime Devos wrote on 5 Mar 2022 23:37
(name . Ludovic Courtès)(address . ludo@gnu.org)(address . 54180@debbugs.gnu.org)
d7cbddcda879db6c58c4c3a1d2e13c4bf46b22d7.camel@telenet.be
Ludovic Courtès schreef op za 05-03-2022 om 23:19 [+0100]:
Toggle quote (12 lines)
> > 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 ..."))
?
-----BEGIN PGP SIGNATURE-----

iI0EABYKADUWIQTB8z7iDFKP233XAR9J4+4iGRcl7gUCYiPmKxccbWF4aW1lZGV2
b3NAdGVsZW5ldC5iZQAKCRBJ4+4iGRcl7quoAQCo2ZM8EqCjSYUYCGXc1qnveOGC
LwzAnZOQ3LpsEq6GZAEAy+WR6jmrb7Q3CEfBK4dumz2Iy7qz839iqmWLfF6SLQw=
=eZvv
-----END PGP SIGNATURE-----


M
M
Maxime Devos wrote on 5 Mar 2022 23:38
Re: [bug#54180] [PATCH 00/12] Home: Clarify and better test symlink-manager.scm
(name . Ludovic Courtès)(address . ludo@gnu.org)(address . 54180@debbugs.gnu.org)
bc5e2f5cd7f06b36e1b506d11217691f90a62928.camel@telenet.be
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@fdn.fr> (expanded from <ludovic.courtes@fdn.fr>): host
taslin.fdn.fr[private/dovecot-lmtp] said: 552 5.2.2
<lcourtes@fdn.fr> Quota
exceeded, please contact vlp. (in reply to end of DATA command)
-----BEGIN PGP SIGNATURE-----

iI0EABYKADUWIQTB8z7iDFKP233XAR9J4+4iGRcl7gUCYiPmahccbWF4aW1lZGV2
b3NAdGVsZW5ldC5iZQAKCRBJ4+4iGRcl7ppxAPsFqlN9V3wm1+nFNELmjvp4/p3W
don2AowdgX+k98RrbAEAzfCdBBomEPpN2sRIxyxhFdnGPoNHbyHiqNmJhQt3oAo=
=e08S
-----END PGP SIGNATURE-----


L
L
Ludovic Courtès wrote on 10 Mar 2022 11:23
Re: bug#54180: [PATCH 00/12] Home: Clarify and better test symlink-manager.scm
(name . Maxime Devos)(address . maximedevos@telenet.be)(address . 54180@debbugs.gnu.org)
87fsnqyum2.fsf_-_@gnu.org
Hi Maxime,

Maxime Devos <maximedevos@telenet.be> skribis:

Toggle quote (8 lines)
> 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’.
L
L
Ludovic Courtès wrote on 10 Mar 2022 11:24
(name . Maxime Devos)(address . maximedevos@telenet.be)(address . 54180@debbugs.gnu.org)
878rtiyuiu.fsf_-_@gnu.org
Maxime Devos <maximedevos@telenet.be> skribis:

Toggle quote (2 lines)
> 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’.
L
L
Ludovic Courtès wrote on 10 Mar 2022 11:28
(name . Maxime Devos)(address . maximedevos@telenet.be)(address . 54180@debbugs.gnu.org)
874k46yudc.fsf_-_@gnu.org
Maxime Devos <maximedevos@telenet.be> skribis:

Toggle quote (4 lines)
> 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.

Toggle quote (6 lines)
> '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’.
L
L
Ludovic Courtès wrote on 10 Mar 2022 11:45
(address . 54180-done@debbugs.gnu.org)
87y21ixezq.fsf@gnu.org
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’.
Closed
?
Your comment

This issue is archived.

To comment on this conversation send an email to 54180@debbugs.gnu.org

To respond to this issue using the mumi CLI, first switch to it
mumi current 54180
Then, you may apply the latest patchset in this issue (with sign off)
mumi am -- -s
Or, compose a reply to this issue
mumi compose
Or, send patches to this issue
mumi send-email *.patch