diff options
Diffstat (limited to 'gnu/system.scm')
| -rw-r--r-- | gnu/system.scm | 24 |
1 files changed, 14 insertions, 10 deletions
diff --git a/gnu/system.scm b/gnu/system.scm index c26d27028b0..85a596ddb98 100644 --- a/gnu/system.scm +++ b/gnu/system.scm | |||
| @@ -257,11 +257,9 @@ from the initrd." | |||
| 257 | (define* (operating-system-directory-base-entries os #:key container?) | 257 | (define* (operating-system-directory-base-entries os #:key container?) |
| 258 | "Return the basic entries of the 'system' directory of OS for use as the | 258 | "Return the basic entries of the 'system' directory of OS for use as the |
| 259 | value of the SYSTEM-SERVICE-TYPE service." | 259 | value of the SYSTEM-SERVICE-TYPE service." |
| 260 | (mlet* %store-monad ((profile (operating-system-profile os)) | 260 | (mlet %store-monad ((locale (operating-system-locale-directory os))) |
| 261 | (locale (operating-system-locale-directory os))) | ||
| 262 | (if container? | 261 | (if container? |
| 263 | (return `(("profile" ,profile) | 262 | (return `(("locale" ,locale))) |
| 264 | ("locale" ,locale))) | ||
| 265 | (mlet %store-monad | 263 | (mlet %store-monad |
| 266 | ((kernel -> (operating-system-kernel os)) | 264 | ((kernel -> (operating-system-kernel os)) |
| 267 | (initrd (operating-system-initrd-file os)) | 265 | (initrd (operating-system-initrd-file os)) |
| @@ -269,7 +267,6 @@ value of the SYSTEM-SERVICE-TYPE service." | |||
| 269 | (return `(("kernel" ,kernel) | 267 | (return `(("kernel" ,kernel) |
| 270 | ("parameters" ,params) | 268 | ("parameters" ,params) |
| 271 | ("initrd" ,initrd) | 269 | ("initrd" ,initrd) |
| 272 | ("profile" ,profile) | ||
| 273 | ("locale" ,locale))))))) ;used by libc | 270 | ("locale" ,locale))))))) ;used by libc |
| 274 | 271 | ||
| 275 | (define* (essential-services os #:key container?) | 272 | (define* (essential-services os #:key container?) |
| @@ -305,6 +302,8 @@ a container or that of a \"bare metal\" system." | |||
| 305 | host-name procs root-fs unmount | 302 | host-name procs root-fs unmount |
| 306 | (service setuid-program-service-type | 303 | (service setuid-program-service-type |
| 307 | (operating-system-setuid-programs os)) | 304 | (operating-system-setuid-programs os)) |
| 305 | (service profile-service-type | ||
| 306 | (operating-system-packages os)) | ||
| 308 | (append other-fs mappings swaps | 307 | (append other-fs mappings swaps |
| 309 | 308 | ||
| 310 | ;; Add the firmware service, unless we are building for a | 309 | ;; Add the firmware service, unless we are building for a |
| @@ -534,11 +533,6 @@ fi\n"))) | |||
| 534 | #$(operating-system-timezone os))) | 533 | #$(operating-system-timezone os))) |
| 535 | ("sudoers" ,(operating-system-sudoers-file os)))))) | 534 | ("sudoers" ,(operating-system-sudoers-file os)))))) |
| 536 | 535 | ||
| 537 | (define (operating-system-profile os) | ||
| 538 | "Return a derivation that builds the system profile of OS." | ||
| 539 | (profile-derivation (manifest (map package->manifest-entry | ||
| 540 | (operating-system-packages os))))) | ||
| 541 | |||
| 542 | (define %root-account | 536 | (define %root-account |
| 543 | ;; Default root account. | 537 | ;; Default root account. |
| 544 | (user-account | 538 | (user-account |
| @@ -639,6 +633,16 @@ hardware-related operations as necessary when booting a Linux container." | |||
| 639 | ;; SYSTEM contains the derivation as a monadic value. | 633 | ;; SYSTEM contains the derivation as a monadic value. |
| 640 | (service-parameters system))) | 634 | (service-parameters system))) |
| 641 | 635 | ||
| 636 | (define* (operating-system-profile os #:key container?) | ||
| 637 | "Return a derivation that builds the system profile of OS." | ||
| 638 | (mlet* %store-monad | ||
| 639 | ((services -> (operating-system-services os #:container? container?)) | ||
| 640 | (profile (fold-services services | ||
| 641 | #:target-type profile-service-type))) | ||
| 642 | (match profile | ||
| 643 | (("profile" profile) | ||
| 644 | (return profile))))) | ||
| 645 | |||
| 642 | (define (operating-system-root-file-system os) | 646 | (define (operating-system-root-file-system os) |
| 643 | "Return the root file system of OS." | 647 | "Return the root file system of OS." |
| 644 | (find (match-lambda | 648 | (find (match-lambda |
