Peter Bex  committed 5c13eed

Implement timeout IOCTL

  • Participants
  • Parent commits 8afdc54

Comments (0)

Files changed (1)

File bpf-interface.scm

 ;;; 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)
       (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)
          ((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)))