~ruther/guix-local

2a13d05e459946d4989e08461233d7f147f029f5 — Ludovic Courtès 11 years ago 715fc9d
system: Add support for swap devices.

* gnu/services/base.scm (swap-service): New procedure.
* gnu/system.scm (<operating-system>)[swap-devices]: New field.
  (swap-services): New procedure.
  (essential-services): Use it.
2 files changed, 31 insertions(+), 1 deletions(-)

M gnu/services/base.scm
M gnu/system.scm
M gnu/services/base.scm => gnu/services/base.scm +22 -0
@@ 39,6 39,7 @@
  #:export (root-file-system-service
            file-system-service
            device-mapping-service
            swap-service
            user-processes-service
            host-name-service
            console-font-service


@@ 614,6 615,27 @@ gexp, to open it, and evaluate @var{close} to close it."
             (stop #~(lambda _ (not #$close)))
             (respawn? #f)))))

(define (swap-service device)
  "Return a service that uses @var{device} as a swap device."
  (define requirement
    (if (string-prefix? "/dev/mapper/" device)
        (list (symbol-append 'device-mapping-
                             (string->symbol (basename device))))
        '()))

  (with-monad %store-monad
    (return (service
             (provision (list (symbol-append 'swap- (string->symbol device))))
             (requirement `(udev ,@requirement))
             (documentation "Enable the given swap device.")
             (start #~(lambda ()
                        (swapon #$device)
                        #t))
             (stop #~(lambda _
                       (swapoff #$device)
                       #f))
             (respawn? #f)))))

(define %base-services
  ;; Convenience variable holding the basic services.
  (let ((motd (text-file "motd" "

M gnu/system.scm => gnu/system.scm +9 -1
@@ 105,6 105,8 @@
  (mapped-devices operating-system-mapped-devices ; list of <mapped-device>
                  (default '()))
  (file-systems operating-system-file-systems)    ; list of fs
  (swap-devices operating-system-swap-devices     ; list of strings
                (default '()))

  (users operating-system-users                   ; list of user accounts
         (default '()))


@@ 228,6 230,11 @@ as 'needed-for-boot'."
                                             (close source target))))
                 (operating-system-mapped-devices os))))

(define (swap-services os)
  "Return the list of swap services for OS as a monadic list."
  (sequence %store-monad
            (map swap-service (operating-system-swap-devices os))))

(define (essential-services os)
  "Return the list of essential services for OS.  These are special services
that implement part of what's declared in OS are responsible for low-level


@@ 235,13 242,14 @@ bookkeeping."
  (mlet* %store-monad ((mappings  (device-mapping-services os))
                       (root-fs   (root-file-system-service))
                       (other-fs  (other-file-system-services os))
                       (swaps     (swap-services os))
                       (procs     (user-processes-service
                                   (map (compose first service-provision)
                                        other-fs)))
                       (host-name (host-name-service
                                   (operating-system-host-name os))))
    (return (cons* host-name procs root-fs
                   (append other-fs mappings)))))
                   (append other-fs mappings swaps)))))

(define (operating-system-services os)
  "Return all the services of OS, including \"internal\" services that do not