03/03: system: 'hosts-file' is now a file-like object.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit 24e02c28fbf2b0efbc2fd6cdcd770037a6cff7e3
Author: Ludovic Courtès <address@hidden>
Date:   Fri Jun 5 22:41:55 2015 +0200

    system: 'hosts-file' is now a file-like object.
    
    Partly fixes <http://bugs.gnu.org/20720>.
    Reported by Alex Kost <address@hidden>.
    
    * gnu/system.scm (default-/etc/hosts): Change 'text-file' to 'plain-file'.
      (maybe-file->monadic): New procedure.
      (operating-system-etc-directory): Use it.
    * doc/guix.texi (operating-system Reference, Networking Services): Adjust
      accordingly.
---
 doc/guix.texi  |   10 +++++-----
 gnu/system.scm |   26 ++++++++++++++++++++++----
 2 files changed, 27 insertions(+), 9 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index ecdfa1b..f8da9c1 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -4480,9 +4480,9 @@ The host name.
 
 @item @code{hosts-file}
 @cindex hosts file
-A zero-argument monadic procedure that returns a text file for use as
+A file-like object (@pxref{G-Expressions, file-like objects}) for use as
 @file{/etc/hosts} (@pxref{Host Names,,, libc, The GNU C Library
-Reference Manual}).  The default is to produce a file with entries for
+Reference Manual}).  The default is a file with entries for
 @code{localhost} and @var{host-name}.
 
 @item @code{mapped-devices} (default: @code{'()})
@@ -5299,9 +5299,9 @@ This variable is typically used in the @code{hosts-file} 
field of an
   (hosts-file
     ;; Create a /etc/hosts file with aliases for "localhost"
     ;; and "mymachine", as well as for Facebook servers.
-    (text-file "hosts"
-               (string-append (local-host-aliases host-name)
-                              %facebook-host-aliases))))
+    (plain-file "hosts"
+                (string-append (local-host-aliases host-name)
+                               %facebook-host-aliases))))
 @end example
 
 This mechanism can prevent programs running locally, such as Web
diff --git a/gnu/system.scm b/gnu/system.scm
index ede0a6f..92ed454 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -110,7 +110,7 @@
             (default %base-firmware))
 
   (host-name operating-system-host-name)          ; string
-  (hosts-file operating-system-hosts-file         ; M item | #f
+  (hosts-file operating-system-hosts-file         ; file-like | #f
               (default #f))
 
   (mapped-devices operating-system-mapped-devices ; list of <mapped-device>
@@ -374,7 +374,7 @@ This is the GNU system.  Welcome.\n")
 
 (define (default-/etc/hosts host-name)
   "Return the default /etc/hosts file."
-  (text-file "hosts" (local-host-aliases host-name)))
+  (plain-file "hosts" (local-host-aliases host-name)))
 
 (define (emacs-site-file)
   "Return the Emacs 'site-start.el' file.  That file contains the necessary
@@ -585,6 +585,22 @@ use 'plain-file' instead~%")
     (x
      x)))
 
+(define (maybe-file->monadic file-name thing)
+  "If THING is a value in %STORE-MONAD, return it as is; otherwise return
+THING in the %STORE-MONAD.
+
+This is for backward-compatibility of fields that used to be monadic values
+and are now file-like objects."
+  (with-monad %store-monad
+    (match thing
+      ((? procedure?)
+       (warning (_ "using a monadic value for '~a' is deprecated; \
+use 'plain-file' instead~%")
+                file-name)
+       thing)
+      (x
+       (return x)))))
+
 (define (operating-system-etc-directory os)
   "Return that static part of the /etc directory of OS."
   (mlet* %store-monad
@@ -595,8 +611,10 @@ use 'plain-file' instead~%")
                              (append-map service-pam-services services)))
        (profile-drv (operating-system-profile os))
        (skeletons   (operating-system-skeletons os))
-       (/etc/hosts  (or (operating-system-hosts-file os)
-                        (default-/etc/hosts (operating-system-host-name os))))
+       (/etc/hosts  (maybe-file->monadic
+                     "hosts"
+                     (or (operating-system-hosts-file os)
+                         (default-/etc/hosts (operating-system-host-name 
os)))))
        (shells      (user-shells os)))
    (etc-directory #:pam-services pam-services
                   #:skeletons skeletons