(module libpcap mzscheme
  (require "define-utils.ss"
           "netutils.ss"
           "ffi-utils.ss"
           "security-guard.ss"
           (lib "list.ss")
           (lib "etc.ss")
           (all-except (lib "contract.ss") ->)
           (rename (lib "contract.ss") => ->)
           (lib "foreign.ss")) (unsafe!)
  
  (provide
   raise-pcap-exn
   (rename open-live-secure open-live)
   open-dead
   (rename open-offline-secure open-offline)
   (rename dump-open-secure dump-open)
   dump-fopen
   dump
   dump-flush
   dump-file
   dump-close
   (rename setnonblock set-non-block!)
   (rename getnonblock get-non-block)
   (rename setfilter set-filter!)
   (rename findalldevs find-all-devs)
   (rename lookupdev lookup-dev)
   (rename lookupnet lookup-net)
   dispatch
   loop
   compile-filter
   compile-nopcap
   next
   next-ex
   datalink
   list-datalinks
   set-datalink!
   datalink-name-to-val
   datalink-val-to-name
   datalink-val-to-description
   snapshot
   (rename is-swapped swapped?)
   major-version
   minor-version
   stats
   file
   fileno
   get-selectable-fd
   perror
   (rename geterr get-error)
   strerror
   lib-version
   (rename close pcap-close))
  
  (provide* (unsafe next*)
            (unsafe next-ex*)
            (unsafe loop*)
            (unsafe dispatch*)
            (unsafe dump*))
  (define-unsafer unsafe-pcap!)
  
  
  ;;;;
  ;;;;  This has been tested on:
  ;;;;    FreeBSD libpcap version 9.1
  ;;;;    WindowsXP winpcap version 3.1 beta 4
  ;;;; 
  
  
  ;                             
  ;                             
  ;       @                     
  ;       @          @          
  ;       @          @          
  ;    *@*@  @@@#+ @@@@@   @@@#+
  ;   +* :@     -@   @        -@
  ;   #   @  -&@@@   @     -&@@@
  ;   #   @  $+  @   @     $+  @
  ;   +* :@  #+ +@   #:    #+ +@
  ;    &@*@  :#@*@   :#@   :#@*@
  ;                             
  ;                             
  ;                      @@@@@@@@
  
  
  ;; Returns the path to the dll
  (define (get-dll-path file)
    (case (system-type)
      [(unix) file]
      [(windows) (build-path (this-expression-source-directory) "..\\lib\\" file)]))
  
  
  ;; Load up auxillary dll's for windows so they'll be found by wpcap
  (if (eq? 'windows (system-type))
      (begin
        (ffi-lib (get-dll-path "WanPacket.dll"))
        (ffi-lib (get-dll-path "Packet.dll"))))
  
  
  ;; libpcap :: ffi-lib
  (define libpcap (ffi-lib 
                   (case (system-type)
                     [(unix) "libpcap"]
                     [(windows) (get-dll-path "wpcap")])))
  
  
  (define/provide SNAPLEN 65535)
  
  ;;
  ;; PCAP-ERRORBUF-SIZE from pcap.h
  ;;
  (define PCAP-ERRORBUF-SIZE 256)
  (define err-buf (make-parameter (make-bytes PCAP-ERRORBUF-SIZE)))
  
  
  ;; A pointer/c is cpointer? or #f if NULL
  (define pointer/c (union cpointer? false/c))
  
  ;; use utf-8 strings
  (default-_string-type _string*/utf-8)
  
  ;; The types
  ;; A pcap is a
  (define-handle pcap)
  
  ;; A dumper is a
  (define-handle dumper)
  
  ;;
  ;; Data-link level type codes. from net/bpf.h
  ;;
  (define _datalink (_enum
                     '(DLT-INVALID = -1
                                   DLT-NULL = 0
                                   DLT-EN10MB = 1
                                   DLT-EN3MB = 2
                                   DLT-AX25 = 3
                                   DLT-PRONET = 4
                                   DLT-CHAOS = 5
                                   DLT-IEEE802 = 6
                                   DLT-ARCNET = 7
                                   DLT-SLIP = 8
                                   DLT-PPP = 9
                                   DLT-FDDI = 10
                                   DLT-ATM-RFC1483 = 11
                                   DLT-RAW = 12
                                   DLT-SLIP-BSDOS = 15
                                   DLT-PPP-BSDOS = 16
                                   DLT-ATM-CLIP = 19
                                   DLT-PPP-SERIAL = 50
                                   DLT-PPP-ETHER = 51
                                   DLT-SYMANTEC-FIREWALL = 99
                                   DLT-C-HDLC = 104
                                   DLT-IEEE802-11 = 105
                                   DLT-FRELAY = 107
                                   DLT-LOOP = 108
                                   DLT-ENC = 109
                                   DLT-LINUX-SLL = 113
                                   DLT-LTALK = 114
                                   DLT-ECONET = 115
                                   DLT-IPFILTER = 116
                                   DLT-PFLOG = 117
                                   DLT-CISCO-IOS = 118
                                   DLT-PRISM-HEADER = 119
                                   DLT-AIRONET-HEADER = 120
                                   DLT-PFSYNC = 121
                                   DLT-IP-OVER-FC = 122
                                   DLT-SUNATM = 123
                                   DLT-RIO = 124
                                   DLT-PCI-EXP = 125
                                   DLT-AURORA = 126
                                   DLT-IEEE802-11-RADIO = 127
                                   DLT-TZSP = 128
                                   DLT-ARCNET-LINUX = 129
                                   DLT-JUNIPER-MLPPP = 130
                                   DLT-APPLE-IP-OVER-IEEE1394 = 138
                                   DLT-JUNIPER-MLFR = 131
                                   DLT-JUNIPER-ES = 132
                                   DLT-JUNIPER-GGSN = 133
                                   DLT-JUNIPER-MFR = 134
                                   DLT-JUNIPER-ATM2 = 135
                                   DLT-JUNIPER-SERVICES = 136
                                   DLT-JUNIPER-ATM1 = 137
                                   DLT-MTP2-WITH-PHDR = 139
                                   DLT-MTP2 = 140
                                   DLT-MTP3 = 141
                                   DLT-SCCP = 142
                                   DLT-DOCSIS = 143
                                   DLT-LINUX-IRDA = 144
                                   DLT-IBM-SP = 145
                                   DLT-IBM-SN = 146
                                   DLT-USER0 = 147
                                   DLT-USER1 = 148
                                   DLT-USER2 = 149
                                   DLT-USER3 = 150
                                   DLT-USER4 = 151
                                   DLT-USER5 = 152
                                   DLT-USER6 = 153
                                   DLT-USER7 = 154
                                   DLT-USER8 = 155
                                   DLT-USER9 = 156
                                   DLT-USER10 = 157
                                   DLT-USER11 = 158
                                   DLT-USER12 = 159
                                   DLT-USER13 = 160
                                   DLT-USER14 = 161
                                   DLT-USER15 = 162
                                   DLT-IEEE802-11-RADIO-AVS = 163
                                   DLT-JUNIPER-MONITOR = 164
                                   DLT-BACNET-MS-TP = 165
                                   DLT-PPP-PPPD = 166
                                   DLT-JUNIPER-PPPOE = 167
                                   DLT-JUNIPER-PPPOE-ATM = 168
                                   DLT-GPRS-LLC = 169
                                   DLT-GPF-T = 170
                                   DLT-GPF-F = 171
                                   DLT-GCOM-T1E1 = 172
                                   DLT-GCOM-SERIAL = 173
                                   DLT-JUNIPER-PIC-PEER = 174
                                   DLT-ERF-ETH = 175
                                   DLT-ERF-POS = 176
                                   DLT-LINUX-LAPD = 177)))
  
  
  
  ;; A net is a
  (define-struct/provide/contract net ([ip string?]
                                       [mask string?]) 
    (make-inspector))
  
  
  
  ;; A addr holds address information
  (define-clist-struct _addr-list 
    addr
    ([next _addr-list]
     [addr _sockaddr]
     [netmask _sockaddr]
     [broadaddr _sockaddr]
     [dstaddr _sockaddr]))
  
  
  ;; iface-flag definitions
  (define _iface-flags (_enum
                        '(PCAP-IF-FLAG-NONE = 0
                                            PCAP-IF-FLAG-LOOPBACK = 1)))
  
  
  ;; A iface holds information about a pcap interface
  (define-clist-struct _iface-list 
    iface
    ([next _iface-list]
     [name _string]
     [description _string]
     [addresses _addr-list]
     [flags _iface-flags])
    freealldevs)
  
  
  
  
  ;; A stat is a
  ;; NOTE the unix version is missing the ps-bs-capt
  (define/provide-ctype-struct stat
    _stat 
    ([ps-recv _uint]
     [ps-drop _uint]
     [ps-ifdrop _uint]
     [ps-bs-capt _uint])
    (make-inspector))
  
  
  
  
  
  ;; A timeval is a struct long tv-sec long tv-usec ...
  (define/provide-ctype-struct timeval
    _timeval
    ([tv-sec _ulong]
     [tv-usec _ulong])
    (make-inspector))
  
  
  
  ;; A pkthdr is a
  (define/provide-ctype-struct pkthdr
    _pkthdr
    ([ts _timeval]
     [caplen _uint32]
     [len _uint32])
    (make-inspector))
  
  
  
  ;; A packet is a
  (define-struct/provide/contract packet ([head pkthdr?]
                                          [data (union cpointer? bytes?)])
    (make-inspector))
  
  
  ;; A bpf-program is a
  (define-ctype-struct bpf-program
    _bpf-program
    ([len _uint]
     [ptr _pointer]))
  
  
  ;; The exceptions
  (define-struct (exn:fail:pcap exn:fail) ())
  (provide (struct exn:fail:pcap ()))
  
  ;                                                       
  ;                                                       
  ;     $@                            @                   
  ;    &-                      @                          
  ;    @                       @                          
  ;   @@@@  @   @ @-$$+  +@@  @@@@   @@    &@$- @-$$+ -#@@@
  ;    @    @   @ @+  @ ++     @      @   ++  $ @+  @ $+  
  ;    @    @   @ @   @ $      @      @   $   @ @   @  +#$+
  ;    @    #-  @ @   @ ++     $      @   ++  $ @   @     @
  ;    @     $@+@ @   @  +@@   -$@  @@@@@  &@$- @   @ @@@$+
  ;                                                       
  ;                                                       
  ;                                                #@#@#@#@
  
  ;; Raises a exn:fail:pcap exception
  (define-syntax raise-pcap-exn
    (syntax-rules ()
      ((_ msg)
       (raise (make-exn:fail:pcap (string->immutable-string msg) (current-continuation-marks))))))
  
  
  ;; Ensures that we have a string
  ;; converts cstrings to strings
  ;; ((union bytes? string?) . => . string?)
  (define (cstring/string->string str)
    (cond
      [(string? str) str]
      [else (cstring->string str)]))
  
  
  
  ;; Handles error values
  ;; error if #f
  ;; success if any
  ;; ((union false/c any/c) string? . => . any)
  (define (std-error-handler ret-val err-buf)
    (if ret-val
        ret-val
        (raise-pcap-exn (cstring/string->string err-buf))))
  
  ;; Handles error values
  ;; error if -1
  ;; false if 0
  ;; true if any
  ;; (integer? (union string? bytes?) . => . boolean?)
  (define (-1_0_1_error-handler ret-val err-buf)
    (cond
      [(= -1 ret-val) (raise-pcap-exn (cstring/string->string err-buf))]
      [(= 0 ret-val) #f]
      [else #t]))
  
  ;; Handlers error values
  ;; error if -1
  ;; any
  ;; (integer? (union string? bytes?) any/c . => . any)
  (define (-1_any-error-handler ret-val err-buf val)
    (cond
      [(= -1 ret-val) (raise-pcap-exn (cstring/string->string err-buf))]
      [else val]))
  
  
  ;; The packet type
  (define packet/c (flat-named-contract "packet" 
                                        (lambda (pkt) 
                                          (or (eof-object? pkt) (packet? pkt) (not pkt)))))
  
  ;; Handles the results of a next-ex call
  ;; success if 1
  ;; error if -1
  ;; eof if -2 (Eof [offline capture])
  ;; #f if 0 (Timeout [live capture])
  ;; (integer? pkthdr? cpointer? boolean? . => . packet/c)
  (define (next-ex-error-handler ret head data safe)
    (cond
      [(= 1 ret) (make-packet head
                              (if safe
                                  (make-sized-byte-string 
                                   data
                                   (pkthdr-caplen head))
                                  data))]
      [(= 0 ret) #f] ; Timeout
      [(= -1 ret) (raise-pcap-exn "Error reading packet")]
      [(= -2 ret) eof]))
  
  
  ;; The libpcap definitions
  (ffi-func/contract libpcap
                     (("^" "pcap-") 
                      ("!$" "")     ; No !'s
                      ("~$" "")     ; Avoid dups
                      ("-" "_")
                      ("[*]" "")    ; Remove *unsafe flag
                      )
                     ([open-live
                       ;; device snaplen promisc to-ms -> pcap
                       (string? integer? boolean? integer? . => . pcap?) ; raises exn:fail:pcap
                       (_fun _string _int _bool _int (eb : _string = (err-buf)) -> (ret : _pcap)
                             -> (std-error-handler ret eb))]
                      
                      ;; datalink snaplen -> pcap
                      [open-dead
                       (symbol? integer? . => . pcap?) ; raises exn:fail:pcap
                       (_fun _datalink _int -> (ret : _pcap)
                             -> (std-error-handler ret "Unknown error: open-dead"))]
                      
                      ;; filename -> pcap
                      [open-offline
                       ((union string? path?) . => . pcap?) ; raises exn:fail:pcap
                       (_fun _string (eb : _string = (err-buf)) -> (ret : _pcap)
                             -> (std-error-handler ret eb))]
                      
                      ;; dump
                      [dump
                       (dumper? pkthdr? bytes? . => . void?)
                       (_fun _dumper (_ptr i _pkthdr) _bytes -> _void)]
                      
                      
                      ;; dump*
                      [dump*
                       (dumper? pkthdr? cpointer? . => . void?)
                       (_fun _dumper (_ptr i _pkthdr) _pointer -> _void)]
                      
                      ;; pcap filename -> dumper
                      [dump-open
                       (pcap? (union string? path?) . => . dumper?) ; raises exn:fail:pcap
                       (_fun (pcap : _pcap) _string -> (ret : _dumper)
                             -> (std-error-handler ret (geterr pcap)))]
                      
                      ;; Not implemented below <grin>
                      ;; as there is not way to use it
                      ;; dump-fopen
                      
                      [dump-flush
                       (dumper? . => . void?) ; raises exn:fail:pcap
                       (_fun _dumper -> (ret : _int)
                             -> (-1_any-error-handler
                                 ret 
                                 "Unknown error: dump-flush"
                                 (void)))]
                      
                      ;; Not implemented below <grin>
                      ;; as there is not way to use it
                      ;; dump-file
                      
                      [dump-close
                       (dumper? . => . void?)
                       (_fun _dumper -> _void)]
                      
                      [setnonblock
                       (pcap? boolean? . => . void?) ; raises exn:fail:pcap
                       (_fun _pcap _bool (eb : _string = (err-buf)) -> (ret : _int)
                             -> (begin 
                                  (-1_0_1_error-handler ret eb)
                                  (void)))]
                      
                      [getnonblock
                       (pcap? . => . boolean?) ; raises exn:fail:pcap
                       (_fun _pcap (eb : _string = (err-buf)) -> (ret : _int) 
                             -> (-1_0_1_error-handler ret eb))]
                      
                      ;; called automatically
                      [freealldevs 
                       (pointer/c . => . void?) ; raises exn:fail:pcap
                       (_fun _pointer -> _void)]
                      
                      [findalldevs
                       (=> (listof iface?)) ; raises exn:fail:network exn:fail:pcap
                       (_fun (ifaces : (_ptr o _iface-list)) (eb : _string = (err-buf)) -> (ret : _int)
                             -> (begin (-1_0_1_error-handler ret eb)
                                       ;; We call freealldevs on ifaces as part of the definition of _iface-list
                                       ifaces))]
                      
                      ;; -> device
                      [lookupdev 
                       (=> string?) ; raises exn:fail:pcap
                       (_fun (eb : _string = (err-buf)) -> (ret : (if (eq? (system-type) 'windows) _string/utf-16  _string))
                             -> (std-error-handler ret eb))]
                      
                      ;; device -> net
                      [lookupnet
                       (string? . => . net?) ; raises exn:fail:pcap
                       (_fun _string (netp : (_ptr o _ip-addr)) (maskp : (_ptr o _ip-addr)) (eb : _string = (err-buf)) -> (ret : _int)
                             -> 
                             (let ([bad "0.0.0.0"])
                               (-1_any-error-handler
                                (if (and (equal? netp bad) (equal? maskp bad))
                                    -1
                                    ret)
                                eb
                                (make-net netp maskp))))]
                      
                      ;; dispatch is defined below
                      
                      ;; loop is defined below
                      
                      [compile~
                       ; pcap filter optimize netmask
                       (pcap? string? boolean? string? . => . bpf-program?) ; raises exn:fail:pcap
                       (_fun (pcap : _pcap) (bpf : (_ptr io _bpf-program) = (make-bpf-program 0 #f)) _string _bool _ip-addr -> (ret : _int)
                             ->
                             (begin
                               (register-finalizer bpf 
                                                   freecode)
                               (-1_any-error-handler ret (string-append "compile-filter error: " (geterr pcap)) bpf)))]
                      
                      ;; compile-nopcap is provided below so that we can get an error message
                      
                      [setfilter
                       (pcap? bpf-program? . => . void?) ; raises exn:fail:pcap
                       (_fun (pcap : _pcap) (_ptr i _bpf-program) -> (ret : _int)
                             ->
                             (-1_any-error-handler ret (geterr pcap) (void)))]
                      
                      [freecode
                       (bpf-program? . => . void?)
                       (_fun (_ptr i _bpf-program) -> _void)]
                      
                      [next
                       (pcap? . => . packet/c)
                       (_fun _pcap (head : (_ptr io _pkthdr) = (make-pkthdr (make-timeval 0 0) 0 0)) -> (ret : _pointer)
                             -> 
                             (if ret
                                 (make-packet head (make-sized-byte-string ret (pkthdr-caplen head)))
                                 #f))]
                      
                      [next*
                       (pcap? . => . packet/c)
                       (_fun _pcap (head : (_ptr io _pkthdr) = (make-pkthdr (make-timeval 0 0) 0 0)) -> (ret : _pointer)
                             -> 
                             (if ret
                                 (make-packet head ret)
                                 #f))]
                      
                      [next-ex
                       (pcap? . => . packet/c) ; raises exn:fail:pcap
                       (_fun _pcap (head : (_ptr o (_ptr o _pkthdr))) (data : (_ptr o _pointer)) -> (ret : _int)
                             -> (next-ex-error-handler ret head data #t))]
                      
                      [next-ex*
                       (pcap? . => . packet/c) ; raises exn:fail:pcap
                       (_fun _pcap (head : (_ptr o (_ptr o _pkthdr))) (data : (_ptr o _pointer)) -> (ret : _int)
                             -> (next-ex-error-handler ret head data #f))]
                      
                      
                      ; breakloop is defined below
                      
                      [datalink
                       (pcap? . => . symbol?)
                       (_fun _pcap -> _datalink)]
                      
                      [list-datalinks
                       (pcap? . => . (listof (union symbol? false/c))) ; raises exn:fail:pcap
                       ;; We must use a _ptr and not a _list as we don't know at call time how long the list will be
                       (_fun _pcap (links : (_ptr o _pointer)) -> (ret : _int)
                             -> 
                             (begin
                               (register-finalizer links free)
                               (cblock->list 
                                (-1_any-error-handler ret "Unknown error: list-datalinks" links)
                                _datalink ret)))]
                      
                      [set-datalink!
                       (pcap? symbol? . => . void?) ; raises exn:fail:pcap
                       (_fun _pcap _datalink -> (ret : _int)
                             -> (begin
                                  (-1_0_1_error-handler ret "Unknown error: set-datalink!")
                                  (void)))]
                      
                      [datalink-name-to-val 
                       (string? . => . symbol?)
                       (_fun _string -> (ret : _datalink)
                             -> (if (eq? ret 'DLT-INVALID)
                                    (std-error-handler #f "Invalid datalink")
                                    ret))]
                      
                      [datalink-val-to-name 
                       (symbol? . => . string?)
                       (_fun _datalink -> (ret : _string) ; raises exn:fail:pcap
                             -> (std-error-handler ret "Invalid datalink"))]
                      
                      
                      [datalink-val-to-description 
                       (symbol? . => . string?)
                       (_fun _datalink -> (ret : _string) ; raises exn:fail:pcap
                             -> (std-error-handler ret "Invalid datalink"))]
                      
                      [snapshot 
                       (pcap? . => . integer?)
                       (_fun _pcap -> _int)]
                      
                      [is-swapped
                       (pcap? . => . boolean?)
                       (_fun _pcap -> _bool)]
                      
                      [major-version
                       (pcap? . => . integer?)
                       (_fun _pcap -> _int)]
                      
                      [minor-version
                       (pcap? . => . integer?)
                       (_fun _pcap -> _int)]
                      
                      [stats
                       (pcap? . => . stat?) ; raises exn:fail:pcap
                       (_fun (pcap : _pcap) (val : (_ptr io _stat) = (make-stat 0 0 0 0)) -> (ret : _int) 
                             -> (-1_any-error-handler ret (geterr pcap) val))]
                      
                      ;; Not implemented below <grin>
                      ;; as there is not way to use them
                      ;; file
                      ;; fileno
                      ;; get-selectable-fd
                      
                      ;; We implement perror using geterr so that current-error-port is used
                      ;; perror (defined below)
                      
                      [geterr
                       (pcap? . => . string?)
                       (_fun _pcap -> _string)]
                      
                      [strerror 
                       (integer? . => . string?)
                       (_fun _int -> _string)]
                      
                      [lib-version 
                       (=> string?)
                       (_fun -> _string)]
                      
                      [close
                       (pcap? . => . void?)
                       (_fun _pcap -> _void)]
                      
                      ))
  
  ;; open-live with security-guard check
  ;; open-live already has a contract
  ;; raises exn:fail:pcap exn:fail
  ;; to-ms should be +inf.0 (not 0) for a forever timeout
  (define open-live-secure
    (opt-lambda ([device (lookupdev)] [snaplen SNAPLEN] [promisc #t] [to-ms 1])
      (security-check-network-server "open-live" 0)
      (open-live device snaplen promisc (if (= to-ms +inf.0) 0 to-ms))))
  
  
  ;; open-offline with security-guard check
  ;; open-offline already has a contract
  ;; raises exn:fail:pcap exn:fail
  (define open-offline-secure
    (lambda (filename)
      (security-check-file "open-offline" filename 
                           '(SCHEME-GUARD-FILE-EXISTS 
                             SCHEME-GUARD-FILE-READ))
      (open-offline filename)))
  
  
  ;; dump-open with security-guard check
  ;; dump-open already has a contract
  ;; raises exn:fail:pcap exn:fail
  (define dump-open-secure
    (lambda (pcap filename)
      (security-check-file "dump-open" filename 
                           '(SCHEME-GUARD-FILE-EXISTS 
                             SCHEME-GUARD-FILE-WRITE))
      (dump-open pcap filename)))
  
  
  ;; compile-filter with optional args
  (define compile-filter
    (opt-lambda (pcap filter [optimize #t] [netmask "0.0.0.0"])
      (compile~ pcap filter optimize netmask)))
  
  
  ;; dump-fopen
  ;; (pcap? any/c -> void) raise exn:fail:unsuported
  (define/contract dump-fopen
    (pcap? any/c . => . void?)
    (lambda (pcap FILE)
      (raise (make-exn:fail:unsupported "dump-fopen is not implemented as there is no way to use a FILE *" (current-continuation-marks)))))
  
  
  ;; dump-file
  ;; (dumper? -> void) raise exn:fail:unsuported
  (define/contract dump-file
    (dumper? . => . void?)
    (lambda (dumper)
      (raise (make-exn:fail:unsupported "dump-file is not implemented as there is no way to use a FILE *" (current-continuation-marks)))))
  
  
  ;; file
  ;; (pcap -> void) raise exn:fail:unsuported
  (define/contract file
    (pcap? . => . void?)
    (lambda (pcap)
      (raise (make-exn:fail:unsupported "file is not implemented as there is no way to use a FILE *" (current-continuation-marks)))))
  
  
  ;; fileno
  ;; (pcap -> void) raise exn:fail:unsuported
  (define/contract fileno
    (pcap? . => . void?)
    (lambda (pcap)
      (raise (make-exn:fail:unsupported "fileno is not implemented as there is no way to use a file descriptor" (current-continuation-marks)))))
  
  
  ;; get-selectable-fd
  ;; (pcap -> void) raise exn:fail:unsuported
  (define/contract get-selectable-fd
    (pcap? . => . void?)
    (lambda (pcap)
      (raise (make-exn:fail:unsupported "get-selectable-fd is not implemented as there is no way to use a file descriptor" (current-continuation-marks)))))
  
  
  ;; perror with current-error-port
  (define/contract perror 
    (pcap? string? . => . void?)
    (lambda (pcap prefix)
      (fprintf (current-error-port) "~a: ~a\n" prefix (geterr pcap))))
  
  
  ;; compile-nopcap scheme implementation to provide error message
  ;; raises exn:fail:pcap
  (define/contract
    compile-nopcap
    (symbol? integer? string? boolean? string? . => . bpf-program?)
    (opt-lambda (datalink snaplen filter [optimize #t] [netmask "0.0.0.0"])
      (let ([pcap #f])
        (dynamic-wind
         (lambda () (set! pcap (open-dead datalink snaplen)))
         (lambda () (compile~ pcap filter optimize netmask))
         (lambda () (close pcap))))))
  
  
  
  ;; callback passes breakloop that takes know arguments
  ;; count should be +inf.0 not -1 for running forever
  ;; We don't pass user as it's nothing but a poor mans closure
  ;; Return # of packets read
  ;; Return #f if breakloop was called
  ;; raise exn:fail:pcap on error
  (define (make-loop/dispatch cont-on-timeout next-ex)
    (lambda (pcap count callback)
      (let/cc brk-k
        (let loop ([sofar 0])
          (cond
            ;; Finish when sofar = count
            [(= sofar count) sofar]
            [else
             (let ([packet (next-ex pcap)])
               (when (packet? packet)
                 (callback 
                  (packet-head packet) 
                  (packet-data packet) 
                  (lambda () (brk-k #f))))
               
               ;; for loop we continue on a read timeout (packet == #f)
               (if (or (packet? packet) (and (not packet) cont-on-timeout))
                   ; Only decrement when got a packet
                   (loop (if packet (add1 sofar) sofar))
                   sofar))])))))
  
  
  (define/contract dispatch
    ; pcap count (pkthdr data breakloop)
    (pcap? integer? (pkthdr? bytes? (=> false/c) . => . any) . => . (union integer? false/c))
    (make-loop/dispatch #f next-ex))
  
  (define/contract loop
    ; pcap count (pkthdr data breakloop)
    (pcap? integer? (pkthdr? bytes? (=> false/c) . => . any) . => . (union integer? false/c))
    (make-loop/dispatch #t next-ex))
  
  (define/contract dispatch*
    ; pcap count (pkthdr pointer breakloop)
    (pcap? integer? (pkthdr? cpointer? (=> false/c) . => . any) . => . (union integer? false/c))
    (make-loop/dispatch #f next-ex*))
  
  (define/contract loop*
    ; pcap count (pkthdr pointer breakloop)
    (pcap? integer? (pkthdr? cpointer? (=> false/c) . => . any) . => . (union integer? false/c))
    (make-loop/dispatch #t next-ex*))
  
  
  
  
  
  
  )