guix-patches
[Top][All Lists]
Advanced

[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






reply via email to

[Prev in Thread] Current Thread [Next in Thread]