#!/bin/sh
(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!)
(define ip-dst 16)
(define (get-ip-off pcap)
(cond
[(eq? 'DLT-EN10MB (datalink pcap)) 14]
[(eq? 'DLT-NULL (datalink pcap)) 2]
[else (error "Unknown datalink")]))
(define (ip-header-size data ip-off)
(* 4 (- (ptr-ref data _uint8 'abs (+ ip-off 0)) 64)))
(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)))
(define (_bytes-list size)
(apply _list-struct (make-list size _byte)))
(define _bytes4 (_bytes-list 4))
(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))
(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)))))))))
)