[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
02/04: file-systems: Always use (guix build syscalls).
From: |
Ludovic Courtès |
Subject: |
02/04: file-systems: Always use (guix build syscalls). |
Date: |
Sun, 4 Sep 2016 22:07:33 +0000 (UTC) |
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)))))