[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
bug#26341: [PATCH 3/5] build: syscalls: Add mount and umount to #:replac
From: |
Mathieu Othacehe |
Subject: |
bug#26341: [PATCH 3/5] build: syscalls: Add mount and umount to #:replace list. |
Date: |
Sat, 8 Apr 2017 18:03:27 +0200 |
* guix/build/syscalls.scm (mount): Use static-or-ffi macro
and move from #:export list to #:replace list.
(umount): Ditto.
---
guix/build/syscalls.scm | 86 +++++++++++++++++++++++--------------------------
1 file changed, 41 insertions(+), 45 deletions(-)
diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
index 6afbfb86e..42071e7b1 100644
--- a/guix/build/syscalls.scm
+++ b/guix/build/syscalls.scm
@@ -45,8 +45,6 @@
MNT_EXPIRE
UMOUNT_NOFOLLOW
restart-on-EINTR
- mount
- umount
mount-points
swapon
swapoff
@@ -140,7 +138,9 @@
login-type
utmpx-entries
(read-utmpx-from-port . read-utmpx))
- #:replace (RB_AUTOBOOT
+ #:replace (mount
+ umount
+ RB_AUTOBOOT
RB_HALT_SYSTEM
RB_ENABLED_CAD
RB_DISABLE_CAD
@@ -478,57 +478,53 @@ procedure, otherwise return FFI-PROCEDURE."
(define UMOUNT_NOFOLLOW 8)
(define mount
- ;; If called from the statically linked Guile, use Guile core 'mount'.
- ;; Otherwise, use an FFI binding to define 'mount'.
;; XXX: '#:update-mtab?' is not implemented by core 'mount'.
- (if (module-defined? the-scm-module 'mount)
- (module-ref the-scm-module 'mount)
- (let ((proc (syscall->procedure int "mount" `(* * * ,unsigned-long *))))
- (lambda* (source target type #:optional (flags 0) options
- #:key (update-mtab? #f))
- "Mount device SOURCE on TARGET as a file system TYPE.
+ (static-or-ffi
+ 'mount
+ (let ((proc (syscall->procedure int "mount" `(* * * ,unsigned-long *))))
+ (lambda* (source target type #:optional (flags 0) options
+ #:key (update-mtab? #f))
+ "Mount device SOURCE on TARGET as a file system TYPE.
Optionally, FLAGS may be a bitwise-or of the MS_* <sys/mount.h>
constants, and OPTIONS may be a string. When FLAGS contains
MS_REMOUNT, SOURCE and TYPE are ignored. When UPDATE-MTAB? is true,
update /etc/mtab. Raise a 'system-error' exception on error."
- (let-values (((ret err)
- (proc (if source
- (string->pointer source)
- %null-pointer)
- (string->pointer target)
- (if type
- (string->pointer type)
- %null-pointer)
- flags
- (if options
- (string->pointer options)
- %null-pointer))))
- (unless (zero? ret)
- (throw 'system-error "mount" "mount ~S on ~S: ~A"
- (list source target (strerror err))
- (list err)))
- (when update-mtab?
- (augment-mtab source target type options)))))))
+ (let-values (((ret err)
+ (proc (if source
+ (string->pointer source)
+ %null-pointer)
+ (string->pointer target)
+ (if type
+ (string->pointer type)
+ %null-pointer)
+ flags
+ (if options
+ (string->pointer options)
+ %null-pointer))))
+ (unless (zero? ret)
+ (throw 'system-error "mount" "mount ~S on ~S: ~A"
+ (list source target (strerror err))
+ (list err)))
+ (when update-mtab?
+ (augment-mtab source target type options)))))))
(define umount
- ;; If called from the statically linked Guile, use Guile core 'umount'.
- ;; Otherwise, use an FFI binding to define 'umount'.
;; XXX: '#:update-mtab?' is not implemented by core 'umount'.
- (if (module-defined? the-scm-module 'umount)
- (module-ref the-scm-module 'umount)
- (let ((proc (syscall->procedure int "umount2" `(* ,int))))
- (lambda* (target #:optional (flags 0)
- #:key (update-mtab? #f))
- "Unmount TARGET. Optionally FLAGS may be one of the MNT_* or
UMOUNT_*
+ (static-or-ffi
+ 'umount
+ (let ((proc (syscall->procedure int "umount2" `(* ,int))))
+ (lambda* (target #:optional (flags 0)
+ #:key (update-mtab? #f))
+ "Unmount TARGET. Optionally FLAGS may be one of the MNT_* or UMOUNT_*
constants from <sys/mount.h>."
- (let-values (((ret err)
- (proc (string->pointer target) flags)))
- (unless (zero? ret)
- (throw 'system-error "umount" "~S: ~A"
- (list target (strerror err))
- (list err)))
- (when update-mtab?
- (remove-from-mtab target)))))))
+ (let-values (((ret err)
+ (proc (string->pointer target) flags)))
+ (unless (zero? ret)
+ (throw 'system-error "umount" "~S: ~A"
+ (list target (strerror err))
+ (list err)))
+ (when update-mtab?
+ (remove-from-mtab target)))))))
(define (mount-points)
"Return the mounts points for currently mounted file systems."
--
2.12.2
- bug#26341: [PATCH] build: vm: Add missing module., (continued)
bug#26341: [PATCH 3/5] build: syscalls: Add mount and umount to #:replace list.,
Mathieu Othacehe <=
bug#26341: [PATCH 4/5] build: syscalls: Add load-linux-module., Mathieu Othacehe, 2017/04/08
bug#26341: [PATCH 5/5] build: Fix compilation warnings., Mathieu Othacehe, 2017/04/08
bug#26341: [PATCH 2/5] build: syscalls: Allow use to network-interface syscalls independently of calling context., Mathieu Othacehe, 2017/04/08
bug#26341: [PATCH 1/5] build: syscalls: Add reboot., Mathieu Othacehe, 2017/04/10
- bug#26341: [PATCH 2/5] build: syscalls: Use define-as-needed for mount and umount., Mathieu Othacehe, 2017/04/10
- bug#26341: [PATCH 5/5] build: Fix compilation warnings., Mathieu Othacehe, 2017/04/10
- bug#26341: [PATCH 4/5] build: syscalls: Add load-linux-module., Mathieu Othacehe, 2017/04/10
- bug#26341: [PATCH 3/5] build: syscalls: Use define-as-needed for network-interface syscalls., Mathieu Othacehe, 2017/04/10
- bug#26341: [PATCH 1/5] build: syscalls: Add reboot., Ludovic Courtès, 2017/04/11