bug#20255: 'search-paths' should respect both user and system profile.

[Ludovic Courtès]

宋文武 <address@hidden> skribis:

> Or better to generate a 'profile' script for each manifest, and then
> merged in shell level, so it can work out-of-the-box. How about:
>   - /etc/profile:
>     # configuration for the whole system goes here.
>     # shouldn't refer profile paths.
>     export LANG=en_US.utf8
>     export SSL_CERT_DIR=/etc/ssl/certs
>     export LINUX_MODULE_DIRECTORY=/run/booted-system/kernel/lib/modules
>     [...]
>
>     source /run/current-system/profile/etc/profile
>
>     if [ -f $HOME/.guix-profile/etc/profile ]; then
>       source $HOME/.guix-profile/etc/profile
>     fi
>
>     # honor setuid-programs
>     export PATH=/run/setuid-programs:$PATH
>
>   - /run/current-system/profile/etc/profile:
>     export 
> PATH=/run/current-system/profile/bin:/run/current-system/profile/sbin:$PATH
>     export MANPATH=/run/current-system/profile/share/man:$PATH
>     [...]
>     
>   - ~/.guix-profile/etc/profile:
>     export PATH=~/.guix-profile/bin:~/.guix-profile/sbin:$PATH
>     [...]

There’s a further complication here: ‘profile-derivation’, which builds
the profile, doesn’t know its user-visible name ~/.guix-profile.  It
just knows its store file name.  However, we don’t want etc/profile to
read:

  export PATH=/gnu/store/...-profile/bin:$PATH

because then, the user’s environment variables in a running session
would keep pointing to a given profile generation.

So we have to tell ‘profile-generation’ what the user-visible name of
the profile is going to be.  Attached is a very rough patch to do that.
This is not so nice because all user interfaces will now have to pass
that #:target parameter or etc/profile will be “wrong.”

Another option would be to simply run:

  eval `guix package -p ~/.guix-profile --search-paths`

This has two downsides:

  1. It takes ~200 ms to run on my laptop, which can maybe be
     noticeable; OTOH it’s only for interactive shells, so maybe that’s
     OK.

  2. If there’s a manifest format change and /etc/profile calls a ‘guix’
     command that cannot handle the manifest format (because it’s older
     than the ‘guix’ used to build the profile), then it doesn’t work at
     all (that’s a bit contrived, but not completely impossible.)

Thoughts?

Ludo’.

        Modified   guix/profiles.scm
diff --git a/guix/profiles.scm b/guix/profiles.scm
index 8445e00..308dc23 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -582,10 +582,15 @@ MANIFEST.  Single-file bundles are required by programs 
such as Git and Lynx."
 
 (define* (profile-derivation manifest
                              #:key
+                             target
                              (hooks %default-profile-hooks))
   "Return a derivation that builds a profile (aka. 'user environment') with
 the given MANIFEST.  The profile includes additional derivations returned by
-the monadic procedures listed in HOOKS--such as an Info 'dir' file, etc."
+the monadic procedures listed in HOOKS--such as an Info 'dir' file, etc.
+
+When TARGET is not #f, it must be a string denoting the file name under which
+the profile will be available--e.g., \"/home/rms/.guix-profile\".  This name
+is used in the profile's 'etc/profile' file (read that again.)"
   (mlet %store-monad ((extras (if (null? (manifest-entries manifest))
                                   (return '())
                                   (sequence %store-monad
@@ -598,20 +603,72 @@ the monadic procedures listed in HOOKS--such as an Info 
'dir' file, etc."
 
     (define builder
       #~(begin
-          (use-modules (ice-9 pretty-print)
-                       (guix build union))
+          (use-modules (ice-9 match)
+                       (ice-9 regex)
+                       (ice-9 pretty-print)
+                       (guix build union)
+                       (guix build utils)
+                       (guix search-paths))
+
+          (define target
+            '#$target)
+
+          (define search-paths
+            (map sexp->search-path-specification
+                 '#$(map search-path-specification->sexp
+                         (append-map manifest-entry-search-paths
+                                     (manifest-entries manifest)))))
+
+          (define (use-target value separator)
+            (let ((items ((@@ (guix search-paths) string-tokenize*)
+                          value separator)))
+              (string-join (map (lambda (str)
+                                  (string-append target
+                                                 (string-drop str
+                                                              (string-length
+                                                               #$output))))
+                                items)
+                           separator)))
+
+          (define write-environment-variable-definition
+            (match-lambda
+              ((spec . value)
+               (let ((variable (search-path-specification-variable spec))
+                     (sep      (search-path-specification-separator spec)))
+                 (display
+                  (environment-variable-definition variable
+                                                   (if target
+                                                       (use-target value sep)
+                                                       value)
+                                                   #:separator sep
+                                                   #:kind 'prefix))
+                 (newline)))))
 
           (setvbuf (current-output-port) _IOLBF)
           (setvbuf (current-error-port) _IOLBF)
 
+          ;; Make the symlinks.
           (union-build #$output '#$inputs
                        #:log-port (%make-void-port "w"))
+
+          ;; Store meta-data.
           (call-with-output-file (string-append #$output "/manifest")
             (lambda (p)
-              (pretty-print '#$(manifest->gexp manifest) p)))))
+              (pretty-print '#$(manifest->gexp manifest) p)))
+
+          ;; Store a ready-to-use Bash profile.
+          (mkdir-p (string-append #$output "/etc"))
+          (with-output-to-file (string-append #$output "/etc/profile")
+            (lambda ()
+              (let ((variables (evaluate-search-paths search-paths #$output)))
+                (for-each write-environment-variable-definition
+                          variables))))))
 
     (gexp->derivation "profile" builder
-                      #:modules '((guix build union))
+                      #:modules '((guix build union)
+                                  (guix build utils)
+                                  (guix search-paths)
+                                  (guix records))
                       #:local-build? #t)))
 
 (define (profile-regexp profile)
        Modified   guix/scripts/package.scm
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 7f53af7..38ec8ed 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -833,6 +833,7 @@ more information.~%"))
                (let* ((prof-drv (run-with-store (%store)
                                   (profile-derivation
                                    new
+                                   #:target (user-friendly-profile profile)
                                    #:hooks (if bootstrap?
                                                '()
                                                %default-profile-hooks))))