02/04: file-systems: Always use (guix build syscalls).

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit 2ff0da025745dd4ddce45d34c89fdf39190f9104
Author: Ludovic Courtès <address@hidden>
Date:   Sun Sep 4 23:39:17 2016 +0200

    file-systems: Always use (guix build syscalls).
    
    * gnu/build/file-systems.scm: Use (guix build syscalls)
    unconditionally.  Override the 'mount' and 'umount' bindings
    when (guile) provides them.
    (MS_RDONLY, MS_NOSUID, MS_NODEV, MS_NOEXEC, MS_REMOUNT)
    (MS_BIND, MS_MOVE): Remove.
    * guix/build/syscalls.scm (%libc-errno-pointer): Add
    'false-if-exception' around 'dynamic-func'.
---
 gnu/build/file-systems.scm |   34 ++++++++++++----------------------
 guix/build/syscalls.scm    |    3 ++-
 2 files changed, 14 insertions(+), 23 deletions(-)

diff --git a/gnu/build/file-systems.scm b/gnu/build/file-systems.scm
index f277cbf..f1fccbd 100644
--- a/gnu/build/file-systems.scm
+++ b/gnu/build/file-systems.scm
@@ -19,6 +19,7 @@
 (define-module (gnu build file-systems)
   #:use-module (guix build utils)
   #:use-module (guix build bournish)
+  #:use-module (guix build syscalls)
   #:use-module (rnrs io ports)
   #:use-module (rnrs bytevectors)
   #:use-module (ice-9 match)
@@ -41,17 +42,16 @@
             uuid->string
             string->uuid
 
-            MS_RDONLY
-            MS_NOSUID
-            MS_NODEV
-            MS_NOEXEC
-            MS_BIND
-            MS_MOVE
             bind-mount
 
             mount-flags->bit-mask
             check-file-system
-            mount-file-system))
+            mount-file-system)
+  #:re-export (mount
+               umount
+               MS_BIND
+               MS_MOVE
+               MS_RDONLY))
 
 ;;; Commentary:
 ;;;
@@ -61,21 +61,11 @@
 ;;; Code:
 
 ;; 'mount' is already defined in the statically linked Guile used for initial
-;; RAM disks, but in all other cases the (guix build syscalls) module contains
-;; the mount binding.
-(eval-when (expand load eval)
-  (unless (defined? 'mount)
-    (module-use! (current-module)
-                 (resolve-interface '(guix build syscalls)))))
-
-;; Linux mount flags, from libc's <sys/mount.h>.
-(define MS_RDONLY 1)
-(define MS_NOSUID 2)
-(define MS_NODEV  4)
-(define MS_NOEXEC 8)
-(define MS_REMOUNT 32)
-(define MS_BIND 4096)
-(define MS_MOVE 8192)
+;; RAM disks, in which case the bindings in (guix build syscalls) do not work
+;; (the FFI bindings do not work there).  Override them in that case.
+(when (module-defined? the-scm-module 'mount)
+  (set! mount (@ (guile) mount))
+  (set! umount (@ (guile) umount)))
 
 (define (bind-mount source target)
   "Bind-mount SOURCE at TARGET."
diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
index c663899..e5315ed 100644
--- a/guix/build/syscalls.scm
+++ b/guix/build/syscalls.scm
@@ -283,7 +283,8 @@ given TYPES.  READ uses WRAP-FIELDS to return its value."
 
 (define %libc-errno-pointer
   ;; Glibc's 'errno' pointer.
-  (let ((errno-loc (dynamic-func "__errno_location" (dynamic-link))))
+  (let ((errno-loc (false-if-exception
+                    (dynamic-func "__errno_location" (dynamic-link)))))
     (and errno-loc
          (let ((proc (pointer->procedure '* errno-loc '())))
            (proc)))))