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'.
This commit is contained in:
Ludovic Courtès 2016-09-04 23:39:17 +02:00
parent 14d5ca2e2e
commit 2ff0da0257
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 14 additions and 23 deletions

View File

@ -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."

View File

@ -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)))))