02/04: services: cleanup-service: Catch 'system-error' instead of everything.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit 3c4c8c3e06cb50724942780fd6f240a7c1891261
Author: Ludovic Courtès <address@hidden>
Date:   Wed Jan 6 14:49:48 2016 +0100

    services: cleanup-service: Catch 'system-error' instead of everything.
    
    This makes sure that critical errors such as unbound-variable do not go
    undetected.
    
    * gnu/services.scm (cleanup-gexp): Introduce local 'fail-safe' macro and
    use it.  Remove uses of 'false-if-exception'.
---
 gnu/services.scm |   23 +++++++++++++++++------
 1 files changed, 17 insertions(+), 6 deletions(-)

diff --git a/gnu/services.scm b/gnu/services.scm
index 27a4883..f302816 100644
--- a/gnu/services.scm
+++ b/gnu/services.scm
@@ -255,12 +255,23 @@ boot."
                 ;; XXX This needs to happen before service activations, so it
                 ;; has to be here, but this also implicitly assumes that /tmp
                 ;; and /var/run are on the root partition.
-                (false-if-exception (delete-file-recursively "/tmp"))
-                (false-if-exception (delete-file-recursively "/var/run"))
-                (false-if-exception (mkdir "/tmp"))
-                (false-if-exception (chmod "/tmp" #o1777))
-                (false-if-exception (mkdir "/var/run"))
-                (false-if-exception (chmod "/var/run" #o755))))))
+                (letrec-syntax ((fail-safe (syntax-rules ()
+                                             ((_ exp rest ...)
+                                              (begin
+                                                (catch 'system-error
+                                                  (lambda () exp)
+                                                  (const #f))
+                                                (fail-safe rest ...)))
+                                             ((_)
+                                              #t))))
+                  ;; Ignore I/O errors so the system can boot.
+                  (fail-safe
+                   (delete-file-recursively "/tmp")
+                   (delete-file-recursively "/var/run")
+                   (mkdir "/tmp")
+                   (chmod "/tmp" #o1777)
+                   (mkdir "/var/run")
+                   (chmod "/var/run" #o755)))))))
 
 (define cleanup-service-type
   ;; Service that cleans things up in /tmp and similar.