Add setup file, copyright and BPF device interface

Add an initial opaque record type holding a connection to the BPF
device.  At least this now allows us to open a BPF device onto a network
interface and request which network device we're connected to.

5 files changed, 162 insertions, 1 deletions

diff --git a/COPYING.BSD b/COPYING.BSD
new file mode 100644
index 0000000..5dcf37e
--- /dev/null
+++ b/COPYING.BSD
@@ -0,0 +1,25 @@
+;;; Copyright (c) 2013, Peter Bex
+;; All rights reserved.
+;
+; Redistribution and use in source and binary forms, with or without
+; modification, are permitted provided that the following conditions
+; are met:
+;
+; 1. Redistributions of source code must retain the above copyright
+;    notice, this list of conditions and the following disclaimer.
+; 2. Redistributions in binary form must reproduce the above copyright
+;    notice, this list of conditions and the following disclaimer in the
+;    documentation and/or other materials provided with the distribution.
+;
+; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+; FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+; COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
+; INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
+; (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+; HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+; STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+; ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED
+; OF THE POSSIBILITY OF SUCH DAMAGE.
\ No newline at end of file
diff --git a/bpf-assembler.scm b/bpf-assembler.scm
index 8741193..07e7f39 100644
--- a/bpf-assembler.scm
+++ b/bpf-assembler.scm
@@ -1,4 +1,9 @@
-(module bpf-assembler                 ; Maybe I should call this "bassie" ;)
+;;;
+;;; Assembler/disassembler between S-expressions and BPF bytecode
+;;;
+;;; Copyright (c) 2013 by Peter Bex, see file COPYING.BSD
+;;;
+(module bpf-assembler
         (exprs->bpf-bytecode bpf-bytecode->exprs)
 
 (import chicken scheme)
diff --git a/bpf-interface.scm b/bpf-interface.scm
new file mode 100644
index 0000000..49046b0
--- /dev/null
+++ b/bpf-interface.scm
@@ -0,0 +1,111 @@
+;;;
+;;; Interface to the /dev/bpf[N] devices (ioctls, opening/closing etc)
+;;;
+;;; Copyright (c) 2013 by Peter Bex, see file COPYING.BSD
+;;;
+(module bpf-interface
+  (bpf-open bpf-close bpf? bpf-interface-set! bpf-interface)
+
+(import chicken scheme foreign)
+
+(use posix lolevel)
+
+(foreign-declare "#include <errno.h>")
+(foreign-declare "#include <string.h>")
+
+(foreign-declare "#include <sys/types.h>")
+(foreign-declare "#include <sys/time.h>")
+(foreign-declare "#include <sys/ioctl.h>")
+(foreign-declare "#include <net/bpf.h>")
+;; For BIOCGETIF/BIOCSETIF
+(foreign-declare "#include <net/if.h>")
+
+(define error-string (foreign-lambda c-string "strerror" int))
+
+;; From the IOCTL egg, with tweaks.  Would be overkill to use it as a dependency
+(define ioctl0
+  (foreign-lambda* int (((c-pointer int) err) (int fd) (unsigned-long req))
+    "int res = ioctl(fd, req);"
+    "*err = errno;"
+    "return(res);"))
+
+(define ioctl1
+  (foreign-lambda* int (((c-pointer int) err) (int fd)
+                        (unsigned-long req) (scheme-pointer val1))
+    "int res = ioctl(fd, req, val1);"
+    "*err = errno;"
+    "return(res);"))
+
+(define (ioctl port request #!optional arg)
+  (let ((fd (if (port? port) (port->fileno port) port)))
+    (let-location ((err int))
+      (let ((res (if arg
+                     (ioctl1 (location err) fd request arg)
+                     (ioctl0 (location err) fd request))))
+        (if (= res -1)
+            (error (error-string err))
+            res)))))
+
+;;;;;;;;;;;
+
+(define-record bpf fd)
+
+(define-record-printer (bpf obj out)
+  (fprintf out "#<bpf on interface: ~S>" (bpf-interface obj)))
+
+(define (bpf-open interface #!optional buffer-length)
+  (let lp ((i -1)
+           (prev-fn #f)
+           (prev-error #f))
+    ;; Try /dev/bpf first, before enumerating all of the /dev/bpfN options.
+    ;; If all fail, show the error of the last file we tried, as soon as we
+    ;; can't find any existing bpf files anymore.
+    ;; This can be improved if Chicken allowed us to distinguish between
+    ;; "nonexistent file"-type errors and other errors.
+    (let ((fn (string-append "/dev/bpf" (if (fx= i -1) "" (number->string i)))))
+      (if (and prev-error (not (file-exists? fn)))
+          (let* ((om (get-condition-property prev-error 'exn 'message))
+                 (msg (string-append
+                       "Unable to open bpf device " prev-fn ": " om)))
+            (signal (make-composite-condition
+                     (make-property-condition
+                      'exn 'location 'bpf-open 'message msg)
+                     (make-property-condition 'bpf)
+                     (make-property-condition 'i/o)
+                     (make-property-condition 'file))))
+          (let* ((fd (condition-case (file-open fn (fx+ open/read open/write))
+                       (e (exn i/o file) (lp (fx+ i 1) fn e))))
+                 (bpf (make-bpf fd)))
+            (set-finalizer! bpf bpf-close)
+            (bpf-interface-set! bpf interface)
+            bpf)))))
+
+(define (bpf-close bpf)
+  (and-let* ((fd (bpf-fd bpf)))
+    (file-close fd)
+    (bpf-fd-set! bpf #f))
+  (void))
+
+(define interface-name-maximum-length (foreign-value "IF_NAMESIZE" int))
+
+(define (bpf-interface-set! bpf interface)
+  (let ((ifreq (make-blob (foreign-value "sizeof(struct ifreq)" int)))
+        (len (string-length interface)))
+    (when (>= len interface-name-maximum-length)
+      (error (string-append "Interface name exceeds maximum length of "
+                            (number->string interface-name-maximum-length))
+             interface))
+    ((foreign-lambda* void ((scheme-pointer i) (scheme-pointer s) (int len))
+       "char *ifname = ((struct ifreq *)i)->ifr_name;"
+       "strncpy(ifname, s, len);"
+       "ifname[len] = '\\0';") ifreq interface len)
+    (ioctl (bpf-fd bpf) (foreign-value "BIOCSETIF" int) ifreq)
+    (void)))
+
+(define (bpf-interface bpf)
+  (let ((ifreq (make-blob (foreign-value "sizeof(struct ifreq)" int))))
+    (ioctl (bpf-fd bpf) (foreign-value "BIOCGETIF" int) ifreq)
+    ((foreign-lambda* c-string ((scheme-pointer i))
+       "C_return(((struct ifreq *)i)->ifr_name);") ifreq)))
+
+)
diff --git a/bpf.meta b/bpf.meta
new file mode 100644
index 0000000..a5ffaba
--- /dev/null
+++ b/bpf.meta
@@ -0,0 +1,8 @@
+;;; -*- Scheme -*-
+
+((synopsis "Support for the Berkeley Packet Filter (BPF)")
+ (author "Peter Bex")
+ (category net)
+ (license "BSD")
+ (depends bitstring matchable)
+ (test-depends test))
diff --git a/bpf.setup b/bpf.setup
new file mode 100644
index 0000000..ba55d90
--- /dev/null
+++ b/bpf.setup
@@ -0,0 +1,12 @@
+;; -*- Scheme -*-
+
+(compile -s -O3 bpf-interface.scm -j bpf-interface)
+(compile -s -O3 bpf-interface.import.scm)
+(compile -s -O3 bpf-assembler.scm -j bpf-assembler)
+(compile -s -O3 bpf-assembler.import.scm)
+
+(install-extension
+  'bpf
+  '("bpf-interface.so" "bpf-interface.import.so"
+    "bpf-assembler.so" "bpf-assembler.import.so")
+  `((version "0.1")))