From 4a718e6f2f76616e06848d94022ee8d05a17bea1 Mon Sep 17 00:00:00 2001
From: Rohan Prinja <address@hidden>
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