From 77dcfb4c028417bed53c523dbb8c314e9556f85b Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Thu, 11 Oct 2018 18:04:51 +0200
Subject: profiles: Add 'ensure-profile-directory'.

* guix/scripts/package.scm (ensure-default-profile): Move
/var/guix/profiles/per-user handling to...
* guix/profiles.scm (ensure-profile-directory): ... here.  New
procedure.
* po/guix/POTFILES.in: Add 'guix/profiles.scm'.
---
 guix/profiles.scm | 43 ++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 42 insertions(+), 1 deletion(-)

(limited to 'guix/profiles.scm')

diff --git a/guix/profiles.scm b/guix/profiles.scm
index de3a044646..6c3b26423e 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -28,7 +28,8 @@ (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))
+                #:select (package-name->name+version mkdir-p))
+  #:use-module (guix i18n)
   #:use-module (guix records)
   #:use-module (guix packages)
   #:use-module (guix derivations)
@@ -127,6 +128,7 @@ (define-module (guix profiles)
             %user-profile-directory
             %profile-directory
             %current-profile
+            ensure-profile-directory
             canonicalize-profile
             user-friendly-profile))
 
@@ -1610,6 +1612,45 @@ (define %current-profile
   ;; coexist with Nix profiles.
   (string-append %profile-directory "/guix-profile"))
 
+(define (ensure-profile-directory)
+  "Attempt to create /…/profiles/per-user/$USER if needed."
+  (let ((s (stat %profile-directory #f)))
+    (unless (and s (eq? 'directory (stat:type s)))
+      (catch 'system-error
+        (lambda ()
+          (mkdir-p %profile-directory))
+        (lambda args
+          ;; Often, we cannot create %PROFILE-DIRECTORY because its
+          ;; parent directory is root-owned and we're running
+          ;; unprivileged.
+          (raise (condition
+                  (&message
+                   (message
+                    (format #f
+                            (G_ "while creating directory `~a': ~a")
+                            %profile-directory
+                            (strerror (system-error-errno args)))))
+                  (&fix-hint
+                   (hint
+                    (format #f (G_ "Please create the @file{~a} directory, \
+with you as the owner.")
+                            %profile-directory))))))))
+
+    ;; Bail out if it's not owned by the user.
+    (unless (or (not s) (= (stat:uid s) (getuid)))
+      (raise (condition
+              (&message
+               (message
+                (format #f (G_ "directory `~a' is not owned by you")
+                        %profile-directory)))
+              (&fix-hint
+               (hint
+                (format #f (G_ "Please change the owner of @file{~a} \
+to user ~s.")
+                        %profile-directory (or (getenv "USER")
+                                               (getenv "LOGNAME")
+                                               (getuid))))))))))
+
 (define (canonicalize-profile profile)
   "If PROFILE is %USER-PROFILE-DIRECTORY, return %CURRENT-PROFILE.  Otherwise
 return PROFILE unchanged.  The goal is to treat '-p ~/.guix-profile' as if
-- 
cgit v1.2.3