ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-24 05:18:07 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

syscalls: Add 'add-network-route/gateway' and 'delete-network-route'.

Browse source 
* 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.
This commit is contained in:
Ludovic Courtès 2016-11-20 23:35:25 +01:00
parent 8eb790f368
commit 9e38e3cf52
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 134 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

110
guix/build/syscalls.scm
View file

@ -95,6 +95,8 @@ (define-module (guix build syscalls)
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 @@ (define SIOCSIFNETMASK
(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>.
@ -1088,6 +1098,106 @@ (define* (set-network-interface-up name
(lambda ()
(close-port sock)))))
;;;
;;; 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'.

24
tests/syscalls.scm
View file

@ -374,6 +374,30 @@ (define perform-container-tests?
(#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