From mboxrd@z Thu Jan 1 00:00:00 1970 Received: from eggs.gnu.org ([2001:4830:134:3::10]:38875) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1cwsqM-0002ST-Q5 for guix-patches@gnu.org; Sat, 08 Apr 2017 12:04:07 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1cwsqJ-0003t3-HD for guix-patches@gnu.org; Sat, 08 Apr 2017 12:04:06 -0400 Received: from debbugs.gnu.org ([208.118.235.43]:40143) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1cwsqJ-0003ss-De for guix-patches@gnu.org; Sat, 08 Apr 2017 12:04:03 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1cwsqJ-0004Mo-6u for guix-patches@gnu.org; Sat, 08 Apr 2017 12:04:03 -0400 Subject: bug#26341: [PATCH 3/5] build: syscalls: Add mount and umount to #:replace list. Resent-Message-ID: From: Mathieu Othacehe Date: Sat, 8 Apr 2017 18:03:27 +0200 Message-Id: <20170408160329.4068-4-m.othacehe@gmail.com> In-Reply-To: <20170408160329.4068-1-m.othacehe@gmail.com> References: <20170408160329.4068-1-m.othacehe@gmail.com> List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+kyle=kyleam.com@gnu.org Sender: "Guix-patches" To: 26341@debbugs.gnu.org * 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_* 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 ." - (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