services: Add 'profile-service-type'.
* gnu/services.scm (packages->profile-entry): New procedure. (profile-service-type): New variable. * gnu/system.scm (operating-system-directory-base-entries): Remove the "profile" entry. (essential-services): Add a PROFILE-SERVICE-TYPE instance. (operating-system-profile): Rewrite in terms of 'fold-services'. * doc/guix.texi (Service Reference): Add 'profile-service-type'. * doc/images/service-graph.dot: Likewise.master
Ludovic Courtès
parent
d62e201cfd
commit
af4c3fd5e3
|
|
@ -7899,6 +7899,12 @@ executable file names, passed as gexps, and adds them to the set of
|
|||
setuid-root programs on the system (@pxref{Setuid Programs}).
|
||||
@end defvr
|
||||
|
||||
@defvr {Scheme Variable} profile-service-type
|
||||
Type of the service that populates the @dfn{system profile}---i.e., the
|
||||
programs under @file{/run/current-system/profile}. Other services can
|
||||
extend it by passing it lists of packages to add to the system profile.
|
||||
@end defvr
|
||||
|
||||
|
||||
@node dmd Services
|
||||
@subsubsection dmd Services
|
||||
|
|
|
|||
|
|
@ -2,6 +2,7 @@ digraph "Service Type Dependencies" {
|
|||
dmd [shape = box, fontname = Helvetica];
|
||||
pam [shape = box, fontname = Helvetica];
|
||||
etc [shape = box, fontname = Helvetica];
|
||||
profile [shape = box, fontname = Helvetica];
|
||||
accounts [shape = box, fontname = Helvetica];
|
||||
activation [shape = box, fontname = Helvetica];
|
||||
boot [shape = box, fontname = Helvetica];
|
||||
|
|
@ -35,4 +36,5 @@ digraph "Service Type Dependencies" {
|
|||
guix -> accounts;
|
||||
boot -> system;
|
||||
etc -> system;
|
||||
profile -> system;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -21,6 +21,7 @@
|
|||
#:use-module (guix monads)
|
||||
#:use-module (guix store)
|
||||
#:use-module (guix records)
|
||||
#:use-module (guix profiles)
|
||||
#:use-module (guix sets)
|
||||
#:use-module (guix ui)
|
||||
#:use-module (gnu packages base)
|
||||
|
|
@ -68,6 +69,7 @@
|
|||
etc-service-type
|
||||
etc-directory
|
||||
setuid-program-service-type
|
||||
profile-service-type
|
||||
firmware-service-type
|
||||
|
||||
%boot-service
|
||||
|
|
@ -414,6 +416,23 @@ FILES must be a list of name/file-like object pairs."
|
|||
(compose concatenate)
|
||||
(extend append)))
|
||||
|
||||
(define (packages->profile-entry packages)
|
||||
"Return a system entry for the profile containing PACKAGES."
|
||||
(mlet %store-monad ((profile (profile-derivation
|
||||
(manifest (map package->manifest-entry
|
||||
(delete-duplicates packages eq?))))))
|
||||
(return `(("profile" ,profile)))))
|
||||
|
||||
(define profile-service-type
|
||||
;; The service that populates the system's profile---i.e.,
|
||||
;; /run/current-system/profile. It is extended by package lists.
|
||||
(service-type (name 'profile)
|
||||
(extensions
|
||||
(list (service-extension system-service-type
|
||||
packages->profile-entry)))
|
||||
(compose concatenate)
|
||||
(extend append)))
|
||||
|
||||
(define (firmware->activation-gexp firmware)
|
||||
"Return a gexp to make the packages listed in FIRMWARE loadable by the
|
||||
kernel."
|
||||
|
|
|
|||
|
|
@ -257,11 +257,9 @@ from the initrd."
|
|||
(define* (operating-system-directory-base-entries os #:key container?)
|
||||
"Return the basic entries of the 'system' directory of OS for use as the
|
||||
value of the SYSTEM-SERVICE-TYPE service."
|
||||
(mlet* %store-monad ((profile (operating-system-profile os))
|
||||
(locale (operating-system-locale-directory os)))
|
||||
(mlet %store-monad ((locale (operating-system-locale-directory os)))
|
||||
(if container?
|
||||
(return `(("profile" ,profile)
|
||||
("locale" ,locale)))
|
||||
(return `(("locale" ,locale)))
|
||||
(mlet %store-monad
|
||||
((kernel -> (operating-system-kernel os))
|
||||
(initrd (operating-system-initrd-file os))
|
||||
|
|
@ -269,7 +267,6 @@ value of the SYSTEM-SERVICE-TYPE service."
|
|||
(return `(("kernel" ,kernel)
|
||||
("parameters" ,params)
|
||||
("initrd" ,initrd)
|
||||
("profile" ,profile)
|
||||
("locale" ,locale))))))) ;used by libc
|
||||
|
||||
(define* (essential-services os #:key container?)
|
||||
|
|
@ -305,6 +302,8 @@ a container or that of a \"bare metal\" system."
|
|||
host-name procs root-fs unmount
|
||||
(service setuid-program-service-type
|
||||
(operating-system-setuid-programs os))
|
||||
(service profile-service-type
|
||||
(operating-system-packages os))
|
||||
(append other-fs mappings swaps
|
||||
|
||||
;; Add the firmware service, unless we are building for a
|
||||
|
|
@ -534,11 +533,6 @@ fi\n")))
|
|||
#$(operating-system-timezone os)))
|
||||
("sudoers" ,(operating-system-sudoers-file os))))))
|
||||
|
||||
(define (operating-system-profile os)
|
||||
"Return a derivation that builds the system profile of OS."
|
||||
(profile-derivation (manifest (map package->manifest-entry
|
||||
(operating-system-packages os)))))
|
||||
|
||||
(define %root-account
|
||||
;; Default root account.
|
||||
(user-account
|
||||
|
|
@ -639,6 +633,16 @@ hardware-related operations as necessary when booting a Linux container."
|
|||
;; SYSTEM contains the derivation as a monadic value.
|
||||
(service-parameters system)))
|
||||
|
||||
(define* (operating-system-profile os #:key container?)
|
||||
"Return a derivation that builds the system profile of OS."
|
||||
(mlet* %store-monad
|
||||
((services -> (operating-system-services os #:container? container?))
|
||||
(profile (fold-services services
|
||||
#:target-type profile-service-type)))
|
||||
(match profile
|
||||
(("profile" profile)
|
||||
(return profile)))))
|
||||
|
||||
(define (operating-system-root-file-system os)
|
||||
"Return the root file system of OS."
|
||||
(find (match-lambda
|
||||
|
|
|
|||
Reference in New Issue