Browse Source

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.
gn-latest-20200428
Ludovic Courtès 6 years ago
parent
commit
af4c3fd5e3
  1. 6
      doc/guix.texi
  2. 2
      doc/images/service-graph.dot
  3. 19
      gnu/services.scm
  4. 24
      gnu/system.scm

6
doc/guix.texi

@ -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
doc/images/service-graph.dot

@ -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;
}

19
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."

24
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

Loading…
Cancel
Save