X-Git-Url: https://git.rrq.au/?a=blobdiff_plain;f=socket-sniff.lsp;h=f056d2e34ca569f7b14123f7c472e6f919b47749;hb=HEAD;hp=95639e91bb483c661caf7d4b0354e73780c8b776;hpb=9fdc6d3d282b01b6d0ed303aacb2e5d9d724092b;p=rrq%2Fnewlisp-ftw.git

diff --git a/socket-sniff.lsp b/socket-sniff.lsp
index 95639e9..f056d2e 100755
--- a/socket-sniff.lsp
+++ b/socket-sniff.lsp
@@ -24,18 +24,20 @@
 
 (letex ((AF_INET 2)
         (SOCK_RAW 10)
-        (IPPROTO_RAW (htons 0x0800))
+        (IPPROTO_RAW (htons 0x0800)) ; htons(ETH_P_IP)
+        (IPPROTO_ALL (htons 0x0003)) ; htons(ETH_P_ALL)
         (SOL_SOCKET 1)
         (SO_BINDTODEVICE 25)
         (SO_BROADCAST 6)
+	(PACKET_OUTGOING 4)
         (SIZEOF_struct_sockaddr 16)
         )
   (define (raw-socket)
-    (socket AF_INET SOCK_RAW IPPROTO_RAW))
+    (socket AF_INET SOCK_RAW IPPROTO_ALL))
 
   (define (bind-to-device FD IFACE)
     (when (!= (setsockopt FD SOL_SOCKET SO_BINDTODEVICE IFACE (length IFACE)))
-      (die "setsockopt bind"))
+      (die "setsockopt bind to device"))
     (when (!= (setsockopt FD SOL_SOCKET SO_BROADCAST (pack "lu" 1) 4))
       (die "setsockopt broadcast"))
     0)
@@ -44,6 +46,10 @@
 
 (context MAIN)
 
+(define (ipbits IP)
+  (join (map (fn (X) (-8 (string "0000000" (bits X))))
+	     (map int (parse IP ".")))))
+
 (setf IFACE (main-args -1) FD (LIBC6:raw-socket) )
 
 (when (< FD)
@@ -52,9 +58,49 @@
 (when (!= (LIBC6:bind-to-device FD IFACE))
   (LIBC6:die "bind-to-device"))
 
+(setf SHOW 0)
+
+(define TBL:TBL nil)
+(define TOT:TOT nil)
+
+(define (add-show-table IP SZ)
+  (TBL IP (+ (or (TBL IP) 0) SZ))
+  (let ((NOW (date-value)))
+    (when (> NOW SHOW)
+      (when (> (- NOW SHOW) 5) (setf SHOW NOW))
+      (inc SHOW 5)
+      (! "tput cup 0 0")
+      (let ((OUT '()) (x 0))
+	(dolist (LN (TBL))
+	  (let ((IP (LN 0)) (N (LN 1)))
+	    (TOT IP (+ (or (TOT IP) 0) N))
+	    (TOT IP (max 0 (- (or (TOT IP) 0) 10000)))
+	    (push (list (ipbits IP) IP (TOT IP) (TBL IP)) OUT -1)
+	    (TBL IP 0)))
+	(sort OUT (fn (x y)
+		      (and (> (x -2))
+			   (if (> (x -1)) (or (= (y -1)) (> (x -2) (y -2)))
+			     (= (y -2)) true
+			     (= (y -1)) (> (x -2) (y -2))))))
+	(dotimes (i 30)
+	  (! "tput el")
+	  (when (setf x (pop OUT))
+	    (unless (> (x -2)) (setf x nil)))
+	  (println (or x "")))))))
+
+(! "clear")
+
+;; unbuffered stdout
 (LIBC6:setbuf (LIBC6:fdopen 1 "w") 0)
 
+(define (ipv4-packet) ; BUFFER
+  (let ((IPV4SRC (unpack "bbbb" (30 BUFFER)))) ; 14+12
+    (add-show-table (join (map string IPV4SRC) ".") (length BUFFER))))
+
 (while (> (setf N (read FD BUFFER 2048)) 0)
-  (write 1 BUFFER))
+  (when (> (length BUFFER) 34)
+    (let ((MACHDR (unpack "bbbbbb bbbbbb bb" BUFFER)))
+      ;(write-line 1 (string MACHDR))
+      (when (= (-2 MACHDR) '(8 0)) (ipv4-packet)))))
 
 (exit 0)