pcap.scm

   1 ;;;============================================================================
   2
   3 ;;; File: "pcap.scm", Time-stamp: <2008-05-15 14:07:39 feeley>
   4
   5 ;;; Copyright (c) 2008 by Marc Feeley, All Rights Reserved.
   6
   7 ;;; A simple interface to the pcap library.
   8
   9 ;;;============================================================================
  10
  11 (##namespace ("pcap#"))
  12
  13 (##include "~~/lib/gambit#.scm")
  14
  15 (##include "pcap#.scm")
  16
  17 ;;;============================================================================
  18
  19 (define ifbridge-program "./ifbridge")
  20
  21 (define (sudo program arguments)
  22   (open-process
  23    (list path: "sudo"
  24          arguments: (cons program arguments))))
  25
  26 (define (intf-list)
  27   (let* ((port (sudo ifbridge-program (list "list")))
  28          (result (read-all port read-line)))
  29     (close-port port)
  30     result))
  31
  32 (define (intf-open name)
  33   (let* ((read-port (sudo ifbridge-program (list "read" name)))
  34          (write-port (sudo ifbridge-program (list "write" name))))
  35     (cons read-port write-port)))
  36
  37 (define (fetch-uint-be u8vect start len)
  38   (let loop ((i 0) (n 0))
  39     (if (< i len)
  40         (loop (+ i 1) (+ (u8vector-ref u8vect (+ start i)) (* 256 n)))
  41         n)))
  42
  43 (define (read-u32-be port)
  44   (let* ((u8vect (u8vector 0 0 0 0))
  45          (n (read-subu8vector u8vect 0 4 port)))
  46     (and (eqv? n 4)
  47          (fetch-uint-be u8vect 0 4))))
  48
  49 (define (intf-read intf)
  50   (let ((read-port (car intf)))
  51     (write-u8 0 read-port)
  52     (let ((len (read-u32-be read-port)))
  53       (and len
  54            (let* ((u8vect (make-u8vector len))
  55                   (n (read-subu8vector u8vect 0 len read-port)))
  56              (and (eqv? n len)
  57                   u8vect))))))
  58
  59 (define (store-uint-be u8vect start len n)
  60   (let loop ((i (- len 1)) (n n))
  61     (if (>= i 0)
  62         (begin
  63           (u8vector-set! u8vect (+ start i) (bitwise-and 255 n))
  64           (loop (- i 1) (arithmetic-shift n -8))))))
  65
  66 (define (write-u32-be n port)
  67   (let ((u8vect (u8vector 0 0 0 0)))
  68     (store-uint-be u8vect 0 4 n)
  69     (write-subu8vector u8vect 0 4 port)))
  70
  71 (define (intf-write-subu8vector intf u8vect start end)
  72   (let ((write-port (cdr intf)))
  73     (let ((len (- end start)))
  74       (write-u32-be len write-port)
  75       (write-subu8vector u8vect start end write-port)
  76       (force-output write-port))))
  77
  78 (define (intf-write intf u8vect)
  79   (intf-write-subu8vector intf u8vect 0 (u8vector-length u8vect)))
  80
  81 ;;;============================================================================