From 5b2ca83bcee868d7e2ff603e3b43d93ac807786d Mon Sep 17 00:00:00 2001
From: Peter Bex <peter@more-magic.net>
Date: Fri, 10 May 2013 22:22:57 +0200
Subject: Expose flush ioctl and add listing/getter/setter of datalink types.
 For now, we just work with the underlying integer values.  Maybe later we'll
 translate these to symbols?

---
 bpf-interface.scm | 51 +++++++++++++++++++++++++++++++++++++++++++++++----
 1 file changed, 47 insertions(+), 4 deletions(-)

diff --git a/bpf-interface.scm b/bpf-interface.scm
index 3f9e47a..efcb476 100644
--- a/bpf-interface.scm
+++ b/bpf-interface.scm
@@ -4,11 +4,13 @@
 ;;; Copyright (c) 2013 by Peter Bex, see file COPYING.BSD
 ;;;
 (module bpf-interface
-  (bpf-open bpf-close bpf? bpf-buffer-length bpf-interface bpf-interface-set!)
+  (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)
 
 (import chicken scheme foreign)
 
-(use posix lolevel)
+(use posix lolevel srfi-1)
 
 (foreign-declare "#include <errno.h>")
 (foreign-declare "#include <string.h>")
@@ -55,7 +57,7 @@
       (fprintf out "#<bpf on interface: ~S>" (bpf-interface obj))
       (display "#<bpf (closed)>" out)))
 
-(define (bpf-open interface #!optional buffer-length)
+(define (bpf-open interface #!key buffer-length promiscuous)
   (let lp ((i -1)
            (prev-fn #f)
            (prev-error #f))
@@ -83,6 +85,9 @@
             (when buffer-length
               (bpf-buffer-length-set! bpf buffer-length))
             (bpf-interface-set! bpf interface)
+            ;; Rather pointless to expose this as a "setter" procedure(?)
+            (when promiscuous
+              (ioctl fd (foreign-value "BIOCPROMISC" int)))
             bpf)))))
 
 (define (bpf-close bpf)
@@ -91,6 +96,9 @@
     (bpf-fd-set! bpf #f))
   (void))
 
+(define (bpf-flush! bpf)
+  (ioctl (bpf-fd bpf) (foreign-value "BIOCFLUSH" int)))
+
 ;; Returns the *actual* size that was set, the requested size is too big
 ;; Remember, this can only be done *before* setting the interface.
 ;; Oddly enough, the interface can be switched afterwards, so there's
@@ -123,8 +131,43 @@
        "C_return(((struct ifreq *)i)->ifr_name);") ifreq)))
 
 (define (bpf-buffer-length bpf)
-  (let-location ((length int))
+  (let-location ((length unsigned-int))
     (ioctl (bpf-fd bpf) (foreign-value "BIOCGBLEN" int) (location length))
     length))
 
+;; These are a bit problematic: there is a shitload of known types.
+;; Maybe we should automatically convert to a symbol, but that
+;; requires coding all of the types in here.  OTOH, that's
+;; more-or-less what C is doing with its #defines.
+(define (bpf-datalink-type bpf)
+  (let-location ((type unsigned-int))
+    (ioctl (bpf-fd bpf) (foreign-value "BIOCGDLT" int) (location type))
+    type))
+
+(define (bpf-datalink-type-set! bpf type)
+  (let-location ((type unsigned-int type))
+    (ioctl (bpf-fd bpf) (foreign-value "BIOCSDLT" int) (location type))
+    (void)))
+
+(define (bpf-list-datalink-types bpf)
+  ;; First, get the number of types (required slot length)
+  (let ((in (make-blob (foreign-value "sizeof(struct bpf_dltlist)" int))))
+    ((foreign-lambda* void (((c-pointer "struct bpf_dltlist") p))
+       "p->bfl_list = NULL;") (location in))
+    (ioctl (bpf-fd bpf) (foreign-value "BIOCGDLTLIST" int) (location in))
+    (let* ((length ((foreign-lambda* unsigned-int
+                        (((c-pointer "struct bpf_dltlist") p))
+                      "C_return(p->bfl_len);") (location in)))
+           ;; Now, get that many types
+           (types (make-blob (* (foreign-value "sizeof(u_int)" int) length))))
+      ((foreign-lambda* void (((c-pointer "struct bpf_dltlist") p)
+                              ((c-pointer "u_int") list))
+         "p->bfl_list = list;") (location in) (location types))
+      (ioctl (bpf-fd bpf) (foreign-value "BIOCGDLTLIST" int) (location in))
+      (list-tabulate
+       length
+       (lambda (i)
+         ((foreign-lambda* unsigned-int (((c-pointer "u_int") p) (int i))
+            "C_return(p[i]);") (location types) i))))))
+
 )
-- 
cgit v1.2.3