gnu: Add ruby-asciidoctor.

[jackhill/guix/guix.git] / gnu / build / install.scm

diff --git a/gnu/build/install.scm b/gnu/build/install.scm
index 9085e22..9e30c0d 100644 (file)
--- a/gnu/build/install.scm
+++ b/gnu/build/install.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -21,7 +22,8 @@
   #:use-module (guix build store-copy)
   #:use-module (srfi srfi-26)
   #:use-module (ice-9 match)
-  #:export (install-grub
+  #:export (install-boot-config
+            evaluate-populate-directive
             populate-root-file-system
             reset-timestamps
             register-closure
@@ -36,27 +38,18 @@
 ;;;
 ;;; Code:
 
-(define* (install-grub grub.cfg device mount-point)
-  "Install GRUB with GRUB.CFG on DEVICE, which is assumed to be mounted on
-MOUNT-POINT.
-
-Note that the caller must make sure that GRUB.CFG is registered as a GC root
-so that the fonts, background images, etc. referred to by GRUB.CFG are not
-GC'd."
-  (let* ((target (string-append mount-point "/boot/grub/grub.cfg"))
+(define (install-boot-config bootcfg bootcfg-location mount-point)
+  "Atomically copy BOOTCFG into BOOTCFG-LOCATION on the MOUNT-POINT.  Note
+that the caller must make sure that BOOTCFG is registered as a GC root so
+that the fonts, background images, etc. referred to by BOOTCFG are not GC'd."
+  (let* ((target (string-append mount-point bootcfg-location))
          (pivot  (string-append target ".new")))
     (mkdir-p (dirname target))
 
-    ;; Copy GRUB.CFG instead of just symlinking it, because symlinks won't
+    ;; Copy BOOTCFG instead of just symlinking it, because symlinks won't
     ;; work when /boot is on a separate partition.  Do that atomically.
-    (copy-file grub.cfg pivot)
-    (rename-file pivot target)
-
-    (unless (zero? (system* "grub-install" "--no-floppy"
-                            "--boot-directory"
-                            (string-append mount-point "/boot")
-                            device))
-      (error "failed to install GRUB"))))
+    (copy-file bootcfg pivot)
+    (rename-file pivot target)))
 
 (define (evaluate-populate-directive directive target)
   "Evaluate DIRECTIVE, an sexp describing a file or directory to create under
@@ -103,7 +96,7 @@ STORE."
     (directory ,store 0 30000 #o1775)
 
     (directory "/etc")
-    (directory "/var/log")                          ; for dmd
+    (directory "/var/log")                          ; for shepherd
     (directory "/var/guix/gcroots")
     (directory "/var/empty")                        ; for no-login accounts
     (directory "/var/db")                           ; for dhclient, etc.
@@ -118,6 +111,10 @@ STORE."
     ("/var/guix/gcroots/booted-system" -> "/run/booted-system")
     ("/var/guix/gcroots/current-system" -> "/run/current-system")
 
+    ;; XXX: 'guix-register' creates this symlink with a wrong target, so
+    ;; create it upfront to be sure.
+    ("/var/guix/gcroots/profiles" -> "/var/guix/profiles")
+
     (directory "/bin")
     (directory "/tmp" 0 0 #o1777)                 ; sticky bit
     (directory "/var/tmp" 0 0 #o1777)
@@ -159,7 +156,7 @@ as created and modified at the Epoch."
                 ;; read-only store.
                 (unless (eq? (stat:type s) 'symlink)
                   (utime file 0 0 0 0))))
-            (find-files directory "")))
+            (find-files directory #:directories? #t)))
 
 (define* (register-closure store closure
                            #:key (deduplicate? #t))
@@ -176,13 +173,16 @@ rest of STORE."
 
 (define* (populate-single-profile-directory directory
                                             #:key profile closure
-                                            deduplicate?)
+                                            deduplicate?
+                                            register?)
   "Populate DIRECTORY with a store containing PROFILE, whose closure is given
 in the file called CLOSURE (as generated by #:references-graphs.)  DIRECTORY
 is initialized to contain a single profile under /root pointing to PROFILE.
-DEDUPLICATE? determines whether to deduplicate files in the store.
+When REGISTER? is true, initialize DIRECTORY/var/guix/db to reflect the
+contents of the store; DEDUPLICATE? determines whether to deduplicate files in
+the store.
 
-This is used to create the self-contained Guix tarball."
+This is used to create the self-contained tarballs with 'guix pack'."
   (define (scope file)
     (string-append directory "/" file))
 
@@ -197,14 +197,16 @@ This is used to create the self-contained Guix tarball."
 
   ;; Populate the store.
   (populate-store (list closure) directory)
-  (register-closure (canonicalize-path directory) closure
-                    #:deduplicate? deduplicate?)
-
-  ;; XXX: 'guix-register' registers profiles as GC roots but the symlink
-  ;; target uses $TMPDIR.  Fix that.
-  (delete-file (scope "/var/guix/gcroots/profiles"))
-  (symlink* "/var/guix/profiles"
-            "/var/guix/gcroots/profiles")
+
+  (when register?
+    (register-closure (canonicalize-path directory) closure
+                      #:deduplicate? deduplicate?)
+
+    ;; XXX: 'guix-register' registers profiles as GC roots but the symlink
+    ;; target uses $TMPDIR.  Fix that.
+    (delete-file (scope "/var/guix/gcroots/profiles"))
+    (symlink* "/var/guix/profiles"
+              "/var/guix/gcroots/profiles"))
 
   ;; Make root's profile, which makes it a GC root.
   (mkdir-p* %root-profile)