summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--bpf-interface.scm24
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)))
+
+
)