;;;; Copyright (c) 2006, Evan Farrer
;;;; All rights reserved.
;;;;
;;;; Redistribution and use in source and binary forms, with or without
;;;; modification, are permitted provided that the following conditions are met:
;;;;
;;;;     * Redistributions of source code must retain the above copyright
;;;;       notice, this list of conditions and the following disclaimer.
;;;;     * Redistributions in binary form must reproduce the above copyright
;;;;       notice, this list of conditions and the following disclaimer in the
;;;;       documentation and/or other materials provided with the distribution.
;;;;     * Neither the name of the developer nor the names of its contributors
;;;;       may be used to endorse or promote products derived from this software
;;;;       without specific prior written permission.
;;;;
;;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
;;;; AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
;;;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
;;;; ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
;;;; LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
;;;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
;;;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
;;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
;;;; CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
;;;; ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
;;;; POSSIBILITY OF SUCH DAMAGE.
;;;;

;;;; This module contains wrappers around the pcap library
;;;; Evan Farrer

(module SPeaCAP mzscheme
  (require "private/libpcap.ss"
           "private/netutils.ss"
           "private/privdrop.ss"
           (lib "etc.ss")
           (lib "list.ss"))
  
  (provide
   (all-from-except "private/libpcap.ss" raise-pcap-exn)
   (all-from "private/netutils.ss")
   (all-from "private/privdrop.ss")
   call-with-open-live
   call-with-open-offline
   call-with-dump-open
   lookup-dev-ex)
  
  
  ;; call proc with a pcap
  ;; pcap is closed automatically
  ;; [device (lookupdev)] [snaplen SNAPLEN] [promisc #t] [to-ms 1] proc
  ;; Note that the last parameter is always proc and is not optional the rest are optional
  (define-syntax call-with-open-live
    (syntax-rules ()
      ((_ proc)
       (call-with-open-live (lookup-dev) proc))
      ((_ device proc)
       (call-with-open-live device SNAPLEN proc))
      ((_ device snaplen proc)
       (call-with-open-live device snaplen #t proc))
      ((_ device snaplen promisc proc)
       (call-with-open-live device snaplen promisc 1 proc))
      ((_ device snaplen promisc to-ms proc)
       (let ([pcap #f])
         (dynamic-wind
          (lambda () (set! pcap (open-live device snaplen promisc to-ms)))
          (lambda () (proc pcap))
          (lambda () (pcap-close pcap)))))))
  
  
  ;; call proc with a pcap
  ;; pcap is closed automatically
  (define (call-with-open-offline filename proc)
    (let ([pcap #f])
      (dynamic-wind
       (lambda () (set! pcap (open-offline filename)))
       (lambda () (proc pcap))
       (lambda () (pcap-close pcap)))))
  
  ;; call proc with a dumper
  ;; dumper is closed automatically
  (define (call-with-dump-open pcap filename proc)
    (let ([dumph #f])
      (dynamic-wind
       (lambda () (set! dumph (dump-open pcap filename)))
       (lambda () (proc dumph))
       (lambda () (dump-close dumph)))))
  
  ;; A working replacement for lookup-dev
  ;; If allow-loopback is #t then an interface name with the PCAP-IF-FLAG-LOOPBACK flag may be returned
  (define lookup-dev-ex
    (opt-lambda ([allow-loopback #f])
      (define flag (if allow-loopback 'PCAP-IF-FLAG-LOOPBACK 'PCAP-IF-FLAG-NONE))
      (let ([iface (foldl
                    (lambda (item acc)
                      (if (null? (iface-addresses item))
                          acc
                          (if (and acc (eq? flag (iface-flags acc)))
                              acc
                              item)))
                    #f
                    (find-all-devs))])
        (if iface
            (iface-name iface)
            (raise-pcap-exn "Unable to find device")))))
  )