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
next prev 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).