diff options
authorPeter Bex <>2013-08-27 22:32:17 +0200
committerPeter Bex <>2016-03-04 21:38:49 +0100
commit8ed1e1d9da4ac8a6d5827d8a1938f1067055a6be (patch)
parent3e605b8b566e829cd8a0b5ea2ad9c7d560529234 (diff)
Apparently even nonblocking reads are blocking in a way(?!) and we will get multiple packets off the iface.
The actual packet data is preceded by a "struct bpf_hdr" header we need to skip. Because of that, passing a raw buffer is not going to be very useful, so bpf-read-packet! can be removed from the API.
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))
(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)
+(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)))