From 1bdbd195d7979fe2058b88d7033eaeb93b524fb7 Mon Sep 17 00:00:00 2001 From: Rohan Prinja 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 +;;; Copyright © 2015 Rohan Prinja ;;; ;;; 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-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 ; 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 + (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 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