GNU bug report logs - #26341
[PATCH] build: vm: Add missing module.

Previous Next

Full log

Message #50 received at 26341 <at> debbugs.gnu.org (full text, mbox):

From: Mathieu Othacehe <m.othacehe <at> gmail.com>
To: 26341 <at> debbugs.gnu.org
Cc: Mathieu Othacehe <m.othacehe <at> gmail.com>
Subject: [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

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.