aboutsummaryrefslogtreecommitdiff
path: root/gnu
diff options
context:
space:
mode:
Diffstat (limited to 'gnu')
-rw-r--r--gnu/services/dmd.scm2
-rw-r--r--gnu/services/xorg.scm2
-rw-r--r--gnu/system.scm56
-rw-r--r--gnu/system/vm.scm59
4 files changed, 45 insertions, 74 deletions
diff --git a/gnu/services/dmd.scm b/gnu/services/dmd.scm
index 0d17285890..982c196fe4 100644
--- a/gnu/services/dmd.scm
+++ b/gnu/services/dmd.scm
@@ -64,7 +64,7 @@
services))
;; guix-daemon 0.6 aborts if 'PATH' is undefined, so work around it.
- (setenv "PATH" "/run/current-system/bin")
+ (setenv "PATH" "/run/current-system/profile/bin")
(format #t "starting services...~%")
(for-each start '#$(append-map service-provision services))))
diff --git a/gnu/services/xorg.scm b/gnu/services/xorg.scm
index 1988cfa6a0..7215297f69 100644
--- a/gnu/services/xorg.scm
+++ b/gnu/services/xorg.scm
@@ -139,7 +139,7 @@ When AUTO-LOGIN? is true, log in automatically as DEFAULT-USER."
(mlet %store-monad ((startx (or startx (xorg-start-command)))
(xinitrc (xinitrc)))
(text-file* "slim.cfg" "
-default_path /run/current-system/bin
+default_path /run/current-system/profile/bin
default_xserver " startx "
xserver_arguments :0 vt7
xauth_path " xauth "/bin/xauth
diff --git a/gnu/system.scm b/gnu/system.scm
index 9ce94d0230..ec3e2fcd6c 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -55,6 +55,7 @@
operating-system-derivation
operating-system-profile
+ operating-system-grub.cfg
<file-system>
file-system
@@ -263,7 +264,7 @@ explicitly appear in OS."
(locale "C") (timezone "Europe/Paris")
(skeletons '())
(pam-services '())
- (profile "/var/run/current-system/profile")
+ (profile "/run/current-system/profile")
(sudoers ""))
"Return a derivation that builds the static part of the /etc directory."
(mlet* %store-monad
@@ -273,8 +274,8 @@ explicitly appear in OS."
(shells (text-file "shells" ; used by xterm and others
"\
/bin/sh
-/run/current-system/bin/sh
-/run/current-system/bin/bash\n"))
+/run/current-system/profile/bin/sh
+/run/current-system/profile/bin/bash\n"))
(issue (text-file "issue" "
This is an alpha preview of the GNU system. Welcome.
@@ -293,8 +294,8 @@ export LC_ALL=\"" locale "\"
export TZ=\"" timezone "\"
export TZDIR=\"" tzdata "/share/zoneinfo\"
-export PATH=$HOME/.guix-profile/bin:" profile "/bin:" profile "/sbin
-export PATH=/run/setuid-programs:$PATH
+export PATH=/run/setuid-programs:/run/current-system/profile/sbin
+export PATH=$HOME/.guix-profile/bin:/run/current-system/profile/bin:$PATH
export CPATH=$HOME/.guix-profile/include:" profile "/include
export LIBRARY_PATH=$HOME/.guix-profile/lib:" profile "/lib
alias ls='ls -p --color'
@@ -402,7 +403,8 @@ alias ll='ls -l'
we're running in the final root."
(define %modules
'((guix build activation)
- (guix build utils)))
+ (guix build utils)
+ (guix build linux-initrd)))
(mlet* %store-monad ((services (operating-system-services os))
(etc (operating-system-etc-directory os))
@@ -446,6 +448,9 @@ we're running in the final root."
;; Activate setuid programs.
(activate-setuid-programs (list #$@setuid-progs))
+ ;; Set up /run/current-system.
+ (activate-current-system #:boot? #t)
+
;; Close any remaining open file descriptors to be on the
;; safe side. This must be the very last thing we do,
;; because Guile has internal FDs such as 'sleep_pipe'
@@ -466,8 +471,8 @@ we're running in the final root."
(_ #f))
(operating-system-file-systems os)))
-(define (operating-system-derivation os)
- "Return a derivation that builds OS."
+(define (operating-system-initrd-file os)
+ "Return a gexp denoting the initrd file of OS."
(define boot-file-systems
(filter (match-lambda
(($ <file-system> device "/")
@@ -476,15 +481,16 @@ we're running in the final root."
boot?))
(operating-system-file-systems os)))
+ (mlet %store-monad
+ ((initrd ((operating-system-initrd os) boot-file-systems)))
+ (return #~(string-append #$initrd "/initrd"))))
+
+(define (operating-system-grub.cfg os)
+ "Return the GRUB configuration file for OS."
(mlet* %store-monad
- ((profile (operating-system-profile os))
- (etc (operating-system-etc-directory os))
- (services (operating-system-services os))
- (boot (operating-system-boot-script os))
- (kernel -> (operating-system-kernel os))
- (initrd ((operating-system-initrd os) boot-file-systems))
- (initrd-file -> #~(string-append #$initrd "/initrd"))
+ ((system (operating-system-derivation os))
(root-fs -> (operating-system-root-file-system os))
+ (kernel -> (operating-system-kernel os))
(entries -> (list (menu-entry
(label (string-append
"GNU system with "
@@ -494,15 +500,25 @@ we're running in the final root."
(linux-arguments
(list (string-append "--root="
(file-system-device root-fs))
- #~(string-append "--load=" #$boot)))
- (initrd initrd-file))))
- (grub.cfg (grub-configuration-file entries)))
+ #~(string-append "--system=" #$system)
+ #~(string-append "--load=" #$system
+ "/boot")))
+ (initrd #~(string-append #$system "/initrd"))))))
+ (grub-configuration-file entries)))
+
+(define (operating-system-derivation os)
+ "Return a derivation that builds OS."
+ (mlet* %store-monad
+ ((profile (operating-system-profile os))
+ (etc (operating-system-etc-directory os))
+ (boot (operating-system-boot-script os))
+ (kernel -> (operating-system-kernel os))
+ (initrd (operating-system-initrd-file os)))
(file-union "system"
`(("boot" ,#~#$boot)
("kernel" ,#~#$kernel)
- ("initrd" ,initrd-file)
+ ("initrd" ,initrd)
("profile" ,#~#$profile)
- ("grub.cfg" ,#~#$grub.cfg)
("etc" ,#~#$etc)))))
;;; system.scm ends here
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index 58e5416b3e..4bf0e06081 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -192,7 +192,6 @@ made available under the /xchg CIFS share."
(file-system-type "ext4")
grub-configuration
(register-closures? #t)
- (populate #f)
(inputs '())
copy-inputs?)
"Return a bootable, stand-alone QEMU image, with a root partition of type
@@ -203,12 +202,7 @@ file (GRUB-CONFIGURATION must be the name of a file in the VM.)
INPUTS is a list of inputs (as for packages). When COPY-INPUTS? is true, copy
all of INPUTS into the image being built. When REGISTER-CLOSURES? is true,
register INPUTS in the store database of the image so that Guix can be used in
-the image.
-
-POPULATE is a list of directives stating directories or symlinks to be created
-in the disk image partition. It is evaluated once the image has been
-populated with INPUTS-TO-COPY. It can be used to provide additional files,
-such as /etc files."
+the image."
(mlet %store-monad
((graph (sequence %store-monad (map input->name+output inputs))))
(expression->derivation-in-linux-vm
@@ -241,8 +235,7 @@ such as /etc files."
#:copy-closures? #$copy-inputs?
#:register-closures? #$register-closures?
#:disk-image-size #$disk-image-size
- #:file-system-type #$file-system-type
- #:directives '#$populate)
+ #:file-system-type #$file-system-type)
(reboot))))
#:system system
#:make-disk-image? #t
@@ -254,39 +247,6 @@ such as /etc files."
;;; Stand-alone VM image.
;;;
-(define (operating-system-build-gid os)
- "Return as a monadic value the group id for build users of OS, or #f."
- (mlet %store-monad ((services (operating-system-services os)))
- (return (any (lambda (service)
- (and (equal? '(guix-daemon)
- (service-provision service))
- (match (service-user-groups service)
- ((group)
- (user-group-id group)))))
- services))))
-
-(define (operating-system-default-contents os)
- "Return a list of directives suitable for 'system-qemu-image' describing the
-basic contents of the root file system of OS."
- (mlet* %store-monad ((os-drv (operating-system-derivation os))
- (build-gid (operating-system-build-gid os))
- (profile (operating-system-profile os)))
- (return #~((directory #$(%store-prefix) 0 #$(or build-gid 0))
- (directory "/etc")
- (directory "/var/log") ; for dmd
- (directory "/var/run/nscd")
- (directory "/var/guix/gcroots")
- ("/var/guix/gcroots/system" -> #$os-drv)
- (directory "/run")
- ("/run/current-system" -> #$profile)
- (directory "/bin")
- ("/bin/sh" -> "/run/current-system/bin/bash")
- (directory "/tmp")
- (directory "/var/guix/profiles/per-user/root" 0 0)
-
- (directory "/root" 0 0) ; an exception
- (directory "/home" 0 0)))))
-
(define* (system-qemu-image os
#:key
(file-system-type "ext4")
@@ -312,14 +272,12 @@ of the GNU system as described by OS."
file-systems-to-keep)))))
(mlet* %store-monad
((os-drv (operating-system-derivation os))
- (os-dir -> (derivation->output-path os-drv))
- (grub.cfg -> (string-append os-dir "/grub.cfg"))
- (populate (operating-system-default-contents os)))
+ (grub.cfg (operating-system-grub.cfg os)))
(qemu-image #:grub-configuration grub.cfg
- #:populate populate
#:disk-image-size disk-image-size
#:file-system-type file-system-type
- #:inputs `(("system" ,os-drv))
+ #:inputs `(("system" ,os-drv)
+ ("grub.cfg" ,grub.cfg))
#:copy-inputs? #t))))
(define (virtualized-operating-system os)
@@ -356,11 +314,8 @@ environment with the store shared with the host."
with the host."
(mlet* %store-monad
((os-drv (operating-system-derivation os))
- (os-dir -> (derivation->output-path os-drv))
- (grub.cfg -> (string-append os-dir "/grub.cfg"))
- (populate (operating-system-default-contents os)))
+ (grub.cfg (operating-system-grub.cfg os)))
(qemu-image #:grub-configuration grub.cfg
- #:populate populate
#:disk-image-size disk-image-size
#:inputs `(("system" ,os-drv))
@@ -390,7 +345,7 @@ exec " #$qemu "/bin/qemu-system-x86_64 -enable-kvm -no-reboot -net nic,model=vir
-kernel " #$(operating-system-kernel os) "/bzImage \
-initrd " #$os-drv "/initrd \
-append \"" #$(if graphic? "" "console=ttyS0 ")
- "--load=" #$os-drv "/boot --root=/dev/vda1\" \
+ "--system=" #$os-drv " --load=" #$os-drv "/boot --root=/dev/vda1\" \
-serial stdio \
-drive file=" #$image
",if=virtio,cache=writeback,werror=report,readonly\n")
generated by cgit v1.2.3 (git 2.45.0) at 2024-12-02 06:35:42 +0000