08/17: PRELIMINARY: Add support for hibernation.

[Mark H. Weaver]

mhw pushed a commit to branch reproduce-bug-29774
in repository guix.

commit af8d58efa05927b24694c87379cccc378f3fdde7
Author: Mark H Weaver <address@hidden>
Date:   Sun Aug 14 05:33:12 2016 -0400

    PRELIMINARY: Add support for hibernation.
    
    * gnu/build/linux-boot.scm (boot-system): Look for a resume=<device-name>
    argument on the linux command line, and if present, attempt to resume from
    hibernation.
    * gnu/services/desktop.scm (<elogind-configuration>): Change the default
    value of the 'handle-hibernate-key' key to 'hibernate'.
---
 gnu/build/linux-boot.scm | 50 +++++++++++++++++++++++++++++++++++++++++++++---
 gnu/services/desktop.scm |  6 +-----
 2 files changed, 48 insertions(+), 8 deletions(-)

diff --git a/gnu/build/linux-boot.scm b/gnu/build/linux-boot.scm
index 18d8726..3d2828a 100644
--- a/gnu/build/linux-boot.scm
+++ b/gnu/build/linux-boot.scm
@@ -479,9 +479,10 @@ upon error."
   (call-with-error-handling
    (lambda ()
      (mount-essential-file-systems)
-     (let* ((args    (linux-command-line))
-            (to-load (find-long-option "--load" args))
-            (root    (find-long-option "--root" args)))
+     (let* ((args          (linux-command-line))
+            (to-load       (find-long-option "--load" args))
+            (root          (find-long-option "--root" args))
+            (resume-device (find-long-option "resume" args)))
 
        (when (member "--repl" args)
          (start-repl))
@@ -506,6 +507,49 @@ upon error."
          (unless (pre-mount)
            (error "pre-mount actions failed")))
 
+       ;;
+       ;; Attempt to resume from hibernation.
+       ;;
+       ;; IMPORTANT: This *must* happen before we mount any filesystems on
+       ;; disk.  Quoting linux-libre/Documentation/swsusp.txt:
+       ;; 
+       ;; * BIG FAT WARNING **************************************************
+       ;; *
+       ;; * If you touch anything on disk between suspend and resume...
+       ;; *                            ...kiss your data goodbye.
+       ;; *
+       ;; * If you do resume from initrd after your filesystems are mounted...
+       ;; *                            ...bye bye root partition.
+       ;; *                    [this is actually same case as above]
+       ;; *
+       (when (and resume-device
+                  (file-exists? resume-device)
+                  (file-exists? "/sys/power/resume"))
+         (false-if-exception
+          (let* ((device-base-name
+                  ;; The base name of the device file, after resolving
+                  ;; symlinks.
+                  (let loop ((file resume-device))
+                    (match (stat:type (lstat file))
+                      ('symlink
+                       (let ((target (readlink file)))
+                         (if (string-prefix? "/" target)
+                             (loop target)
+                             (loop (string-append (dirname file) "/" 
target)))))
+                      (_ (basename file)))))
+                 (major+minor
+                  ;; The major:minor string (e.g. "8:2") corresponding
+                  ;; to the resume device.
+                  (call-with-input-file (string-append "/sys/class/block/"
+                                                       device-base-name
+                                                       "/dev")
+                    read-line)))
+            ;; Write the major:minor string to /sys/power/resume
+            ;; to attempt resume from hibernation.
+            (when major+minor
+              (call-with-output-file "/sys/power/resume"
+                (cut display major+minor <>))))))
+
        (if root
            (mount-root-file-system (canonicalize-device-spec root)
                                    root-fs-type
diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm
index 517d5d3..e19c85c 100644
--- a/gnu/services/desktop.scm
+++ b/gnu/services/desktop.scm
@@ -574,11 +574,7 @@ include the @command{udisksctl} command, part of UDisks, 
and GNOME Disks."
   (handle-suspend-key              elogind-handle-suspend-key
                                    (default 'suspend))
   (handle-hibernate-key            elogind-handle-hibernate-key
-                                   ;; (default 'hibernate)
-                                   ;; XXX Ignore it for now, since we don't
-                                   ;; yet handle resume-from-hibernation in
-                                   ;; our initrd.
-                                   (default 'ignore))
+                                   (default 'hibernate))
   (handle-lid-switch               elogind-handle-lid-switch
                                    (default 'suspend))
   (handle-lid-switch-docked        elogind-handle-lid-switch-docked