From 67e5f3b71d87d0a0e444df2e039c458629708cd4 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Wed, 16 Nov 2016 23:36:29 +0100
Subject: syscalls: Add bindings for SIOCGIFNETMASK and SIOCSIFNETMASK.

* guix/build/syscalls.scm (SIOCGIFNETMASK, SIOCSIFNETMASK): New
variables.
(set-network-interface-netmask, network-interface-netmask): New
procedures.
* tests/syscalls.scm ("network-interface-netmask lo")
("set-network-interface-netmask"): New tests.
---
 guix/build/syscalls.scm | 42 ++++++++++++++++++++++++++++++++++++++++++
 tests/syscalls.scm      | 21 +++++++++++++++++++++
 2 files changed, 63 insertions(+)

diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
index 1ad6cb4618..f4d4d155ec 100644
--- a/guix/build/syscalls.scm
+++ b/guix/build/syscalls.scm
@@ -87,10 +87,12 @@
             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
 
@@ -764,6 +766,14 @@ exception if it's already taken."
   (if (string-contains %host-type "linux")
       #x8916                                      ;GNU/Linux
       -1))                                        ;FIXME: GNU/Hurd?
+(define SIOCGIFNETMASK
+  (if (string-contains %host-type "linux")
+      #x891b                                      ;GNU/Linux
+      -1))                                        ;FIXME: GNU/Hurd?
+(define SIOCSIFNETMASK
+  (if (string-contains %host-type "linux")
+      #x891c                                      ;GNU/Linux
+      -1))                                        ;FIXME: GNU/Hurd?
 
 ;; Flags and constants from <net/if.h>.
 
@@ -970,6 +980,22 @@ interface NAME."
                (list name (strerror err))
                (list err))))))
 
+(define (set-network-interface-netmask socket name sockaddr)
+  "Set the network mask of 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) SIOCSIFNETMASK
+                          (bytevector->pointer req))))
+      (unless (zero? ret)
+        (throw 'system-error "set-network-interface-netmask"
+               "set-network-interface-netmask on ~A: ~A"
+               (list name (strerror err))
+               (list err))))))
+
 (define (network-interface-address socket name)
   "Return the address of network interface NAME.  The result is an object of
 the same type as that returned by 'make-socket-address'."
@@ -986,6 +1012,22 @@ the same type as that returned by 'make-socket-address'."
                  (list name (strerror err))
                  (list err))))))
 
+(define (network-interface-netmask socket name)
+  "Return the netmask of network interface NAME.  The result is an object of
+the same type as that returned by 'make-socket-address'."
+  (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) SIOCGIFNETMASK
+                          (bytevector->pointer req))))
+      (if (zero? ret)
+          (read-socket-address req IF_NAMESIZE)
+          (throw 'system-error "network-interface-netmask"
+                 "network-interface-netmask on ~A: ~A"
+                 (list name (strerror err))
+                 (list err))))))
+
 (define (configure-network-interface name sockaddr flags)
   "Configure network interface NAME to use SOCKADDR, an address as returned by
 'make-socket-address', and FLAGS, a bitwise-or of IFF_* constants."
diff --git a/tests/syscalls.scm b/tests/syscalls.scm
index 9eb19f9c80..fd177265f0 100644
--- a/tests/syscalls.scm
+++ b/tests/syscalls.scm
@@ -326,6 +326,27 @@
         ;; We get EPERM with Linux 3.18ish and EACCES with 2.6.32.
         (memv (system-error-errno args) (list EPERM EACCES))))))
 
+(test-equal "network-interface-netmask lo"
+  (make-socket-address AF_INET (inet-pton AF_INET "255.0.0.0") 0)
+  (let* ((sock (socket AF_INET SOCK_STREAM 0))
+         (addr (network-interface-netmask sock "lo")))
+    (close-port sock)
+    addr))
+
+(test-skip (if (zero? (getuid)) 1 0))
+(test-assert "set-network-interface-netmask"
+  (let ((sock (socket AF_INET SOCK_STREAM 0)))
+    (catch 'system-error
+      (lambda ()
+        (set-network-interface-netmask sock "nonexistent"
+                                       (make-socket-address
+                                        AF_INET
+                                        (inet-pton AF_INET "255.0.0.0")
+                                        0)))
+      (lambda args
+        (close-port sock)
+        (memv (system-error-errno args) (list EPERM EACCES))))))
+
 (test-equal "network-interfaces returns one or more interfaces"
   '(#t #t #t)
   (match (network-interfaces)
-- 
cgit v1.2.3