ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-23 21:17:11 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

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

Browse source 
* 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 @@ (define builder
#:guile-for-build guile
#:local-build? #t)))
(define* (file-union files
#:key (inputs '()) (name "file-union"))
(define* (file-union name files)
"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
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
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))))
(gexp->derivation name builder))
(define* (etc-directory #:key
(locale "C") (timezone "Europe/Paris")
@ -200,10 +177,7 @@ (define* (etc-directory #:key
(profile "/var/run/current-system/profile"))
"Return a derivation that builds the static part of the /etc directory."
(mlet* %store-monad
((services (package-file net-base "etc/services"))
(protocols (package-file net-base "etc/protocols"))
(rpc (package-file net-base "etc/rpc"))
(passwd (passwd-file accounts))
((passwd (passwd-file accounts))
(shadow (passwd-file accounts #:shadow? #t))
(group (group-file groups))
(pam.d (pam-services->directory pam-services))
@ -236,30 +210,21 @@ (define* (etc-directory #:key
export LIBRARY_PATH=$HOME/.guix-profile/lib:" profile "/lib
alias ls='ls -p --color'
alias ll='ls -l'
"))
(tz-file (package-file tzdata
(string-append "share/zoneinfo/" timezone)))
(files -> `(("services" ,services)
("protocols" ,protocols)
("rpc" ,rpc)
("pam.d" ,(derivation->output-path pam.d))
("login.defs" ,login.defs)
("issue" ,issue)
("shells" ,shells)
("profile" ,(derivation->output-path bashrc))
("localtime" ,tz-file)
("passwd" ,(derivation->output-path passwd))
("shadow" ,(derivation->output-path shadow))
("group" ,group))))
(file-union files
#:inputs `(("net" ,net-base)
("pam.d" ,pam.d)
("passwd" ,passwd)
("shadow" ,shadow)
("bashrc" ,bashrc)
("tzdata" ,tzdata))
#:name "etc")))
")))
(file-union "etc"
`(("services" ,#~(string-append #$net-base "/etc/services"))
("protocols" ,#~(string-append #$net-base "/etc/protocols"))
("rpc" ,#~(string-append #$net-base "/etc/rpc"))
("pam.d" ,#~#$pam.d)
("login.defs" ,#~#$login.defs)
("issue" ,#~#$issue)
("shells" ,#~#$shells)
("profile" ,#~#$bashrc)
("localtime" ,#~(string-append #$tzdata "/share/zoneinfo/"
#$timezone))
("passwd" ,#~#$passwd)
("shadow" ,#~#$shadow)
("group" ,#~#$group)))))
(define (operating-system-profile os)
"Return a derivation that builds the default profile of OS."
@ -314,15 +279,12 @@ (define (operating-system-boot-script os)
(define (operating-system-derivation os)
"Return a derivation that builds OS."
(mlet* %store-monad
((profile-drv (operating-system-profile os))
(profile -> (derivation->output-path profile-drv))
(etc-drv (operating-system-etc-directory os))
(etc -> (derivation->output-path etc-drv))
((profile (operating-system-profile os))
(etc (operating-system-etc-directory os))
(services (sequence %store-monad (operating-system-services os)))
(boot-drv (operating-system-boot-script os))
(boot -> (derivation->output-path boot-drv))
(kernel -> (operating-system-kernel os))
(kernel-dir (package-file kernel))
(initrd (operating-system-initrd os))
(initrd-file -> (string-append (derivation->output-path initrd)
"/initrd"))
@ -336,18 +298,12 @@ (define (operating-system-derivation os)
,(string-append "--load=" boot)))
(initrd initrd-file))))
(grub.cfg (grub-configuration-file entries)))
(file-union `(("boot" ,boot)
("kernel" ,kernel-dir)
("initrd" ,initrd-file)
("profile" ,profile)
("grub.cfg" ,grub.cfg)
("etc" ,etc))
#:inputs `(("boot" ,boot-drv)
("kernel" ,kernel)
("initrd" ,initrd)
("bash" ,bash)
("profile" ,profile-drv)
("etc" ,etc-drv))
#:name "system")))
(file-union "system"
`(("boot" ,#~#$boot-drv)
("kernel" ,#~#$kernel)
("initrd" ,#~(string-append #$initrd "/initrd"))
("profile" ,#~#$profile)
("grub.cfg" ,#~#$grub.cfg)
("etc" ,#~#$etc)))))
;;; system.scm ends here