summaryrefslogtreecommitdiff
path: root/bpf-interface.scm
diff options
context:
space:
mode:
Diffstat (limited to 'bpf-interface.scm')
-rw-r--r--bpf-interface.scm111
1 files changed, 111 insertions, 0 deletions
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)))
+
+)