* [PATCH] getifaddrs wrapper @ 2015-06-19 9:50 Rohan Prinja 2015-06-19 12:03 ` Ludovic Courtès 0 siblings, 1 reply; 9+ messages in thread From: Rohan Prinja @ 2015-06-19 9:50 UTC (permalink / raw) To: guix-devel [-- Attachment #1.1: Type: text/plain, Size: 24 bytes --] PTAL, thank you -Rohan [-- Attachment #1.2: Type: text/html, Size: 57 bytes --] [-- Attachment #2: 0001-add-wrapper-for-getifaddrs-3-to-guix-build-syscalls..patch --] [-- Type: application/octet-stream, Size: 3207 bytes --] From 668910afbe979145a7699708817e28d219ec0750 Mon Sep 17 00:00:00 2001 From: Rohan Prinja <rohan.prinja@gmail.com> Date: Fri, 19 Jun 2015 12:05:05 +0530 Subject: [PATCH] add wrapper for getifaddrs (3) to guix/build/syscalls.scm --- guix/build/syscalls.scm | 76 +++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 76 insertions(+) diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm index 3585bf2..e5d296a 100644 --- a/guix/build/syscalls.scm +++ b/guix/build/syscalls.scm @@ -36,6 +36,7 @@ swapon swapoff processes + getifaddrs IFF_UP IFF_BROADCAST @@ -381,6 +382,81 @@ the C structure with the given TYPES." (address (int128 ~ big)) (scopeid int32)) +;; TODO: no support for unions yet. +;; This only supports broadcast addrs. +(define-c-struct ifaddrs ;<ifaddrs.h> + read-ifaddrs + write-ifaddrs! + (ifa-next '*) + (ifa-name '*) + (ifa-flags unsigned-int) + (ifa-addr '*) + (ifa-netmask '*) + (ifu-broadcastaddr '*) + (ifa-data '*)) + +(define-syntax-rule (bytevector-slice bv start len) + (let* ((res (make-bytevector len 0)) + (_ (bytevector-copy! bv start res 0 len))) + res)) + +;; See getifaddrs (3) for a description of +;; struct ifaddrs. +(define %struct-ifaddrs-type + `(* * ,unsigned-int * * * *)) + +(define %getifaddrs + (let* ((ptr (dynamic-func "getifaddrs" (dynamic-link))) + (proc (pointer->procedure int ptr (list '*))) + (struct-init (list %null-pointer + %null-pointer + 0 + %null-pointer + %null-pointer + %null-pointer + %null-pointer))) + (lambda () + "Wrapper around getifaddrs (3)." + (let* ((ifap (make-c-struct %struct-ifaddrs-type + struct-init)) + (ifapp (scm->pointer ifap)) ; ifap ptr + (ret (proc ifapp)) + (err (errno))) + (if (zero? ret) + (next-ifaddr (parse-ifaddrs ifapp)) + (throw 'system-error "getifaddrs" "~S: ~A" + (list ifap (strerror err)) + (list err))))))) + +(define (getifaddrs) + "Obtain a list of network interfaces on the local system." + (let ((ifaddrs (%getifaddrs))) + (let lp ((curr ifaddrs) (res '())) + (if (last-interface? curr) + (reverse res) + (lp (next-ifaddr curr) (cons curr res)))))) + +;; Given a pointer to a struct ifaddrs, parse it into a list. +(define-syntax-rule (parse-ifaddrs ptr) + (parse-c-struct ptr %struct-ifaddrs-type)) + +;; Retrieve a bytevector aliasing the memory pointed to by the +;; ifa_next struct ifaddrs* pointer. +(define-syntax-rule (next-ifaddr ifaddrs) + (parse-c-struct (car ifaddrs) %struct-ifaddrs-type)) + +;; Retrieve interface name. +(define-syntax-rule (ifaddr-name ifaddrs) + (pointer->string (cadr ifaddrs))) + +;; Retrieve interface flags. +(define-syntax-rule (ifaddr-flags ifaddrs) + (list-ref ifaddrs 2)) + +;; Is an interface the last in the intrusive linked list of struct ifaddrs? +(define-syntax-rule (last-interface? ifaddrs) + (null-pointer? (car ifaddrs))) + (define (write-socket-address! sockaddr bv index) "Write SOCKADDR, a socket address as returned by 'make-socket-address', to bytevector BV at INDEX." -- 1.9.1 ^ permalink raw reply related [flat|nested] 9+ messages in thread
* Re: [PATCH] getifaddrs wrapper 2015-06-19 9:50 [PATCH] getifaddrs wrapper Rohan Prinja @ 2015-06-19 12:03 ` Ludovic Courtès 2015-07-02 10:59 ` Rohan Prinja 0 siblings, 1 reply; 9+ messages in thread From: Ludovic Courtès @ 2015-06-19 12:03 UTC (permalink / raw) To: Rohan Prinja; +Cc: guix-devel Rohan Prinja <rohan.prinja@gmail.com> skribis: > From 668910afbe979145a7699708817e28d219ec0750 Mon Sep 17 00:00:00 2001 > From: Rohan Prinja <rohan.prinja@gmail.com> > Date: Fri, 19 Jun 2015 12:05:05 +0530 > Subject: [PATCH] add wrapper for getifaddrs (3) to guix/build/syscalls.scm Nice! I have a few comments, but nothing major. Please add a copyright line for yourself in the file. Please do not use tabs at all in the file. Could you add a test in the tests/syscalls.scm file? Basically something that makes sure that ‘getifaddrs’ returns a (possibly empty) list, with relevant values. > +;; TODO: no support for unions yet. It’s not clear what’s “to be done” here. Could you rephrase it maybe? > +;; This only supports broadcast addrs. Ditto. > +(define-c-struct ifaddrs ;<ifaddrs.h> > + read-ifaddrs > + write-ifaddrs! > + (ifa-next '*) > + (ifa-name '*) > + (ifa-flags unsigned-int) > + (ifa-addr '*) > + (ifa-netmask '*) > + (ifu-broadcastaddr '*) > + (ifa-data '*)) Currently ‘read-ifaddrs’ and ‘write-ifaddrs!’ are unused, but they should be used (see below.) > +(define-syntax-rule (bytevector-slice bv start len) Please change ‘define-syntax-rule’ to ‘define’ and add a docstring. > + (let* ((res (make-bytevector len 0)) > + (_ (bytevector-copy! bv start res 0 len))) > + res)) Rather: (let ((result (make-bytevector len))) (bytevector-copy! bv start result 0 len) result) > +;; See getifaddrs (3) for a description of > +;; struct ifaddrs. > +(define %struct-ifaddrs-type > + `(* * ,unsigned-int * * * *)) The comment should be “FFI type for ‘struct ifaddr’.” > +(define %getifaddrs > + (let* ((ptr (dynamic-func "getifaddrs" (dynamic-link))) > + (proc (pointer->procedure int ptr (list '*))) > + (struct-init (list %null-pointer > + %null-pointer > + 0 > + %null-pointer > + %null-pointer > + %null-pointer > + %null-pointer))) > + (lambda () > + "Wrapper around getifaddrs (3)." > + (let* ((ifap (make-c-struct %struct-ifaddrs-type > + struct-init)) > + (ifapp (scm->pointer ifap)) ; ifap ptr s/ifapp/ptr/ and s/scm->pointer/pointer-address/ because ‘make-c-struct’ returns a pointer object. > + (ret (proc ifapp)) > + (err (errno))) > + (if (zero? ret) > + (next-ifaddr (parse-ifaddrs ifapp)) Use ‘read-ifaddrs’ instead of ‘parse-ifaddrs’. > +(define (getifaddrs) > + "Obtain a list of network interfaces on the local system." s/Obtain a/Return the/ > + (let ((ifaddrs (%getifaddrs))) > + (let lp ((curr ifaddrs) (res '())) > + (if (last-interface? curr) > + (reverse res) > + (lp (next-ifaddr curr) (cons curr res)))))) s/lp/loop/ for consistency This is OK, but the problem is that each object in the list that is returned is a tuple, so it’s not very convenient. What about defining a <interface-address> record type, and converting the tuples to that, so that users of ‘getifaddrs’ directly get this more convenient interface? Like: (define-record-type <interface-address> (interface-address name flags) interface-address? (name interface-address-name) (flags interface-address-flags)) The type predicate and accessors need to be exported, of course. > +;; Given a pointer to a struct ifaddrs, parse it into a list. > +(define-syntax-rule (parse-ifaddrs ptr) > + (parse-c-struct ptr %struct-ifaddrs-type)) No longer needed. > +;; Retrieve a bytevector aliasing the memory pointed to by the > +;; ifa_next struct ifaddrs* pointer. > +(define-syntax-rule (next-ifaddr ifaddrs) > + (parse-c-struct (car ifaddrs) %struct-ifaddrs-type)) s/define-syntax-rule/define/ Use ‘match’ instead of ‘car’; same for the following macros. > +;; Retrieve interface name. > +(define-syntax-rule (ifaddr-name ifaddrs) > + (pointer->string (cadr ifaddrs))) > + > +;; Retrieve interface flags. > +(define-syntax-rule (ifaddr-flags ifaddrs) > + (list-ref ifaddrs 2)) These become unneeded once <interface-address> is added. Could you send an updated patch? If something is unclear, please let me know! Thank you! Ludo’. ^ permalink raw reply [flat|nested] 9+ messages in thread
* Re: [PATCH] getifaddrs wrapper 2015-06-19 12:03 ` Ludovic Courtès @ 2015-07-02 10:59 ` Rohan Prinja 2015-07-02 12:23 ` Ludovic Courtès 0 siblings, 1 reply; 9+ messages in thread From: Rohan Prinja @ 2015-07-02 10:59 UTC (permalink / raw) To: Ludovic Courtès; +Cc: guix-devel [-- Attachment #1: Type: text/plain, Size: 4822 bytes --] PTAL, tests to follow soon. Thank you. On 19 June 2015 at 17:33, Ludovic Courtès <ludo@gnu.org> wrote: > Rohan Prinja <rohan.prinja@gmail.com> skribis: > >> From 668910afbe979145a7699708817e28d219ec0750 Mon Sep 17 00:00:00 2001 >> From: Rohan Prinja <rohan.prinja@gmail.com> >> Date: Fri, 19 Jun 2015 12:05:05 +0530 >> Subject: [PATCH] add wrapper for getifaddrs (3) to guix/build/syscalls.scm > > Nice! > > I have a few comments, but nothing major. > > Please add a copyright line for yourself in the file. > > Please do not use tabs at all in the file. > > Could you add a test in the tests/syscalls.scm file? Basically > something that makes sure that ‘getifaddrs’ returns a (possibly empty) > list, with relevant values. > >> +;; TODO: no support for unions yet. > > It’s not clear what’s “to be done” here. Could you rephrase it maybe? > >> +;; This only supports broadcast addrs. > > Ditto. > >> +(define-c-struct ifaddrs ;<ifaddrs.h> >> + read-ifaddrs >> + write-ifaddrs! >> + (ifa-next '*) >> + (ifa-name '*) >> + (ifa-flags unsigned-int) >> + (ifa-addr '*) >> + (ifa-netmask '*) >> + (ifu-broadcastaddr '*) >> + (ifa-data '*)) > > Currently ‘read-ifaddrs’ and ‘write-ifaddrs!’ are unused, but they > should be used (see below.) > >> +(define-syntax-rule (bytevector-slice bv start len) > > Please change ‘define-syntax-rule’ to ‘define’ and add a docstring. > >> + (let* ((res (make-bytevector len 0)) >> + (_ (bytevector-copy! bv start res 0 len))) >> + res)) > > Rather: > > (let ((result (make-bytevector len))) > (bytevector-copy! bv start result 0 len) > result) > >> +;; See getifaddrs (3) for a description of >> +;; struct ifaddrs. >> +(define %struct-ifaddrs-type >> + `(* * ,unsigned-int * * * *)) > > The comment should be “FFI type for ‘struct ifaddr’.” > >> +(define %getifaddrs >> + (let* ((ptr (dynamic-func "getifaddrs" (dynamic-link))) >> + (proc (pointer->procedure int ptr (list '*))) >> + (struct-init (list %null-pointer >> + %null-pointer >> + 0 >> + %null-pointer >> + %null-pointer >> + %null-pointer >> + %null-pointer))) >> + (lambda () >> + "Wrapper around getifaddrs (3)." >> + (let* ((ifap (make-c-struct %struct-ifaddrs-type >> + struct-init)) >> + (ifapp (scm->pointer ifap)) ; ifap ptr > > s/ifapp/ptr/ and s/scm->pointer/pointer-address/ because ‘make-c-struct’ > returns a pointer object. > >> + (ret (proc ifapp)) >> + (err (errno))) >> + (if (zero? ret) >> + (next-ifaddr (parse-ifaddrs ifapp)) > > Use ‘read-ifaddrs’ instead of ‘parse-ifaddrs’. > >> +(define (getifaddrs) >> + "Obtain a list of network interfaces on the local system." > > s/Obtain a/Return the/ > >> + (let ((ifaddrs (%getifaddrs))) >> + (let lp ((curr ifaddrs) (res '())) >> + (if (last-interface? curr) >> + (reverse res) >> + (lp (next-ifaddr curr) (cons curr res)))))) > > s/lp/loop/ for consistency > > This is OK, but the problem is that each object in the list that is > returned is a tuple, so it’s not very convenient. > > What about defining a <interface-address> record type, and converting > the tuples to that, so that users of ‘getifaddrs’ directly get this more > convenient interface? Like: > > (define-record-type <interface-address> > (interface-address name flags) > interface-address? > (name interface-address-name) > (flags interface-address-flags)) > > The type predicate and accessors need to be exported, of course. > >> +;; Given a pointer to a struct ifaddrs, parse it into a list. >> +(define-syntax-rule (parse-ifaddrs ptr) >> + (parse-c-struct ptr %struct-ifaddrs-type)) > > No longer needed. > >> +;; Retrieve a bytevector aliasing the memory pointed to by the >> +;; ifa_next struct ifaddrs* pointer. >> +(define-syntax-rule (next-ifaddr ifaddrs) >> + (parse-c-struct (car ifaddrs) %struct-ifaddrs-type)) > > s/define-syntax-rule/define/ > > Use ‘match’ instead of ‘car’; same for the following macros. > >> +;; Retrieve interface name. >> +(define-syntax-rule (ifaddr-name ifaddrs) >> + (pointer->string (cadr ifaddrs))) >> + >> +;; Retrieve interface flags. >> +(define-syntax-rule (ifaddr-flags ifaddrs) >> + (list-ref ifaddrs 2)) > > These become unneeded once <interface-address> is added. > > Could you send an updated patch? > > If something is unclear, please let me know! > > Thank you! > > Ludo’. [-- Attachment #2: 0001-guix-build-syscalls.scm-refactor-according-to-code-r.patch --] [-- Type: text/x-patch, Size: 7445 bytes --] From 1bdbd195d7979fe2058b88d7033eaeb93b524fb7 Mon Sep 17 00:00:00 2001 From: Rohan Prinja <rohan.prinja@gmail.com> Date: Thu, 2 Jul 2015 16:28:24 +0530 Subject: [PATCH] guix/build/syscalls.scm: refactor according to code review --- guix/build/syscalls.scm | 150 ++++++++++++++++++++++++++++++++---------------- 1 file changed, 101 insertions(+), 49 deletions(-) diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm index e5d296a..5afdd47 100644 --- a/guix/build/syscalls.scm +++ b/guix/build/syscalls.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2015 Rohan Prinja <rohan.prinja@gmail.com> ;;; ;;; This file is part of GNU Guix. ;;; @@ -20,6 +21,7 @@ #:use-module (system foreign) #:use-module (rnrs bytevectors) #:use-module (srfi srfi-1) + #:use-module (srfi srfi-9) #:use-module (ice-9 rdelim) #:use-module (ice-9 regex) #:use-module (ice-9 match) @@ -36,7 +38,12 @@ swapon swapoff processes - getifaddrs + getifaddrs + + <interface-address> + interface-address? + interface-address-name + interface-address-flags IFF_UP IFF_BROADCAST @@ -382,8 +389,6 @@ the C structure with the given TYPES." (address (int128 ~ big)) (scopeid int32)) -;; TODO: no support for unions yet. -;; This only supports broadcast addrs. (define-c-struct ifaddrs ;<ifaddrs.h> read-ifaddrs write-ifaddrs! @@ -395,67 +400,114 @@ the C structure with the given TYPES." (ifu-broadcastaddr '*) (ifa-data '*)) -(define-syntax-rule (bytevector-slice bv start len) - (let* ((res (make-bytevector len 0)) - (_ (bytevector-copy! bv start res 0 len))) +(define-record-type <interface-address> + (make-interface-address name flags addr netmask broadaddr data) + interface-address? + (name interface-address-name) + (flags interface-address-flags) + (addr interface-address-addr) + (netmask interface-address-netmask) + (broadaddr interface-address-broadaddr) + (data interface-address-data)) + +(define (bytevector-slice bv start len) + "Return a new bytevector (not a view into the old one) +containing the elements from BV from index START upto +index START + LEN - 1" + (let* ((res (make-bytevector len 0))) + (bytevector-copy! bv start res 0 len) res)) -;; See getifaddrs (3) for a description of -;; struct ifaddrs. +;; FFI type for 'struct ifaddrs'. (define %struct-ifaddrs-type `(* * ,unsigned-int * * * *)) +;; Initializer for 'struct ifaddrs'. +(define %struct-ifaddrs-init + (list %null-pointer + %null-pointer + 0 + %null-pointer + %null-pointer + %null-pointer + %null-pointer)) + (define %getifaddrs - (let* ((ptr (dynamic-func "getifaddrs" (dynamic-link))) - (proc (pointer->procedure int ptr (list '*))) - (struct-init (list %null-pointer - %null-pointer - 0 - %null-pointer - %null-pointer - %null-pointer - %null-pointer))) + (let* ((func-ptr (dynamic-func "getifaddrs" (dynamic-link))) + (proc (pointer->procedure int func-ptr (list '*)))) (lambda () "Wrapper around getifaddrs (3)." - (let* ((ifap (make-c-struct %struct-ifaddrs-type - struct-init)) - (ifapp (scm->pointer ifap)) ; ifap ptr - (ret (proc ifapp)) - (err (errno))) - (if (zero? ret) - (next-ifaddr (parse-ifaddrs ifapp)) - (throw 'system-error "getifaddrs" "~S: ~A" - (list ifap (strerror err)) - (list err))))))) + (let* ((ptr (make-c-struct %struct-ifaddrs-type + %struct-ifaddrs-init)) + (ret (proc ptr)) + (err (errno))) + (if (zero? ret) + (next-ifaddr (ifaddrs-pointer->bv ptr)) + (throw 'system-error "getifaddrs" "~S: ~A" + (list ptr (strerror err)) + (list err))))))) + +(define (make-ifaddrs bv) + "Convert a bytevector aliasing the memory pointed to by a +'struct ifaddrs' pointer into a <interface-address> record." + (match (read-ifaddrs bv 0) + ((next name-ptr flags addr netmask broadaddr data) + (make-interface-address (pointer->string (make-pointer name-ptr)) + flags + (make-pointer addr) + netmask + (make-pointer broadaddr) + (make-pointer data))))) (define (getifaddrs) - "Obtain a list of network interfaces on the local system." + "Return the list of network interfaces on the local system." (let ((ifaddrs (%getifaddrs))) - (let lp ((curr ifaddrs) (res '())) + (let loop ((curr ifaddrs) (res '())) (if (last-interface? curr) - (reverse res) - (lp (next-ifaddr curr) (cons curr res)))))) - -;; Given a pointer to a struct ifaddrs, parse it into a list. -(define-syntax-rule (parse-ifaddrs ptr) - (parse-c-struct ptr %struct-ifaddrs-type)) - -;; Retrieve a bytevector aliasing the memory pointed to by the -;; ifa_next struct ifaddrs* pointer. -(define-syntax-rule (next-ifaddr ifaddrs) - (parse-c-struct (car ifaddrs) %struct-ifaddrs-type)) - -;; Retrieve interface name. -(define-syntax-rule (ifaddr-name ifaddrs) - (pointer->string (cadr ifaddrs))) - -;; Retrieve interface flags. -(define-syntax-rule (ifaddr-flags ifaddrs) - (list-ref ifaddrs 2)) + (map make-ifaddrs (reverse res)) + (loop (next-ifaddr curr) + (cons curr res)))))) + +;; Retrieve the ifa-name field from a 'struct ifaddrs' +;; pointer passed in as a bytevector BV. +(define-syntax-rule (ifaddr-name bv) + (match (read-ifaddrs bv 0) + ((next name-ptr flags addr netmask broadaddr data) + (pointer->string (make-pointer name-ptr))))) + +;; Retrieve the ifa-flags field from a 'struct ifaddrs' +;; pointer passed in as a bytevector BV. +(define-syntax-rule (ifaddr-flags bv) + (match (read-ifaddrs bv 0) + ((next name-ptr flags addr netmask broadaddr data) + flags))) + +(define (ifaddrs-pointer->bv ptr) + "Return a bytevector aliasing the memory pointed to by a +'struct ifaddrs' pointer, passed as a pointer object PTR." + (pointer->bytevector ptr (sizeof %struct-ifaddrs-type))) + +;; Return the bytevector aliasing the memory pointed to by +;; the ifa-next field in a 'struct ifaddrs' pointer passed in +;; as a bytevector. +(define next-ifaddr + (compose ifaddrs-pointer->bv + next-ifaddr-ptr)) + +(define (next-ifaddr-ptr bv) + "Return a bytevector aliasing the memory pointed to by the +ifa_next field of a struct ifaddrs* pointer passed as a +bytevector BV." + (let* ((ptr-size (sizeof '*)) + (address (cond ((= ptr-size 4) (bytevector-u32-native-ref bv 0)) + ((= ptr-size 8) (bytevector-u64-native-ref bv 0))))) + (make-pointer address))) ;; Is an interface the last in the intrusive linked list of struct ifaddrs? +;; Here, IFADDRS is a bytevector aliasing the memory pointed to by +;; a 'struct ifaddrs' pointer. (define-syntax-rule (last-interface? ifaddrs) - (null-pointer? (car ifaddrs))) + (null-pointer? (next-ifaddr-ptr ifaddrs))) (define (write-socket-address! sockaddr bv index) "Write SOCKADDR, a socket address as returned by 'make-socket-address', to -- 1.9.1 ^ permalink raw reply related [flat|nested] 9+ messages in thread
* Re: [PATCH] getifaddrs wrapper 2015-07-02 10:59 ` Rohan Prinja @ 2015-07-02 12:23 ` Ludovic Courtès 2015-07-16 8:30 ` Rohan Prinja 0 siblings, 1 reply; 9+ messages in thread From: Ludovic Courtès @ 2015-07-02 12:23 UTC (permalink / raw) To: Rohan Prinja; +Cc: guix-devel Rohan Prinja <rohan.prinja@gmail.com> skribis: > PTAL, tests to follow soon. It’s looking good now, thanks! Could you send the updated patch against master, that includes a simple test in tests/syscalls.scm that makes sure that ‘getifaddrs’ returns a possibly empty list of <interface-address>? TIA, Ludo’. ^ permalink raw reply [flat|nested] 9+ messages in thread
* Re: [PATCH] getifaddrs wrapper 2015-07-02 12:23 ` Ludovic Courtès @ 2015-07-16 8:30 ` Rohan Prinja 2015-07-16 13:50 ` Rohan Prinja 0 siblings, 1 reply; 9+ messages in thread From: Rohan Prinja @ 2015-07-16 8:30 UTC (permalink / raw) To: Ludovic Courtès; +Cc: guix-devel [-- Attachment #1: Type: text/plain, Size: 553 bytes --] A bug causing broadcast-addr and other fields AFTER the flags field in 'struct getifaddrs' to be accessed incorrectly has been fixed. On 2 July 2015 at 17:53, Ludovic Courtès <ludo@gnu.org> wrote: > Rohan Prinja <rohan.prinja@gmail.com> skribis: > >> PTAL, tests to follow soon. > > It’s looking good now, thanks! > > Could you send the updated patch against master, that includes a simple > test in tests/syscalls.scm that makes sure that ‘getifaddrs’ returns a > possibly empty list of <interface-address>? > > TIA, > Ludo’. [-- Attachment #2: 0001-guix-build-syscalls.scm-export-the-new-functions.patch --] [-- Type: text/x-patch, Size: 1086 bytes --] From a4158777607d871d028e6bacc9aeb3a1b8178f9d Mon Sep 17 00:00:00 2001 From: Rohan Prinja <rohan.prinja@gmail.com> Date: Thu, 16 Jul 2015 13:01:36 +0530 Subject: [PATCH 1/5] guix/build/syscalls.scm: export the new functions --- guix/build/syscalls.scm | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm index 5afdd47..d155f49 100644 --- a/guix/build/syscalls.scm +++ b/guix/build/syscalls.scm @@ -44,6 +44,19 @@ interface-address? interface-address-name interface-address-flags + interface-address-data + + interface-address-addr + interface-address-netmask + interface-address-broadaddr + + ;; Wrappers around the above three functions. Each + ;; of these returns either a socket address or #f. + interface-address-address + interface-address-broadcast-addr + interface-address-netmask-addr + + make-ifaddrs IFF_UP IFF_BROADCAST -- 1.9.1 [-- Attachment #3: 0002-guix-build-syscalls.scm-add-wrapper-accessors-for-ne.patch --] [-- Type: text/x-patch, Size: 6248 bytes --] From 1a43f24c5e848f07c94e291637ef30210c87fbe5 Mon Sep 17 00:00:00 2001 From: Rohan Prinja <rohan.prinja@gmail.com> Date: Thu, 16 Jul 2015 13:06:25 +0530 Subject: [PATCH 2/5] guix/build/syscalls.scm: add wrapper accessors for netmask, addr and broadaddr --- guix/build/syscalls.scm | 108 +++++++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 103 insertions(+), 5 deletions(-) diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm index d155f49..800a3a8 100644 --- a/guix/build/syscalls.scm +++ b/guix/build/syscalls.scm @@ -435,6 +435,16 @@ index START + LEN - 1" (define %struct-ifaddrs-type `(* * ,unsigned-int * * * *)) +;; Size of 'struct sockaddr' in bytes. +;; See also: bind (2). +(define %sizeof-struct-sockaddr + (+ 14 (sizeof unsigned-short))) + +(define (ifaddrs-pointer->bv ptr) + "Return a bytevector aliasing the memory pointed to by a +'struct ifaddrs' pointer, passed as a pointer object PTR." + (pointer->bytevector ptr (sizeof %struct-ifaddrs-type))) + ;; Initializer for 'struct ifaddrs'. (define %struct-ifaddrs-init (list %null-pointer @@ -445,6 +455,22 @@ index START + LEN - 1" %null-pointer %null-pointer)) +(define (next-ifaddr-ptr bv) + "Return a bytevector aliasing the memory pointed to by the +ifa_next field of a struct ifaddrs* pointer passed as a +bytevector BV." + (let* ((ptr-size (sizeof '*)) + (address (cond ((= ptr-size 4) (bytevector-u32-native-ref bv 0)) + ((= ptr-size 8) (bytevector-u64-native-ref bv 0))))) + (make-pointer address))) + +;; Return the bytevector aliasing the memory pointed to by +;; the ifa-next field in a 'struct ifaddrs' pointer passed in +;; as a bytevector. +(define next-ifaddr + (compose ifaddrs-pointer->bv + next-ifaddr-ptr)) + (define %getifaddrs (let* ((func-ptr (dynamic-func "getifaddrs" (dynamic-link))) (proc (pointer->procedure int func-ptr (list '*)))) @@ -468,25 +494,97 @@ index START + LEN - 1" (make-interface-address (pointer->string (make-pointer name-ptr)) flags (make-pointer addr) - netmask + (make-pointer netmask) (make-pointer broadaddr) (make-pointer data))))) +;; Is an interface the last in the intrusive linked list of struct ifaddrs? +;; Here, the only argument is a bytevector aliasing the memory pointed to by +;; a 'struct ifaddrs' pointer. +(define last-interface? + (compose null-pointer? next-ifaddr-ptr)) + +(define (pack-ifaddrs bv) + "Strip out the needless 4-byte padding after the +unsigned-int ifa-flags field" + (if (and (= 8 (sizeof '*)) + (= 4 (sizeof unsigned-int))) + (let* ((res (make-bytevector 52 0))) + (bytevector-copy! bv 0 res 0 20) + (bytevector-copy! bv 24 res 20 32) + res) + bv)) + (define (getifaddrs) "Return the list of network interfaces on the local system." (let ((ifaddrs (%getifaddrs))) (let loop ((curr ifaddrs) (res '())) (if (last-interface? curr) - (map make-ifaddrs (reverse res)) + (map (compose make-ifaddrs pack-ifaddrs) + (reverse res)) (loop (next-ifaddr curr) (cons curr res)))))) -;; Retrieve the ifa-name field from a 'struct ifaddrs' +;; Given a bytevector aliasing the memory pointed to by +;; a 'struct sockaddr' pointer, return a socket address. +(define-syntax-rule (bytevector->sockaddr bv) + (match (read-sockaddr-in bv 0) + ((family port address) + (if (member family (list AF_INET AF_INET6 AF_UNIX)) + (inet-ntop family address) + #f)))) + +;; Note: address fields in 'struct getifaddrs' are pointers to +;; 'struct sockaddr'. In 'interface-address-broadcast-addr' we are +;; implicitly typecasting this 'sockaddr' pointer to a +;; 'sockaddr_in' pointer. + +;; Note: getifaddrs returns multiple interfaces with the same +;; e.g. on my system I see multiple "eth0"s. The difference is +;; that for one of the eth0's, the family of the address +;; pointed to by the ifu.ifa-broadaddr field is 17, which is +;; not an AF_* constant. Hence the check for "(member family ...)". + +(define (extract-address-field iface field) + "Extract a field corresponding to an IPv4 address from a 'struct +sockaddr' from an <interface-address> record type." + (let* ((addr (field iface)) + (bv (pointer->bytevector addr %sizeof-struct-sockaddr))) + (bytevector->sockaddr bv))) + +;; Given an <interface-address> record IFACE, return its +;; address field as a sockaddr if it exists, otherwise return #f. +(define (interface-address-address iface) + (extract-address-field iface interface-address-addr)) + +;; Given an <interface-address> record IFACE, return its broadcast +;; address field as a sockaddr if it exists, otherwise return #f. +(define (interface-address-broadcast-addr iface) + (extract-address-field iface interface-address-broadaddr)) + +;; Given an <interface-address> record IFACE, return its netmask +;; address field as a sockaddr if it exists, otherwise return #f. +(define (interface-address-netmask-addr iface) + (extract-address-field iface interface-address-netmask)) + +;; Retrieve the ifa-next-ptr field from a 'struct ifaddrs' ;; pointer passed in as a bytevector BV. -(define-syntax-rule (ifaddr-name bv) +(define-syntax-rule (ifaddr-next-ptr bv) (match (read-ifaddrs bv 0) ((next name-ptr flags addr netmask broadaddr data) - (pointer->string (make-pointer name-ptr))))) + next))) + +;; Retrieve the bytes corresponding to the ifa-name field +;; from a 'struct ifaddrs' pointer passed in as a bytevector BV. +(define-syntax-rule (ifaddr-name-bytes bv) + (match (read-ifaddrs bv 0) + ((next name-ptr flags addr netmask broadaddr data) + name-ptr))) + +;; Retrieve the string pointed to by the ifa-name field +;; from a 'struct ifaddrs' pointer passed in as a bytevector BV. +(define-syntax-rule (ifaddr-name bv) + (pointer->string (make-pointer (ifaddr-name-bytes bv)))) ;; Retrieve the ifa-flags field from a 'struct ifaddrs' ;; pointer passed in as a bytevector BV. -- 1.9.1 [-- Attachment #4: 0003-guix-build-syscalls.scm-remove-unneeded-low-level-ac.patch --] [-- Type: text/x-patch, Size: 1899 bytes --] From 881412da8f41ea4f4c7c621ea840feaba6fec919 Mon Sep 17 00:00:00 2001 From: Rohan Prinja <rohan.prinja@gmail.com> Date: Thu, 16 Jul 2015 13:26:48 +0530 Subject: [PATCH 3/5] guix/build/syscalls.scm: remove unneeded low-level accessor --- guix/build/syscalls.scm | 27 --------------------------- 1 file changed, 27 deletions(-) diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm index 800a3a8..a50a9bf 100644 --- a/guix/build/syscalls.scm +++ b/guix/build/syscalls.scm @@ -593,33 +593,6 @@ sockaddr' from an <interface-address> record type." ((next name-ptr flags addr netmask broadaddr data) flags))) -(define (ifaddrs-pointer->bv ptr) - "Return a bytevector aliasing the memory pointed to by a -'struct ifaddrs' pointer, passed as a pointer object PTR." - (pointer->bytevector ptr (sizeof %struct-ifaddrs-type))) - -;; Return the bytevector aliasing the memory pointed to by -;; the ifa-next field in a 'struct ifaddrs' pointer passed in -;; as a bytevector. -(define next-ifaddr - (compose ifaddrs-pointer->bv - next-ifaddr-ptr)) - -(define (next-ifaddr-ptr bv) - "Return a bytevector aliasing the memory pointed to by the -ifa_next field of a struct ifaddrs* pointer passed as a -bytevector BV." - (let* ((ptr-size (sizeof '*)) - (address (cond ((= ptr-size 4) (bytevector-u32-native-ref bv 0)) - ((= ptr-size 8) (bytevector-u64-native-ref bv 0))))) - (make-pointer address))) - -;; Is an interface the last in the intrusive linked list of struct ifaddrs? -;; Here, IFADDRS is a bytevector aliasing the memory pointed to by -;; a 'struct ifaddrs' pointer. -(define-syntax-rule (last-interface? ifaddrs) - (null-pointer? (next-ifaddr-ptr ifaddrs))) - (define (write-socket-address! sockaddr bv index) "Write SOCKADDR, a socket address as returned by 'make-socket-address', to bytevector BV at INDEX." -- 1.9.1 [-- Attachment #5: 0004-tests-syscalls.scm-add-utility-functions-for-testing.patch --] [-- Type: text/x-patch, Size: 4651 bytes --] From 4a718e6f2f76616e06848d94022ee8d05a17bea1 Mon Sep 17 00:00:00 2001 From: Rohan Prinja <rohan.prinja@gmail.com> Date: Thu, 16 Jul 2015 13:27:13 +0530 Subject: [PATCH 4/5] tests/syscalls.scm: add utility functions for testing --- tests/syscalls.scm | 89 +++++++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 88 insertions(+), 1 deletion(-) diff --git a/tests/syscalls.scm b/tests/syscalls.scm index 706f3df..bf4f604 100644 --- a/tests/syscalls.scm +++ b/tests/syscalls.scm @@ -21,11 +21,98 @@ #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) #:use-module (srfi srfi-64) - #:use-module (ice-9 match)) + #:use-module (ice-9 match) + #:use-module ((ice-9 popen) #:select (open-pipe*)) + #:use-module ((ice-9 rdelim) #:select (read-line)) + #:use-module ((ice-9 regex) #:select (string-match match:substring)) + #:use-module (rnrs bytevectors) + #:use-module (system foreign) + #:use-module ((rnrs io ports) #:select (port-eof?))) ;; Test the (guix build syscalls) module, although there's not much that can ;; actually be tested without being root. +;; Is the first character of a string #\space? +(define-syntax-rule (first-char-is-space? string) + (eq? #\space (string-ref string 0))) + +;; In the output produced by ifconfig (8), is a line +;; one that starts a new interface description? +(define-syntax-rule (line-contains-iface-name? line) + (not (or (string-null? line) + (first-char-is-space? line)))) + +(define (ifconfig-find-all-interfaces) + "List all the network interfaces as identified +by ifconfig (8)." + (let ((pipe (open-pipe* OPEN_READ "ifconfig"))) + (let lp ((line (read-line pipe)) + (res '())) + (cond ((port-eof? pipe) (reverse res)) + ((line-contains-iface-name? line) + (let* ((trimmed-line (string-trim-both line)) + (split-line (string-split trimmed-line #\space)) + (iface-name (car split-line))) + (lp (read-line pipe) + (cons iface-name res)))) + (else (lp (read-line pipe) res)))))) + +(define (extract-iface-name line) + "Extract the name of the interface from a line in the output of +ifconfig (8) which is known to be the first line describing said +interface." + (let ((str-ls (string->list line))) + (let lp ((ls str-ls) (res '())) + (if (eq? #\space (car ls)) + (apply string (reverse res)) + (lp (cdr ls) (cons (car ls) res)))))) + +(define (ifconfig-extract-addr-of iface-name type) + "Call ifconfig (8) to find out the broadcast address of the +interface whose name is a prefix of the string IFACE-NAME. The +broadcast address is returned as a printable string." + (let ((pipe (open-pipe* OPEN_READ "ifconfig"))) + (let lp ((line (read-line pipe))) + (if (eof-object? line) + #f + (if (and (line-contains-iface-name? line) + (string-prefix? iface-name + (extract-iface-name line))) + (let* ((next-line (read-line pipe)) + (search-string (cond ((eq? type 'broadcast) "Bcast:") + ((eq? type 'netmask) "Mask:") + (else "inet addr:"))) + (str-byte "[0-9]([0-9][0-9])?") + (ipaddr-regex (string-append search-string + str-byte "\\." + str-byte "\\." + str-byte "\\." + str-byte)) + (match (string-match ipaddr-regex next-line))) + (if match + (string-drop (match:substring match) (cond ((eq? type 'broadcast) 6) + ((eq? type 'netmask) 5) + (else 10))) + (lp (read-line pipe)))) + (lp (read-line pipe))))))) + +(define (prefix? ls1 ls2) + "Is list LS1 a prefix of list LS2?. This procedure +assumes that (length ls1) <= (length ls2)." + (or (null? ls1) + (and (equal? (car ls1) (car ls2)) + (prefix? (cdr ls1) (cdr ls2))))) + +(define (remove-duplicates ls) + "Remove consecutive duplicate elements from a list LS. +For example, (4 2 2 2 2 1 3 3) => (4 2 1 3)." + (cond ((< (length ls) 2) + ls) + ((equal? (car ls) (cadr ls)) + (remove-duplicates (cdr ls))) + (else + (cons (car ls) (remove-duplicates (cdr ls)))))) + (test-begin "syscalls") (test-equal "mount, ENOENT" -- 1.9.1 [-- Attachment #6: 0005-tests-syscalls.scm-add-getifaddrs-tests.patch --] [-- Type: text/x-patch, Size: 3552 bytes --] From a60e8083de3a6cec3b610be54f6bef77ce18a36d Mon Sep 17 00:00:00 2001 From: Rohan Prinja <rohan.prinja@gmail.com> Date: Thu, 16 Jul 2015 13:27:34 +0530 Subject: [PATCH 5/5] tests/syscalls.scm: add getifaddrs tests --- tests/syscalls.scm | 52 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 52 insertions(+) diff --git a/tests/syscalls.scm b/tests/syscalls.scm index bf4f604..3665575 100644 --- a/tests/syscalls.scm +++ b/tests/syscalls.scm @@ -213,6 +213,58 @@ For example, (4 2 2 2 2 1 3 3) => (4 2 1 3)." ;; We get EPERM with Linux 3.18ish and EACCES with 2.6.32. (memv (system-error-errno args) (list EPERM EACCES)))))) +(test-assert "getifaddrs" + (let* ((ifaddrs (getifaddrs)) + (names (map interface-address-name ifaddrs))) + (member "lo" names))) + +(test-assert "ifconfig-result-is-subset-of-getifaddrs-result" + (let* ((ifaddrs (getifaddrs)) + (names (map interface-address-name ifaddrs)) + (sorted-names (sort names string<?)) + (unique-names (remove-duplicates sorted-names)) + (ifconfig (ifconfig-find-all-interfaces))) + (prefix? + (sort (ifconfig-find-all-interfaces) string<?) + unique-names))) + +(test-assert "getifaddrs-address" + (let* ((is-eth-iface? (lambda (i) + (string-prefix? "eth" + (interface-address-name i)))) + (ifaddrs (getifaddrs)) + (eth-ifaces (filter is-eth-iface? ifaddrs)) + (getifaddrs-tmp (map interface-address-address eth-ifaces)) + (getifaddrs-result (remove not getifaddrs-tmp)) + (ifconfig-result (ifconfig-extract-addr-of "eth" 'address))) + (member ifconfig-result getifaddrs-result))) + +(test-assert "getifaddrs-broadcast-address" + (let* ((is-eth-iface? (lambda (i) + (string-prefix? "eth" + (interface-address-name i)))) + (ifaddrs (getifaddrs)) + (eth-ifaces (filter is-eth-iface? ifaddrs)) + (getifaddrs-tmp (map interface-address-broadcast-addr eth-ifaces)) + (getifaddrs-result (remove not getifaddrs-tmp)) + (ifconfig-result (ifconfig-extract-addr-of "eth" 'broadcast))) + (member ifconfig-result getifaddrs-result))) + +(test-assert "getifaddrs-netmask-address" + (let* ((is-eth-iface? (lambda (i) + (string-prefix? "eth" + (interface-address-name i)))) + (ifaddrs (getifaddrs)) + (eth-ifaces (filter is-eth-iface? ifaddrs)) + (getifaddrs-tmp (remove (lambda (i) + (null-pointer? + (interface-address-netmask i))) + eth-ifaces)) + (getifaddrs-tmp (map interface-address-netmask-addr getifaddrs-tmp)) + (getifaddrs-result (remove not getifaddrs-tmp)) + (ifconfig-result (ifconfig-extract-addr-of "eth" 'netmask))) + (member ifconfig-result getifaddrs-result))) + (test-end) \f -- 1.9.1 ^ permalink raw reply related [flat|nested] 9+ messages in thread
* Re: [PATCH] getifaddrs wrapper 2015-07-16 8:30 ` Rohan Prinja @ 2015-07-16 13:50 ` Rohan Prinja 2015-07-16 15:38 ` Ludovic Courtès 0 siblings, 1 reply; 9+ messages in thread From: Rohan Prinja @ 2015-07-16 13:50 UTC (permalink / raw) To: Ludovic Courtès; +Cc: guix-devel [-- Attachment #1: Type: text/plain, Size: 732 bytes --] Added a convenience macro to make the filtering out of unneeded interfaces cleaner. On 16 July 2015 at 14:00, Rohan Prinja <rohan.prinja@gmail.com> wrote: > A bug causing broadcast-addr and other fields AFTER the flags field in > 'struct getifaddrs' to be accessed incorrectly has been fixed. > > On 2 July 2015 at 17:53, Ludovic Courtès <ludo@gnu.org> wrote: >> Rohan Prinja <rohan.prinja@gmail.com> skribis: >> >>> PTAL, tests to follow soon. >> >> It’s looking good now, thanks! >> >> Could you send the updated patch against master, that includes a simple >> test in tests/syscalls.scm that makes sure that ‘getifaddrs’ returns a >> possibly empty list of <interface-address>? >> >> TIA, >> Ludo’. [-- Attachment #2: 0001-guix-build-syscalls.scm-tests-syscalls.scm-un-export.patch --] [-- Type: text/x-patch, Size: 5034 bytes --] From 6192e9a17b52b95d307fc80268f854d8e886005c Mon Sep 17 00:00:00 2001 From: Rohan Prinja <rohan.prinja@gmail.com> Date: Thu, 16 Jul 2015 19:19:29 +0530 Subject: [PATCH] guix/build/syscalls.scm, tests/syscalls.scm: un-export make-ifaddrs, and add a convenience macro to filter out non-useful interfaces --- guix/build/syscalls.scm | 17 +++++++++++------ tests/syscalls.scm | 19 ++++++------------- 2 files changed, 17 insertions(+), 19 deletions(-) diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm index a50a9bf..0cda091 100644 --- a/guix/build/syscalls.scm +++ b/guix/build/syscalls.scm @@ -56,7 +56,7 @@ interface-address-broadcast-addr interface-address-netmask-addr - make-ifaddrs + remove-if-netmask-null IFF_UP IFF_BROADCAST @@ -534,11 +534,6 @@ unsigned-int ifa-flags field" (inet-ntop family address) #f)))) -;; Note: address fields in 'struct getifaddrs' are pointers to -;; 'struct sockaddr'. In 'interface-address-broadcast-addr' we are -;; implicitly typecasting this 'sockaddr' pointer to a -;; 'sockaddr_in' pointer. - ;; Note: getifaddrs returns multiple interfaces with the same ;; e.g. on my system I see multiple "eth0"s. The difference is ;; that for one of the eth0's, the family of the address @@ -552,6 +547,16 @@ sockaddr' from an <interface-address> record type." (bv (pointer->bytevector addr %sizeof-struct-sockaddr))) (bytevector->sockaddr bv))) +;; Note: address fields in 'struct getifaddrs' are pointers to +;; 'struct sockaddr'. In 'extract-address-field' we are +;; implicitly typecasting this 'sockaddr' pointer to a +;; 'sockaddr_in' pointer. + +;; Utility macro to remove all ifaces from the output IFACES of +;; (getifaddrs) that have a null-pointer in the 'netmask' field. +(define-syntax-rule (remove-if-netmask-null ifaces) + (remove (compose null-pointer? interface-address-netmask) ifaces)) + ;; Given an <interface-address> record IFACE, return its ;; address field as a sockaddr if it exists, otherwise return #f. (define (interface-address-address iface) diff --git a/tests/syscalls.scm b/tests/syscalls.scm index 3665575..87c58ea 100644 --- a/tests/syscalls.scm +++ b/tests/syscalls.scm @@ -232,10 +232,9 @@ For example, (4 2 2 2 2 1 3 3) => (4 2 1 3)." (let* ((is-eth-iface? (lambda (i) (string-prefix? "eth" (interface-address-name i)))) - (ifaddrs (getifaddrs)) + (ifaddrs (remove-if-netmask-null (getifaddrs))) (eth-ifaces (filter is-eth-iface? ifaddrs)) - (getifaddrs-tmp (map interface-address-address eth-ifaces)) - (getifaddrs-result (remove not getifaddrs-tmp)) + (getifaddrs-result (map interface-address-address eth-ifaces)) (ifconfig-result (ifconfig-extract-addr-of "eth" 'address))) (member ifconfig-result getifaddrs-result))) @@ -243,10 +242,9 @@ For example, (4 2 2 2 2 1 3 3) => (4 2 1 3)." (let* ((is-eth-iface? (lambda (i) (string-prefix? "eth" (interface-address-name i)))) - (ifaddrs (getifaddrs)) + (ifaddrs (remove-if-netmask-null (getifaddrs))) (eth-ifaces (filter is-eth-iface? ifaddrs)) - (getifaddrs-tmp (map interface-address-broadcast-addr eth-ifaces)) - (getifaddrs-result (remove not getifaddrs-tmp)) + (getifaddrs-result (map interface-address-broadcast-addr eth-ifaces)) (ifconfig-result (ifconfig-extract-addr-of "eth" 'broadcast))) (member ifconfig-result getifaddrs-result))) @@ -254,14 +252,9 @@ For example, (4 2 2 2 2 1 3 3) => (4 2 1 3)." (let* ((is-eth-iface? (lambda (i) (string-prefix? "eth" (interface-address-name i)))) - (ifaddrs (getifaddrs)) + (ifaddrs (remove-if-netmask-null (getifaddrs))) (eth-ifaces (filter is-eth-iface? ifaddrs)) - (getifaddrs-tmp (remove (lambda (i) - (null-pointer? - (interface-address-netmask i))) - eth-ifaces)) - (getifaddrs-tmp (map interface-address-netmask-addr getifaddrs-tmp)) - (getifaddrs-result (remove not getifaddrs-tmp)) + (getifaddrs-result (map interface-address-netmask-addr eth-ifaces)) (ifconfig-result (ifconfig-extract-addr-of "eth" 'netmask))) (member ifconfig-result getifaddrs-result))) -- 1.9.1 ^ permalink raw reply related [flat|nested] 9+ messages in thread
* Re: [PATCH] getifaddrs wrapper 2015-07-16 13:50 ` Rohan Prinja @ 2015-07-16 15:38 ` Ludovic Courtès 2015-07-17 10:57 ` Rohan Prinja 0 siblings, 1 reply; 9+ messages in thread From: Ludovic Courtès @ 2015-07-16 15:38 UTC (permalink / raw) To: Rohan Prinja; +Cc: guix-devel Rohan Prinja <rohan.prinja@gmail.com> skribis: > Added a convenience macro to make the filtering out of unneeded > interfaces cleaner. >> On 2 July 2015 at 17:53, Ludovic Courtès <ludo@gnu.org> wrote: [...] >>> Could you send the updated patch against master, that includes a simple >>> test in tests/syscalls.scm that makes sure that ‘getifaddrs’ returns a >>> possibly empty list of <interface-address>? Could you please do both things ↑, or at least the first item (I’ll finish polishing it)? ‘git diff origin/master’ should produce the patch. TIA! Ludo’. ^ permalink raw reply [flat|nested] 9+ messages in thread
* Re: [PATCH] getifaddrs wrapper 2015-07-16 15:38 ` Ludovic Courtès @ 2015-07-17 10:57 ` Rohan Prinja 2015-07-25 12:59 ` Ludovic Courtès 0 siblings, 1 reply; 9+ messages in thread From: Rohan Prinja @ 2015-07-17 10:57 UTC (permalink / raw) To: Ludovic Courtès; +Cc: guix-devel [-- Attachment #1: Type: text/plain, Size: 935 bytes --] Hi, 'git rebase' kept failing after a pull, so I squashed my 8 commits into one. That got the rebase to work. Sorry for the giant patch... Ludo: the tests for syscalls.scm are included in the patch as well. Thank you, Rohan On 16 July 2015 at 21:08, Ludovic Courtès <ludo@gnu.org> wrote: > Rohan Prinja <rohan.prinja@gmail.com> skribis: > >> Added a convenience macro to make the filtering out of unneeded >> interfaces cleaner. > >>> On 2 July 2015 at 17:53, Ludovic Courtès <ludo@gnu.org> wrote: > > [...] > >>>> Could you send the updated patch against master, that includes a simple >>>> test in tests/syscalls.scm that makes sure that ‘getifaddrs’ returns a >>>> possibly empty list of <interface-address>? > > Could you please do both things ↑, or at least the first item (I’ll > finish polishing it)? > > ‘git diff origin/master’ should produce the patch. > > TIA! > > Ludo’. [-- Attachment #2: getifaddrs-patch.patch --] [-- Type: text/x-patch, Size: 16008 bytes --] diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm index dcca5fc..8262e0b 100644 --- a/guix/build/syscalls.scm +++ b/guix/build/syscalls.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2015 David Thompson <davet@gnu.org> +;;; Copyright © 2015 Rohan Prinja <rohan.prinja@gmail.com> ;;; ;;; This file is part of GNU Guix. ;;; @@ -21,6 +22,7 @@ #:use-module (system foreign) #:use-module (rnrs bytevectors) #:use-module (srfi srfi-1) + #:use-module (srfi srfi-9) #:use-module (ice-9 rdelim) #:use-module (ice-9 regex) #:use-module (ice-9 match) @@ -57,6 +59,26 @@ clone setns + getifaddrs + + <interface-address> + interface-address? + interface-address-name + interface-address-flags + interface-address-data + + interface-address-addr + interface-address-netmask + interface-address-broadaddr + + ;; Wrappers around the above three functions. Each + ;; of these returns either a socket address or #f. + interface-address-address + interface-address-broadcast-addr + interface-address-netmask-addr + + remove-if-netmask-null + IFF_UP IFF_BROADCAST IFF_LOOPBACK @@ -478,6 +500,202 @@ the C structure with the given TYPES." (address (int128 ~ big)) (scopeid int32)) +(define-c-struct ifaddrs ;<ifaddrs.h> + read-ifaddrs + write-ifaddrs! + (ifa-next '*) + (ifa-name '*) + (ifa-flags unsigned-int) + (ifa-addr '*) + (ifa-netmask '*) + (ifu-broadcastaddr '*) + (ifa-data '*)) + +(define-record-type <interface-address> + (make-interface-address name flags addr netmask broadaddr data) + interface-address? + (name interface-address-name) + (flags interface-address-flags) + (addr interface-address-addr) + (netmask interface-address-netmask) + (broadaddr interface-address-broadaddr) + (data interface-address-data)) + +(define (bytevector-slice bv start len) + "Return a new bytevector (not a view into the old one) +containing the elements from BV from index START upto +index START + LEN - 1" + (let* ((res (make-bytevector len 0))) + (bytevector-copy! bv start res 0 len) + res)) + +;; FFI type for 'struct ifaddrs'. +(define %struct-ifaddrs-type + `(* * ,unsigned-int * * * *)) + +;; Size of 'struct sockaddr' in bytes. +;; See also: bind (2). +(define %sizeof-struct-sockaddr + (+ 14 (sizeof unsigned-short))) + +(define (ifaddrs-pointer->bv ptr) + "Return a bytevector aliasing the memory pointed to by a +'struct ifaddrs' pointer, passed as a pointer object PTR." + (pointer->bytevector ptr (sizeof %struct-ifaddrs-type))) + +;; Initializer for 'struct ifaddrs'. +(define %struct-ifaddrs-init + (list %null-pointer + %null-pointer + 0 + %null-pointer + %null-pointer + %null-pointer + %null-pointer)) + +(define (next-ifaddr-ptr bv) + "Return a bytevector aliasing the memory pointed to by the +ifa_next field of a struct ifaddrs* pointer passed as a +bytevector BV." + (let* ((ptr-size (sizeof '*)) + (address (cond ((= ptr-size 4) (bytevector-u32-native-ref bv 0)) + ((= ptr-size 8) (bytevector-u64-native-ref bv 0))))) + (make-pointer address))) + +;; Return the bytevector aliasing the memory pointed to by +;; the ifa-next field in a 'struct ifaddrs' pointer passed in +;; as a bytevector. +(define next-ifaddr + (compose ifaddrs-pointer->bv + next-ifaddr-ptr)) + +(define %getifaddrs + (let* ((func-ptr (dynamic-func "getifaddrs" (dynamic-link))) + (proc (pointer->procedure int func-ptr (list '*)))) + (lambda () + "Wrapper around getifaddrs (3)." + (let* ((ptr (make-c-struct %struct-ifaddrs-type + %struct-ifaddrs-init)) + (ret (proc ptr)) + (err (errno))) + (if (zero? ret) + (next-ifaddr (ifaddrs-pointer->bv ptr)) + (throw 'system-error "getifaddrs" "~S: ~A" + (list ptr (strerror err)) + (list err))))))) + +(define (make-ifaddrs bv) + "Convert a bytevector aliasing the memory pointed to by a +'struct ifaddrs' pointer into a <interface-address> record." + (match (read-ifaddrs bv 0) + ((next name-ptr flags addr netmask broadaddr data) + (make-interface-address (pointer->string (make-pointer name-ptr)) + flags + (make-pointer addr) + (make-pointer netmask) + (make-pointer broadaddr) + (make-pointer data))))) + +;; Is an interface the last in the intrusive linked list of struct ifaddrs? +;; Here, the only argument is a bytevector aliasing the memory pointed to by +;; a 'struct ifaddrs' pointer. +(define last-interface? + (compose null-pointer? next-ifaddr-ptr)) + +(define (pack-ifaddrs bv) + "Strip out the needless 4-byte padding after the +unsigned-int ifa-flags field" + (if (and (= 8 (sizeof '*)) + (= 4 (sizeof unsigned-int))) + (let* ((res (make-bytevector 52 0))) + (bytevector-copy! bv 0 res 0 20) + (bytevector-copy! bv 24 res 20 32) + res) + bv)) + +(define (getifaddrs) + "Return the list of network interfaces on the local system." + (let ((ifaddrs (%getifaddrs))) + (let loop ((curr ifaddrs) (res '())) + (if (last-interface? curr) + (map (compose make-ifaddrs pack-ifaddrs) + (reverse res)) + (loop (next-ifaddr curr) + (cons curr res)))))) + +;; Given a bytevector aliasing the memory pointed to by +;; a 'struct sockaddr' pointer, return a socket address. +(define-syntax-rule (bytevector->sockaddr bv) + (match (read-sockaddr-in bv 0) + ((family port address) + (if (member family (list AF_INET AF_INET6 AF_UNIX)) + (inet-ntop family address) + #f)))) + +;; Note: getifaddrs returns multiple interfaces with the same +;; e.g. on my system I see multiple "eth0"s. The difference is +;; that for one of the eth0's, the family of the address +;; pointed to by the ifu.ifa-broadaddr field is 17, which is +;; not an AF_* constant. Hence the check for "(member family ...)". + +(define (extract-address-field iface field) + "Extract a field corresponding to an IPv4 address from a 'struct +sockaddr' from an <interface-address> record type." + (let* ((addr (field iface)) + (bv (pointer->bytevector addr %sizeof-struct-sockaddr))) + (bytevector->sockaddr bv))) + +;; Note: address fields in 'struct getifaddrs' are pointers to +;; 'struct sockaddr'. In 'extract-address-field' we are +;; implicitly typecasting this 'sockaddr' pointer to a +;; 'sockaddr_in' pointer. + +;; Utility macro to remove all ifaces from the output IFACES of +;; (getifaddrs) that have a null-pointer in the 'netmask' field. +(define-syntax-rule (remove-if-netmask-null ifaces) + (remove (compose null-pointer? interface-address-netmask) ifaces)) + +;; Given an <interface-address> record IFACE, return its +;; address field as a sockaddr if it exists, otherwise return #f. +(define (interface-address-address iface) + (extract-address-field iface interface-address-addr)) + +;; Given an <interface-address> record IFACE, return its broadcast +;; address field as a sockaddr if it exists, otherwise return #f. +(define (interface-address-broadcast-addr iface) + (extract-address-field iface interface-address-broadaddr)) + +;; Given an <interface-address> record IFACE, return its netmask +;; address field as a sockaddr if it exists, otherwise return #f. +(define (interface-address-netmask-addr iface) + (extract-address-field iface interface-address-netmask)) + +;; Retrieve the ifa-next-ptr field from a 'struct ifaddrs' +;; pointer passed in as a bytevector BV. +(define-syntax-rule (ifaddr-next-ptr bv) + (match (read-ifaddrs bv 0) + ((next name-ptr flags addr netmask broadaddr data) + next))) + +;; Retrieve the bytes corresponding to the ifa-name field +;; from a 'struct ifaddrs' pointer passed in as a bytevector BV. +(define-syntax-rule (ifaddr-name-bytes bv) + (match (read-ifaddrs bv 0) + ((next name-ptr flags addr netmask broadaddr data) + name-ptr))) + +;; Retrieve the string pointed to by the ifa-name field +;; from a 'struct ifaddrs' pointer passed in as a bytevector BV. +(define-syntax-rule (ifaddr-name bv) + (pointer->string (make-pointer (ifaddr-name-bytes bv)))) + +;; Retrieve the ifa-flags field from a 'struct ifaddrs' +;; pointer passed in as a bytevector BV. +(define-syntax-rule (ifaddr-flags bv) + (match (read-ifaddrs bv 0) + ((next name-ptr flags addr netmask broadaddr data) + flags))) + (define (write-socket-address! sockaddr bv index) "Write SOCKADDR, a socket address as returned by 'make-socket-address', to bytevector BV at INDEX." diff --git a/tests/syscalls.scm b/tests/syscalls.scm index 6b614a5..73105a5 100644 --- a/tests/syscalls.scm +++ b/tests/syscalls.scm @@ -23,11 +23,98 @@ #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) #:use-module (srfi srfi-64) - #:use-module (ice-9 match)) + #:use-module (ice-9 match) + #:use-module ((ice-9 popen) #:select (open-pipe*)) + #:use-module ((ice-9 rdelim) #:select (read-line)) + #:use-module ((ice-9 regex) #:select (string-match match:substring)) + #:use-module (rnrs bytevectors) + #:use-module (system foreign) + #:use-module ((rnrs io ports) #:select (port-eof?))) ;; Test the (guix build syscalls) module, although there's not much that can ;; actually be tested without being root. +;; Is the first character of a string #\space? +(define-syntax-rule (first-char-is-space? string) + (eq? #\space (string-ref string 0))) + +;; In the output produced by ifconfig (8), is a line +;; one that starts a new interface description? +(define-syntax-rule (line-contains-iface-name? line) + (not (or (string-null? line) + (first-char-is-space? line)))) + +(define (ifconfig-find-all-interfaces) + "List all the network interfaces as identified +by ifconfig (8)." + (let ((pipe (open-pipe* OPEN_READ "ifconfig"))) + (let lp ((line (read-line pipe)) + (res '())) + (cond ((port-eof? pipe) (reverse res)) + ((line-contains-iface-name? line) + (let* ((trimmed-line (string-trim-both line)) + (split-line (string-split trimmed-line #\space)) + (iface-name (car split-line))) + (lp (read-line pipe) + (cons iface-name res)))) + (else (lp (read-line pipe) res)))))) + +(define (extract-iface-name line) + "Extract the name of the interface from a line in the output of +ifconfig (8) which is known to be the first line describing said +interface." + (let ((str-ls (string->list line))) + (let lp ((ls str-ls) (res '())) + (if (eq? #\space (car ls)) + (apply string (reverse res)) + (lp (cdr ls) (cons (car ls) res)))))) + +(define (ifconfig-extract-addr-of iface-name type) + "Call ifconfig (8) to find out the broadcast address of the +interface whose name is a prefix of the string IFACE-NAME. The +broadcast address is returned as a printable string." + (let ((pipe (open-pipe* OPEN_READ "ifconfig"))) + (let lp ((line (read-line pipe))) + (if (eof-object? line) + #f + (if (and (line-contains-iface-name? line) + (string-prefix? iface-name + (extract-iface-name line))) + (let* ((next-line (read-line pipe)) + (search-string (cond ((eq? type 'broadcast) "Bcast:") + ((eq? type 'netmask) "Mask:") + (else "inet addr:"))) + (str-byte "[0-9]([0-9][0-9])?") + (ipaddr-regex (string-append search-string + str-byte "\\." + str-byte "\\." + str-byte "\\." + str-byte)) + (match (string-match ipaddr-regex next-line))) + (if match + (string-drop (match:substring match) (cond ((eq? type 'broadcast) 6) + ((eq? type 'netmask) 5) + (else 10))) + (lp (read-line pipe)))) + (lp (read-line pipe))))))) + +(define (prefix? ls1 ls2) + "Is list LS1 a prefix of list LS2?. This procedure +assumes that (length ls1) <= (length ls2)." + (or (null? ls1) + (and (equal? (car ls1) (car ls2)) + (prefix? (cdr ls1) (cdr ls2))))) + +(define (remove-duplicates ls) + "Remove consecutive duplicate elements from a list LS. +For example, (4 2 2 2 2 1 3 3) => (4 2 1 3)." + (cond ((< (length ls) 2) + ls) + ((equal? (car ls) (cadr ls)) + (remove-duplicates (cdr ls))) + (else + (cons (car ls) (remove-duplicates (cdr ls)))))) + (test-begin "syscalls") (test-equal "mount, ENOENT" @@ -211,6 +298,51 @@ ;; We get EPERM with Linux 3.18ish and EACCES with 2.6.32. (memv (system-error-errno args) (list EPERM EACCES)))))) +(test-assert "getifaddrs" + (let* ((ifaddrs (getifaddrs)) + (names (map interface-address-name ifaddrs))) + (member "lo" names))) + +(test-assert "ifconfig-result-is-subset-of-getifaddrs-result" + (let* ((ifaddrs (getifaddrs)) + (names (map interface-address-name ifaddrs)) + (sorted-names (sort names string<?)) + (unique-names (remove-duplicates sorted-names)) + (ifconfig (ifconfig-find-all-interfaces))) + (prefix? + (sort (ifconfig-find-all-interfaces) string<?) + unique-names))) + +(test-assert "getifaddrs-address" + (let* ((is-eth-iface? (lambda (i) + (string-prefix? "eth" + (interface-address-name i)))) + (ifaddrs (remove-if-netmask-null (getifaddrs))) + (eth-ifaces (filter is-eth-iface? ifaddrs)) + (getifaddrs-result (map interface-address-address eth-ifaces)) + (ifconfig-result (ifconfig-extract-addr-of "eth" 'address))) + (member ifconfig-result getifaddrs-result))) + +(test-assert "getifaddrs-broadcast-address" + (let* ((is-eth-iface? (lambda (i) + (string-prefix? "eth" + (interface-address-name i)))) + (ifaddrs (remove-if-netmask-null (getifaddrs))) + (eth-ifaces (filter is-eth-iface? ifaddrs)) + (getifaddrs-result (map interface-address-broadcast-addr eth-ifaces)) + (ifconfig-result (ifconfig-extract-addr-of "eth" 'broadcast))) + (member ifconfig-result getifaddrs-result))) + +(test-assert "getifaddrs-netmask-address" + (let* ((is-eth-iface? (lambda (i) + (string-prefix? "eth" + (interface-address-name i)))) + (ifaddrs (remove-if-netmask-null (getifaddrs))) + (eth-ifaces (filter is-eth-iface? ifaddrs)) + (getifaddrs-result (map interface-address-netmask-addr eth-ifaces)) + (ifconfig-result (ifconfig-extract-addr-of "eth" 'netmask))) + (member ifconfig-result getifaddrs-result))) + (test-end) \f ^ permalink raw reply related [flat|nested] 9+ messages in thread
* Re: [PATCH] getifaddrs wrapper 2015-07-17 10:57 ` Rohan Prinja @ 2015-07-25 12:59 ` Ludovic Courtès 0 siblings, 0 replies; 9+ messages in thread From: Ludovic Courtès @ 2015-07-25 12:59 UTC (permalink / raw) To: Rohan Prinja; +Cc: guix-devel Hi Rohan, Sorry for the delay. Commit e7f5691 adds the ‘getifaddrs’ bindings under the name ‘network-interfaces’ (there was already a procedure with that name, which I’ve renamed to ‘network-interface-names’ in b89e740.) I ended up doing things differently from your patch, notably because I was willing to get more support from ‘define-c-struct’, which led me to find a couple of shortcomings that needed to be fixed (apologies for not noticing these earlier!). I’ve written tests which, unlike yours, do not use the ‘ifconfig’ command, mostly because there are several ‘ifconfig’ implementations so I doubt we can reliably parse their output, and because I don’t want tests to introduce an additional dependency. Anyway, now one can do things like this: --8<---------------cut here---------------start------------->8--- scheme@(guile-user)> ,use(guix build syscalls) scheme@(guile-user)> ,use(srfi srfi-1) scheme@(guile-user)> (network-interfaces) $13 = (#<interface "lo" up family:17 16cb380> #<interface "eno1" up family:17 16cb340> #<interface "wlp0s29u1u2" up family:17 16cb300> #<interface "lo" up 127.0.0.1 16cb2c0> #<interface "wlp0s29u1u2" up 192.168.0.86 16cb280> #<interface "lo" up 0:0:0:1:: 16cb1c0> #<interface "wlp0s29u1u2" up 6202:b4ff:fe99:9b36:300:: 16cb100>) scheme@(guile-user)> (filter (lambda (i) (= AF_INET6 (sockaddr:fam (interface-address i)))) (network-interfaces)) $14 = (#<interface "lo" up 0:0:0:1:: 1ba0b80> #<interface "wlp0s29u1u2" up 6202:b4ff:fe99:9b36:300:: 1ba0ac0>) --8<---------------cut here---------------end--------------->8--- Pretty neat, no? :-) Note that family 17 is AF_PACKET. Currently libguile does not support AF_PACKET, which means we cannot do much with these addresses. Comments & bug reports welcome! Thanks again for your earlier work on this. Even if the final patch is different, your work and the discussions we’ve had have been helpful in getting things into shape. Ludo’. ^ permalink raw reply [flat|nested] 9+ messages in thread
end of thread, other threads:[~2015-07-25 12:59 UTC | newest] Thread overview: 9+ messages (download: mbox.gz follow: Atom feed -- links below jump to the message on this page -- 2015-06-19 9:50 [PATCH] getifaddrs wrapper Rohan Prinja 2015-06-19 12:03 ` Ludovic Courtès 2015-07-02 10:59 ` Rohan Prinja 2015-07-02 12:23 ` Ludovic Courtès 2015-07-16 8:30 ` Rohan Prinja 2015-07-16 13:50 ` Rohan Prinja 2015-07-16 15:38 ` Ludovic Courtès 2015-07-17 10:57 ` Rohan Prinja 2015-07-25 12:59 ` Ludovic Courtès
Code repositories for project(s) associated with this external index https://git.savannah.gnu.org/cgit/guix.git This is an external index of several public inboxes, see mirroring instructions on how to clone and mirror all data and code used by this external index.