From mboxrd@z Thu Jan 1 00:00:00 1970 From: Mark H Weaver Subject: Re: [PATCH] build: syscalls: Delay syscalls evaluation. Date: Sat, 06 Feb 2016 12:36:24 -0500 Message-ID: <878u2x4u7b.fsf@netris.org> References: <56B49D34.1020705@gmail.com> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:34821) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1aS6mn-0007pH-F6 for guix-devel@gnu.org; Sat, 06 Feb 2016 12:36:42 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1aS6mi-0004oj-Uq for guix-devel@gnu.org; Sat, 06 Feb 2016 12:36:41 -0500 Received: from world.peace.net ([50.252.239.5]:45234) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1aS6mi-0004oc-Pk for guix-devel@gnu.org; Sat, 06 Feb 2016 12:36:36 -0500 In-Reply-To: <56B49D34.1020705@gmail.com> (Manolis Ragkousis's message of "Fri, 5 Feb 2016 15:01:40 +0200") List-Id: "Development of GNU Guix and the GNU System distribution." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-devel-bounces+gcggd-guix-devel=m.gmane.org@gnu.org Sender: guix-devel-bounces+gcggd-guix-devel=m.gmane.org@gnu.org To: Manolis Ragkousis Cc: guix-devel@gnu.org, Justus Winter <4winter@informatik.uni-hamburg.de> --=-=-= Content-Type: text/plain Manolis Ragkousis writes: > Hello hackers, > > Justus tried to build Guix on his Hurd machine and he found out that > even though we disable (guix build syscalls) from building when > sys/mount.h is not present, it still tries to build it. > > As I found out, (guix utils) module uses the syscalls module so that's > why it still tried to build it. That's why I followed a different approach. > I delayed the evaluation of ptr and proc on mount, umount, swapon, etc. > and it builds now. > > WDYT? If you agree with the change I will push it to wip-hurd and/or > master. The last time this issue was raised, in August 2015, I came up with another approach to accomplish the same goal, but without any per-call overhead. I vaguely recall proposing it, but I don't remember where or what came of it. I've attached it below. Mark --=-=-= Content-Type: text/x-patch; charset=utf-8 Content-Disposition: inline; filename=0001-syscalls-If-a-syscall-is-not-available-defer-the-err.patch Content-Transfer-Encoding: quoted-printable Content-Description: [PATCH] syscalls: If a syscall is not available, defer the error >From b283ad4097a48de11a616083da09ae0e76bab343 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Sat, 22 Aug 2015 13:07:50 -0400 Subject: [PATCH] syscalls: If a syscall is not available, defer the error. * guix/build/syscalls.scm (syscall->procedure): New procedure. (mount, umount, swapon, swapoff, clone, setns, pivot-root): Use it. --- guix/build/syscalls.scm | 35 +++++++++++++++++++++-------------- 1 file changed, 21 insertions(+), 14 deletions(-) diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm index 68f340c..3065f43 100644 --- a/guix/build/syscalls.scm +++ b/guix/build/syscalls.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright =C2=A9 2014, 2015 Ludovic Court=C3=A8s ;;; Copyright =C2=A9 2015 David Thompson +;;; Copyright =C2=A9 2015 Mark H Weaver ;;; ;;; This file is part of GNU Guix. ;;; @@ -135,6 +136,19 @@ "Evaluate EXPR and restart upon EINTR. Return the value of EXPR." (call-with-restart-on-EINTR (lambda () expr))) =20 +(define (syscall->procedure return-type name argument-types) + "Return a procedure that wraps the C function NAME using the dynamic FFI. +If an error occurs while creating the binding, defer the error report until +the returned procedure is called." + (catch #t + (lambda () + (let ((ptr (dynamic-func name (dynamic-link)))) + (pointer->procedure return-type ptr argument-types))) + (lambda args + (lambda _ + (error (format #f "~a: syscall->procedure failed: ~s" + name args)))))) + (define (augment-mtab source target type options) "Augment /etc/mtab with information about the given mount point." (let ((port (open-file "/etc/mtab" "a"))) @@ -183,8 +197,7 @@ (define UMOUNT_NOFOLLOW 8) =20 (define mount - (let* ((ptr (dynamic-func "mount" (dynamic-link))) - (proc (pointer->procedure int ptr `(* * * ,unsigned-long *)))) + (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, F= LAGS @@ -212,8 +225,7 @@ error." (augment-mtab source target type options)))))) =20 (define umount - (let* ((ptr (dynamic-func "umount2" (dynamic-link))) - (proc (pointer->procedure int ptr `(* ,int)))) + (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= _* @@ -240,8 +252,7 @@ constants from ." (loop (cons mount-point result)))))))))) =20 (define swapon - (let* ((ptr (dynamic-func "swapon" (dynamic-link))) - (proc (pointer->procedure int ptr (list '* int)))) + (let ((proc (syscall->procedure int "swapon" (list '* int)))) (lambda* (device #:optional (flags 0)) "Use the block special device at DEVICE for swapping." (let ((ret (proc (string->pointer device) flags)) @@ -252,8 +263,7 @@ constants from ." (list err))))))) =20 (define swapoff - (let* ((ptr (dynamic-func "swapoff" (dynamic-link))) - (proc (pointer->procedure int ptr '(*)))) + (let ((proc (syscall->procedure int "swapoff" '(*)))) (lambda (device) "Stop using block special device DEVICE for swapping." (let ((ret (proc (string->pointer device))) @@ -313,8 +323,7 @@ string TMPL and return its file name. TMPL must end wi= th 'XXXXXX'." ;; The libc interface to sys_clone is not useful for Scheme programs, so t= he ;; low-level system call is wrapped instead. (define clone - (let* ((ptr (dynamic-func "syscall" (dynamic-link))) - (proc (pointer->procedure int ptr (list int int '*))) + (let ((proc (syscall->procedure int "syscall" (list int int '*))) ;; TODO: Don't do this. (syscall-id (match (utsname:machine (uname)) ("i686" 120) @@ -328,8 +337,7 @@ are shared between the parent and child processes." (proc syscall-id flags %null-pointer)))) =20 (define setns - (let* ((ptr (dynamic-func "setns" (dynamic-link))) - (proc (pointer->procedure int ptr (list int int)))) + (let ((proc (syscall->procedure int "setns" (list int int)))) (lambda (fdes nstype) "Reassociate the current process with the namespace specified by FDE= S, a file descriptor obtained by opening a /proc/PID/ns/* file. NSTYPE specifi= es @@ -343,8 +351,7 @@ there is no such limitation." (list err))))))) =20 (define pivot-root - (let* ((ptr (dynamic-func "pivot_root" (dynamic-link))) - (proc (pointer->procedure int ptr (list '* '*)))) + (let ((proc (syscall->procedure int "pivot_root" (list '* '*)))) (lambda (new-root put-old) "Change the root file system to NEW-ROOT and move the current root f= ile system to PUT-OLD." --=20 2.5.0 --=-=-=--