Archived
1
0
Fork 0

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

* 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

View file

@ -38,6 +38,7 @@
#:use-module (ice-9 format) #:use-module (ice-9 format)
#:export (root-file-system-service #:export (root-file-system-service
file-system-service file-system-service
user-unmount-service
device-mapping-service device-mapping-service
swap-service swap-service
user-processes-service user-processes-service
@ -145,6 +146,33 @@ names such as device-mapping services."
(umount #$target) (umount #$target)
#f)))))) #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 (define %do-not-kill-file
;; Name of the file listing PIDs of processes that must survive when halting ;; Name of the file listing PIDs of processes that must survive when halting
;; the system. Typical example is user-space file systems. ;; the system. Typical example is user-space file systems.

View file

@ -269,16 +269,20 @@ from the initrd."
"Return the list of essential services for OS. These are special services "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 that implement part of what's declared in OS are responsible for low-level
bookkeeping." bookkeeping."
(define known-fs
(map file-system-mount-point (operating-system-file-systems os)))
(mlet* %store-monad ((mappings (device-mapping-services os)) (mlet* %store-monad ((mappings (device-mapping-services os))
(root-fs (root-file-system-service)) (root-fs (root-file-system-service))
(other-fs (other-file-system-services os)) (other-fs (other-file-system-services os))
(unmount (user-unmount-service known-fs))
(swaps (swap-services os)) (swaps (swap-services os))
(procs (user-processes-service (procs (user-processes-service
(map (compose first service-provision) (map (compose first service-provision)
other-fs))) other-fs)))
(host-name (host-name-service (host-name (host-name-service
(operating-system-host-name os)))) (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))))) (append other-fs mappings swaps)))))
(define (operating-system-services os) (define (operating-system-services os)

View file

@ -112,7 +112,9 @@ the given target.")
(stop #~(lambda (target) (stop #~(lambda (target)
;; Delete the temporary directory, but leave everything ;; Delete the temporary directory, but leave everything
;; mounted as there may still be processes using it ;; 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 (delete-file-recursively
(string-append target #$%backing-directory)))))))) (string-append target #$%backing-directory))))))))