diff options
| -rw-r--r-- | bpf-interface.scm | 75 |
1 files changed, 67 insertions, 8 deletions
diff --git a/bpf-interface.scm b/bpf-interface.scm index 0277140..b80a086 100644 --- a/bpf-interface.scm +++ b/bpf-interface.scm @@ -9,11 +9,11 @@ (bpf-open bpf-close bpf? bpf-buffer-length bpf-flush! bpf-interface bpf-interface-set! bpf-stats bpf-datalink-type bpf-datalink-type-set! bpf-list-datalink-types - bpf-filter-set!) + bpf-filter-set! bpf-read-packet) (import chicken scheme foreign) -(use posix lolevel srfi-1 srfi-4 bitstring) +(use posix lolevel srfi-1 srfi-4 bitstring bpf-assembler) (foreign-declare "#include <errno.h>") (foreign-declare "#include <string.h>") @@ -57,7 +57,9 @@ ;;;;;;;;;;; -(define-record bpf fd) +;; tmp-buffer is a stupid workaround for the fact that buffer length must +;; match the read size, even in nonblocking mode. +(define-record bpf fd tmp-buffer tmp-buffer-offset tmp-buffer-max-offset) (define-record-printer (bpf obj out) (if (bpf-fd obj) @@ -85,14 +87,15 @@ (make-property-condition 'bpf) (make-property-condition 'i/o) (make-property-condition 'file)))) - (let* ((mode (bitwise-ior open/read open/write open/nonblock)) + (let* ((mode (bitwise-ior open/rdwr open/nonblock)) (fd (condition-case (file-open fn mode) (e (exn i/o file) (lp (fx+ i 1) fn e)))) - (bpf (make-bpf fd))) + (bpf (make-bpf fd #f #f #f))) (set-finalizer! bpf bpf-close) ;; Length _must_ be set before interface is assigned - (when buffer-length - (bpf-buffer-length-set! bpf buffer-length)) + (if buffer-length + (bpf-buffer-length-set! bpf buffer-length) + (bpf-tmp-buffer-set! bpf (make-blob (bpf-buffer-length bpf)))) (bpf-interface-set! bpf interface) ;; Rather pointless to expose this as a "setter" procedure(?) (when promiscuous @@ -115,6 +118,10 @@ (define (bpf-buffer-length-set! bpf requested-length) (let-location ((new-length int requested-length)) (ioctl bpf BIOCSBLEN new-length) + ;; TODO: Should we copy the bits of the old buffer that fit in the new? + (bpf-tmp-buffer-offset-set! bpf #f) + (bpf-tmp-buffer-max-offset-set! bpf #f) + (bpf-tmp-buffer-set! bpf (make-blob new-length)) new-length)) (define interface-name-maximum-length (foreign-value "IF_NAMESIZE" int)) @@ -221,7 +228,9 @@ (define (bpf-filter-set! bpf filter) (check-version! bpf) (let ((prog (make-blob (foreign-value "sizeof(struct bpf_program)" int))) - (insns (cond ((bitstring? filter) (bitstring->blob filter)) + (insns (cond ((pair? filter) + (bitstring->blob (exprs->bpf-bytecode filter))) + ((bitstring? filter) (bitstring->blob filter)) ((or (blob? filter) (string? filter)) filter) ((u8vector? filter) (u8vector->blob/shared filter)) (else (error "Unsupported filter data type" filter))))) @@ -232,4 +241,54 @@ (ioctl bpf BIOCSETF prog) (void))) +(define (extract-next-packet! bpf) + (let* ((tmp-buf (bpf-tmp-buffer bpf)) + (tmp-offset (bpf-tmp-buffer-offset bpf))) + (let-location ((caplen int) + (offset-add int)) + ;; Calculate capture size and offset of the next packet's start + ((foreign-lambda* void (((c-pointer "struct bpf_hdr") bh) + ((c-pointer int) caplen) ((c-pointer int) offset)) + "*caplen = bh->bh_caplen;" + "*offset = BPF_WORDALIGN(bh->bh_hdrlen + bh->bh_caplen);") + (make-locative tmp-buf tmp-offset) + (location caplen) (location offset-add)) + (let* ((tmp-max-offset (bpf-tmp-buffer-max-offset bpf)) + (buffer (make-blob caplen))) + ((foreign-lambda* void (((c-pointer "struct bpf_hdr") bh) + (scheme-pointer buf)) + "C_memcpy(buf, (void *)bh+bh->bh_hdrlen, bh->bh_caplen);") + (make-locative tmp-buf tmp-offset) buffer) + ;; Advance, or reset if we've reached the end + (bpf-tmp-buffer-offset-set! + bpf (and (not (>= (+ tmp-offset offset-add) tmp-max-offset)) + (+ tmp-offset offset-add))) + buffer)))) + +(define (bpf-read-packet bpf) + (let* ((fd (bpf-fd bpf)) + (tmp-buf (bpf-tmp-buffer bpf))) + (unless (bpf-tmp-buffer-offset bpf) ; Only read if no data in buffer + (let lp () + (let-location ((err int) (n int)) + ((foreign-lambda* void ((int fd) (scheme-pointer p) (int len) + ((c-pointer int) err) ((c-pointer int) n)) + "*n = read(fd, p, len);" + "*err = errno;") + fd tmp-buf (##sys#size tmp-buf) (location err) (location n)) + ;; We use ##sys# here to avoid having to load srfi-18 + (cond + ((or (fx= -1 n) (fx= 0 n)) ; 0 is returned on OpenBSD for EAGAIN + (if (or (fx= 0 n) (fx= err (foreign-value "EAGAIN" int))) + (begin + (##sys#thread-block-for-i/o! ##sys#current-thread fd #:input) + (##sys#thread-yield!) + (lp)) + (error (string-append "Cannot read packet - " + (error-string err)) bpf))) + (else + (bpf-tmp-buffer-offset-set! bpf 0) + (bpf-tmp-buffer-max-offset-set! bpf n)))))) + (extract-next-packet! bpf))) + ) |