diff options
Diffstat (limited to 'gnu')
| -rw-r--r-- | gnu/services.scm | 19 | ||||
| -rw-r--r-- | gnu/system.scm | 24 |
2 files changed, 33 insertions, 10 deletions
diff --git a/gnu/services.scm b/gnu/services.scm index 8a66d453df..0e1c74bda8 100644 --- a/gnu/services.scm +++ b/gnu/services.scm @@ -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." diff --git a/gnu/system.scm b/gnu/system.scm index c26d27028b..85a596ddb9 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -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 |