1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
|
;;;
;;; 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-buffer-length bpf-interface bpf-interface-set!)
(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) (c-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)
;; Length _must_ be set before interface is assigned
(when buffer-length
(bpf-buffer-length-set! bpf buffer-length))
(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))
;; Returns the *actual* size that was set, the requested size is too big
;; Remember, this can only be done *before* setting the interface.
;; Oddly enough, the interface can be switched afterwards, so there's
;; 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))
new-length))
(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) (location 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))
((foreign-lambda* c-string ((scheme-pointer i))
"C_return(((struct ifreq *)i)->ifr_name);") ifreq)))
(define (bpf-buffer-length bpf)
(let-location ((length int))
(ioctl (bpf-fd bpf) (foreign-value "BIOCGBLEN" int) (location length))
length))
)
|
