Implement timeout IOCTL

1 files changed, 23 insertions, 1 deletions

diff --git a/bpf-interface.scm b/bpf-interface.scm
index efcb476..a76228f 100644
--- a/bpf-interface.scm
+++ b/bpf-interface.scm
@@ -3,10 +3,14 @@
 ;;;
 ;;; Copyright (c) 2013 by Peter Bex, see file COPYING.BSD
 ;;;
+;;; TODO: Think about FreeBSD/OpenBSD extensions like LOCK, DIRFILT.
+;;;       also NetBSD's "number of accepted packets" in GSTATS.
+;;;       OS X seems to support only the smallest common denominator.
 (module bpf-interface
   (bpf-open bpf-close bpf? bpf-buffer-length bpf-flush!
             bpf-interface bpf-interface-set!
-            bpf-datalink-type bpf-datalink-type-set! bpf-list-datalink-types)
+            bpf-datalink-type bpf-datalink-type-set! bpf-list-datalink-types
+            bpf-read-timeout bpf-read-timeout-set!)
 
 (import chicken scheme foreign)
 
@@ -57,6 +61,7 @@
       (fprintf out "#<bpf on interface: ~S>" (bpf-interface obj))
       (display "#<bpf (closed)>" out)))
 
+;; Promiscuous mode is not guaranteed to be off even if the flag is #f
 (define (bpf-open interface #!key buffer-length promiscuous)
   (let lp ((i -1)
            (prev-fn #f)
@@ -170,4 +175,21 @@
          ((foreign-lambda* unsigned-int (((c-pointer "u_int") p) (int i))
             "C_return(p[i]);") (location types) i))))))
 
+(define (bpf-read-timeout bpf)
+  (let ((tv (make-blob (foreign-value "sizeof(struct timeval)" int))))
+    (ioctl (bpf-fd bpf) (foreign-value "BIOCGRTIMEOUT" int) (location tv))
+    ((foreign-lambda* double (((c-pointer "struct timeval") tv))
+       "C_return(tv->tv_sec + tv->tv_usec / 1000000.0);") (location tv))))
+
+(define (bpf-read-timeout-set! bpf timeout)
+  (let ((tv (make-blob (foreign-value "sizeof(struct timeval)" int)))
+        (timeout (max 0 timeout)))
+    ((foreign-lambda* void (((c-pointer "struct timeval") tv) (double timeout))
+       "double i;"
+       "tv->tv_usec = (int)(modf(timeout, &i) * 1000000);"
+       "tv->tv_sec = (int)timeout;") (location tv) timeout)
+    (ioctl (bpf-fd bpf) (foreign-value "BIOCSRTIMEOUT" int) (location tv))
+    (void)))
+
+
 )