diff options
authorPeter Bex <>2013-05-11 16:19:08 +0200
committerPeter Bex <>2016-03-04 21:38:49 +0100
commit813eb3cc32c292c79078f73fc409c68eb3c75d7a (patch)
parent92e0ab3e297d81dac7d0d247ea7d8fe3932455ae (diff)
Make ioctl interface a little less verbose by generating some stuff that's always the same in a macro. This should also inline it
1 files changed, 29 insertions, 25 deletions
diff --git a/bpf-interface.scm b/bpf-interface.scm
index 5a90e22..68c9984 100644
--- a/bpf-interface.scm
+++ b/bpf-interface.scm
@@ -27,7 +27,7 @@
(define error-string (foreign-lambda c-string "strerror" int))
-;; From the IOCTL egg, with tweaks. Would be overkill to use it as a dependency
+;; From the IOCTL egg, with some tweaks for brevity and convenience
(define ioctl0
(foreign-lambda* int (((c-pointer int) err) (int fd) (unsigned-long req))
"int res = ioctl(fd, req);"
@@ -41,15 +41,19 @@
"*err = errno;"
-(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-syntax ioctl
+ (ir-macro-transformer
+ (lambda (e i c)
+ (let ((fd `(bpf-fd ,(cadr e))) ; Always a bpf object
+ (request `(foreign-value ,(->string (strip-syntax (caddr e))) int))
+ (arg (and (pair? (cdddr e)) `(location ,(cadddr e)))))
+ `(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)))))))
@@ -91,7 +95,7 @@
(bpf-interface-set! bpf interface)
;; Rather pointless to expose this as a "setter" procedure(?)
(when promiscuous
- (ioctl fd (foreign-value "BIOCPROMISC" int)))
+ (ioctl bpf BIOCPROMISC))
(define (bpf-close bpf)
@@ -101,7 +105,7 @@
(define (bpf-flush! bpf)
- (ioctl (bpf-fd bpf) (foreign-value "BIOCFLUSH" int)))
+ (ioctl bpf BIOCFLUSH))
;; Returns the *actual* size that was set, the requested size is too big
;; Remember, this can only be done *before* setting the interface.
@@ -109,7 +113,7 @@
;; no way to set a new interface *and* buffer-length...
(define (bpf-buffer-length-set! bpf requested-length)
(let-location ((new-length int requested-length))
- (ioctl (bpf-fd bpf) (foreign-value "BIOCSBLEN" int) (location new-length))
+ (ioctl bpf BIOCSBLEN new-length)
(define interface-name-maximum-length (foreign-value "IF_NAMESIZE" int))
@@ -125,18 +129,18 @@
"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) (location ifreq))
+ (ioctl bpf BIOCSETIF ifreq)
(define (bpf-interface bpf)
(let ((ifreq (make-blob (foreign-value "sizeof(struct ifreq)" int))))
- (ioctl (bpf-fd bpf) (foreign-value "BIOCGETIF" int) (location ifreq))
+ (ioctl bpf BIOCGETIF ifreq)
((foreign-lambda* c-string ((scheme-pointer i))
"C_return(((struct ifreq *)i)->ifr_name);") ifreq)))
(define (bpf-buffer-length bpf)
(let-location ((length unsigned-int))
- (ioctl (bpf-fd bpf) (foreign-value "BIOCGBLEN" int) (location length))
+ (ioctl bpf BIOCGBLEN length)
;; These are a bit problematic: there is a shitload of known types.
@@ -145,12 +149,12 @@
;; more-or-less what C is doing with its #defines.
(define (bpf-datalink-type bpf)
(let-location ((type unsigned-int))
- (ioctl (bpf-fd bpf) (foreign-value "BIOCGDLT" int) (location type))
+ (ioctl bpf BIOCGDLT type)
(define (bpf-datalink-type-set! bpf type)
(let-location ((type unsigned-int type))
- (ioctl (bpf-fd bpf) (foreign-value "BIOCSDLT" int) (location type))
+ (ioctl bpf BIOCSDLT type)
(define (bpf-list-datalink-types bpf)
@@ -158,7 +162,7 @@
(let ((in (make-blob (foreign-value "sizeof(struct bpf_dltlist)" int))))
((foreign-lambda* void (((c-pointer "struct bpf_dltlist") p))
"p->bfl_list = NULL;") (location in))
- (ioctl (bpf-fd bpf) (foreign-value "BIOCGDLTLIST" int) (location in))
+ (ioctl bpf BIOCGDLTLIST in)
(let* ((length ((foreign-lambda* unsigned-int
(((c-pointer "struct bpf_dltlist") p))
"C_return(p->bfl_len);") (location in)))
@@ -167,7 +171,7 @@
((foreign-lambda* void (((c-pointer "struct bpf_dltlist") p)
((c-pointer "u_int") list))
"p->bfl_list = list;") (location in) (location types))
- (ioctl (bpf-fd bpf) (foreign-value "BIOCGDLTLIST" int) (location in))
+ (ioctl bpf BIOCGDLTLIST in)
(lambda (i)
@@ -176,7 +180,7 @@
(define (bpf-read-timeout bpf)
(let ((tv (make-blob (foreign-value "sizeof(struct timeval)" int))))
- (ioctl (bpf-fd bpf) (foreign-value "BIOCGRTIMEOUT" int) (location tv))
+ (ioctl bpf BIOCGRTIMEOUT tv)
((foreign-lambda* double (((c-pointer "struct timeval") tv))
"C_return(tv->tv_sec + tv->tv_usec / 1000000.0);") (location tv))))
@@ -187,12 +191,12 @@
"double i;"
"tv->tv_usec = (int)(modf(timeout, &i) * 1000000);"
"tv->tv_sec = (int)timeout;") (location tv) timeout)
- (ioctl (bpf-fd bpf) (foreign-value "BIOCSRTIMEOUT" int) (location tv))
+ (ioctl bpf BIOCSRTIMEOUT tv)
(define (bpf-stats bpf)
(let ((st (make-blob (foreign-value "sizeof(struct bpf_stat)" int))))
- (ioctl (bpf-fd bpf) (foreign-value "BIOCGSTATS" int) (location st))
+ (ioctl bpf BIOCGSTATS st)
(let ((result '()))
(let-syntax ((add-stat!
(syntax-rules ()
@@ -214,7 +218,7 @@
(let ((expected-major (foreign-value "BPF_MAJOR_VERSION" int))
(expected-minor (foreign-value "BPF_MINOR_VERSION" int))
(v (make-blob (foreign-value "sizeof(struct bpf_version)" int))))
- (ioctl (bpf-fd bpf) (foreign-value "BIOCVERSION" int) (location v))
+ (ioctl bpf BIOCVERSION v)
(let-location ((major int) (minor int))
((foreign-lambda* void (((c-pointer "struct bpf_version") v)
((c-pointer int) major) ((c-pointer int) minor))
@@ -240,7 +244,7 @@
(scheme-pointer i) (unsigned-int len))
"p->bf_len = len;"
"p->bf_insns = i;") (location prog) insns (fx/ (##sys#size insns) 8))
- (ioctl (bpf-fd bpf) (foreign-value "BIOCSETF" int) (location prog))
+ (ioctl bpf BIOCSETF prog)