socket-sniff.lsp

   1 #!/usr/bin/newlisp
   2 #
   3 # Open a raw socket to sniff an interface; output to stdout
   4
   5 (signal 2 (fn (x) (exit 0)))
   6
   7 (context 'LIBC6)
   8 (constant 'library "/lib/x86_64-linux-gnu/libc.so.6")
   9 (import library "ioctl" "int" "int" "long" "void*" )
  10 (import library "perror" "void" "char*" )
  11 (import library "fdopen" "void*" "int" "char*" )
  12 (import library "setbuf" "void" "void*" "void*" )
  13 (import library "ntohs" "int" "int" )
  14 (import library "htons" "int" "int" )
  15 (import library "inet_addr" "void*" "void*")
  16 (import library "socket" "int" "int" "int" "int")
  17 (import library "setsockopt" "int" "int" "int" "int" "void*" "int")
  18 (import library "perror" "void" "char*")
  19 (setf bind-socket (import library "bind" "int" "int" "void*" "int"))
  20
  21 (define (die)
  22   (perror (join (map string (args)) " "))
  23   (exit 1))
  24
  25 (letex ((AF_INET 2)
  26         (SOCK_RAW 10)
  27         (IPPROTO_RAW (htons 0x0800)) ; htons(ETH_P_IP)
  28         (IPPROTO_ALL (htons 0x0003)) ; htons(ETH_P_ALL)
  29         (SOL_SOCKET 1)
  30         (SO_BINDTODEVICE 25)
  31         (SO_BROADCAST 6)
  32         (PACKET_OUTGOING 4)
  33         (SIZEOF_struct_sockaddr 16)
  34         )
  35   (define (raw-socket)
  36     (socket AF_INET SOCK_RAW IPPROTO_ALL))
  37
  38   (define (bind-to-device FD IFACE)
  39     (when (!= (setsockopt FD SOL_SOCKET SO_BINDTODEVICE IFACE (length IFACE)))
  40       (die "setsockopt bind to device"))
  41     (when (!= (setsockopt FD SOL_SOCKET SO_BROADCAST (pack "lu" 1) 4))
  42       (die "setsockopt broadcast"))
  43     0)
  44
  45   ) ; end letex
  46
  47 (context MAIN)
  48
  49 (define (ipbits IP)
  50   (join (map (fn (X) (-8 (string "0000000" (bits X))))
  51              (map int (parse IP ".")))))
  52
  53 (setf IFACE (main-args -1) FD (LIBC6:raw-socket) )
  54
  55 (when (< FD)
  56   (LIBC6:die "socket"))
  57
  58 (when (!= (LIBC6:bind-to-device FD IFACE))
  59   (LIBC6:die "bind-to-device"))
  60
  61 (setf SHOW 0)
  62
  63 (define TBL:TBL nil)
  64 (define TOT:TOT nil)
  65
  66 (define (add-show-table IP SZ)
  67   (TBL IP (+ (or (TBL IP) 0) SZ))
  68   (let ((NOW (date-value)))
  69     (when (> NOW SHOW)
  70       (when (> (- NOW SHOW) 5) (setf SHOW NOW))
  71       (inc SHOW 5)
  72       (! "tput cup 0 0")
  73       (let ((OUT '()) (x 0))
  74         (dolist (LN (TBL))
  75           (let ((IP (LN 0)) (N (LN 1)))
  76             (TOT IP (+ (or (TOT IP) 0) N))
  77             (TOT IP (max 0 (- (or (TOT IP) 0) 10000)))
  78             (push (list (ipbits IP) IP (TOT IP) (TBL IP)) OUT -1)
  79             (TBL IP 0)))
  80         (sort OUT (fn (x y)
  81                       (and (> (x -2))
  82                            (if (> (x -1)) (or (= (y -1)) (> (x -2) (y -2)))
  83                              (= (y -2)) true
  84                              (= (y -1)) (> (x -2) (y -2))))))
  85         (dotimes (i 30)
  86           (! "tput el")
  87           (when (setf x (pop OUT))
  88             (unless (> (x -2)) (setf x nil)))
  89           (println (or x "")))))))
  90
  91 (! "clear")
  92
  93 ;; unbuffered stdout
  94 (LIBC6:setbuf (LIBC6:fdopen 1 "w") 0)
  95
  96 (define (ipv4-packet) ; BUFFER
  97   (let ((IPV4SRC (unpack "bbbb" (30 BUFFER)))) ; 14+12
  98     (add-show-table (join (map string IPV4SRC) ".") (length BUFFER))))
  99
 100 (while (> (setf N (read FD BUFFER 2048)) 0)
 101   (when (> (length BUFFER) 34)
 102     (let ((MACHDR (unpack "bbbbbb bbbbbb bb" BUFFER)))
 103       ;(write-line 1 (string MACHDR))
 104       (when (= (-2 MACHDR) '(8 0)) (ipv4-packet)))))
 105
 106 (exit 0)