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

Partly fixes <http://bugs.gnu.org/20720>.
Reported by Alex Kost <alezost@gmail.com>.

* 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.
This commit is contained in:
Ludovic Courtès 2015-06-05 22:41:55 +02:00
parent 847658395e
commit 24e02c28fb
2 changed files with 27 additions and 9 deletions

View File

@ -4480,9 +4480,9 @@ The host name.
@item @code{hosts-file} @item @code{hosts-file}
@cindex 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 @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}. @code{localhost} and @var{host-name}.
@item @code{mapped-devices} (default: @code{'()}) @item @code{mapped-devices} (default: @code{'()})
@ -5299,7 +5299,7 @@ This variable is typically used in the @code{hosts-file} field of an
(hosts-file (hosts-file
;; Create a /etc/hosts file with aliases for "localhost" ;; Create a /etc/hosts file with aliases for "localhost"
;; and "mymachine", as well as for Facebook servers. ;; and "mymachine", as well as for Facebook servers.
(text-file "hosts" (plain-file "hosts"
(string-append (local-host-aliases host-name) (string-append (local-host-aliases host-name)
%facebook-host-aliases)))) %facebook-host-aliases))))
@end example @end example

View File

@ -110,7 +110,7 @@
(default %base-firmware)) (default %base-firmware))
(host-name operating-system-host-name) ; string (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)) (default #f))
(mapped-devices operating-system-mapped-devices ; list of <mapped-device> (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) (define (default-/etc/hosts host-name)
"Return the default /etc/hosts file." "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) (define (emacs-site-file)
"Return the Emacs 'site-start.el' file. That file contains the necessary "Return the Emacs 'site-start.el' file. That file contains the necessary
@ -585,6 +585,22 @@ use 'plain-file' instead~%")
(x (x
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) (define (operating-system-etc-directory os)
"Return that static part of the /etc directory of OS." "Return that static part of the /etc directory of OS."
(mlet* %store-monad (mlet* %store-monad
@ -595,8 +611,10 @@ use 'plain-file' instead~%")
(append-map service-pam-services services))) (append-map service-pam-services services)))
(profile-drv (operating-system-profile os)) (profile-drv (operating-system-profile os))
(skeletons (operating-system-skeletons os)) (skeletons (operating-system-skeletons os))
(/etc/hosts (or (operating-system-hosts-file os) (/etc/hosts (maybe-file->monadic
(default-/etc/hosts (operating-system-host-name os)))) "hosts"
(or (operating-system-hosts-file os)
(default-/etc/hosts (operating-system-host-name os)))))
(shells (user-shells os))) (shells (user-shells os)))
(etc-directory #:pam-services pam-services (etc-directory #:pam-services pam-services
#:skeletons skeletons #:skeletons skeletons