Package: guix-patches;
Reported by: Arun Isaac <arunisaac <at> systemreboot.net>
Date: Mon, 13 Jun 2022 12:14:02 UTC
Severity: normal
Tags: patch
Done: Arun Isaac <arunisaac <at> systemreboot.net>
Bug is archived. No further changes may be made.
Message #8 received at 55941 <at> debbugs.gnu.org (full text, mbox):
From: Arun Isaac <arunisaac <at> systemreboot.net> To: 55941 <at> debbugs.gnu.org, Maxime Devos <maximedevos <at> telenet.be> Cc: Arun Isaac <arunisaac <at> systemreboot.net> Subject: [PATCH core-updates 1/3] utils: Move switch-symlinks to (guix build utils). 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 <m.othacehe <at> gmail.com>
;;; Copyright © 2020 Danny Milosavljevic <dannym <at> scratchpost.org>
;;; Copyright © 2014 David Thompson <davet <at> gnu.org>
+;;; Copyright © 2022 Arun Isaac <arunisaac <at> systemreboot.net>
;;;
;;; 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 <pierre.langlois <at> gmx.com>
;;; Copyright © 2021 Oleg Pykhalov <go.wigust <at> gmail.com>
;;; Copyright © 2022 Ludovic Courtès <ludo <at> gnu.org>
+;;; Copyright © 2022 Arun Isaac <arunisaac <at> systemreboot.net>
;;;
;;; 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 <zimon.toutoune <at> gmail.com>
;;; Copyright © 2018 Steve Sprang <scs <at> stevesprang.com>
;;; Copyright © 2022 Josselin Poiret <dev <at> jpoiret.xyz>
+;;; Copyright © 2022 Arun Isaac <arunisaac <at> systemreboot.net>
;;;
;;; 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 <rekado <at> elephly.net>
;;; Copyright © 2019 Christopher Baines <mail <at> cbaines.net>
;;; Copyright © 2019 Jakob L. Kreuze <zerodaysfordays <at> sdf.org>
+;;; Copyright © 2022 Arun Isaac <arunisaac <at> systemreboot.net>
;;;
;;; 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
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.