unofficial mirror of guix-patches@gnu.org 
 help / color / mirror / code / Atom feed
* bug#26341: [PATCH] build: vm: Add missing module.
@ 2017-04-02 15:01 Mathieu Othacehe
  2017-04-04 12:41 ` Ludovic Courtès
                   ` (3 more replies)
  0 siblings, 4 replies; 30+ messages in thread
From: Mathieu Othacehe @ 2017-04-02 15:01 UTC (permalink / raw)
  To: 26341

* gnu/build/vm.scm (define-module): Use module (guix build syscalls).

It fixes the following warnings during guix build :

gnu/build/vm.scm:233:3: warning: possibly unbound variable `mount'
gnu/build/vm.scm:238:3: warning: possibly unbound variable `umount'
gnu/build/vm.scm:268:8: warning: possibly unbound variable `mount'
gnu/build/vm.scm:276:8: warning: possibly unbound variable `umount'
gnu/build/vm.scm:315:4: warning: possibly unbound variable `mount'
gnu/build/vm.scm:323:4: warning: possibly unbound variable `umount'
---
 gnu/build/vm.scm | 1 +
 1 file changed, 1 insertion(+)

diff --git a/gnu/build/vm.scm b/gnu/build/vm.scm
index 766163e1d..cc705832c 100644
--- a/gnu/build/vm.scm
+++ b/gnu/build/vm.scm
@@ -22,6 +22,7 @@
 (define-module (gnu build vm)
   #:use-module (guix build utils)
   #:use-module (guix build store-copy)
+  #:use-module (guix build syscalls)
   #:use-module (gnu build linux-boot)
   #:use-module (gnu build install)
   #:use-module (guix records)
-- 
2.12.2

^ permalink raw reply related	[flat|nested] 30+ messages in thread

* bug#26341: [PATCH] build: vm: Add missing module.
  2017-04-02 15:01 bug#26341: [PATCH] build: vm: Add missing module Mathieu Othacehe
@ 2017-04-04 12:41 ` Ludovic Courtès
  2017-04-05 10:30   ` Mathieu Othacehe
  2017-04-06  6:55 ` bug#26341: [PATCH 1/2] build: syscalls: Allow mount and umount use from static Guile Mathieu Othacehe
                   ` (2 subsequent siblings)
  3 siblings, 1 reply; 30+ messages in thread
From: Ludovic Courtès @ 2017-04-04 12:41 UTC (permalink / raw)
  To: Mathieu Othacehe; +Cc: 26341

[-- Attachment #1: Type: text/plain, Size: 1417 bytes --]

Hello Mathieu,

Mathieu Othacehe <m.othacehe@gmail.com> skribis:

> * gnu/build/vm.scm (define-module): Use module (guix build syscalls).
>
> It fixes the following warnings during guix build :
>
> gnu/build/vm.scm:233:3: warning: possibly unbound variable `mount'
> gnu/build/vm.scm:238:3: warning: possibly unbound variable `umount'
> gnu/build/vm.scm:268:8: warning: possibly unbound variable `mount'
> gnu/build/vm.scm:276:8: warning: possibly unbound variable `umount'
> gnu/build/vm.scm:315:4: warning: possibly unbound variable `mount'
> gnu/build/vm.scm:323:4: warning: possibly unbound variable `umount'

This is weird but on purpose: this module is used in a context, in (gnu
system vm), where ‘guile-static-stripped’ is running, in the initrd.
And ‘guile-static-stripped’ has ‘guile-linux-syscalls.patch’, which adds
bindings for ‘mount’, ‘umount’, etc.

Conversely, (guix build syscalls) relies on the ability to do
dlopen(NULL) and to resolve “mount” et al. from libc.so.  This cannot
work with the statically-linked Guile, which is why we have
‘guile-linux-syscalls.patch’.

So this patch cannot be applied as is, and I think it would break things
that use (gnu build vm).

That said, we should improve this.  Perhaps something along the lines of
the attached patch would work.

Could you try and send an updated patch?

Thanks,
Ludo’.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Type: text/x-patch, Size: 717 bytes --]

diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
index 5aae1530f..e108d6169 100644
--- a/guix/build/syscalls.scm
+++ b/guix/build/syscalls.scm
@@ -462,7 +462,9 @@ the returned procedure is called."
 (define UMOUNT_NOFOLLOW 8)
 
 (define mount
-  (let ((proc (syscall->procedure int "mount" `(* * * ,unsigned-long *))))
+  (let ((proc (if (module-defined? the-scm-module 'mount)
+                  (module-ref the-scm-module 'mount)
+                  (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

^ permalink raw reply related	[flat|nested] 30+ messages in thread

* bug#26341: [PATCH] build: vm: Add missing module.
  2017-04-04 12:41 ` Ludovic Courtès
@ 2017-04-05 10:30   ` Mathieu Othacehe
  2017-04-05 10:32     ` Mathieu Othacehe
  2017-04-05 21:35     ` Ludovic Courtès
  0 siblings, 2 replies; 30+ messages in thread
From: Mathieu Othacehe @ 2017-04-05 10:30 UTC (permalink / raw)
  To: Ludovic Courtès; +Cc: 26341


Hi Ludo,

> That said, we should improve this.  Perhaps something along the lines of
> the attached patch would work.
>
> Could you try and send an updated patch?

Well, I tried a "guix system vm ..." with just my patch and it worked. I
agree with you it shouldn't work because it is not possible to use FFI
in static Guile.

I don't exactly what happend but it might be something like that :

(gnu build vm) -- uses module ----> (guix build syscalls) (with my patch)
                      |                    |
                      |                    |
                      |               -------- provides
                      |               |      |
                      |               v      v
                      |               mount  umount (FFI versions)
                      |
                      -------------> (gnu build linux-boot)
                                          |
                                          | uses
                                       (gnu build file-systems)
                                                  |
                                                  |
                                                  overrides mount and
                                                  unount with libguile
                                                  versions if you're
                                                  using static Guile.

So we end-up using libguile mount and umount in (gnu build vm) and not
FFI versions of (guix build syscalls).

However, it is still a good idea to allow modules to use (guix build
syscalls) independently of the fact that they are running inside static
Guile or not.

So the attached patch (your previous patch, sligtly modified) could be
ok ?

Thank you,

Mathieu

                                                 
                                                  
                                                  
                                                  

^ permalink raw reply	[flat|nested] 30+ messages in thread

* bug#26341: [PATCH] build: vm: Add missing module.
  2017-04-05 10:30   ` Mathieu Othacehe
@ 2017-04-05 10:32     ` Mathieu Othacehe
  2017-04-05 21:39       ` Ludovic Courtès
  2017-04-05 21:35     ` Ludovic Courtès
  1 sibling, 1 reply; 30+ messages in thread
From: Mathieu Othacehe @ 2017-04-05 10:32 UTC (permalink / raw)
  To: Ludovic Courtès; +Cc: 26341

[-- Attachment #1: Type: text/plain, Size: 38 bytes --]


The attached patch ...

Sorry

Mathie

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: mount.patch --]
[-- Type: text/x-diff, Size: 4426 bytes --]

diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
index 3fa318df3..2de664aa7 100644
--- a/guix/build/syscalls.scm
+++ b/guix/build/syscalls.scm
@@ -462,51 +462,51 @@ the returned procedure is called."
 (define UMOUNT_NOFOLLOW 8)
 
 (define mount
-  (let ((proc (if (module-defined? the-scm-module 'mount)
-                  (module-ref the-scm-module 'mount)
-                  (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
+  (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.  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
-  (let ((proc (if (module-defined? the-scm-module 'umount)
-                  (module-ref the-scm-module 'umount)
-                  (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_*
+  (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_*
 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."

[-- Attachment #3: Type: text/plain, Size: 2 bytes --]

u

^ permalink raw reply related	[flat|nested] 30+ messages in thread

* bug#26341: [PATCH] build: vm: Add missing module.
  2017-04-05 10:30   ` Mathieu Othacehe
  2017-04-05 10:32     ` Mathieu Othacehe
@ 2017-04-05 21:35     ` Ludovic Courtès
  1 sibling, 0 replies; 30+ messages in thread
From: Ludovic Courtès @ 2017-04-05 21:35 UTC (permalink / raw)
  To: Mathieu Othacehe; +Cc: 26341

Hello!

Mathieu Othacehe <m.othacehe@gmail.com> skribis:

>> That said, we should improve this.  Perhaps something along the lines of
>> the attached patch would work.
>>
>> Could you try and send an updated patch?
>
> Well, I tried a "guix system vm ..." with just my patch and it worked. I
> agree with you it shouldn't work because it is not possible to use FFI
> in static Guile.
>
> I don't exactly what happend but it might be something like that :
>
> (gnu build vm) -- uses module ----> (guix build syscalls) (with my patch)
>                       |                    |
>                       |                    |
>                       |               -------- provides
>                       |               |      |
>                       |               v      v
>                       |               mount  umount (FFI versions)
>                       |
>                       -------------> (gnu build linux-boot)
>                                           |
>                                           | uses
>                                        (gnu build file-systems)
>                                                   |
>                                                   |
>                                                   overrides mount and
>                                                   unount with libguile
>                                                   versions if you're
>                                                   using static Guile.
>
> So we end-up using libguile mount and umount in (gnu build vm) and not
> FFI versions of (guix build syscalls).

Yeah, I think there must have been a “(guix build syscalls) overrides
core binding ‘mount’” warning, and Guile chose the core binding over the
other one so things turned out to work fine.

> However, it is still a good idea to allow modules to use (guix build
> syscalls) independently of the fact that they are running inside static
> Guile or not.

Agreed!

Ludo’.

^ permalink raw reply	[flat|nested] 30+ messages in thread

* bug#26341: [PATCH] build: vm: Add missing module.
  2017-04-05 10:32     ` Mathieu Othacehe
@ 2017-04-05 21:39       ` Ludovic Courtès
  2017-04-06  6:55         ` Mathieu Othacehe
  0 siblings, 1 reply; 30+ messages in thread
From: Ludovic Courtès @ 2017-04-05 21:39 UTC (permalink / raw)
  To: Mathieu Othacehe; +Cc: 26341

Mathieu Othacehe <m.othacehe@gmail.com> skribis:

> diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
> index 3fa318df3..2de664aa7 100644
> --- a/guix/build/syscalls.scm
> +++ b/guix/build/syscalls.scm
> @@ -462,51 +462,51 @@ the returned procedure is called."
>  (define UMOUNT_NOFOLLOW 8)
>  
>  (define mount
> -  (let ((proc (if (module-defined? the-scm-module 'mount)
> -                  (module-ref the-scm-module 'mount)
> -                  (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
> +  (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.  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."

That introduces a slight difference: in one case #:update-mtab? is not
honored.  That said, it’s probably OK to ignore it; maybe leave an “XXX”
comment above just in case.  ;-)

Otherwise LGTM.

Can you send a ‘git format-patch’ thing?  (Otherwise I could write the
commit log on your behalf.)

Thanks!

Ludo’.

^ permalink raw reply	[flat|nested] 30+ messages in thread

* bug#26341: [PATCH] build: vm: Add missing module.
  2017-04-05 21:39       ` Ludovic Courtès
@ 2017-04-06  6:55         ` Mathieu Othacehe
  2017-04-06  8:10           ` Ludovic Courtès
  0 siblings, 1 reply; 30+ messages in thread
From: Mathieu Othacehe @ 2017-04-06  6:55 UTC (permalink / raw)
  To: Ludovic Courtès; +Cc: 26341


> That introduces a slight difference: in one case #:update-mtab? is not
> honored.  That said, it’s probably OK to ignore it; maybe leave an “XXX”
> comment above just in case.  ;-)

Ok !

> Can you send a ‘git format-patch’ thing?  (Otherwise I could write the
> commit log on your behalf.)

Sure, I'll send new patches !

I have a follow-up question. Would it be ok to do the same thing for
other warnings on syscalls, 'reboot' for example ?

Thanks,

Mathieu

^ permalink raw reply	[flat|nested] 30+ messages in thread

* bug#26341: [PATCH 1/2] build: syscalls: Allow mount and umount use from static Guile.
  2017-04-02 15:01 bug#26341: [PATCH] build: vm: Add missing module Mathieu Othacehe
  2017-04-04 12:41 ` Ludovic Courtès
@ 2017-04-06  6:55 ` Mathieu Othacehe
  2017-04-06  6:55   ` bug#26341: [PATCH 2/2] build: vm: Add missing module Mathieu Othacehe
  2017-04-08 16:03 ` bug#26341: [PATCH 0/5] Fix warnings related to syscalls in static Guile Mathieu Othacehe
  2017-04-10 17:18 ` bug#26341: [PATCH 1/5] build: syscalls: Add reboot Mathieu Othacehe
  3 siblings, 1 reply; 30+ messages in thread
From: Mathieu Othacehe @ 2017-04-06  6:55 UTC (permalink / raw)
  To: 26341

* guix/build/syscalls.scm (mount): Use Guile core mount if called from
  static Guile, otherwise use FFI based mount implementation.
  (umount): Ditto.
  This allows to use (guix build syscalls) from a module independently
  of calling context.
---
 guix/build/syscalls.scm | 86 +++++++++++++++++++++++++++----------------------
 1 file changed, 48 insertions(+), 38 deletions(-)

diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
index 5aae1530f..4bcb2a871 100644
--- a/guix/build/syscalls.scm
+++ b/guix/build/syscalls.scm
@@ -462,47 +462,57 @@ the returned procedure is called."
 (define UMOUNT_NOFOLLOW 8)
 
 (define 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))))))
+  ;; 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.
+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)))))))
 
 (define 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_*
+  ;; 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_*
 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

^ permalink raw reply related	[flat|nested] 30+ messages in thread

* bug#26341: [PATCH 2/2] build: vm: Add missing module.
  2017-04-06  6:55 ` bug#26341: [PATCH 1/2] build: syscalls: Allow mount and umount use from static Guile Mathieu Othacehe
@ 2017-04-06  6:55   ` Mathieu Othacehe
  0 siblings, 0 replies; 30+ messages in thread
From: Mathieu Othacehe @ 2017-04-06  6:55 UTC (permalink / raw)
  To: 26341

* gnu/build/vm.scm (define-module): Use module (guix build syscalls).

It fixes the following warnings during guix build :

gnu/build/vm.scm:233:3: warning: possibly unbound variable `mount'
gnu/build/vm.scm:238:3: warning: possibly unbound variable `umount'
gnu/build/vm.scm:268:8: warning: possibly unbound variable `mount'
gnu/build/vm.scm:276:8: warning: possibly unbound variable `umount'
gnu/build/vm.scm:315:4: warning: possibly unbound variable `mount'
gnu/build/vm.scm:323:4: warning: possibly unbound variable `umount'

This was not possible until commit f05346979 because we had to be sure
that Guile core implementation of 'mount' and 'umount' was used in
initrd context.
---
 gnu/build/vm.scm | 1 +
 1 file changed, 1 insertion(+)

diff --git a/gnu/build/vm.scm b/gnu/build/vm.scm
index 60ee18ebe..44a3000eb 100644
--- a/gnu/build/vm.scm
+++ b/gnu/build/vm.scm
@@ -21,6 +21,7 @@
 (define-module (gnu build vm)
   #:use-module (guix build utils)
   #:use-module (guix build store-copy)
+  #:use-module (guix build syscalls)
   #:use-module (gnu build linux-boot)
   #:use-module (gnu build install)
   #:use-module (guix records)
-- 
2.12.2

^ permalink raw reply related	[flat|nested] 30+ messages in thread

* bug#26341: [PATCH] build: vm: Add missing module.
  2017-04-06  6:55         ` Mathieu Othacehe
@ 2017-04-06  8:10           ` Ludovic Courtès
  2017-04-07 21:36             ` Ludovic Courtès
  0 siblings, 1 reply; 30+ messages in thread
From: Ludovic Courtès @ 2017-04-06  8:10 UTC (permalink / raw)
  To: Mathieu Othacehe; +Cc: 26341

Mathieu Othacehe <m.othacehe@gmail.com> skribis:

>> That introduces a slight difference: in one case #:update-mtab? is not
>> honored.  That said, it’s probably OK to ignore it; maybe leave an “XXX”
>> comment above just in case.  ;-)
>
> Ok !
>
>> Can you send a ‘git format-patch’ thing?  (Otherwise I could write the
>> commit log on your behalf.)
>
> Sure, I'll send new patches !
>
> I have a follow-up question. Would it be ok to do the same thing for
> other warnings on syscalls, 'reboot' for example ?

Sure!  Likewise for ‘network-interface-flags’ and
‘set-network-interface-flags’, which guile-linux-syscalls.patch defines
in exactly the same way as (guix build syscalls).

Thanks,
Ludo’.

^ permalink raw reply	[flat|nested] 30+ messages in thread

* bug#26341: [PATCH] build: vm: Add missing module.
  2017-04-06  8:10           ` Ludovic Courtès
@ 2017-04-07 21:36             ` Ludovic Courtès
  2017-04-08  9:24               ` Mathieu Othacehe
  0 siblings, 1 reply; 30+ messages in thread
From: Ludovic Courtès @ 2017-04-07 21:36 UTC (permalink / raw)
  To: Mathieu Othacehe; +Cc: 26341

ludo@gnu.org (Ludovic Courtès) skribis:

> Mathieu Othacehe <m.othacehe@gmail.com> skribis:
>
>>> That introduces a slight difference: in one case #:update-mtab? is not
>>> honored.  That said, it’s probably OK to ignore it; maybe leave an “XXX”
>>> comment above just in case.  ;-)
>>
>> Ok !
>>
>>> Can you send a ‘git format-patch’ thing?  (Otherwise I could write the
>>> commit log on your behalf.)
>>
>> Sure, I'll send new patches !
>>
>> I have a follow-up question. Would it be ok to do the same thing for
>> other warnings on syscalls, 'reboot' for example ?
>
> Sure!  Likewise for ‘network-interface-flags’ and
> ‘set-network-interface-flags’, which guile-linux-syscalls.patch defines
> in exactly the same way as (guix build syscalls).

I’ve applied the first patches in the meantime.

I noticed that we get this at boot time (from the initrd):

  WARNING: (gnu build file-systems): imported module (guix build syscalls) overrides core binding `mount'

To get rid of it, (guix build syscalls) should in fact #:re-export those
bindings (or #:replace).  Annoying.

Ludo’.

^ permalink raw reply	[flat|nested] 30+ messages in thread

* bug#26341: [PATCH] build: vm: Add missing module.
  2017-04-07 21:36             ` Ludovic Courtès
@ 2017-04-08  9:24               ` Mathieu Othacehe
  0 siblings, 0 replies; 30+ messages in thread
From: Mathieu Othacehe @ 2017-04-08  9:24 UTC (permalink / raw)
  To: Ludovic Courtès; +Cc: 26341


Hi Ludo,

> To get rid of it, (guix build syscalls) should in fact #:re-export those
> bindings (or #:replace).  Annoying.

Thanks for applying.

Yes I saw, I'll propose a serie soon that fixes all those warnings at
compilation time and run-time.

Mathieu

^ permalink raw reply	[flat|nested] 30+ messages in thread

* bug#26341: [PATCH 0/5] Fix warnings related to syscalls in static Guile.
  2017-04-02 15:01 bug#26341: [PATCH] build: vm: Add missing module Mathieu Othacehe
  2017-04-04 12:41 ` Ludovic Courtès
  2017-04-06  6:55 ` bug#26341: [PATCH 1/2] build: syscalls: Allow mount and umount use from static Guile Mathieu Othacehe
@ 2017-04-08 16:03 ` Mathieu Othacehe
  2017-04-08 16:03   ` bug#26341: [PATCH 1/5] build: syscalls: Add reboot Mathieu Othacehe
                     ` (4 more replies)
  2017-04-10 17:18 ` bug#26341: [PATCH 1/5] build: syscalls: Add reboot Mathieu Othacehe
  3 siblings, 5 replies; 30+ messages in thread
From: Mathieu Othacehe @ 2017-04-08 16:03 UTC (permalink / raw)
  To: 26341

This serie fixes the remaining warnings both at compilation
and during initrd execution.

Thank you,

Mathieu

Mathieu Othacehe (5):
  build: syscalls: Add reboot.
  build: syscalls: Allow use to network-interface syscalls independently
    of calling context.
  build: syscalls: Add mount and umount to #:replace list.
  build: syscalls: Add load-linux-module.
  build: Fix compilation warnings.

 gnu/build/file-systems.scm  |  15 +--
 gnu/build/linux-boot.scm    |   2 +
 gnu/build/linux-modules.scm |   2 +
 guix/build/syscalls.scm     | 258 +++++++++++++++++++++++++++-----------------
 4 files changed, 163 insertions(+), 114 deletions(-)

-- 
2.12.2

^ permalink raw reply	[flat|nested] 30+ messages in thread

* bug#26341: [PATCH 1/5] build: syscalls: Add reboot.
  2017-04-08 16:03 ` bug#26341: [PATCH 0/5] Fix warnings related to syscalls in static Guile Mathieu Othacehe
@ 2017-04-08 16:03   ` Mathieu Othacehe
  2017-04-10  9:42     ` Ludovic Courtès
  2017-04-08 16:03   ` bug#26341: [PATCH 2/5] build: syscalls: Allow use to network-interface syscalls independently of calling context Mathieu Othacehe
                     ` (3 subsequent siblings)
  4 siblings, 1 reply; 30+ messages in thread
From: Mathieu Othacehe @ 2017-04-08 16:03 UTC (permalink / raw)
  To: 26341

* guix/build/syscalls.scm (static-or-ffi): New macro. Used to dispatch between
  static Guile core implementation and FFI version.
(reboot): New export procedure. Reimplemented from guile-linux-syscalls.patch.
(RB_AUTOBOOT, ..., RB_KEXEC): New exported flags replacing static Guile flags.
---
 guix/build/syscalls.scm | 36 +++++++++++++++++++++++++++++++++++-
 1 file changed, 35 insertions(+), 1 deletion(-)

diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
index 4bcb2a871..af5ec4b6a 100644
--- a/guix/build/syscalls.scm
+++ b/guix/build/syscalls.scm
@@ -2,6 +2,7 @@
 ;;; Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2015 David Thompson <davet@gnu.org>
 ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
+;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -144,7 +145,15 @@
             utmpx-address
             login-type
             utmpx-entries
-            (read-utmpx-from-port . read-utmpx)))
+            (read-utmpx-from-port . read-utmpx))
+  #:replace (RB_AUTOBOOT
+             RB_HALT_SYSTEM
+             RB_ENABLED_CAD
+             RB_DISABLE_CAD
+             RB_POWER_OFF
+             RB_SW_SUSPEND
+             RB_KEXEC
+             reboot))
 
 ;;; Commentary:
 ;;;
@@ -409,6 +418,13 @@ the returned procedure is called."
         (error (format #f "~a: syscall->procedure failed: ~s"
                        name args))))))
 
+(define-syntax-rule (static-or-ffi symbol ffi-procedure)
+  "If SYMBOL is defined in the core Guile module, return the associated
+procedure, otherwise return FFI-PROCEDURE."
+  (if (module-defined? the-scm-module symbol)
+      (module-ref the-scm-module symbol)
+      ffi-procedure))
+
 \f
 ;;;
 ;;; File systems.
@@ -547,6 +563,24 @@ constants from <sys/mount.h>."
                  (list device (strerror err))
                  (list err)))))))
 
+(define RB_AUTOBOOT    #x01234567)
+(define RB_HALT_SYSTEM #xcdef0123)
+(define RB_ENABLED_CAD #x89abcdef)
+(define RB_DISABLE_CAD 0)
+(define RB_POWER_OFF   #x4321fedc)
+(define RB_SW_SUSPEND  #xd000fce2)
+(define RB_KEXEC       #x45584543)
+
+(define reboot
+  (static-or-ffi
+   'reboot
+   (let ((proc (syscall->procedure int "reboot" (list int))))
+     (lambda* (#:optional (cmd RB_AUTOBOOT))
+       (let-values (((ret err) (proc cmd)))
+         (unless (zero? ret)
+           (throw 'system-error "reboot" "~S: ~A"
+                  (list cmd (strerror err))
+                  (list err))))))))
 (define (kernel? pid)
   "Return #t if PID designates a \"kernel thread\" rather than a normal
 user-land process."
-- 
2.12.2

^ permalink raw reply related	[flat|nested] 30+ messages in thread

* bug#26341: [PATCH 2/5] build: syscalls: Allow use to network-interface syscalls independently of calling context.
  2017-04-08 16:03 ` bug#26341: [PATCH 0/5] Fix warnings related to syscalls in static Guile Mathieu Othacehe
  2017-04-08 16:03   ` bug#26341: [PATCH 1/5] build: syscalls: Add reboot Mathieu Othacehe
@ 2017-04-08 16:03   ` Mathieu Othacehe
  2017-04-08 16:03   ` bug#26341: [PATCH 3/5] build: syscalls: Add mount and umount to #:replace list Mathieu Othacehe
                     ` (2 subsequent siblings)
  4 siblings, 0 replies; 30+ messages in thread
From: Mathieu Othacehe @ 2017-04-08 16:03 UTC (permalink / raw)
  To: 26341

* guix/build/syscalls.scm (network-interface-flags): Use static-or-ffi macro
  and add to #:replace list.
(set-network-interface-flags): Ditto.
(set-network-interface-address): Ditto.
(IFF_UP, IFF_BROADCAST and IFF_LOOPBACK): Move from #:export to #:replace.
---
 guix/build/syscalls.scm | 123 ++++++++++++++++++++++++++----------------------
 1 file changed, 66 insertions(+), 57 deletions(-)

diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
index af5ec4b6a..6afbfb86e 100644
--- a/guix/build/syscalls.scm
+++ b/guix/build/syscalls.scm
@@ -84,17 +84,11 @@
 
             PF_PACKET
             AF_PACKET
-            IFF_UP
-            IFF_BROADCAST
-            IFF_LOOPBACK
             all-network-interface-names
             network-interface-names
-            network-interface-flags
             network-interface-netmask
             loopback-network-interface?
             network-interface-address
-            set-network-interface-flags
-            set-network-interface-address
             set-network-interface-netmask
             set-network-interface-up
             configure-network-interface
@@ -153,7 +147,13 @@
              RB_POWER_OFF
              RB_SW_SUSPEND
              RB_KEXEC
-             reboot))
+             reboot
+             IFF_UP
+             IFF_BROADCAST
+             IFF_LOOPBACK
+             network-interface-flags
+             set-network-interface-flags
+             set-network-interface-address))
 
 ;;; Commentary:
 ;;;
@@ -1066,26 +1066,29 @@ that are not up."
                 (else
                  (loop interfaces))))))))
 
-(define (network-interface-flags socket name)
-  "Return a number that is the bit-wise or of 'IFF*' flags for network
+(define network-interface-flags
+  (static-or-ffi
+   'network-interface-flags
+   (lambda (socket name)
+     "Return a number that is the bit-wise or of 'IFF*' flags for network
 interface NAME."
-  (let ((req (make-bytevector ifreq-struct-size)))
-    (bytevector-copy! (string->utf8 name) 0 req 0
-                      (min (string-length name) (- IF_NAMESIZE 1)))
-    (let-values (((ret err)
-                  (%ioctl (fileno socket) SIOCGIFFLAGS
-                          (bytevector->pointer req))))
-      (if (zero? ret)
-
-          ;; The 'ifr_flags' field is IF_NAMESIZE bytes after the beginning of
-          ;; 'struct ifreq', and it's a short int.
-          (bytevector-sint-ref req IF_NAMESIZE (native-endianness)
-                               (sizeof short))
-
-          (throw 'system-error "network-interface-flags"
-                 "network-interface-flags on ~A: ~A"
-                 (list name (strerror err))
-                 (list err))))))
+     (let ((req (make-bytevector ifreq-struct-size)))
+       (bytevector-copy! (string->utf8 name) 0 req 0
+                         (min (string-length name) (- IF_NAMESIZE 1)))
+       (let-values (((ret err)
+                     (%ioctl (fileno socket) SIOCGIFFLAGS
+                             (bytevector->pointer req))))
+         (if (zero? ret)
+
+             ;; The 'ifr_flags' field is IF_NAMESIZE bytes after the
+             ;; beginning of 'struct ifreq', and it's a short int.
+             (bytevector-sint-ref req IF_NAMESIZE (native-endianness)
+                                  (sizeof short))
+
+             (throw 'system-error "network-interface-flags"
+                    "network-interface-flags on ~A: ~A"
+                    (list name (strerror err))
+                    (list err))))))))
 
 (define (loopback-network-interface? name)
   "Return true if NAME designates a loopback network interface."
@@ -1094,38 +1097,44 @@ interface NAME."
     (close-port sock)
     (not (zero? (logand flags IFF_LOOPBACK)))))
 
-(define (set-network-interface-flags socket name flags)
-  "Set the flag of network interface NAME to FLAGS."
-  (let ((req (make-bytevector ifreq-struct-size)))
-    (bytevector-copy! (string->utf8 name) 0 req 0
-                      (min (string-length name) (- IF_NAMESIZE 1)))
-    ;; Set the 'ifr_flags' field.
-    (bytevector-uint-set! req IF_NAMESIZE flags (native-endianness)
-                          (sizeof short))
-    (let-values (((ret err)
-                  (%ioctl (fileno socket) SIOCSIFFLAGS
-                          (bytevector->pointer req))))
-      (unless (zero? ret)
-        (throw 'system-error "set-network-interface-flags"
-               "set-network-interface-flags on ~A: ~A"
-               (list name (strerror err))
-               (list err))))))
+(define set-network-interface-flags
+  (static-or-ffi
+   'set-network-interface-flags
+   (lambda (socket name flags)
+     "Set the flag of network interface NAME to FLAGS."
+     (let ((req (make-bytevector ifreq-struct-size)))
+       (bytevector-copy! (string->utf8 name) 0 req 0
+                         (min (string-length name) (- IF_NAMESIZE 1)))
+       ;; Set the 'ifr_flags' field.
+       (bytevector-uint-set! req IF_NAMESIZE flags (native-endianness)
+                             (sizeof short))
+       (let-values (((ret err)
+                     (%ioctl (fileno socket) SIOCSIFFLAGS
+                             (bytevector->pointer req))))
+         (unless (zero? ret)
+           (throw 'system-error "set-network-interface-flags"
+                  "set-network-interface-flags on ~A: ~A"
+                  (list name (strerror err))
+                  (list err))))))))
 
-(define (set-network-interface-address socket name sockaddr)
-  "Set the address of network interface NAME to SOCKADDR."
-  (let ((req (make-bytevector ifreq-struct-size)))
-    (bytevector-copy! (string->utf8 name) 0 req 0
-                      (min (string-length name) (- IF_NAMESIZE 1)))
-    ;; Set the 'ifr_addr' field.
-    (write-socket-address! sockaddr req IF_NAMESIZE)
-    (let-values (((ret err)
-                  (%ioctl (fileno socket) SIOCSIFADDR
-                          (bytevector->pointer req))))
-      (unless (zero? ret)
-        (throw 'system-error "set-network-interface-address"
-               "set-network-interface-address on ~A: ~A"
-               (list name (strerror err))
-               (list err))))))
+(define set-network-interface-address
+  (static-or-ffi
+   'set-network-interface-address
+   (lambda (socket name sockaddr)
+     "Set the address of network interface NAME to SOCKADDR."
+     (let ((req (make-bytevector ifreq-struct-size)))
+       (bytevector-copy! (string->utf8 name) 0 req 0
+                         (min (string-length name) (- IF_NAMESIZE 1)))
+       ;; Set the 'ifr_addr' field.
+       (write-socket-address! sockaddr req IF_NAMESIZE)
+       (let-values (((ret err)
+                     (%ioctl (fileno socket) SIOCSIFADDR
+                             (bytevector->pointer req))))
+         (unless (zero? ret)
+           (throw 'system-error "set-network-interface-address"
+                  "set-network-interface-address on ~A: ~A"
+                  (list name (strerror err))
+                  (list err))))))))
 
 (define (set-network-interface-netmask socket name sockaddr)
   "Set the network mask of interface NAME to SOCKADDR."
-- 
2.12.2

^ permalink raw reply related	[flat|nested] 30+ messages in thread

* bug#26341: [PATCH 3/5] build: syscalls: Add mount and umount to #:replace list.
  2017-04-08 16:03 ` bug#26341: [PATCH 0/5] Fix warnings related to syscalls in static Guile Mathieu Othacehe
  2017-04-08 16:03   ` bug#26341: [PATCH 1/5] build: syscalls: Add reboot Mathieu Othacehe
  2017-04-08 16:03   ` bug#26341: [PATCH 2/5] build: syscalls: Allow use to network-interface syscalls independently of calling context Mathieu Othacehe
@ 2017-04-08 16:03   ` Mathieu Othacehe
  2017-04-08 16:03   ` bug#26341: [PATCH 4/5] build: syscalls: Add load-linux-module Mathieu Othacehe
  2017-04-08 16:03   ` bug#26341: [PATCH 5/5] build: Fix compilation warnings Mathieu Othacehe
  4 siblings, 0 replies; 30+ messages in thread
From: Mathieu Othacehe @ 2017-04-08 16:03 UTC (permalink / raw)
  To: 26341

* 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

^ permalink raw reply related	[flat|nested] 30+ messages in thread

* bug#26341: [PATCH 4/5] build: syscalls: Add load-linux-module.
  2017-04-08 16:03 ` bug#26341: [PATCH 0/5] Fix warnings related to syscalls in static Guile Mathieu Othacehe
                     ` (2 preceding siblings ...)
  2017-04-08 16:03   ` bug#26341: [PATCH 3/5] build: syscalls: Add mount and umount to #:replace list Mathieu Othacehe
@ 2017-04-08 16:03   ` Mathieu Othacehe
  2017-04-08 16:03   ` bug#26341: [PATCH 5/5] build: Fix compilation warnings Mathieu Othacehe
  4 siblings, 0 replies; 30+ messages in thread
From: Mathieu Othacehe @ 2017-04-08 16:03 UTC (permalink / raw)
  To: 26341

* guix/build/syscalls.scm (load-linux-module): New procedure. Reimplemented
  from guile-linux-syscalls.patch. Add to #:replace list.
---
 guix/build/syscalls.scm | 17 +++++++++++++++++
 1 file changed, 17 insertions(+)

diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
index 42071e7b1..14d97fb61 100644
--- a/guix/build/syscalls.scm
+++ b/guix/build/syscalls.scm
@@ -148,6 +148,7 @@
              RB_SW_SUSPEND
              RB_KEXEC
              reboot
+             load-linux-module
              IFF_UP
              IFF_BROADCAST
              IFF_LOOPBACK
@@ -577,6 +578,22 @@ constants from <sys/mount.h>."
            (throw 'system-error "reboot" "~S: ~A"
                   (list cmd (strerror err))
                   (list err))))))))
+
+(define load-linux-module
+  (static-or-ffi
+   'load-linux-module
+   (let ((proc (syscall->procedure int "init_module"
+                                   (list '* unsigned-long '*))))
+     (lambda* (data #:optional (options ""))
+       (let-values (((ret err)
+                     (proc (bytevector->pointer data)
+                           (bytevector-length data)
+                           (string->pointer options))))
+         (unless (zero? ret)
+           (throw 'system-error "load-linux-module" "~A"
+                  (list (strerror err))
+                  (list err))))))))
+
 (define (kernel? pid)
   "Return #t if PID designates a \"kernel thread\" rather than a normal
 user-land process."
-- 
2.12.2

^ permalink raw reply related	[flat|nested] 30+ messages in thread

* bug#26341: [PATCH 5/5] build: Fix compilation warnings.
  2017-04-08 16:03 ` bug#26341: [PATCH 0/5] Fix warnings related to syscalls in static Guile Mathieu Othacehe
                     ` (3 preceding siblings ...)
  2017-04-08 16:03   ` bug#26341: [PATCH 4/5] build: syscalls: Add load-linux-module Mathieu Othacehe
@ 2017-04-08 16:03   ` Mathieu Othacehe
  4 siblings, 0 replies; 30+ messages in thread
From: Mathieu Othacehe @ 2017-04-08 16:03 UTC (permalink / raw)
  To: 26341

* gnu/build/linux-boot.scm (define-module): Use (guix build syscalls).
* gnu/build/linux-modules.scm (define-module): Ditto.
* gnu/build/file-systems (define-module): Stop re-exporting mount, umount and
  MS_* flags as this is now safe to include (guix build syscalls) instead.
  (mount): Remove procedure.
  (umount): Ditto.
---
 gnu/build/file-systems.scm  | 15 ++-------------
 gnu/build/linux-boot.scm    |  2 ++
 gnu/build/linux-modules.scm |  2 ++
 3 files changed, 6 insertions(+), 13 deletions(-)

diff --git a/gnu/build/file-systems.scm b/gnu/build/file-systems.scm
index fe98df95d..eb9f07861 100644
--- a/gnu/build/file-systems.scm
+++ b/gnu/build/file-systems.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2016, 2017 David Craven <david@craven.ch>
+;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -47,12 +48,7 @@
 
             mount-flags->bit-mask
             check-file-system
-            mount-file-system)
-  #:re-export (mount
-               umount
-               MS_BIND
-               MS_MOVE
-               MS_RDONLY))
+            mount-file-system))
 
 ;;; Commentary:
 ;;;
@@ -61,13 +57,6 @@
 ;;;
 ;;; Code:
 
-;; 'mount' is already defined in the statically linked Guile used for initial
-;; RAM disks, in which case the bindings in (guix build syscalls) do not work
-;; (the FFI bindings do not work there).  Override them in that case.
-(when (module-defined? the-scm-module 'mount)
-  (set! mount (@ (guile) mount))
-  (set! umount (@ (guile) umount)))
-
 (define (bind-mount source target)
   "Bind-mount SOURCE at TARGET."
   (mount source target "" MS_BIND))
diff --git a/gnu/build/linux-boot.scm b/gnu/build/linux-boot.scm
index c34a3f7c1..360ef3fae 100644
--- a/gnu/build/linux-boot.scm
+++ b/gnu/build/linux-boot.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -26,6 +27,7 @@
   #:use-module (ice-9 match)
   #:use-module (ice-9 ftw)
   #:use-module (guix build utils)
+  #:use-module (guix build syscalls)
   #:use-module (gnu build linux-modules)
   #:use-module (gnu build file-systems)
   #:export (mount-essential-file-systems
diff --git a/gnu/build/linux-modules.scm b/gnu/build/linux-modules.scm
index d7feb3a08..5ca7bf8e3 100644
--- a/gnu/build/linux-modules.scm
+++ b/gnu/build/linux-modules.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2014, 2016 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -18,6 +19,7 @@
 
 (define-module (gnu build linux-modules)
   #:use-module (guix elf)
+  #:use-module (guix build syscalls)
   #:use-module (rnrs io ports)
   #:use-module (rnrs bytevectors)
   #:use-module (srfi srfi-1)
-- 
2.12.2

^ permalink raw reply related	[flat|nested] 30+ messages in thread

* bug#26341: [PATCH 1/5] build: syscalls: Add reboot.
  2017-04-08 16:03   ` bug#26341: [PATCH 1/5] build: syscalls: Add reboot Mathieu Othacehe
@ 2017-04-10  9:42     ` Ludovic Courtès
  2017-04-10 13:18       ` Mathieu Othacehe
  0 siblings, 1 reply; 30+ messages in thread
From: Ludovic Courtès @ 2017-04-10  9:42 UTC (permalink / raw)
  To: Mathieu Othacehe; +Cc: 26341

Hi Mathieu,

Mathieu Othacehe <m.othacehe@gmail.com> skribis:

> * guix/build/syscalls.scm (static-or-ffi): New macro. Used to dispatch between
>   static Guile core implementation and FFI version.
> (reboot): New export procedure. Reimplemented from guile-linux-syscalls.patch.
> (RB_AUTOBOOT, ..., RB_KEXEC): New exported flags replacing static Guile flags.

[...]

> +  #:replace (RB_AUTOBOOT
> +             RB_HALT_SYSTEM
> +             RB_ENABLED_CAD
> +             RB_DISABLE_CAD
> +             RB_POWER_OFF
> +             RB_SW_SUSPEND
> +             RB_KEXEC
> +             reboot))

The problem is that we cannot #:replace unconditionally (when not using
the patched Guile, there’s nothing to replace¹).

So perhaps we should remove #:export, #:replace, and #:re-export for
‘mount’ & co, and instead have a macro like this:

  (define-syntax define-as-needed
    (syntax-rules ()
      "Define VARIABLE.  If VARIABLE already exists in (guile) then re-export it,
  otherwise export the newly-defined VARIABLE."
      ((_ (proc args ...) body ...)
       (define-as-needed proc (lambda (args ...) body ...)))
      ((_ variable value)
       (begin
         (when (module-defined? the-scm-module 'variable)
           (re-export variable))

         (define variable
           (if (module-defined? the-scm-module 'variable)
               (module-ref the-scm-module 'variable)
               value))

         (unless (module-defined? the-scm-module 'variable)
           (export variable))))))

  (define-as-needed RB_AUTOBOOT #x123)
  (define-as-needed (mount foo bar)
    'baz)

WDYT?

Sorry that this simple thing ends up being complicated!  ;-)

Thank you,
Ludo’.

¹ In practice #:replace works even when there’s nothing to replace, but
  I’d rather not rely on it.

^ permalink raw reply	[flat|nested] 30+ messages in thread

* bug#26341: [PATCH 1/5] build: syscalls: Add reboot.
  2017-04-10  9:42     ` Ludovic Courtès
@ 2017-04-10 13:18       ` Mathieu Othacehe
  2017-04-10 13:41         ` Ludovic Courtès
  0 siblings, 1 reply; 30+ messages in thread
From: Mathieu Othacehe @ 2017-04-10 13:18 UTC (permalink / raw)
  To: Ludovic Courtès; +Cc: 26341


Hey Ludo,

> The problem is that we cannot #:replace unconditionally (when not using
> the patched Guile, there’s nothing to replace¹).

Yes I was relying on #:replace ability to just export the symbol if
there's nothing to replace (as explained in your note¹).

>
> WDYT?

Anyway, your macro seems a nicer way than dealing with export/replace.
I gave it a try and everything still seems warning free.

My only concern is that it won't be obvious for people who want to use
reboot or mount or any other syscall that they have to use (guix build
syscalls) because the #:export list won't contain those syscalls.

Maybe a big explanation on top of the file would be enough ?

Thanks,

Mathieu

^ permalink raw reply	[flat|nested] 30+ messages in thread

* bug#26341: [PATCH 1/5] build: syscalls: Add reboot.
  2017-04-10 13:18       ` Mathieu Othacehe
@ 2017-04-10 13:41         ` Ludovic Courtès
  2017-04-10 17:18           ` Mathieu Othacehe
  0 siblings, 1 reply; 30+ messages in thread
From: Ludovic Courtès @ 2017-04-10 13:41 UTC (permalink / raw)
  To: Mathieu Othacehe; +Cc: 26341

Hi,

Mathieu Othacehe <m.othacehe@gmail.com> skribis:

>> The problem is that we cannot #:replace unconditionally (when not using
>> the patched Guile, there’s nothing to replace¹).
>
> Yes I was relying on #:replace ability to just export the symbol if
> there's nothing to replace (as explained in your note¹).
>
>>
>> WDYT?
>
> Anyway, your macro seems a nicer way than dealing with export/replace.
> I gave it a try and everything still seems warning free.
>
> My only concern is that it won't be obvious for people who want to use
> reboot or mount or any other syscall that they have to use (guix build
> syscalls) because the #:export list won't contain those syscalls.
>
> Maybe a big explanation on top of the file would be enough ?

Yes, I think it would be enough.

Also, the initrd is the only context where one can omit (use-modules
(guix build syscalls)) so I think people will choose to use it by
default.

Thanks,
Ludo’.

^ permalink raw reply	[flat|nested] 30+ messages in thread

* bug#26341: [PATCH 1/5] build: syscalls: Add reboot.
  2017-04-10 13:41         ` Ludovic Courtès
@ 2017-04-10 17:18           ` Mathieu Othacehe
  0 siblings, 0 replies; 30+ messages in thread
From: Mathieu Othacehe @ 2017-04-10 17:18 UTC (permalink / raw)
  To: Ludovic Courtès; +Cc: 26341


> Yes, I think it would be enough.

Ok so, here's a new serie using this macro !

Thanks,

Mathieu

^ permalink raw reply	[flat|nested] 30+ messages in thread

* bug#26341: [PATCH 1/5] build: syscalls: Add reboot.
  2017-04-02 15:01 bug#26341: [PATCH] build: vm: Add missing module Mathieu Othacehe
                   ` (2 preceding siblings ...)
  2017-04-08 16:03 ` bug#26341: [PATCH 0/5] Fix warnings related to syscalls in static Guile Mathieu Othacehe
@ 2017-04-10 17:18 ` Mathieu Othacehe
  2017-04-10 17:18   ` bug#26341: [PATCH 2/5] build: syscalls: Use define-as-needed for mount and umount Mathieu Othacehe
                     ` (4 more replies)
  3 siblings, 5 replies; 30+ messages in thread
From: Mathieu Othacehe @ 2017-04-10 17:18 UTC (permalink / raw)
  To: 26341

* guix/build/syscalls.scm (define-as-needed): New macro.
(reboot): New procedure. Reimplemented from guile-linux-syscalls.patch.
(RB_AUTOBOOT, ..., RB_KEXEC): New flags copied from static Guile patch.

Co-Authored-By: Ludovic Courtès <ludo@gnu.org>
---
 guix/build/syscalls.scm | 51 +++++++++++++++++++++++++++++++++++++++++++++++--
 1 file changed, 49 insertions(+), 2 deletions(-)

diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
index 4bcb2a871..0de39aee6 100644
--- a/guix/build/syscalls.scm
+++ b/guix/build/syscalls.scm
@@ -2,6 +2,7 @@
 ;;; Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2015 David Thompson <davet@gnu.org>
 ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
+;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -149,8 +150,19 @@
 ;;; Commentary:
 ;;;
 ;;; This module provides bindings to libc's syscall wrappers.  It uses the
-;;; FFI, and thus requires a dynamically-linked Guile.  (For statically-linked
-;;; Guile, we instead apply 'guile-linux-syscalls.patch'.)
+;;; FFI, and thus requires a dynamically-linked Guile.
+;;;
+;;; Some syscalls are already defined in statically-linked Guile by applying
+;;; 'guile-linux-syscalls.patch'.
+;;;
+;;; Visibility of syscall's symbols shared between this module and static Guile
+;;; is a bit delicate. It is handled by 'define-as-needed' macro.
+;;;
+;;; This macro is used to export symbols in dynamic Guile context, and to
+;;; re-export them in static Guile context.
+;;;
+;;; This way, even if they don't appear in #:export list, it is safe to use
+;;; syscalls from this module in static or dynamic Guile context.
 ;;;
 ;;; Code:
 
@@ -409,6 +421,25 @@ the returned procedure is called."
         (error (format #f "~a: syscall->procedure failed: ~s"
                        name args))))))
 
+(define-syntax define-as-needed
+  (syntax-rules ()
+    "Define VARIABLE.  If VARIABLE already exists in (guile) then re-export it,
+  otherwise export the newly-defined VARIABLE."
+    ((_ (proc args ...) body ...)
+     (define-as-needed proc (lambda* (args ...) body ...)))
+    ((_ variable value)
+     (begin
+       (when (module-defined? the-scm-module 'variable)
+         (re-export variable))
+
+       (define variable
+         (if (module-defined? the-scm-module 'variable)
+             (module-ref the-scm-module 'variable)
+             value))
+
+       (unless (module-defined? the-scm-module 'variable)
+         (export variable))))))
+
 \f
 ;;;
 ;;; File systems.
@@ -547,6 +578,22 @@ constants from <sys/mount.h>."
                  (list device (strerror err))
                  (list err)))))))
 
+(define-as-needed RB_AUTOBOOT    #x01234567)
+(define-as-needed RB_HALT_SYSTEM #xcdef0123)
+(define-as-needed RB_ENABLED_CAD #x89abcdef)
+(define-as-needed RB_DISABLE_CAD 0)
+(define-as-needed RB_POWER_OFF   #x4321fedc)
+(define-as-needed RB_SW_SUSPEND  #xd000fce2)
+(define-as-needed RB_KEXEC       #x45584543)
+
+(define-as-needed (reboot #:optional (cmd RB_AUTOBOOT))
+  (let ((proc (syscall->procedure int "reboot" (list int))))
+    (let-values (((ret err) (proc cmd)))
+      (unless (zero? ret)
+        (throw 'system-error "reboot" "~S: ~A"
+               (list cmd (strerror err))
+               (list err))))))
+
 (define (kernel? pid)
   "Return #t if PID designates a \"kernel thread\" rather than a normal
 user-land process."
-- 
2.12.2

^ permalink raw reply related	[flat|nested] 30+ messages in thread

* bug#26341: [PATCH 2/5] build: syscalls: Use define-as-needed for mount and umount.
  2017-04-10 17:18 ` bug#26341: [PATCH 1/5] build: syscalls: Add reboot Mathieu Othacehe
@ 2017-04-10 17:18   ` Mathieu Othacehe
  2017-04-10 17:18   ` bug#26341: [PATCH 3/5] build: syscalls: Use define-as-needed for network-interface syscalls Mathieu Othacehe
                     ` (3 subsequent siblings)
  4 siblings, 0 replies; 30+ messages in thread
From: Mathieu Othacehe @ 2017-04-10 17:18 UTC (permalink / raw)
  To: 26341

* guix/build/syscalls.scm (mount): Use define-as-needed macro
  and remove from export list.
(umount): Ditto.
---
 guix/build/syscalls.scm | 86 ++++++++++++++++++++++---------------------------
 1 file changed, 38 insertions(+), 48 deletions(-)

diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
index 0de39aee6..79a0da7c5 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
@@ -492,58 +490,50 @@ the returned procedure is called."
 (define MNT_EXPIRE      4)
 (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
+(define-as-needed (mount source target type
+                         #:optional (flags 0) options
                          #:key (update-mtab? #f))
-          "Mount device SOURCE on TARGET as a file system TYPE.
+  "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)))))))
-
-(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_*
+  ;; XXX: '#:update-mtab?' is not implemented by core 'mount'.
+  (let ((proc (syscall->procedure int "mount" `(* * * ,unsigned-long *))))
+    (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-as-needed (umount 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)))))))
+  ;; XXX: '#:update-mtab?' is not implemented by core 'umount'.
+  (let ((proc (syscall->procedure int "umount2" `(* ,int))))
+    (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

^ permalink raw reply related	[flat|nested] 30+ messages in thread

* bug#26341: [PATCH 3/5] build: syscalls: Use define-as-needed for network-interface syscalls.
  2017-04-10 17:18 ` bug#26341: [PATCH 1/5] build: syscalls: Add reboot Mathieu Othacehe
  2017-04-10 17:18   ` bug#26341: [PATCH 2/5] build: syscalls: Use define-as-needed for mount and umount Mathieu Othacehe
@ 2017-04-10 17:18   ` Mathieu Othacehe
  2017-04-10 17:18   ` bug#26341: [PATCH 4/5] build: syscalls: Add load-linux-module Mathieu Othacehe
                     ` (2 subsequent siblings)
  4 siblings, 0 replies; 30+ messages in thread
From: Mathieu Othacehe @ 2017-04-10 17:18 UTC (permalink / raw)
  To: 26341

* guix/build/syscalls.scm (network-interface-flags): Use define-as-needed macro
  and remove from export list.
(set-network-interface-flags): Ditto.
(set-network-interface-address): Ditto.
(IFF_UP, IFF_BROADCAST and IFF_LOOPBACK): Ditto.
---
 guix/build/syscalls.scm | 22 ++++++++--------------
 1 file changed, 8 insertions(+), 14 deletions(-)

diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
index 79a0da7c5..d1f3cd65c 100644
--- a/guix/build/syscalls.scm
+++ b/guix/build/syscalls.scm
@@ -82,17 +82,11 @@
 
             PF_PACKET
             AF_PACKET
-            IFF_UP
-            IFF_BROADCAST
-            IFF_LOOPBACK
             all-network-interface-names
             network-interface-names
-            network-interface-flags
             network-interface-netmask
             loopback-network-interface?
             network-interface-address
-            set-network-interface-flags
-            set-network-interface-address
             set-network-interface-netmask
             set-network-interface-up
             configure-network-interface
@@ -920,9 +914,9 @@ exception if it's already taken."
 
 ;; Flags and constants from <net/if.h>.
 
-(define IFF_UP #x1)                               ;Interface is up
-(define IFF_BROADCAST #x2)                        ;Broadcast address valid.
-(define IFF_LOOPBACK #x8)                         ;Is a loopback net.
+(define-as-needed IFF_UP #x1)                     ;Interface is up
+(define-as-needed IFF_BROADCAST #x2)              ;Broadcast address valid.
+(define-as-needed IFF_LOOPBACK #x8)               ;Is a loopback net.
 
 (define IF_NAMESIZE 16)                           ;maximum interface name size
 
@@ -1069,7 +1063,7 @@ that are not up."
                 (else
                  (loop interfaces))))))))
 
-(define (network-interface-flags socket name)
+(define-as-needed (network-interface-flags socket name)
   "Return a number that is the bit-wise or of 'IFF*' flags for network
 interface NAME."
   (let ((req (make-bytevector ifreq-struct-size)))
@@ -1080,8 +1074,8 @@ interface NAME."
                           (bytevector->pointer req))))
       (if (zero? ret)
 
-          ;; The 'ifr_flags' field is IF_NAMESIZE bytes after the beginning of
-          ;; 'struct ifreq', and it's a short int.
+          ;; The 'ifr_flags' field is IF_NAMESIZE bytes after the
+          ;; beginning of 'struct ifreq', and it's a short int.
           (bytevector-sint-ref req IF_NAMESIZE (native-endianness)
                                (sizeof short))
 
@@ -1097,7 +1091,7 @@ interface NAME."
     (close-port sock)
     (not (zero? (logand flags IFF_LOOPBACK)))))
 
-(define (set-network-interface-flags socket name flags)
+(define-as-needed (set-network-interface-flags socket name flags)
   "Set the flag of network interface NAME to FLAGS."
   (let ((req (make-bytevector ifreq-struct-size)))
     (bytevector-copy! (string->utf8 name) 0 req 0
@@ -1114,7 +1108,7 @@ interface NAME."
                (list name (strerror err))
                (list err))))))
 
-(define (set-network-interface-address socket name sockaddr)
+(define-as-needed (set-network-interface-address socket name sockaddr)
   "Set the address of network interface NAME to SOCKADDR."
   (let ((req (make-bytevector ifreq-struct-size)))
     (bytevector-copy! (string->utf8 name) 0 req 0
-- 
2.12.2

^ permalink raw reply related	[flat|nested] 30+ messages in thread

* bug#26341: [PATCH 4/5] build: syscalls: Add load-linux-module.
  2017-04-10 17:18 ` bug#26341: [PATCH 1/5] build: syscalls: Add reboot Mathieu Othacehe
  2017-04-10 17:18   ` bug#26341: [PATCH 2/5] build: syscalls: Use define-as-needed for mount and umount Mathieu Othacehe
  2017-04-10 17:18   ` bug#26341: [PATCH 3/5] build: syscalls: Use define-as-needed for network-interface syscalls Mathieu Othacehe
@ 2017-04-10 17:18   ` Mathieu Othacehe
  2017-04-10 17:18   ` bug#26341: [PATCH 5/5] build: Fix compilation warnings Mathieu Othacehe
  2017-04-11  9:15   ` bug#26341: [PATCH 1/5] build: syscalls: Add reboot Ludovic Courtès
  4 siblings, 0 replies; 30+ messages in thread
From: Mathieu Othacehe @ 2017-04-10 17:18 UTC (permalink / raw)
  To: 26341

* guix/build/syscalls.scm (load-linux-module): New procedure. Reimplemented
  from guile-linux-syscalls.patch.
---
 guix/build/syscalls.scm | 12 ++++++++++++
 1 file changed, 12 insertions(+)

diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
index d1f3cd65c..0529c228a 100644
--- a/guix/build/syscalls.scm
+++ b/guix/build/syscalls.scm
@@ -578,6 +578,18 @@ constants from <sys/mount.h>."
                (list cmd (strerror err))
                (list err))))))
 
+(define-as-needed (load-linux-module data #:optional (options ""))
+  (let ((proc (syscall->procedure int "init_module"
+                                  (list '* unsigned-long '*))))
+    (let-values (((ret err)
+                  (proc (bytevector->pointer data)
+                        (bytevector-length data)
+                        (string->pointer options))))
+      (unless (zero? ret)
+        (throw 'system-error "load-linux-module" "~A"
+               (list (strerror err))
+               (list err))))))
+
 (define (kernel? pid)
   "Return #t if PID designates a \"kernel thread\" rather than a normal
 user-land process."
-- 
2.12.2

^ permalink raw reply related	[flat|nested] 30+ messages in thread

* bug#26341: [PATCH 5/5] build: Fix compilation warnings.
  2017-04-10 17:18 ` bug#26341: [PATCH 1/5] build: syscalls: Add reboot Mathieu Othacehe
                     ` (2 preceding siblings ...)
  2017-04-10 17:18   ` bug#26341: [PATCH 4/5] build: syscalls: Add load-linux-module Mathieu Othacehe
@ 2017-04-10 17:18   ` Mathieu Othacehe
  2017-04-11  9:15   ` bug#26341: [PATCH 1/5] build: syscalls: Add reboot Ludovic Courtès
  4 siblings, 0 replies; 30+ messages in thread
From: Mathieu Othacehe @ 2017-04-10 17:18 UTC (permalink / raw)
  To: 26341

* gnu/build/linux-boot.scm (define-module): Use (guix build syscalls).
* gnu/build/linux-modules.scm (define-module): Ditto.
* gnu/build/file-systems (define-module): Stop re-exporting mount, umount and
  MS_* flags as this is now safe to include (guix build syscalls) instead.
  (mount): Remove procedure.
  (umount): Ditto.
---
 gnu/build/file-systems.scm  | 15 ++-------------
 gnu/build/linux-boot.scm    |  2 ++
 gnu/build/linux-modules.scm |  2 ++
 3 files changed, 6 insertions(+), 13 deletions(-)

diff --git a/gnu/build/file-systems.scm b/gnu/build/file-systems.scm
index fe98df95d..eb9f07861 100644
--- a/gnu/build/file-systems.scm
+++ b/gnu/build/file-systems.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2016, 2017 David Craven <david@craven.ch>
+;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -47,12 +48,7 @@
 
             mount-flags->bit-mask
             check-file-system
-            mount-file-system)
-  #:re-export (mount
-               umount
-               MS_BIND
-               MS_MOVE
-               MS_RDONLY))
+            mount-file-system))
 
 ;;; Commentary:
 ;;;
@@ -61,13 +57,6 @@
 ;;;
 ;;; Code:
 
-;; 'mount' is already defined in the statically linked Guile used for initial
-;; RAM disks, in which case the bindings in (guix build syscalls) do not work
-;; (the FFI bindings do not work there).  Override them in that case.
-(when (module-defined? the-scm-module 'mount)
-  (set! mount (@ (guile) mount))
-  (set! umount (@ (guile) umount)))
-
 (define (bind-mount source target)
   "Bind-mount SOURCE at TARGET."
   (mount source target "" MS_BIND))
diff --git a/gnu/build/linux-boot.scm b/gnu/build/linux-boot.scm
index c34a3f7c1..360ef3fae 100644
--- a/gnu/build/linux-boot.scm
+++ b/gnu/build/linux-boot.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -26,6 +27,7 @@
   #:use-module (ice-9 match)
   #:use-module (ice-9 ftw)
   #:use-module (guix build utils)
+  #:use-module (guix build syscalls)
   #:use-module (gnu build linux-modules)
   #:use-module (gnu build file-systems)
   #:export (mount-essential-file-systems
diff --git a/gnu/build/linux-modules.scm b/gnu/build/linux-modules.scm
index d7feb3a08..5ca7bf8e3 100644
--- a/gnu/build/linux-modules.scm
+++ b/gnu/build/linux-modules.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2014, 2016 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -18,6 +19,7 @@
 
 (define-module (gnu build linux-modules)
   #:use-module (guix elf)
+  #:use-module (guix build syscalls)
   #:use-module (rnrs io ports)
   #:use-module (rnrs bytevectors)
   #:use-module (srfi srfi-1)
-- 
2.12.2

^ permalink raw reply related	[flat|nested] 30+ messages in thread

* bug#26341: [PATCH 1/5] build: syscalls: Add reboot.
  2017-04-10 17:18 ` bug#26341: [PATCH 1/5] build: syscalls: Add reboot Mathieu Othacehe
                     ` (3 preceding siblings ...)
  2017-04-10 17:18   ` bug#26341: [PATCH 5/5] build: Fix compilation warnings Mathieu Othacehe
@ 2017-04-11  9:15   ` Ludovic Courtès
  2017-04-11 11:39     ` Mathieu Othacehe
  4 siblings, 1 reply; 30+ messages in thread
From: Ludovic Courtès @ 2017-04-11  9:15 UTC (permalink / raw)
  To: Mathieu Othacehe; +Cc: 26341-done

Hi!

Perfect, I removed “build:” from the subject line (it’s usually for
things that relate to the configury and makefiles) and pushed the whole
series.

Thank you!

Ludo’.

^ permalink raw reply	[flat|nested] 30+ messages in thread

* bug#26341: [PATCH 1/5] build: syscalls: Add reboot.
  2017-04-11  9:15   ` bug#26341: [PATCH 1/5] build: syscalls: Add reboot Ludovic Courtès
@ 2017-04-11 11:39     ` Mathieu Othacehe
  2017-04-11 12:20       ` Ludovic Courtès
  0 siblings, 1 reply; 30+ messages in thread
From: Mathieu Othacehe @ 2017-04-11 11:39 UTC (permalink / raw)
  To: Ludovic Courtès; +Cc: 26341-done


Hi Ludo,

Thanks for merging :)

While we are talking of build warnings, the only remaining warnings are
related to cairo :

...
gnu/build/svg.scm:36:12: warning: possibly unbound variable `cairo-create'
gnu/build/svg.scm:36:26: warning: possibly unbound variable `cairo-image-surface-create'
gnu/build/svg.scm:38:4: warning: possibly unbound variable `cairo-scale'
gnu/build/svg.scm:39:4: warning: possibly unbound variable `cairo-set-source-surface'
...

This file mentions closed bug http://bugs.gnu.org/12202. Is there
something that can be done ?

Thank you,

Mathieu

^ permalink raw reply	[flat|nested] 30+ messages in thread

* bug#26341: [PATCH 1/5] build: syscalls: Add reboot.
  2017-04-11 11:39     ` Mathieu Othacehe
@ 2017-04-11 12:20       ` Ludovic Courtès
  0 siblings, 0 replies; 30+ messages in thread
From: Ludovic Courtès @ 2017-04-11 12:20 UTC (permalink / raw)
  To: Mathieu Othacehe; +Cc: 26341-done

Heya,

Mathieu Othacehe <m.othacehe@gmail.com> skribis:

> While we are talking of build warnings, the only remaining warnings are
> related to cairo :
>
> ...
> gnu/build/svg.scm:36:12: warning: possibly unbound variable `cairo-create'
> gnu/build/svg.scm:36:26: warning: possibly unbound variable `cairo-image-surface-create'
> gnu/build/svg.scm:38:4: warning: possibly unbound variable `cairo-scale'
> gnu/build/svg.scm:39:4: warning: possibly unbound variable `cairo-set-source-surface'
> ...
>
> This file mentions closed bug http://bugs.gnu.org/12202. Is there
> something that can be done ?

Good question!  In fact it doesn’t make much sense to have ‘make’
compile this file since it’s only used on the “build side”, from (gnu
system grub).

So perhaps we should simply adjust Makefile.am & co. to not build this
file.  Thoughts?

(I think there’s a couple of other files in a similar situation.)

Ludo’.

^ permalink raw reply	[flat|nested] 30+ messages in thread

end of thread, other threads:[~2017-04-11 12:21 UTC | newest]

Thread overview: 30+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2017-04-02 15:01 bug#26341: [PATCH] build: vm: Add missing module Mathieu Othacehe
2017-04-04 12:41 ` Ludovic Courtès
2017-04-05 10:30   ` Mathieu Othacehe
2017-04-05 10:32     ` Mathieu Othacehe
2017-04-05 21:39       ` Ludovic Courtès
2017-04-06  6:55         ` Mathieu Othacehe
2017-04-06  8:10           ` Ludovic Courtès
2017-04-07 21:36             ` Ludovic Courtès
2017-04-08  9:24               ` Mathieu Othacehe
2017-04-05 21:35     ` Ludovic Courtès
2017-04-06  6:55 ` bug#26341: [PATCH 1/2] build: syscalls: Allow mount and umount use from static Guile Mathieu Othacehe
2017-04-06  6:55   ` bug#26341: [PATCH 2/2] build: vm: Add missing module Mathieu Othacehe
2017-04-08 16:03 ` bug#26341: [PATCH 0/5] Fix warnings related to syscalls in static Guile Mathieu Othacehe
2017-04-08 16:03   ` bug#26341: [PATCH 1/5] build: syscalls: Add reboot Mathieu Othacehe
2017-04-10  9:42     ` Ludovic Courtès
2017-04-10 13:18       ` Mathieu Othacehe
2017-04-10 13:41         ` Ludovic Courtès
2017-04-10 17:18           ` Mathieu Othacehe
2017-04-08 16:03   ` bug#26341: [PATCH 2/5] build: syscalls: Allow use to network-interface syscalls independently of calling context Mathieu Othacehe
2017-04-08 16:03   ` bug#26341: [PATCH 3/5] build: syscalls: Add mount and umount to #:replace list Mathieu Othacehe
2017-04-08 16:03   ` bug#26341: [PATCH 4/5] build: syscalls: Add load-linux-module Mathieu Othacehe
2017-04-08 16:03   ` bug#26341: [PATCH 5/5] build: Fix compilation warnings Mathieu Othacehe
2017-04-10 17:18 ` bug#26341: [PATCH 1/5] build: syscalls: Add reboot Mathieu Othacehe
2017-04-10 17:18   ` bug#26341: [PATCH 2/5] build: syscalls: Use define-as-needed for mount and umount Mathieu Othacehe
2017-04-10 17:18   ` bug#26341: [PATCH 3/5] build: syscalls: Use define-as-needed for network-interface syscalls Mathieu Othacehe
2017-04-10 17:18   ` bug#26341: [PATCH 4/5] build: syscalls: Add load-linux-module Mathieu Othacehe
2017-04-10 17:18   ` bug#26341: [PATCH 5/5] build: Fix compilation warnings Mathieu Othacehe
2017-04-11  9:15   ` bug#26341: [PATCH 1/5] build: syscalls: Add reboot Ludovic Courtès
2017-04-11 11:39     ` Mathieu Othacehe
2017-04-11 12:20       ` Ludovic Courtès

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/guix.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).