diff options
| -rw-r--r-- | COPYING.BSD | 25 | ||||
| -rw-r--r-- | bpf-assembler.scm | 7 | ||||
| -rw-r--r-- | bpf-interface.scm | 111 | ||||
| -rw-r--r-- | bpf.meta | 8 | ||||
| -rw-r--r-- | bpf.setup | 12 |
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"))) |