guix/guix
3
4
Fork 0
mirror of git://git.savannah.gnu.org/guix.git synced 2023-12-14 03:33:07 +01:00
Code Issues Releases Wiki Activity

services: Add 'user-unmount-service' as an essential service.

Browse source 
* gnu/services/base.scm (user-unmount-service): New procedure.
* gnu/system.scm (essential-services): Use it.
* gnu/system/install.scm (cow-store-service): Mention it in comment.
This commit is contained in:
Ludovic Courtès 2014-11-10 22:25:39 +01:00
parent ccea821bef
commit d6e2a622c4
3 changed files with 36 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

28
gnu/services/base.scm
View file

@ -38,6 +38,7 @@
#:use-module (ice-9 format)
#:export (root-file-system-service
file-system-service
user-unmount-service
device-mapping-service
swap-service
user-processes-service
@ -145,6 +146,33 @@ names such as device-mapping services."
(umount #$target)
#f))))))
(define (user-unmount-service known-mount-points)
"Return a service whose sole purpose is to unmount file systems not listed
in KNOWN-MOUNT-POINTS when it is stopped."
(with-monad %store-monad
(return
(service
(documentation "Unmount manually-mounted file systems.")
(provision '(user-unmount))
(start #~(const #t))
(stop #~(lambda args
(define (known? mount-point)
(member mount-point
(cons* "/proc" "/sys"
'#$known-mount-points)))
(for-each (lambda (mount-point)
(format #t "unmounting '~a'...~%" mount-point)
(catch 'system-error
(lambda ()
(umount mount-point))
(lambda args
(let ((errno (system-error-errno args)))
(format #t "failed to unmount '~a': ~a~%"
mount-point (strerror errno))))))
(filter (negate known?) (mount-points)))
#f))))))
(define %do-not-kill-file
;; Name of the file listing PIDs of processes that must survive when halting
;; the system. Typical example is user-space file systems.

6
gnu/system.scm
View file

@ -269,16 +269,20 @@ from the initrd."
"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
bookkeeping."
(define known-fs
(map file-system-mount-point (operating-system-file-systems os)))
(mlet* %store-monad ((mappings (device-mapping-services os))
(root-fs (root-file-system-service))
(other-fs (other-file-system-services os))
(unmount (user-unmount-service known-fs))
(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
(return (cons* host-name procs root-fs unmount
(append other-fs mappings swaps)))))
(define (operating-system-services os)

4
gnu/system/install.scm
View file

@ -112,7 +112,9 @@ the given target.")
(stop #~(lambda (target)
;; Delete the temporary directory, but leave everything
;; mounted as there may still be processes using it
;; since 'user-processes' doesn't depend on us.
;; since 'user-processes' doesn't depend on us. The
;; 'user-unmount' service will unmount TARGET
;; eventually.
(delete-file-recursively
(string-append target #$%backing-directory))))))))