unofficial mirror of guix-patches@gnu.org 
 help / color / mirror / code / Atom feed
From: Mathieu Othacehe <m.othacehe@gmail.com>
To: 26341@debbugs.gnu.org
Subject: bug#26341: [PATCH 2/5] build: syscalls: Allow use to network-interface syscalls independently of calling context.
Date: Sat,  8 Apr 2017 18:03:26 +0200	[thread overview]
Message-ID: <20170408160329.4068-3-m.othacehe@gmail.com> (raw)
In-Reply-To: <20170408160329.4068-1-m.othacehe@gmail.com>

* 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

  parent reply	other threads:[~2017-04-08 16:04 UTC|newest]

Thread overview: 30+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
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   ` Mathieu Othacehe [this message]
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

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://guix.gnu.org/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=20170408160329.4068-3-m.othacehe@gmail.com \
    --to=m.othacehe@gmail.com \
    --cc=26341@debbugs.gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
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).