[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
02/03: syscalls: Add 'add-network-route/gateway' and 'delete-network-rou
|
From: |
Ludovic Courtès |
|
Subject: |
02/03: syscalls: Add 'add-network-route/gateway' and 'delete-network-route'. |
|
Date: |
Sun, 20 Nov 2016 23:36:04 +0000 (UTC) |
civodul pushed a commit to branch master
in repository guix.
commit 9e38e3cf527d907b499f8fc909aac5d0e25a5af7
Author: Ludovic Courtès <address@hidden>
Date: Sun Nov 20 23:35:25 2016 +0100
syscalls: Add 'add-network-route/gateway' and 'delete-network-route'.
* guix/build/syscalls.scm (SIOCADDRT, SIOCDELRT): New variables.
(%rtentry): New C struct.
(RTF_UP, RTF_GATEWAY, %sockaddr-any): New variables.
(add-network-route/gateway, delete-network-route): New procedures.
* tests/syscalls.scm ("add-network-route/gateway")
("delete-network-route"): New tests.
---
guix/build/syscalls.scm | 110 +++++++++++++++++++++++++++++++++++++++++++++++
tests/syscalls.scm | 24 +++++++++++
2 files changed, 134 insertions(+)
diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
index 85de47d..9386c0f 100644
--- a/guix/build/syscalls.scm
+++ b/guix/build/syscalls.scm
@@ -95,6 +95,8 @@
set-network-interface-netmask
set-network-interface-up
configure-network-interface
+ add-network-route/gateway
+ delete-network-route
interface?
interface-name
@@ -805,6 +807,14 @@ exception if it's already taken."
(if (string-contains %host-type "linux")
#x891c ;GNU/Linux
-1)) ;FIXME: GNU/Hurd?
+(define SIOCADDRT
+ (if (string-contains %host-type "linux")
+ #x890B ;GNU/Linux
+ -1)) ;FIXME: GNU/Hurd?
+(define SIOCDELRT
+ (if (string-contains %host-type "linux")
+ #x890C ;GNU/Linux
+ -1)) ;FIXME: GNU/Hurd?
;; Flags and constants from <net/if.h>.
@@ -1090,6 +1100,106 @@ is true, it must be a socket address to use as the
network mask."
;;;
+;;; Network routes.
+;;;
+
+(define-c-struct %rtentry ;'struct rtentry' from <net/route.h>
+ sizeof-rtentry
+ list
+ read-rtentry
+ write-rtentry!
+ (pad1 unsigned-long)
+ (destination (array uint8 16)) ;struct sockaddr
+ (gateway (array uint8 16)) ;struct sockaddr
+ (genmask (array uint8 16)) ;struct sockaddr
+ (flags unsigned-short)
+ (pad2 short)
+ (pad3 long)
+ (tos uint8)
+ (class uint8)
+ (pad4 (array uint8 (if (= 8 (sizeof* '*)) 3 1)))
+ (metric short)
+ (device '*)
+ (mtu unsigned-long)
+ (window unsigned-long)
+ (initial-rtt unsigned-short))
+
+(define RTF_UP #x0001) ;'rtentry' flags from <net/route.h>
+(define RTF_GATEWAY #x0002)
+
+(define %sockaddr-any
+ (make-socket-address AF_INET INADDR_ANY 0))
+
+(define add-network-route/gateway
+ ;; To allow field names to be matched as literals, we need to move them out
+ ;; of the lambda's body since the parameters have the same name. A lot of
+ ;; fuss for very little.
+ (let-syntax ((gateway-offset (identifier-syntax
+ (c-struct-field-offset %rtentry gateway)))
+ (destination-offset (identifier-syntax
+ (c-struct-field-offset %rtentry
destination)))
+ (genmask-offset (identifier-syntax
+ (c-struct-field-offset %rtentry genmask))))
+ (lambda* (socket gateway
+ #:key (destination %sockaddr-any) (genmask %sockaddr-any))
+ "Add a network route for DESTINATION (a socket address as returned by
+'make-socket-address') that goes through GATEWAY (a socket address). For
+instance, the call:
+
+ (add-network-route/gateway sock
+ (make-socket-address
+ AF_INET
+ (inet-pton AF_INET \"192.168.0.1\")
+ 0))
+
+is equivalent to this 'net-tools' command:
+
+ route add -net default gw 192.168.0.1
+
+because the default value of DESTINATION is \"0.0.0.0\"."
+ (let ((route (make-bytevector sizeof-rtentry 0)))
+ (write-socket-address! gateway route gateway-offset)
+ (write-socket-address! destination route destination-offset)
+ (write-socket-address! genmask route genmask-offset)
+ (bytevector-u16-native-set! route
+ (c-struct-field-offset %rtentry flags)
+ (logior RTF_UP RTF_GATEWAY))
+ (let-values (((ret err)
+ (%ioctl (fileno socket) SIOCADDRT
+ (bytevector->pointer route))))
+ (unless (zero? ret)
+ (throw 'system-error "add-network-route/gateway"
+ "add-network-route/gateway: ~A"
+ (list (strerror err))
+ (list err))))))))
+
+(define delete-network-route
+ (let-syntax ((destination-offset (identifier-syntax
+ (c-struct-field-offset %rtentry
destination))))
+ (lambda* (socket destination)
+ "Delete the network route for DESTINATION. For instance, the call:
+
+ (delete-network-route sock
+ (make-socket-address AF_INET INADDR_ANY 0))
+
+is equivalent to the 'net-tools' command:
+
+ route del -net default
+"
+
+ (let ((route (make-bytevector sizeof-rtentry 0)))
+ (write-socket-address! destination route destination-offset)
+ (let-values (((ret err)
+ (%ioctl (fileno socket) SIOCDELRT
+ (bytevector->pointer route))))
+ (unless (zero? ret)
+ (throw 'system-error "delete-network-route"
+ "delete-network-route: ~A"
+ (list (strerror err))
+ (list err))))))))
+
+
+;;;
;;; Details about network interfaces---aka. 'getifaddrs'.
;;;
diff --git a/tests/syscalls.scm b/tests/syscalls.scm
index fd17726..e4ef32c 100644
--- a/tests/syscalls.scm
+++ b/tests/syscalls.scm
@@ -374,6 +374,30 @@
(#f #f)
(lo (interface-address lo)))))))
+(test-skip (if (zero? (getuid)) 1 0))
+(test-assert "add-network-route/gateway"
+ (let ((sock (socket AF_INET SOCK_STREAM 0))
+ (gateway (make-socket-address AF_INET
+ (inet-pton AF_INET "192.168.0.1")
+ 0)))
+ (catch 'system-error
+ (lambda ()
+ (add-network-route/gateway sock gateway))
+ (lambda args
+ (close-port sock)
+ (memv (system-error-errno args) (list EPERM EACCES))))))
+
+(test-skip (if (zero? (getuid)) 1 0))
+(test-assert "delete-network-route"
+ (let ((sock (socket AF_INET SOCK_STREAM 0))
+ (destination (make-socket-address AF_INET INADDR_ANY 0)))
+ (catch 'system-error
+ (lambda ()
+ (delete-network-route sock destination))
+ (lambda args
+ (close-port sock)
+ (memv (system-error-errno args) (list EPERM EACCES))))))
+
(test-equal "tcgetattr ENOTTY"
ENOTTY
(catch 'system-error