aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--gnu/build/file-systems.scm34
-rw-r--r--guix/build/syscalls.scm3
2 files changed, 14 insertions, 23 deletions
diff --git a/gnu/build/file-systems.scm b/gnu/build/file-systems.scm
index f277cbfa34..f1fccbdf2e 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 c663899160..e5315ed6f3 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)))))