linux-initrd: Delete files from the initrd ramfs when switching roots.

* guix/build/linux-initrd.scm (switch-root): Delete file from the old
  root.  Chdir to / after 'chroot' call.  Re-open file descriptors 0, 1,
  and 2.
  (boot-system): Move 'loading' message after the 'switch-root' call.
* gnu/system.scm (operating-system-boot-script): Add loop that closes
  file descriptor before calling 'execl'.

2 files changed, 54 insertions, 3 deletions

diff --git a/gnu/system.scm b/gnu/system.scm
index 65d1ca3418..8a5fe47b30 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -334,6 +334,15 @@ we're running in the final root."
                     ;; Activate setuid programs.
                     (activate-setuid-programs (list #$@setuid-progs))
 
+                    ;; Close any remaining open file descriptors to be on the
+                    ;; safe side.  This must be the very last thing we do,
+                    ;; because Guile has internal FDs such as 'sleep_pipe'
+                    ;; that need to be alive.
+                    (let loop ((fd 3))
+                      (when (< fd 1024)
+                        (false-if-exception (close-fdes fd))
+                        (loop (+ 1 fd))))
+
                     ;; Start dmd.
                     (execl (string-append #$dmd "/bin/dmd")
                            "dmd" "--config" #$dmd-conf)))))
diff --git a/guix/build/linux-initrd.scm b/guix/build/linux-initrd.scm
index b133550bca..c09cdeafb4 100644
--- a/guix/build/linux-initrd.scm
+++ b/guix/build/linux-initrd.scm
@@ -286,9 +286,51 @@ run a file system check."
 util-linux' switch_root(8) does."
   (move-essential-file-systems root)
   (chdir root)
-  ;; TODO: Delete files from the old root.
+
+  ;; Since we're about to 'rm -rf /', try to make sure we're on an initrd.
+  ;; TODO: Use 'statfs' to check the fs type, like klibc does.
+  (when (or (not (file-exists? "/init")) (directory-exists? "/home"))
+    (format (current-error-port)
+            "The root file system is probably not an initrd; \
+bailing out.~%root contents: ~s~%" (scandir "/"))
+    (force-output (current-error-port))
+    (exit 1))
+
+  ;; Delete files from the old root, without crossing mount points (assuming
+  ;; there are no mount points in sub-directories.)  That means we're leaving
+  ;; the empty ROOT directory behind us, but that's OK.
+  (let ((root-device (stat:dev (stat "/"))))
+    (for-each (lambda (file)
+                (unless (member file '("." ".."))
+                  (let* ((file   (string-append "/" file))
+                         (device (stat:dev (lstat file))))
+                    (when (= device root-device)
+                      (delete-file-recursively file)))))
+              (scandir "/")))
+
+  ;; Make ROOT the new root.
   (mount root "/" "" MS_MOVE)
-  (chroot "."))
+  (chroot ".")
+  (chdir "/")
+
+  (when (file-exists? "/dev/console")
+    ;; Close the standard file descriptors since they refer to the old
+    ;; /dev/console.
+    (for-each close-fdes '(0 1 2))
+
+    ;; Reopen them.
+    (let ((in  (open-file "/dev/console" "rbl"))
+          (out (open-file "/dev/console" "wbl")))
+      (dup2 (fileno in) 0)
+      (dup2 (fileno out) 1)
+      (dup2 (fileno out) 2)
+
+      ;; Safely close IN and OUT.
+      (for-each (lambda (port)
+                  (if (memv (fileno port) '(0 1 2))
+                      (set-port-revealed! port 1)
+                      (close-port port)))
+                (list in out)))))
 
 (define* (boot-system #:key
                       (linux-modules '())
@@ -393,8 +435,8 @@ to it are lost."
 
     (if to-load
         (begin
-          (format #t "loading '~a'...\n" to-load)
           (switch-root "/root")
+          (format #t "loading '~a'...\n" to-load)
 
           ;; Obviously this has to be done each time we boot.  Do it from here
           ;; so that statfs(2) returns DEVPTS_SUPER_MAGIC like libc's getpt(3)