kreyren/guix-kreyren
1
0
Fork 0
Code Issues 1 Pull Requests 1 Releases Activity

pull: Tweak cache directory validation code.

Browse Source 
This is a followup to 7c52cad0464175370c44bd4695e4c01a62b8268f.

* guix/scripts/pull.scm (guix-pull): Move cache directory validation
code to...
(validate-cache-directory-ownership): ... here.  New procedure.  Use
SRFI-71 instead of SRFI-11.  Use 'formatted-message' for the error
message, with ASCII quotation marks, and use Texinfo markup for
'&fix-hint'.
This commit is contained in:
Ludovic Courtès 2022-06-13 17:25:30 +02:00
parent 13c46cc29d
commit 9be470b5d2
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 31 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

56
guix/scripts/pull.scm
View File

@ -20,6 +20,7 @@
(define-module (guix scripts pull)
#:use-module ((guix ui) #:hide (display-profile-content))
#:use-module (guix diagnostics)
#:use-module (guix colors)
#:use-module (guix utils)
#:use-module ((guix status) #:select (with-status-verbosity))
@ -49,7 +50,6 @@
#:autoload (gnu packages bootstrap) (%bootstrap-guile)
#:autoload (gnu packages certs) (le-certs)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
@ -787,6 +787,35 @@ Use '~/.config/guix/channels.scm' instead."))
channels))
channels)))
(define (validate-cache-directory-ownership)
"Bail out if the cache directory is not owned by the current user."
(let ((stats dir
(let loop ((dir (cache-directory)))
(let ((stats (stat dir #f)))
(if stats
(values stats dir)
(loop (dirname dir)))))))
(let ((dir:uid (stat:uid stats))
(our:uid (getuid)))
(unless (= dir:uid our:uid)
(let* ((user (lambda (uid) ;handle the unthinkable invalid UID
(or (false-if-exception (passwd:name
(getpwuid uid)))
uid)))
(our:user (user our:uid))
(dir:user (user dir:uid)))
(raise
(make-compound-condition
(formatted-message
(G_ "directory '~a' is not owned by user ~a")
dir our:user)
(condition
(&fix-hint
(hint
(format #f (G_ "You should run this command as ~a; use \
@command{sudo -i} or equivalent if you really want to pull as ~a.")
dir:user our:user)))))))))))
(define-command (guix-pull . args)
(synopsis "pull the latest revision of Guix")
@ -813,30 +842,7 @@ Use '~/.config/guix/channels.scm' instead."))
(else
;; Bail out early when users accidentally run, e.g., ’sudo guix pull’.
;; If CACHE-DIRECTORY doesn't yet exist, test where it would end up.
(let-values (((stats dir) (let loop ((dir (cache-directory)))
(let ((stats (stat dir #f)))
(if stats
(values stats dir)
(loop (dirname dir)))))))
(let ((dir:uid (stat:uid stats))
(our:uid (getuid)))
(unless (= dir:uid our:uid)
(let* ((user (lambda (uid) ; handle the unthinkable invalid UID
(or (false-if-exception (passwd:name
(getpwuid uid)))
uid)))
(our:user (user our:uid))
(dir:user (user dir:uid)))
(raise
(condition
(&message
(message
(format #f (G_ "directory ‘~a’ is not owned by user ~a")
dir our:user)))
(&fix-hint
(hint
(format #f (G_ "You should run this command as ~a; use ‘sudo -i’ or equivalent if you really want to pull as ~a.")
dir:user our:user)))))))))
(validate-cache-directory-ownership)
(with-store store
(with-status-verbosity (assoc-ref opts 'verbosity)