~ruther/guix-local

f6a9d0484c6cdd1554f6ce0e7372ec8b7f2a52ca — Ludovic Courtès 12 years ago 92cb2e2
gnu: vm: Add /run/current-system and /bin/sh.

* gnu/system/vm.scm (operating-system-default-contents): Populate
  /run/current-system and create /bin/sh.
* gnu/system.scm (operating-system-profile-derivation,
  operating-system-profile-directory): New procedures.
  (operating-system-derivation): Use it.
2 files changed, 22 insertions(+), 8 deletions(-)

M gnu/system.scm
M gnu/system/vm.scm
M gnu/system.scm => gnu/system.scm +13 -4
@@ 49,6 49,7 @@
            operating-system-locale
            operating-system-services

            operating-system-profile-directory
            operating-system-derivation))

;;; Commentary:


@@ 284,6 285,17 @@ alias ll='ls -l'
                           ("pam.d" ,pam.d))
                #:name "etc")))

(define (operating-system-profile-derivation os)
  "Return a derivation that builds the default profile of OS."
  ;; TODO: Replace with a real profile with a manifest.
  (union (operating-system-packages os)
         #:name "default-profile"))

(define (operating-system-profile-directory os)
  "Return the directory name of the default profile of OS."
  (mlet %store-monad ((drv (operating-system-profile-derivation os)))
    (return (derivation->output-path drv))))

(define (operating-system-derivation os)
  "Return a derivation that builds OS."
  (mlet* %store-monad


@@ 310,11 322,8 @@ alias ll='ls -l'
                                              services))))
       (groups   -> (append (operating-system-groups os)
                            (append-map service-user-groups services)))
       (packages -> (operating-system-packages os))

       ;; TODO: Replace with a real profile with a manifest.
       (profile-drv (union packages
                           #:name "default-profile"))
       (profile-drv (operating-system-profile-derivation os))
       (profile ->  (derivation->output-path profile-drv))
       (etc-drv     (etc-directory #:accounts accounts #:groups groups
                                   #:pam-services pam-services

M gnu/system/vm.scm => gnu/system/vm.scm +9 -4
@@ 458,15 458,20 @@ such as /etc files."
(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))
                       (os-dir      -> (derivation->output-path os-drv))
                       (build-user-gid (operating-system-build-gid os)))
    (return `((directory "/nix/store" 0 ,(or build-user-gid 0))
  (mlet* %store-monad ((os-drv    (operating-system-derivation os))
                       (os-dir -> (derivation->output-path os-drv))
                       (build-gid (operating-system-build-gid os))
                       (profile   (operating-system-profile-directory os)))
    (return `((directory "/nix/store" 0 ,(or build-gid 0))
              (directory "/etc")
              (directory "/var/log")                     ; for dmd
              (directory "/var/run/nscd")
              (directory "/var/nix/gcroots")
              ("/var/nix/gcroots/system" -> ,os-dir)
              (directory "/run")
              ("/run/current-system" -> ,profile)
              (directory "/bin")
              ("/bin/sh" -> "/run/current-system/bin/sh")
              (directory "/tmp")
              (directory "/var/nix/profiles/per-user/root" 0 0)
              (directory "/var/nix/profiles/per-user/guest"