examples/pcap-http-demo.ss
#!/bin/sh
#|
exec mzscheme -u "$0" "$@"
|#

(module pcap-http-demo mzscheme
  (require "../SPeaCAP.ss"
           (lib "dns.ss" "net")
           (lib "async-channel.ss")
           (only (lib "1.ss" "srfi") make-list)
           (lib "foreign.ss"))(unsafe-pcap!)(unsafe!)
  
  ; Lengths
  (define ip-dst 16)
  
  
  ;; Gets the byte offset of the ip header
  (define (get-ip-off pcap)
    (cond
      [(eq? 'DLT-EN10MB (datalink pcap)) 14]
      [(eq? 'DLT-NULL (datalink pcap)) 2]
      [else (error "Unknown datalink")]))
  
  
  ;; Gets the ip-header size
  (define (ip-header-size data ip-off)
    (* 4 (- (ptr-ref data _uint8 'abs (+ ip-off 0)) 64)))
  
  
  
  ;; Gets the dst address
  (define (get-ip-dst data ip-off ip-size)
    (inet-ntoa (integer-bytes->integer 
                (list->bytes (ptr-ref data _bytes4 'abs (+ ip-off ip-dst))) #t #f)))
  
  
  
  ;; FFI
  (define (_bytes-list size)
    (apply _list-struct (make-list size _byte)))
  
  
  (define _bytes4 (_bytes-list 4))
  
  
  
  ;; Starts a process for printing the addresses
  (define (start-addr-process)
    (let ([hash (make-hash-table 'equal)]
          [dns (dns-find-nameserver)]
          [channel (make-async-channel 1000)])
      (thread (lambda ()
                (let loop ([ip-dst (async-channel-get channel)])
                  (hash-table-get hash 
                                  ip-dst 
                                  (lambda ()
                                    (printf "\t~a\n" 
                                            (with-handlers ([exn? (lambda (x) ip-dst)])
                                              (dns-get-name dns ip-dst)))
                                    (hash-table-put! hash ip-dst #t)))
                  (loop (async-channel-get channel)))))
      channel))
  
  
  
  
  ;; Start sniffing for addresses
  (with-handlers ([exn:fail:pcap? (lambda (exn) (printf "No suitable devices found.  Exiting now.\n"))])
    (call-with-open-live (lookup-dev-ex)
     (lambda (pcap)
       (printf "Watching web request\n\n")
       (set-filter! pcap (compile-filter pcap "ip and tcp dst port 80"))
       
       (let ([ip-off (get-ip-off pcap)]
             [channel (start-addr-process)])
         
         (loop* pcap +inf.0 
                (lambda (head data breakloop)
                  (async-channel-put channel (get-ip-dst data ip-off (ip-header-size data ip-off)))))))))
  
  )