From patchwork Sun Feb 27 13:53:31 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: =?utf-8?q?Ludovic_Court=C3=A8s?= X-Patchwork-Id: 37512 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 5026327BBEA; Sun, 27 Feb 2022 14:00:05 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-3.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,RCVD_IN_MSPIKE_H5,RCVD_IN_MSPIKE_WL, SPF_HELO_PASS autolearn=unavailable autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id 5DC0A27BBE9 for ; Sun, 27 Feb 2022 14:00:04 +0000 (GMT) Received: from localhost ([::1]:39440 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1nOK5j-0001iP-Di for patchwork@mira.cbaines.net; Sun, 27 Feb 2022 09:00:03 -0500 Received: from eggs.gnu.org ([209.51.188.92]:50534) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1nOK05-0008B8-Oj for guix-patches@gnu.org; Sun, 27 Feb 2022 08:54:14 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:35005) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1nOJzu-0001ZR-EX for guix-patches@gnu.org; Sun, 27 Feb 2022 08:54:07 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1nOJzu-0004pi-6Z for guix-patches@gnu.org; Sun, 27 Feb 2022 08:54:02 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#54180] [PATCH 01/12] home: symlink-manager: Clarify module imports. References: <20220227134006.9860-1-ludo@gnu.org> In-Reply-To: <20220227134006.9860-1-ludo@gnu.org> Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sun, 27 Feb 2022 13:54:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 54180 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 54180@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= Received: via spool by 54180-submit@debbugs.gnu.org id=B54180.164597004018569 (code B ref 54180); Sun, 27 Feb 2022 13:54:02 +0000 Received: (at 54180) by debbugs.gnu.org; 27 Feb 2022 13:54:00 +0000 Received: from localhost ([127.0.0.1]:57135 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1nOJzr-0004pQ-Hf for submit@debbugs.gnu.org; Sun, 27 Feb 2022 08:54:00 -0500 Received: from eggs.gnu.org ([209.51.188.92]:44794) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1nOJzp-0004pC-T6 for 54180@debbugs.gnu.org; Sun, 27 Feb 2022 08:53:58 -0500 Received: from [2001:470:142:3::e] (port=50224 helo=fencepost.gnu.org) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1nOJzk-0001Ym-2u; Sun, 27 Feb 2022 08:53:52 -0500 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=MIME-Version:Date:Subject:To:From:in-reply-to: references; bh=2HF3K/6I+bXGXWTvLEmzWBUTGzBHJ7SqpBylqp0wJOA=; b=oSEMhrN/kH4Wsr koScHq/+dGESw4aPfbiQd3gIrPbF63nZkC2SWQAXyC5z+EUbLtaSkpTsLXKCtCxapSEOgSbVsOsYD 2eNWSA+/47Jz2eHFYRumhv4SAh2zk+6dt2fKiGZbjrnEa0xfncJljMOMGzpQusJX2ChTW4ek2SeYp zCLP69SVrsUM64N26ClvbcGGPH+fJ56xEqV+pqfJr1VslmqhM1xbjToGEDNq6SAN1WSzQHRXGvblv XnYMu6dY7jTInnotaNo6MxI3BrcyT3KDzrAs7WNvwJAQIdzRAbCJOUba/3CwoMj2Moq3C6qe9GP8n kbuKoMRceIj6zS4z2asw==; Received: from 91-160-117-201.subs.proxad.net ([91.160.117.201]:55804 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1nOJzi-0007Pg-7u; Sun, 27 Feb 2022 08:53:51 -0500 From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Sun, 27 Feb 2022 14:53:31 +0100 Message-Id: <20220227135342.10296-1-ludo@gnu.org> X-Mailer: git-send-email 2.34.0 MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches * 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 _) From patchwork Sun Feb 27 13:53:32 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: =?utf-8?q?Ludovic_Court=C3=A8s?= X-Patchwork-Id: 37520 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 9D08C27BBEA; Sun, 27 Feb 2022 14:05:00 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-3.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,RCVD_IN_MSPIKE_H5,RCVD_IN_MSPIKE_WL, SPF_HELO_PASS autolearn=unavailable autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id DFE9D27BBE9 for ; Sun, 27 Feb 2022 14:04:59 +0000 (GMT) Received: from localhost ([::1]:46034 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1nOKAT-0006ul-9b for patchwork@mira.cbaines.net; Sun, 27 Feb 2022 09:04:59 -0500 Received: from eggs.gnu.org ([209.51.188.92]:50658) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1nOK0u-0000T0-97 for guix-patches@gnu.org; Sun, 27 Feb 2022 08:55:04 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:35050) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1nOK0s-0001mD-Lq for guix-patches@gnu.org; Sun, 27 Feb 2022 08:55:04 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1nOK0s-0004ti-Ko for guix-patches@gnu.org; Sun, 27 Feb 2022 08:55:02 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#54180] [PATCH 02/12] home: symlink-manager: Move helper procedures as top-level defines. Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sun, 27 Feb 2022 13:55:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 54180 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 54180@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= Received: via spool by 54180-submit@debbugs.gnu.org id=B54180.164597005518635 (code B ref 54180); Sun, 27 Feb 2022 13:55:02 +0000 Received: (at 54180) by debbugs.gnu.org; 27 Feb 2022 13:54:15 +0000 Received: from localhost ([127.0.0.1]:57140 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1nOK07-0004qU-9A for submit@debbugs.gnu.org; Sun, 27 Feb 2022 08:54:15 -0500 Received: from eggs.gnu.org ([209.51.188.92]:44820) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1nOK05-0004q5-To for 54180@debbugs.gnu.org; Sun, 27 Feb 2022 08:54:14 -0500 Received: from [2001:470:142:3::e] (port=50226 helo=fencepost.gnu.org) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1nOJzl-0001Z1-HT; Sun, 27 Feb 2022 08:53:55 -0500 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=MIME-Version:References:In-Reply-To:Date:Subject:To: From; bh=KQEDUU7UIdoXDnp047WQ1OJGZXh84fnerJi/kb71ExM=; b=fLeQyDSHCumGKAcnnDzK k2G1Br0C7dzR9EssLhLUK8NxFC2cc/2Eku3Vj9ZPbKEIUV0OKXgM+oYsUeGCJZEKxC3TmtDz06ycC YD+RO15NT8BNIhXLMXHGYzg7D63/fJx4k2mPdsp6ZfbQ8UQgRwJ+dxKjm0NXbawwoX4v9CFgAentZ 8UFDF1NUgA6/fW46QnHVx09aqVd/nf/rJpblVjh3I2JuIuR81SSrwC2tfoEH1YDzj42+yjsh4kNZ9 j0KoV/0KbWBd6DFXoN08Y2RdWX3+bcCix6YZoMVaptue8kiFtYS/Prkm6HpoEBqFOjMpr1mzIm6uf tcZL5X5Pka1tDQ==; Received: from 91-160-117-201.subs.proxad.net ([91.160.117.201]:55804 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1nOJzk-0007Pg-8C; Sun, 27 Feb 2022 08:53:53 -0500 From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Sun, 27 Feb 2022 14:53:32 +0100 Message-Id: <20220227135342.10296-2-ludo@gnu.org> X-Mailer: git-send-email 2.34.0 In-Reply-To: <20220227135342.10296-1-ludo@gnu.org> References: <20220227135342.10296-1-ludo@gnu.org> MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches * 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))) From patchwork Sun Feb 27 13:53:33 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: =?utf-8?q?Ludovic_Court=C3=A8s?= X-Patchwork-Id: 37514 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 4E9E227BBE9; Sun, 27 Feb 2022 14:01:30 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-3.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,RCVD_IN_MSPIKE_H5,RCVD_IN_MSPIKE_WL, SPF_HELO_PASS autolearn=unavailable autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id 02AF227BBEA for ; Sun, 27 Feb 2022 14:01:30 +0000 (GMT) Received: from localhost ([::1]:40662 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1nOK77-0002Zv-2k for patchwork@mira.cbaines.net; Sun, 27 Feb 2022 09:01:29 -0500 Received: from eggs.gnu.org ([209.51.188.92]:50656) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1nOK0u-0000Sv-8f for guix-patches@gnu.org; Sun, 27 Feb 2022 08:55:04 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:35052) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1nOK0t-0001sf-Q9 for guix-patches@gnu.org; Sun, 27 Feb 2022 08:55:04 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1nOK0t-0004tz-PN for guix-patches@gnu.org; Sun, 27 Feb 2022 08:55:03 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#54180] [PATCH 03/12] home: symlink-manager: Use 'for-each' when used for effects. Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sun, 27 Feb 2022 13:55:03 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 54180 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 54180@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= Received: via spool by 54180-submit@debbugs.gnu.org id=B54180.164597006118697 (code B ref 54180); Sun, 27 Feb 2022 13:55:03 +0000 Received: (at 54180) by debbugs.gnu.org; 27 Feb 2022 13:54:21 +0000 Received: from localhost ([127.0.0.1]:57164 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1nOK0D-0004rM-9D for submit@debbugs.gnu.org; Sun, 27 Feb 2022 08:54:21 -0500 Received: from eggs.gnu.org ([209.51.188.92]:44836) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1nOK0A-0004qD-P7 for 54180@debbugs.gnu.org; Sun, 27 Feb 2022 08:54:19 -0500 Received: from [2001:470:142:3::e] (port=50230 helo=fencepost.gnu.org) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1nOJzs-0001ZO-Mz; Sun, 27 Feb 2022 08:54:07 -0500 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=MIME-Version:References:In-Reply-To:Date:Subject:To: From; bh=U5rrdB/LXzeaieHngRUm1eGOrN7+p1FXRIewoLUvCqg=; b=TZe/Gv677TR9A8L2KyCo Lo3yiH+DWNWb6edW/yVq1GXuuZGeXfvrpjo/QNfjrg+RSqLO/GmLRoiK+haYNzwsfkYe5/3ZyDwoU P2/s08TkDku5I3esHk/Q9OQ537O3O+z8Zyq87fSMI6+bLUcx5Zy3024/diS1ZLFBX/uuD9XjQSRUZ RD12kS+xlJW4MyLx7naFkmFKq+vqy84Jp5ecPfUzwayh3sjr6cabisOZvB8Kw6dkymMy71Bc4h+zO tdBlY+OOFl82zZtiJaiiNffqoQkj1IK08c/efG5FHkXR1ecnczdzbMPODuLONj5azrDE9Khld8q3o RNLoGj2Iz6x97w==; Received: from 91-160-117-201.subs.proxad.net ([91.160.117.201]:55804 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1nOJzl-0007Pg-NN; Sun, 27 Feb 2022 08:53:57 -0500 From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Sun, 27 Feb 2022 14:53:33 +0100 Message-Id: <20220227135342.10296-3-ludo@gnu.org> X-Mailer: git-send-email 2.34.0 In-Reply-To: <20220227135342.10296-1-ludo@gnu.org> References: <20220227135342.10296-1-ludo@gnu.org> MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches * 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 From patchwork Sun Feb 27 13:53:34 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: =?utf-8?q?Ludovic_Court=C3=A8s?= X-Patchwork-Id: 37523 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 69FDD27BBEA; Sun, 27 Feb 2022 14:07:35 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-3.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,RCVD_IN_MSPIKE_H5,RCVD_IN_MSPIKE_WL, SPF_HELO_PASS autolearn=unavailable autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id 12C7C27BBE9 for ; Sun, 27 Feb 2022 14:07:35 +0000 (GMT) Received: from localhost ([::1]:49422 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1nOKD0-0000z5-8I for patchwork@mira.cbaines.net; Sun, 27 Feb 2022 09:07:34 -0500 Received: from eggs.gnu.org ([209.51.188.92]:50700) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1nOK10-0000Xd-0O for guix-patches@gnu.org; Sun, 27 Feb 2022 08:55:13 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:35059) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1nOK0x-0001tZ-0H for guix-patches@gnu.org; Sun, 27 Feb 2022 08:55:07 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1nOK0w-0004up-Ux for guix-patches@gnu.org; Sun, 27 Feb 2022 08:55:06 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#54180] [PATCH 04/12] home: symlink-manager: Use 'file-is-directory?'. Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sun, 27 Feb 2022 13:55:06 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 54180 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 54180@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= Received: via spool by 54180-submit@debbugs.gnu.org id=B54180.164597007018768 (code B ref 54180); Sun, 27 Feb 2022 13:55:06 +0000 Received: (at 54180) by debbugs.gnu.org; 27 Feb 2022 13:54:30 +0000 Received: from localhost ([127.0.0.1]:57178 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1nOK0M-0004sY-Cb for submit@debbugs.gnu.org; Sun, 27 Feb 2022 08:54:30 -0500 Received: from eggs.gnu.org ([209.51.188.92]:44850) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1nOK0A-0004qG-Pn for 54180@debbugs.gnu.org; Sun, 27 Feb 2022 08:54:23 -0500 Received: from [2001:470:142:3::e] (port=50234 helo=fencepost.gnu.org) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1nOJzu-0001ZT-Fp; Sun, 27 Feb 2022 08:54:07 -0500 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=MIME-Version:References:In-Reply-To:Date:Subject:To: From; bh=Iu6fW84CZKtG3DrzzEXHBBf/kxZvuu3PydhwG5xiicQ=; b=Difn/DnBQW8tY8Rs877v dOwBCzxQnzkpyA+qKWlmfjQhY/NRX8V8EiunXft4s4mCoAhCCuNHJ8dkLO87j8HotqfKlSN8jLbVd AV9HcDmo+F4toy3Iv2w0/mWAP4peTMZ2BlJDLap1CcDlyp1BUy/tou/3QgA4INgEsgLLKRNQkelZK ptrdykxIDayO4jKbK+CpMv/aZl5fvBGTLMVPoxixVSNpcjetp0mdReZlJxTuf8lFqtVfn5uX+nWHK OepMaj7M44YtvfjrSYe4uidcv5tmiS9/FHUjVKRyD4oe79d87cDJK6RY+y9cn63YJX01beQxLMy8+ EIiCXNSqCb2N8w==; Received: from 91-160-117-201.subs.proxad.net ([91.160.117.201]:55804 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1nOJzs-0007Pg-SH; Sun, 27 Feb 2022 08:54:02 -0500 From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Sun, 27 Feb 2022 14:53:34 +0100 Message-Id: <20220227135342.10296-4-ludo@gnu.org> X-Mailer: git-send-email 2.34.0 In-Reply-To: <20220227135342.10296-1-ludo@gnu.org> References: <20220227135342.10296-1-ludo@gnu.org> MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches * 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) From patchwork Sun Feb 27 13:53:35 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: =?utf-8?q?Ludovic_Court=C3=A8s?= X-Patchwork-Id: 37516 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 2467627BBEA; Sun, 27 Feb 2022 14:02:08 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-3.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,RCVD_IN_MSPIKE_H5,RCVD_IN_MSPIKE_WL, SPF_HELO_PASS autolearn=unavailable autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id DCA3F27BBE9 for ; Sun, 27 Feb 2022 14:02:07 +0000 (GMT) Received: from localhost ([::1]:41508 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1nOK7i-0003MP-W6 for patchwork@mira.cbaines.net; Sun, 27 Feb 2022 09:02:07 -0500 Received: from eggs.gnu.org ([209.51.188.92]:50668) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1nOK0w-0000WN-8i for guix-patches@gnu.org; Sun, 27 Feb 2022 08:55:06 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:35053) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1nOK0u-0001sr-7d for guix-patches@gnu.org; Sun, 27 Feb 2022 08:55:05 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1nOK0u-0004u6-7N for guix-patches@gnu.org; Sun, 27 Feb 2022 08:55:04 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#54180] [PATCH 05/12] home: symlink-manager: Remove 'empty-directory?' and avoid TOCTTOU race. Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sun, 27 Feb 2022 13:55:04 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 54180 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 54180@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= Received: via spool by 54180-submit@debbugs.gnu.org id=B54180.164597006818724 (code B ref 54180); Sun, 27 Feb 2022 13:55:04 +0000 Received: (at 54180) by debbugs.gnu.org; 27 Feb 2022 13:54:28 +0000 Received: from localhost ([127.0.0.1]:57166 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1nOK0J-0004rv-LS for submit@debbugs.gnu.org; Sun, 27 Feb 2022 08:54:28 -0500 Received: from eggs.gnu.org ([209.51.188.92]:44848) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1nOK0A-0004qF-Pl for 54180@debbugs.gnu.org; Sun, 27 Feb 2022 08:54:20 -0500 Received: from [2001:470:142:3::e] (port=50236 helo=fencepost.gnu.org) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1nOJzv-0001ZV-Br; Sun, 27 Feb 2022 08:54:08 -0500 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=MIME-Version:References:In-Reply-To:Date:Subject:To: From; bh=912F7cZQA0XDyDLS2BIPLh5lsHJs3DYf4xpW2EWNTMk=; b=a+HhsUrXz6P95nIxNFkq cDMy0qyHEYqYTzzPC/usN4FAx6WQA/OjquVUkXtytrhBr8/7gb+rnua6oKVBhBNA3QGwqiiZiea3X 9cIGvsEOB/7YqJ9901fq94fXa9T0oBmNClJzOA15heWiGEuJXijTMb1Mirwj2R5FYEE4gqLcG3Hm8 0areuBCCjD31ivzVbbs9eaBiekV9zRUbAaqSIqXIMkLVn6hTxplnNyjSRdFwU4ZP+XFiJUXtoefPS 5Dgubyw12Msx8VSKpjjqrELmIn+X+g7cW0xDZ8KPC/5HdxGxVuZhC5RS3b8VoVoFLfejhn+q1tCx0 +07i4sBeTWeDTA==; Received: from 91-160-117-201.subs.proxad.net ([91.160.117.201]:55804 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1nOJzu-0007Pg-L8; Sun, 27 Feb 2022 08:54:03 -0500 From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Sun, 27 Feb 2022 14:53:35 +0100 Message-Id: <20220227135342.10296-5-ludo@gnu.org> X-Mailer: git-send-email 2.34.0 In-Reply-To: <20220227135342.10296-1-ludo@gnu.org> References: <20220227135342.10296-1-ludo@gnu.org> MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches 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 ;;; Copyright © 2021 Xinglu Chen +;;; Copyright © 2022 Ludovic Courtès ;;; ;;; 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)) From patchwork Sun Feb 27 13:53:36 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: =?utf-8?q?Ludovic_Court=C3=A8s?= X-Patchwork-Id: 37522 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 1588827BBEA; Sun, 27 Feb 2022 14:07:24 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-3.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,RCVD_IN_MSPIKE_H5,RCVD_IN_MSPIKE_WL, SPF_HELO_PASS autolearn=unavailable autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id B08CF27BBE9 for ; Sun, 27 Feb 2022 14:07:23 +0000 (GMT) Received: from localhost ([::1]:49172 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1nOKCo-0000mT-SW for patchwork@mira.cbaines.net; Sun, 27 Feb 2022 09:07:22 -0500 Received: from eggs.gnu.org ([209.51.188.92]:50654) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1nOK0u-0000Ss-8F for guix-patches@gnu.org; Sun, 27 Feb 2022 08:55:04 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:35051) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1nOK0t-0001s4-8O for guix-patches@gnu.org; Sun, 27 Feb 2022 08:55:04 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1nOK0t-0004tq-6I for guix-patches@gnu.org; Sun, 27 Feb 2022 08:55:03 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#54180] [PATCH 06/12] home: symlink-manager: Avoid extra 'lstat' call. Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sun, 27 Feb 2022 13:55:03 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 54180 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 54180@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= Received: via spool by 54180-submit@debbugs.gnu.org id=B54180.164597006118688 (code B ref 54180); Sun, 27 Feb 2022 13:55:03 +0000 Received: (at 54180) by debbugs.gnu.org; 27 Feb 2022 13:54:21 +0000 Received: from localhost ([127.0.0.1]:57162 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1nOK0C-0004rD-SC for submit@debbugs.gnu.org; Sun, 27 Feb 2022 08:54:21 -0500 Received: from eggs.gnu.org ([209.51.188.92]:44842) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1nOK0A-0004qE-PF for 54180@debbugs.gnu.org; Sun, 27 Feb 2022 08:54:18 -0500 Received: from [2001:470:142:3::e] (port=50238 helo=fencepost.gnu.org) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1nOJzw-0001ZW-2y; Sun, 27 Feb 2022 08:54:08 -0500 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=MIME-Version:References:In-Reply-To:Date:Subject:To: From; bh=Rs5aZkYJUNIiV3ppRvDlBrBglFTvqsHEr5Zil1ftbuM=; b=F+vA0bYgHtV7o0a0xwv1 CPJW8ljG3nFLzT+3nPV6sBzkyUmUqRYiupeyUUjrWNxfJKPsEh+kRmTCTCE5QHIh8zscxsaYYdkRo zZxAciFgKkQjbigWuPmw9fpz5rfR5dKkS5x2wZVgPiZMQmrJKnmoFhgLGlJGaSjd5hFygv2YFHmPz niek1toWqNNJZ7FVpxQcHOZhFhrw2Ytq2KwYuau/RnbyVDaWsE9x/S6wYyYFkt3ZiFIkzjM4sTmNK uf1RhOkFpMZikrHmmpXVfA/ZdKq+6xVMl4MEOZzRNS3NOPGhlN3y8Km24FiSUadbKexJ7V9vrj/vk d19d1p5m4VX/zw==; Received: from 91-160-117-201.subs.proxad.net ([91.160.117.201]:55804 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1nOJzv-0007Pg-H2; Sun, 27 Feb 2022 08:54:03 -0500 From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Sun, 27 Feb 2022 14:53:36 +0100 Message-Id: <20220227135342.10296-6-ludo@gnu.org> X-Mailer: git-send-email 2.34.0 In-Reply-To: <20220227135342.10296-1-ludo@gnu.org> References: <20220227135342.10296-1-ludo@gnu.org> MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches * 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) From patchwork Sun Feb 27 13:53:37 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: =?utf-8?q?Ludovic_Court=C3=A8s?= X-Patchwork-Id: 37518 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id D0C5327BBEA; Sun, 27 Feb 2022 14:03:00 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-3.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,RCVD_IN_MSPIKE_H5,RCVD_IN_MSPIKE_WL, SPF_HELO_PASS autolearn=unavailable autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id 740C127BBE9 for ; Sun, 27 Feb 2022 14:03:00 +0000 (GMT) Received: from localhost ([::1]:42376 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1nOK8Z-00044M-KN for patchwork@mira.cbaines.net; Sun, 27 Feb 2022 09:02:59 -0500 Received: from eggs.gnu.org ([209.51.188.92]:50706) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1nOK11-0000Xi-5v for guix-patches@gnu.org; Sun, 27 Feb 2022 08:55:13 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:35060) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1nOK0x-0001to-Gu for guix-patches@gnu.org; Sun, 27 Feb 2022 08:55:07 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1nOK0x-0004uw-G0 for guix-patches@gnu.org; Sun, 27 Feb 2022 08:55:07 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#54180] [PATCH 07/12] tests: Make sure 'guix home reconfigure' backs up files. Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sun, 27 Feb 2022 13:55:07 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 54180 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 54180@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= Received: via spool by 54180-submit@debbugs.gnu.org id=B54180.164597007118775 (code B ref 54180); Sun, 27 Feb 2022 13:55:07 +0000 Received: (at 54180) by debbugs.gnu.org; 27 Feb 2022 13:54:31 +0000 Received: from localhost ([127.0.0.1]:57180 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1nOK0M-0004sf-MP for submit@debbugs.gnu.org; Sun, 27 Feb 2022 08:54:31 -0500 Received: from eggs.gnu.org ([209.51.188.92]:44854) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1nOK0A-0004qH-Ps for 54180@debbugs.gnu.org; Sun, 27 Feb 2022 08:54:25 -0500 Received: from [2001:470:142:3::e] (port=50240 helo=fencepost.gnu.org) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1nOJzw-0001Zc-Mf; Sun, 27 Feb 2022 08:54:08 -0500 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=MIME-Version:References:In-Reply-To:Date:Subject:To: From; bh=rUm49j68/EWeFH8IeWP5cuqsDExkhaRgEo7KyXRQJD0=; b=rUy7dXm2drVZZuu6Z47v CdZhn4dqkLxD3/wV5YTKhDeNjX7MpFHXtDZdyvVMgta1LxhL0+ErNIiut1B1G4wFUh+UNQ5sHqEKJ 6GM0GZyl/JVIwmle8o4TEejPs6jjMFxBTbNcyeJC/tu0Y06uvYZRIgBXlNNKFs0DjuW4HqbnlbA5l wXO1/5r1l7q0/b04bptGXMUQftgXjRtrgoe+2mIy8NX9sYOJQ/GaAbbdE0I0y5NCvSzxbKSo32//H AmPEZDKekeI8QDMWroRIoNJvwGH8tDPrCBSLr75ZihGNjaSWpuC9zqBlf0iTWvdvXj/n7IVC1ngX+ YPUp7PrD4BPv5w==; Received: from 91-160-117-201.subs.proxad.net ([91.160.117.201]:55804 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1nOJzw-0007Pg-8Q; Sun, 27 Feb 2022 08:54:04 -0500 From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Sun, 27 Feb 2022 14:53:37 +0100 Message-Id: <20220227135342.10296-7-ludo@gnu.org> X-Mailer: git-send-email 2.34.0 In-Reply-To: <20220227135342.10296-1-ludo@gnu.org> References: <20220227135342.10296-1-ludo@gnu.org> MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches * 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 # Copyright © 2021 Oleg Pykhalov +# Copyright © 2022 Ludovic Courtès # # 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'. # From patchwork Sun Feb 27 13:53:38 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: =?utf-8?q?Ludovic_Court=C3=A8s?= X-Patchwork-Id: 37521 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 468A527BBEA; Sun, 27 Feb 2022 14:05:37 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-3.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,RCVD_IN_MSPIKE_H5,RCVD_IN_MSPIKE_WL, SPF_HELO_PASS autolearn=unavailable autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id 1D21327BBE9 for ; Sun, 27 Feb 2022 14:05:37 +0000 (GMT) Received: from localhost ([::1]:46494 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1nOKB6-0007HA-93 for patchwork@mira.cbaines.net; Sun, 27 Feb 2022 09:05:36 -0500 Received: from eggs.gnu.org ([209.51.188.92]:50670) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1nOK0w-0000WQ-8x for guix-patches@gnu.org; Sun, 27 Feb 2022 08:55:06 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:35056) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1nOK0v-0001t3-Jw for guix-patches@gnu.org; Sun, 27 Feb 2022 08:55:05 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1nOK0v-0004uT-Ix for guix-patches@gnu.org; Sun, 27 Feb 2022 08:55:05 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#54180] [PATCH 08/12] tests: Simplify use of 'local-file' in 'tests/guix-home.sh'. Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sun, 27 Feb 2022 13:55:05 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 54180 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 54180@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= Received: via spool by 54180-submit@debbugs.gnu.org id=B54180.164597006918746 (code B ref 54180); Sun, 27 Feb 2022 13:55:05 +0000 Received: (at 54180) by debbugs.gnu.org; 27 Feb 2022 13:54:29 +0000 Received: from localhost ([127.0.0.1]:57172 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1nOK0L-0004sC-0G for submit@debbugs.gnu.org; Sun, 27 Feb 2022 08:54:29 -0500 Received: from eggs.gnu.org ([209.51.188.92]:44872) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1nOK0B-0004qM-ER for 54180@debbugs.gnu.org; Sun, 27 Feb 2022 08:54:20 -0500 Received: from [2001:470:142:3::e] (port=50242 helo=fencepost.gnu.org) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1nOJzz-0001Zi-Q1; Sun, 27 Feb 2022 08:54:11 -0500 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=MIME-Version:References:In-Reply-To:Date:Subject:To: From; bh=uwkm38vquwJo7BaR1mNPNzxsggoICWpBcwabRkBK9kU=; b=SoL2WtDHSyakriqd4LUq hWWEEzOxnKbaU/DYJ4pediTZTmjAKpH3IIhj6eFnVQpOS68LyYp9Lr3ZbGhOhHZAyuHViYdXQGmMi lKlW/YYcfQ27twDF/aMPS1D/p0rbdXh+GPgVVufesXnnbuxNiTXuy5/XAK4DMJZXc6DYZo7JQ8FS+ 9wXYMfZePvDIz9kQuJg5WUYzAx3uWO5xo7FFZOlRBbjyHOI04gnGBwKlQk3Owqj4FUoVw9/0lFbOq G7A1OUhbSOgcYhmpf249XG4NsPvyMErAXcoy4f2WQdN13YRJRNhlWaqmBG1IrNeHui/15K8gZ4x1j MNv+RGVROZxN8A==; Received: from 91-160-117-201.subs.proxad.net ([91.160.117.201]:55804 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1nOJzw-0007Pg-SH; Sun, 27 Feb 2022 08:54:05 -0500 From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Sun, 27 Feb 2022 14:53:38 +0100 Message-Id: <20220227135342.10296-8-ludo@gnu.org> X-Mailer: git-send-email 2.34.0 In-Reply-To: <20220227135342.10296-1-ludo@gnu.org> References: <20220227135342.10296-1-ludo@gnu.org> MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches * 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 From patchwork Sun Feb 27 13:53:39 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: =?utf-8?q?Ludovic_Court=C3=A8s?= X-Patchwork-Id: 37515 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 317C327BBEA; Sun, 27 Feb 2022 14:02:07 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-3.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,RCVD_IN_MSPIKE_H5,RCVD_IN_MSPIKE_WL, SPF_HELO_PASS autolearn=unavailable autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id CEAEB27BBE9 for ; Sun, 27 Feb 2022 14:02:06 +0000 (GMT) Received: from localhost ([::1]:41438 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1nOK7h-0003Jo-Lw for patchwork@mira.cbaines.net; Sun, 27 Feb 2022 09:02:05 -0500 Received: from eggs.gnu.org ([209.51.188.92]:50666) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1nOK0w-0000WM-8T for guix-patches@gnu.org; Sun, 27 Feb 2022 08:55:06 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:35055) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1nOK0v-0001t0-5C for guix-patches@gnu.org; Sun, 27 Feb 2022 08:55:05 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1nOK0v-0004uL-4M for guix-patches@gnu.org; Sun, 27 Feb 2022 08:55:05 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#54180] [PATCH 09/12] tests: Check 'guix home reconfigure' for a second generation. Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sun, 27 Feb 2022 13:55:05 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 54180 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 54180@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= Received: via spool by 54180-submit@debbugs.gnu.org id=B54180.164597006918739 (code B ref 54180); Sun, 27 Feb 2022 13:55:05 +0000 Received: (at 54180) by debbugs.gnu.org; 27 Feb 2022 13:54:29 +0000 Received: from localhost ([127.0.0.1]:57170 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1nOK0K-0004s4-KS for submit@debbugs.gnu.org; Sun, 27 Feb 2022 08:54:28 -0500 Received: from eggs.gnu.org ([209.51.188.92]:44868) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1nOK0B-0004qL-EB for 54180@debbugs.gnu.org; Sun, 27 Feb 2022 08:54:20 -0500 Received: from [2001:470:142:3::e] (port=50244 helo=fencepost.gnu.org) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1nOK01-0001Zp-Cn; Sun, 27 Feb 2022 08:54:11 -0500 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=MIME-Version:References:In-Reply-To:Date:Subject:To: From; bh=kRaL04jmZdrVlSDR58XrELI9WO17jDsb7AMDz2U7LbM=; b=QFC/VUdAih5+L7iDWGXR odFHQiJjnZVNzbGkR638kbJtfpNSxCqTu8ZBZmzbKdN3+wReJdF1rnO6zW8iDI8z7y2WVPHa4/cXC bvO712P9ALmtRk25Lb/fzNw0b1hn3gXuHmicw9RSGdit5fK99vwvYRAWaOwbFxDpQHP0wEMggddO6 MCMp1CYhzgn5YZybYxGOQhOy2ug78K39mg/WgiH4M5AaxTCNeC0Y8goj0y/fxc5nLzcEUDMIRuQgG Gx0oQofwyn2OUilCyAvSLt1QGtUVSX53apK9UTYZq9tG89QNkgqyQPfyjSQ/CBwaHDG24uuUFFO0y RvXijYW/DidjyA==; Received: from 91-160-117-201.subs.proxad.net ([91.160.117.201]:55804 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1nOJzz-0007Pg-VT; Sun, 27 Feb 2022 08:54:09 -0500 From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Sun, 27 Feb 2022 14:53:39 +0100 Message-Id: <20220227135342.10296-9-ludo@gnu.org> X-Mailer: git-send-email 2.34.0 In-Reply-To: <20220227135342.10296-1-ludo@gnu.org> References: <20220227135342.10296-1-ludo@gnu.org> MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches * 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'. # From patchwork Sun Feb 27 13:53:40 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: =?utf-8?q?Ludovic_Court=C3=A8s?= X-Patchwork-Id: 37517 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 3131327BBEA; Sun, 27 Feb 2022 14:02:56 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-3.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,RCVD_IN_MSPIKE_H5,RCVD_IN_MSPIKE_WL, SPF_HELO_PASS autolearn=unavailable autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id A347027BBE9 for ; Sun, 27 Feb 2022 14:02:55 +0000 (GMT) Received: from localhost ([::1]:42298 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1nOK8U-00040x-QD for patchwork@mira.cbaines.net; Sun, 27 Feb 2022 09:02:54 -0500 Received: from eggs.gnu.org ([209.51.188.92]:50676) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1nOK0w-0000Wc-AC for guix-patches@gnu.org; Sun, 27 Feb 2022 08:55:07 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:35057) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1nOK0w-0001t9-1P for guix-patches@gnu.org; Sun, 27 Feb 2022 08:55:06 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1nOK0w-0004ua-0m for guix-patches@gnu.org; Sun, 27 Feb 2022 08:55:06 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#54180] [PATCH 10/12] home: symlink-manager: 'cleanup-symlinks' uses 'file-system-fold'. Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sun, 27 Feb 2022 13:55:05 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 54180 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 54180@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= Received: via spool by 54180-submit@debbugs.gnu.org id=B54180.164597006918753 (code B ref 54180); Sun, 27 Feb 2022 13:55:05 +0000 Received: (at 54180) by debbugs.gnu.org; 27 Feb 2022 13:54:29 +0000 Received: from localhost ([127.0.0.1]:57174 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1nOK0L-0004sJ-A5 for submit@debbugs.gnu.org; Sun, 27 Feb 2022 08:54:29 -0500 Received: from eggs.gnu.org ([209.51.188.92]:44864) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1nOK0B-0004qK-EB for 54180@debbugs.gnu.org; Sun, 27 Feb 2022 08:54:21 -0500 Received: from [2001:470:142:3::e] (port=50246 helo=fencepost.gnu.org) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1nOK01-0001Zv-W0; Sun, 27 Feb 2022 08:54:11 -0500 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=MIME-Version:References:In-Reply-To:Date:Subject:To: From; bh=NMW+/R/OsQyNgulr9QFBN2+8U0wHfw9yN+ObmtVobdc=; b=WPvt9jkXztkvBPToshkQ e+aCkfAeWyAht8wCxOP1/yjnxmFqDRWQcE3Q7tVsUbs4EYcXP9UCRQS4HYhKeXnBRHmpyG8OqNngu twPvkWCBVbup0D0lQzBkHvuMB9EjbqnIwJOrC7k77o/t2JAvCqDATgEKpZ5ep8z6bL6BxD+ImpcxE 3MEh9oc1c/N0XEFA6xshShJfd+P7wOqb+Nd/px2qn44NdjW8lEesS28em+j86E56d7GzmXV2BYggY DnFlgIOcs2kxStPXia1827onSltihg6WcTXdo4iwlgwlrRVdt6ob1GOjrZwS1/tAxkmKJx0FzpyjE qs7W/V/yJ/Dy8Q==; Received: from 91-160-117-201.subs.proxad.net ([91.160.117.201]:55804 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1nOK01-0007Pg-IS; Sun, 27 Feb 2022 08:54:09 -0500 From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Sun, 27 Feb 2022 14:53:40 +0100 Message-Id: <20220227135342.10296-10-ludo@gnu.org> X-Mailer: git-send-email 2.34.0 In-Reply-To: <20220227135342.10296-1-ludo@gnu.org> References: <20220227135342.10296-1-ludo@gnu.org> MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches * 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) From patchwork Sun Feb 27 13:53:41 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: =?utf-8?q?Ludovic_Court=C3=A8s?= X-Patchwork-Id: 37519 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 2AE3E27BBEA; Sun, 27 Feb 2022 14:03:19 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-3.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,RCVD_IN_MSPIKE_H5,RCVD_IN_MSPIKE_WL, SPF_HELO_PASS autolearn=unavailable autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id 9040F27BBE9 for ; Sun, 27 Feb 2022 14:03:18 +0000 (GMT) Received: from localhost ([::1]:43228 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1nOK8r-0004yu-NN for patchwork@mira.cbaines.net; Sun, 27 Feb 2022 09:03:17 -0500 Received: from eggs.gnu.org ([209.51.188.92]:50704) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1nOK10-0000Xg-10 for guix-patches@gnu.org; Sun, 27 Feb 2022 08:55:13 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:35058) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1nOK0w-0001tW-FZ for guix-patches@gnu.org; Sun, 27 Feb 2022 08:55:07 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1nOK0w-0004uh-Eg for guix-patches@gnu.org; Sun, 27 Feb 2022 08:55:06 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#54180] [PATCH 11/12] home: symlink-manager: 'create-symlinks' uses 'file-system-fold'. Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sun, 27 Feb 2022 13:55:06 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 54180 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 54180@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= Received: via spool by 54180-submit@debbugs.gnu.org id=B54180.164597007018761 (code B ref 54180); Sun, 27 Feb 2022 13:55:06 +0000 Received: (at 54180) by debbugs.gnu.org; 27 Feb 2022 13:54:30 +0000 Received: from localhost ([127.0.0.1]:57176 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1nOK0L-0004sQ-QL for submit@debbugs.gnu.org; Sun, 27 Feb 2022 08:54:30 -0500 Received: from eggs.gnu.org ([209.51.188.92]:44874) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1nOK0B-0004qP-FP for 54180@debbugs.gnu.org; Sun, 27 Feb 2022 08:54:21 -0500 Received: from [2001:470:142:3::e] (port=50248 helo=fencepost.gnu.org) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1nOK02-0001Zw-LK; Sun, 27 Feb 2022 08:54:11 -0500 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=MIME-Version:References:In-Reply-To:Date:Subject:To: From; bh=Wc3wWS4w0MygLoS4JJqop3sbWx6tOsj/j8PiSyRTIq8=; b=QBxoS6gwSTCHqY+wW+7m 08ZunIRutzf1wX8u3LADR2V0p2FM6wMw0Fer0yoJ/hF/92FpXoqynr3t18z46vFqqIY2aVlakma7i Dzu2K1fht+skK+4/EoHiBxMCAaKrwBwlym2hYEpyuXXAi+1bXH7iivgqUZ2EjrLpzURSAKv65OrlR fVyY+mwHsrwgfOVYbrL/nQirMkXUML2ENbJkPCp26C0FYJPBbkCOYW1KzAQAtVY7/YuXCgrzre+eu D07nVRjlKCC17lw6EGwCPgK6YOjNL17sBYLhp/ww0Cc5CvIiI2rBWmMoL2JALjzXs0F1EO/ChcpIz DfdbvRP5MJXFZw==; Received: from 91-160-117-201.subs.proxad.net ([91.160.117.201]:55804 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1nOK02-0007Pg-5H; Sun, 27 Feb 2022 08:54:10 -0500 From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Sun, 27 Feb 2022 14:53:41 +0100 Message-Id: <20220227135342.10296-11-ludo@gnu.org> X-Mailer: git-send-email 2.34.0 In-Reply-To: <20220227135342.10296-1-ludo@gnu.org> References: <20220227135342.10296-1-ludo@gnu.org> MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches 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) From patchwork Sun Feb 27 13:53:42 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: =?utf-8?q?Ludovic_Court=C3=A8s?= X-Patchwork-Id: 37513 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 16D5327BBEB; Sun, 27 Feb 2022 14:01:30 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-3.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,RCVD_IN_MSPIKE_H5,RCVD_IN_MSPIKE_WL, SPF_HELO_PASS autolearn=unavailable autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id 7B91027BBE9 for ; Sun, 27 Feb 2022 14:01:29 +0000 (GMT) Received: from localhost ([::1]:40518 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1nOK76-0002Tv-IM for patchwork@mira.cbaines.net; Sun, 27 Feb 2022 09:01:28 -0500 Received: from eggs.gnu.org ([209.51.188.92]:50672) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1nOK0w-0000WU-9u for guix-patches@gnu.org; Sun, 27 Feb 2022 08:55:06 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:35054) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1nOK0u-0001sw-M0 for guix-patches@gnu.org; Sun, 27 Feb 2022 08:55:05 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1nOK0u-0004uE-LL for guix-patches@gnu.org; Sun, 27 Feb 2022 08:55:04 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#54180] [PATCH 12/12] home: symlink-manager: Rename "path" to "file" where appropriate. Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sun, 27 Feb 2022 13:55:04 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 54180 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 54180@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= Received: via spool by 54180-submit@debbugs.gnu.org id=B54180.164597006818731 (code B ref 54180); Sun, 27 Feb 2022 13:55:04 +0000 Received: (at 54180) by debbugs.gnu.org; 27 Feb 2022 13:54:28 +0000 Received: from localhost ([127.0.0.1]:57168 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1nOK0K-0004rx-4n for submit@debbugs.gnu.org; Sun, 27 Feb 2022 08:54:28 -0500 Received: from eggs.gnu.org ([209.51.188.92]:44860) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1nOK0B-0004qJ-Ds for 54180@debbugs.gnu.org; Sun, 27 Feb 2022 08:54:20 -0500 Received: from [2001:470:142:3::e] (port=50250 helo=fencepost.gnu.org) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1nOK03-0001Zz-7r; Sun, 27 Feb 2022 08:54:11 -0500 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=MIME-Version:References:In-Reply-To:Date:Subject:To: From; bh=YUqT4NDHoNx1g9XMtW5BxCtexC77aTws/H+XCMvS+0s=; b=MOeFB9oNYGTyqgWah3+S S4EmDZ77b5FYd2Oo5li5O9NQFWdNIZXgUBcEbJNprJr7lA13pQ76Patrx1O/8zbJkRWiaAwQPGh/e xQ0zYpe9EU6+DIryn9yMX7OsfjyWx5v1/GDSbLaBkBONdeTh8lxT5ZO/H3d0nRbJ2j+c4GzTviRVs NXPSxWInJm240vsXk3Lz140s/eZB6d4oIcLNsnt9qKTf38PtSzVAzBuNLIgL6vCf++JuOsxfHCXe/ VRRRBQe6s8CaiYpjDfIiyrjxkIyhF91ywgTzRJ0uUec7io0Jh8xM2K0GBW+UHHTWdPqIZwrYPFvwm P33sWUwAS0EdGQ==; Received: from 91-160-117-201.subs.proxad.net ([91.160.117.201]:55804 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1nOK02-0007Pg-R0; Sun, 27 Feb 2022 08:54:11 -0500 From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Sun, 27 Feb 2022 14:53:42 +0100 Message-Id: <20220227135342.10296-12-ludo@gnu.org> X-Mailer: git-send-email 2.34.0 In-Reply-To: <20220227135342.10296-1-ludo@gnu.org> References: <20220227135342.10296-1-ludo@gnu.org> MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches * 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")))))))