Subject: [bug#55941] [PATCH core-updates 1/3] utils: Move switch-symlinks to (guix build utils).

From: Arun Isaac <[email-masked]>
Date: Mon, 13 Jun 2022 17:45:21 +0530

* guix/utils.scm (switch-symlinks): Move to ...
* guix/build/utils.scm (switch-symlinks): ... here.
* guix/profiles.scm, guix/scripts/home.scm, guix/scripts/package.scm: Import
switch-symlinks from (guix build utils).
* guix/scripts/system/reconfigure.scm (switch-system-program): Import (guix
build utils) in G-expression.
---
 guix/build/utils.scm                | 8 ++++++++
 guix/profiles.scm                   | 3 ++-
 guix/scripts/home.scm               | 3 ++-
 guix/scripts/package.scm            | 3 ++-
 guix/scripts/system/reconfigure.scm | 4 +++-
 guix/utils.scm                      | 8 --------
 6 files changed, 17 insertions(+), 12 deletions(-)

diff --git a/guix/build/utils.scm b/guix/build/utils.scm
index b822caf619..ce7bdb2024 100644
--- a/guix/build/utils.scm
+++ b/guix/build/utils.scm
@@ -60,6 +60,7 @@ (define-module (guix build utils)
             directory-exists?
             executable-file?
             symbolic-link?
+            switch-symlinks
             call-with-temporary-output-file
             call-with-ascii-input-file
             file-header-match
@@ -240,6 +241,13 @@ (define (symbolic-link? file)
   "Return #t if FILE is a symbolic link (aka. \"symlink\".)"
   (eq? (stat:type (lstat file)) 'symlink))
 
+(define (switch-symlinks link target)
+  "Atomically switch LINK, a symbolic link, to point to TARGET.  Works
+both when LINK already exists and when it does not."
+  (let ((pivot (string-append link ".new")))
+    (symlink target pivot)
+    (rename-file pivot link)))
+
 (define (call-with-temporary-output-file proc)
   "Call PROC with a name of a temporary file and open output port to that
 file; close the file and delete it when leaving the dynamic extent of this
diff --git a/guix/profiles.scm b/guix/profiles.scm
index bf50c00a1e..d3ff8379ad 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -12,6 +12,7 @@
 ;;; Copyright © 2019 Mathieu Othacehe <[email-masked]>
 ;;; Copyright © 2020 Danny Milosavljevic <[email-masked]>
 ;;; Copyright © 2014 David Thompson <[email-masked]>
+;;; Copyright © 2022 Arun Isaac <[email-masked]>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -32,7 +33,7 @@ (define-module (guix profiles)
   #:use-module ((guix config) #:select (%state-directory))
   #:use-module ((guix utils) #:hide (package-name->name+version))
   #:use-module ((guix build utils)
-                #:select (package-name->name+version mkdir-p))
+                #:select (package-name->name+version mkdir-p switch-symlinks))
   #:use-module ((guix diagnostics) #:select (&fix-hint formatted-message))
   #:use-module (guix i18n)
   #:use-module (guix records)
diff --git a/guix/scripts/home.scm b/guix/scripts/home.scm
index 0f5c3388a1..8ba7693a83 100644
--- a/guix/scripts/home.scm
+++ b/guix/scripts/home.scm
@@ -4,6 +4,7 @@
 ;;; Copyright © 2021 Pierre Langlois <[email-masked]>
 ;;; Copyright © 2021 Oleg Pykhalov <[email-masked]>
 ;;; Copyright © 2022 Ludovic Courtès <[email-masked]>
+;;; Copyright © 2022 Arun Isaac <[email-masked]>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -63,7 +64,7 @@ (define-module (guix scripts home)
   #:autoload   (guix scripts home edit) (guix-home-edit)
   #:autoload   (guix scripts home import) (import-manifest)
   #:use-module ((guix status) #:select (with-status-verbosity))
-  #:use-module ((guix build utils) #:select (mkdir-p))
+  #:use-module ((guix build utils) #:select (mkdir-p switch-symlinks))
   #:use-module (guix gexp)
   #:use-module (guix monads)
   #:use-module (srfi srfi-1)
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 99a6cfaa29..14a8e1f5e8 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -11,6 +11,7 @@
 ;;; Copyright © 2020 Simon Tournier <[email-masked]>
 ;;; Copyright © 2018 Steve Sprang <[email-masked]>
 ;;; Copyright © 2022 Josselin Poiret <[email-masked]>
+;;; Copyright © 2022 Arun Isaac <[email-masked]>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -49,7 +50,7 @@ (define-module (guix scripts package)
   #:autoload   (guix channels) (channel-name channel-commit channel->code)
   #:autoload   (guix store roots) (gc-roots user-owned?)
   #:use-module ((guix build utils)
-                #:select (directory-exists? mkdir-p))
+                #:select (directory-exists? mkdir-p switch-symlinks))
   #:use-module (ice-9 format)
   #:use-module (ice-9 match)
   #:autoload   (ice-9 pretty-print) (pretty-print)
diff --git a/guix/scripts/system/reconfigure.scm b/guix/scripts/system/reconfigure.scm
index 9ca66687ee..a173e011b4 100644
--- a/guix/scripts/system/reconfigure.scm
+++ b/guix/scripts/system/reconfigure.scm
@@ -6,6 +6,7 @@
 ;;; Copyright © 2018 Ricardo Wurmus <[email-masked]>
 ;;; Copyright © 2019 Christopher Baines <[email-masked]>
 ;;; Copyright © 2019 Jakob L. Kreuze <[email-masked]>
+;;; Copyright © 2022 Arun Isaac <[email-masked]>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -94,7 +95,8 @@ (define* (switch-system-program os #:optional profile)
                                  #:select? not-config?)
                               ((guix config) => ,(make-config.scm)))
        #~(begin
-           (use-modules (guix config)
+           (use-modules (guix build utils)
+                        (guix config)
                         (guix profiles)
                         (guix utils))
 
diff --git a/guix/utils.scm b/guix/utils.scm
index 37b2e29800..ed791cce1c 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -120,7 +120,6 @@ (define-module (guix utils)
             file-sans-extension
             tarball-sans-extension
             compressed-file?
-            switch-symlinks
             call-with-temporary-directory
             with-atomic-file-output
 
@@ -892,13 +891,6 @@ (define (compressed-file? file)
   (->bool (member (file-extension file)
                   '("gz" "bz2" "xz" "lz" "lzma" "tgz" "tbz2" "zip"))))
 
-(define (switch-symlinks link target)
-  "Atomically switch LINK, a symbolic link, to point to TARGET.  Works
-both when LINK already exists and when it does not."
-  (let ((pivot (string-append link ".new")))
-    (symlink target pivot)
-    (rename-file pivot link)))
-
 (define* (string-replace-substring str substr replacement
                                    #:optional
                                    (start 0)

base-commit: 0d09e2e29d1ef0afabebd843f51d41d6cfe340ee
-- 
2.36.1