From f43714e62080f8bdf1ddb02672d26527ac3819ec Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 16 Nov 2016 23:12:14 +0100 Subject: syscalls: C struct writer correctly handles pointer fields. * guix/build/syscalls.scm (write-type): Add case for '*. --- guix/build/syscalls.scm | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) (limited to 'guix/build') diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm index 2cee6544c4..bdc9940bb3 100644 --- a/guix/build/syscalls.scm +++ b/guix/build/syscalls.scm @@ -202,7 +202,7 @@ result is the alignment of the \"most strictly aligned component\"." types ...)))) (define-syntax write-type - (syntax-rules (~ array) + (syntax-rules (~ array *) ((_ bv offset (type ~ order) value) (bytevector-uint-set! bv offset value (endianness order) (sizeof* type))) @@ -215,6 +215,9 @@ result is the alignment of the \"most strictly aligned component\"." ((head . tail) (write-type bv o type head) (loop (+ 1 i) tail (+ o (sizeof* type)))))))) + ((_ bv offset '* value) + (bytevector-uint-set! bv offset (pointer-address value) + (native-endianness) (sizeof* '*))) ((_ bv offset type value) (bytevector-uint-set! bv offset value (native-endianness) (sizeof* type))))) -- cgit v1.2.3 From 9d9d0c9c982449b820eae98d0f2cfa115b618208 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 16 Nov 2016 23:13:12 +0100 Subject: syscalls: Use 'define-c-struct' for 'struct ifconf'. * guix/build/syscalls.scm (ifconf-struct): Remove. (%ifconf-struct): New C struct. (network-interface-names): Use 'make-bytevector' and 'write-ifconf!' instead of 'make-c-struct', and 'read-ifconf' instead of 'parse-c-struct'. --- guix/build/syscalls.scm | 22 ++++++++++++++-------- 1 file changed, 14 insertions(+), 8 deletions(-) (limited to 'guix/build') diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm index bdc9940bb3..1ad6cb4618 100644 --- a/guix/build/syscalls.scm +++ b/guix/build/syscalls.scm @@ -773,10 +773,13 @@ exception if it's already taken." (define IF_NAMESIZE 16) ;maximum interface name size -(define ifconf-struct - ;; 'struct ifconf', from . - (list int ;int ifc_len - '*)) ;struct ifreq *ifc_ifcu +(define-c-struct %ifconf-struct + sizeof-ifconf + list + read-ifconf + write-ifconf! + (length int) ;int ifc_len + (request '*)) ;struct ifreq *ifc_ifcu (define ifreq-struct-size ;; 'struct ifreq' begins with an array of IF_NAMESIZE bytes containing the @@ -868,15 +871,18 @@ to interfaces that are currently up." (sock (or sock (socket SOCK_STREAM AF_INET 0))) (len (* ifreq-struct-size 10)) (reqs (make-bytevector len)) - (conf (make-c-struct ifconf-struct - (list len (bytevector->pointer reqs))))) + (conf (make-bytevector sizeof-ifconf))) + (write-ifconf! conf 0 + len (bytevector->pointer reqs)) + (let-values (((ret err) - (%ioctl (fileno sock) SIOCGIFCONF conf))) + (%ioctl (fileno sock) SIOCGIFCONF + (bytevector->pointer conf)))) (when close? (close-port sock)) (if (zero? ret) (bytevector->string-list reqs ifreq-struct-size - (match (parse-c-struct conf ifconf-struct) + (match (read-ifconf conf) ((len . _) len))) (throw 'system-error "network-interface-list" "network-interface-list: ~A" -- cgit v1.2.3 From 67e5f3b71d87d0a0e444df2e039c458629708cd4 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès 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(+) (limited to 'guix/build') 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 . @@ -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 From e9ff8d9ff15db2917d7200cda2bb68a52a9b19b0 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 17 Nov 2016 23:09:22 +0100 Subject: syscalls: 'configure-network-interface' has a #:netmask parameter. * guix/build/syscalls.scm (configure-network-interface): Add #:netmask keyword parameter and honor it. --- guix/build/syscalls.scm | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) (limited to 'guix/build') diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm index f4d4d155ec..c3832f6d48 100644 --- a/guix/build/syscalls.scm +++ b/guix/build/syscalls.scm @@ -1028,15 +1028,19 @@ the same type as that returned by 'make-socket-address'." (list name (strerror err)) (list err)))))) -(define (configure-network-interface name sockaddr flags) +(define* (configure-network-interface name sockaddr flags + #:key netmask) "Configure network interface NAME to use SOCKADDR, an address as returned by -'make-socket-address', and FLAGS, a bitwise-or of IFF_* constants." +'make-socket-address', and FLAGS, a bitwise-or of IFF_* constants. If NETMASK +is true, it must be a socket address to use as the network mask." (let ((sock (socket (sockaddr:fam sockaddr) SOCK_STREAM 0))) (dynamic-wind (const #t) (lambda () (set-network-interface-address sock name sockaddr) - (set-network-interface-flags sock name flags)) + (set-network-interface-flags sock name flags) + (when netmask + (set-network-interface-netmask sock name netmask))) (lambda () (close-port sock))))) -- cgit v1.2.3 From 8eb790f368be5d7beac728e55093b6a3ea22328b Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 20 Nov 2016 23:34:36 +0100 Subject: syscalls: Add 'c-struct-field-offset'. * guix/build/syscalls.scm (define-c-struct-macro): New macro. (define-c-struct): Use it. (c-struct-field-offset): New macro. --- guix/build/syscalls.scm | 31 +++++++++++++++++++++++++++++++ 1 file changed, 31 insertions(+) (limited to 'guix/build') diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm index c3832f6d48..85de47d26e 100644 --- a/guix/build/syscalls.scm +++ b/guix/build/syscalls.scm @@ -267,6 +267,29 @@ result is the alignment of the \"most strictly aligned component\"." (align offset type0) type0)))))) +(define-syntax define-c-struct-macro + (syntax-rules () + "Define NAME as a macro that can be queried to get information about the C +struct it represents. In particular: + + (NAME field-offset FIELD) + +returns the offset in bytes of FIELD within the C struct represented by NAME." + ((_ name ((fields types) ...)) + (define-c-struct-macro name + (fields ...) 0 () + ((fields types) ...))) + ((_ name (fields ...) offset (clauses ...) ((field type) rest ...)) + (define-c-struct-macro name + (fields ...) + (+ (align offset type) (type-size type)) + (clauses ... ((_ field-offset field) (align offset type))) + (rest ...))) + ((_ name (fields ...) offset (clauses ...) ()) + (define-syntax name + (syntax-rules (field-offset fields ...) + clauses ...))))) + (define-syntax define-c-struct (syntax-rules () "Define SIZE as the size in bytes of the C structure made of FIELDS. READ @@ -274,6 +297,8 @@ as a deserializer and WRITE! as a serializer for the C structure with the given TYPES. READ uses WRAP-FIELDS to return its value." ((_ name size wrap-fields read write! (fields types) ...) (begin + (define-c-struct-macro name + ((fields types) ...)) (define size (struct-size 0 () types ...)) (define (write! bv offset fields ...) @@ -281,6 +306,12 @@ given TYPES. READ uses WRAP-FIELDS to return its value." (define* (read bv #:optional (offset 0)) (read-types wrap-fields bv offset (types ...) ())))))) +(define-syntax-rule (c-struct-field-offset type field) + "Return the offset in BYTES of FIELD within TYPE, where TYPE is a C struct +defined with 'define-c-struct' and FIELD is a field identifier. An +expansion-time error is raised if FIELD does not exist in TYPE." + (type field-offset field)) + ;;; ;;; FFI. -- cgit v1.2.3 From 9e38e3cf527d907b499f8fc909aac5d0e25a5af7 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 20 Nov 2016 23:35:25 +0100 Subject: 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(+) (limited to 'guix/build') diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm index 85de47d26e..9386c0f5d0 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 . @@ -1088,6 +1098,106 @@ is true, it must be a socket address to use as the network mask." (lambda () (close-port sock))))) + +;;; +;;; Network routes. +;;; + +(define-c-struct %rtentry ;'struct rtentry' from + 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 +(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 fd177265f0..e4ef32c522 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 -- cgit v1.2.3