diff options
| -rw-r--r-- | bpf-interface.scm | 24 |
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))) + + ) |