diff options
| -rw-r--r-- | bpf-interface.scm | 54 |
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;" "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-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)) bpf))))) (define (bpf-close bpf) @@ -101,7 +105,7 @@ (void)) (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) 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) (void))) (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) 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) 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) (void))) (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) (list-tabulate length (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) (void))) (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) (void))) ) |