guix-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[dhcp] 04/08: dhcp: more tests for (dhcp interfaces)


From: Rohan Prinja
Subject: [dhcp] 04/08: dhcp: more tests for (dhcp interfaces)
Date: Mon, 15 Jun 2015 19:26:21 +0000

wenderen pushed a commit to branch master
in repository dhcp.

commit 9ef45fac08aab8a4f45fcd1c76ab0ed64a563a79
Author: Rohan Prinja <address@hidden>
Date:   Sat Jun 13 21:19:09 2015 +0530

    dhcp: more tests for (dhcp interfaces)
---
 dhcp/interfaces.scm       |   19 ++++++++++++++++++-
 tests/dhcp-interfaces.scm |   35 ++++++++++++++++++++++++++++++++++-
 2 files changed, 52 insertions(+), 2 deletions(-)

diff --git a/dhcp/interfaces.scm b/dhcp/interfaces.scm
index 549f7a1..50e5ae8 100644
--- a/dhcp/interfaces.scm
+++ b/dhcp/interfaces.scm
@@ -26,9 +26,15 @@
            hardware-address
            hardware-family
            retain-ethernet-interfaces
+
            print-hardware-address
+           hardware-address-to-string
+
            make-net-iface
+           make-network-interface ; wrapper for make-net-iface
+
            net-iface?
+
            net-iface-name
            net-iface-flags set-net-iface-flags!
            net-iface-ipaddr set-net-iface-ipaddr!
@@ -195,7 +201,7 @@ like MAC address or hardware family type."
   (hardware-property 'family name))
 
 (define (print-hardware-address bv)
-  "Print a hardware address 'bv' given as a length-6 bytevector"
+  "Print a hardware address BV given as a length-6 bytevector"
   (assert (= 6 (bytevector-length bv)))
   (let loop ((i 0))
     (when (< i 6)
@@ -204,6 +210,17 @@ like MAC address or hardware family type."
       (loop (1+ i))))
   (newline))
 
+(define (hardware-address-to-string bv)
+  "Convert a hardware address BV given as a 6-length bytevector
+to a string"
+  (assert (= 6 (bytevector-length bv)))
+  (let loop ((i 0) (ls '()))
+    (if (< i 6)
+       (let* ((byte (bytevector-u8-ref bv i))
+              (s (format #f "~2,'0x" byte)))
+         (loop (1+ i) (cons ":" (cons s ls))))
+       (string-concatenate (reverse (cdr ls))))))
+
 (define (retain-ethernet-interfaces ifaces)
   "Find all ethernet interfaces from a list of
 interface names"
diff --git a/tests/dhcp-interfaces.scm b/tests/dhcp-interfaces.scm
index be972d5..7887c07 100644
--- a/tests/dhcp-interfaces.scm
+++ b/tests/dhcp-interfaces.scm
@@ -21,7 +21,9 @@
             (dhcp interfaces)
             (arp identifiers)
             ((guix build syscalls) #:select (all-network-interfaces))
-            ((ice-9 popen) #:select (open-pipe)))
+            ((ice-9 popen) #:select (open-pipe*))
+            ((ice-9 rdelim) #:select (read-line))
+            ((srfi srfi-1) #:select (last)))
 
 (test-begin "dhcp-interfaces")
 
@@ -29,12 +31,43 @@
 
 (define eth (car (retain-ethernet-interfaces ifaces)))
 
+(define netif
+  (make-network-interface
+   (car
+    (retain-ethernet-interfaces
+     (all-network-interfaces)))
+   'DHCP-INIT))
+
+(define (ifconfig-find-hwaddr name)
+  "Find the hwaddr string of an interface for
+which NAME is a prefix of the interface name"
+  (let ((pipe (open-pipe* OPEN_READ "ifconfig")))
+    (let lp ((line (read-line pipe)))
+      (if (string-prefix? "eth" line)
+         (let* ((trimmed-line (string-trim-both line))
+                (split-line (string-split trimmed-line #\space))
+                (hwaddr (last split-line)))
+           hwaddr)
+         (lp (read-line pipe))))))
+
 (print-hardware-address (hardware-address eth))
 
 (test-eq "correct-family"
         ARPHRD_ETHER
         (hardware-family eth))
 
+(test-assert "netif-correct-family"
+            (string-prefix? "eth"
+                            (net-iface-name netif)))
+
+(test-equal "correct-hwaddr"
+           (hardware-address-to-string (hardware-address eth))
+           (ifconfig-find-hwaddr "eth"))
+
+(test-equal "correct-hwaddr-2"
+           (hardware-address-to-string (car (net-iface-hwaddr netif)))
+           (ifconfig-find-hwaddr "eth"))
+
 (test-end)
 
 (exit (zero? (test-runner-fail-count (test-runner-current))))



reply via email to

[Prev in Thread] Current Thread [Next in Thread]