summaryrefslogtreecommitdiff
path: root/bpf-interface.scm
blob: 3f9e47a8f202eeec82b5e25e5d61271e6874f6ab (plain)
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
129
130
;;;
;;; 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)
  (if (bpf-fd obj)
      (fprintf out "#<bpf on interface: ~S>" (bpf-interface obj))
      (display "#<bpf (closed)>" out)))

(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))

)