nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

system: Change 'file-union' to use gexps. 

* gnu/system.scm (file-union): Make 'name' the first parameter; remove
  'inputs' parameter.  Rewrite using 'gexp->derivation'.
  (etc-directory): Adjust accordingly.
  (operating-system-derivation): Ditto.
This commit is contained in:
Ludovic Courtès 2014-04-27 16:50:34 +02:00
parent b5f4e68635
commit 23f6056b50
1 changed files with 37 additions and 81 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

118
gnu/system.scm
View File

@ -153,44 +153,21 @@ input tuples."
#:guile-for-build guile #:guile-for-build guile
#:local-build? #t))) #:local-build? #t)))
(define* (file-union files (define* (file-union name files)
#:key (inputs '()) (name "file-union"))
"Return a derivation that builds a directory containing all of FILES. Each "Return a derivation that builds a directory containing all of FILES. Each
item in FILES must be a list where the first element is the file name to use item in FILES must be a list where the first element is the file name to use
in the new directory, and the second element is the target file. in the new directory, and the second element is a gexp denoting the target
file."
(define builder
#~(begin
(mkdir #$output)
(chdir #$output)
#$@(map (match-lambda
((target source)
#~(symlink #$source #$target)))
files)))
The subset of FILES corresponding to plain store files is automatically added (gexp->derivation name builder))
as an inputs; additional inputs, such as derivations, are taken from INPUTS."
(mlet %store-monad ((inputs (lower-inputs inputs)))
(let* ((outputs (append-map (match-lambda
((_ (? derivation? drv))
(list (derivation->output-path drv)))
((_ (? derivation? drv) sub-drv ...)
(map (cut derivation->output-path drv <>)
sub-drv))
(_ '()))
inputs))
(inputs (append inputs
(filter (match-lambda
((_ file)
;; Elements of FILES that are store
;; files and that do not correspond to
;; the output of INPUTS are considered
;; inputs (still here?).
(and (direct-store-path? file)
(not (member file outputs)))))
files))))
(derivation-expression name
`(let ((out (assoc-ref %outputs "out")))
(mkdir out)
(chdir out)
,@(map (match-lambda
((name target)
`(symlink ,target ,name)))
files))
#:inputs inputs
#:local-build? #t))))
(define* (etc-directory #:key (define* (etc-directory #:key
(locale "C") (timezone "Europe/Paris") (locale "C") (timezone "Europe/Paris")
@ -200,10 +177,7 @@ as an inputs; additional inputs, such as derivations, are taken from INPUTS."
(profile "/var/run/current-system/profile")) (profile "/var/run/current-system/profile"))
"Return a derivation that builds the static part of the /etc directory." "Return a derivation that builds the static part of the /etc directory."
(mlet* %store-monad (mlet* %store-monad
((services (package-file net-base "etc/services")) ((passwd (passwd-file accounts))
(protocols (package-file net-base "etc/protocols"))
(rpc (package-file net-base "etc/rpc"))
(passwd (passwd-file accounts))
(shadow (passwd-file accounts #:shadow? #t)) (shadow (passwd-file accounts #:shadow? #t))
(group (group-file groups)) (group (group-file groups))
(pam.d (pam-services->directory pam-services)) (pam.d (pam-services->directory pam-services))
@ -236,30 +210,21 @@ export CPATH=$HOME/.guix-profile/include:" profile "/include
export LIBRARY_PATH=$HOME/.guix-profile/lib:" profile "/lib export LIBRARY_PATH=$HOME/.guix-profile/lib:" profile "/lib
alias ls='ls -p --color' alias ls='ls -p --color'
alias ll='ls -l' alias ll='ls -l'
")) ")))
(file-union "etc"
(tz-file (package-file tzdata `(("services" ,#~(string-append #$net-base "/etc/services"))
(string-append "share/zoneinfo/" timezone))) ("protocols" ,#~(string-append #$net-base "/etc/protocols"))
(files -> `(("services" ,services) ("rpc" ,#~(string-append #$net-base "/etc/rpc"))
("protocols" ,protocols) ("pam.d" ,#~#$pam.d)
("rpc" ,rpc) ("login.defs" ,#~#$login.defs)
("pam.d" ,(derivation->output-path pam.d)) ("issue" ,#~#$issue)
("login.defs" ,login.defs) ("shells" ,#~#$shells)
("issue" ,issue) ("profile" ,#~#$bashrc)
("shells" ,shells) ("localtime" ,#~(string-append #$tzdata "/share/zoneinfo/"
("profile" ,(derivation->output-path bashrc)) #$timezone))
("localtime" ,tz-file) ("passwd" ,#~#$passwd)
("passwd" ,(derivation->output-path passwd)) ("shadow" ,#~#$shadow)
("shadow" ,(derivation->output-path shadow)) ("group" ,#~#$group)))))
("group" ,group))))
(file-union files
#:inputs `(("net" ,net-base)
("pam.d" ,pam.d)
("passwd" ,passwd)
("shadow" ,shadow)
("bashrc" ,bashrc)
("tzdata" ,tzdata))
#:name "etc")))
(define (operating-system-profile os) (define (operating-system-profile os)
"Return a derivation that builds the default profile of OS." "Return a derivation that builds the default profile of OS."
@ -314,15 +279,12 @@ we're running in the final root."
(define (operating-system-derivation os) (define (operating-system-derivation os)
"Return a derivation that builds OS." "Return a derivation that builds OS."
(mlet* %store-monad (mlet* %store-monad
((profile-drv (operating-system-profile os)) ((profile (operating-system-profile os))
(profile -> (derivation->output-path profile-drv)) (etc (operating-system-etc-directory os))
(etc-drv (operating-system-etc-directory os))
(etc -> (derivation->output-path etc-drv))
(services (sequence %store-monad (operating-system-services os))) (services (sequence %store-monad (operating-system-services os)))
(boot-drv (operating-system-boot-script os)) (boot-drv (operating-system-boot-script os))
(boot -> (derivation->output-path boot-drv)) (boot -> (derivation->output-path boot-drv))
(kernel -> (operating-system-kernel os)) (kernel -> (operating-system-kernel os))
(kernel-dir (package-file kernel))
(initrd (operating-system-initrd os)) (initrd (operating-system-initrd os))
(initrd-file -> (string-append (derivation->output-path initrd) (initrd-file -> (string-append (derivation->output-path initrd)
"/initrd")) "/initrd"))
@ -336,18 +298,12 @@ we're running in the final root."
,(string-append "--load=" boot))) ,(string-append "--load=" boot)))
(initrd initrd-file)))) (initrd initrd-file))))
(grub.cfg (grub-configuration-file entries))) (grub.cfg (grub-configuration-file entries)))
(file-union `(("boot" ,boot) (file-union "system"
("kernel" ,kernel-dir) `(("boot" ,#~#$boot-drv)
("initrd" ,initrd-file) ("kernel" ,#~#$kernel)
("profile" ,profile) ("initrd" ,#~(string-append #$initrd "/initrd"))
("grub.cfg" ,grub.cfg) ("profile" ,#~#$profile)
("etc" ,etc)) ("grub.cfg" ,#~#$grub.cfg)
#:inputs `(("boot" ,boot-drv) ("etc" ,#~#$etc)))))
("kernel" ,kernel)
("initrd" ,initrd)
("bash" ,bash)
("profile" ,profile-drv)
("etc" ,etc-drv))
#:name "system")))
;;; system.scm ends here ;;; system.scm ends here