From: Ralph Ronnquist <ralph.ronnquist@gmail.com>
Date: Mon, 20 Sep 2021 22:33:03 +0000 (+0000)
Subject: change to show top style traffic
X-Git-Url: https://git.rrq.au/?a=commitdiff_plain;h=78a5c6f4a046b8dce9a2994f885964e96073b249;p=rrq%2Fnewlisp-ftw.git

change to show top style traffic
---

diff --git a/socket-sniff.lsp b/socket-sniff.lsp
index 95639e9..980abe0 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)
@@ -52,9 +54,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 IP (TOT IP) (TBL IP)) OUT -1)
+	    (TBL IP 0)))
+	(sort OUT (fn (x y)
+		      (and (> (x 1))
+			   (if (> (x 2)) (or (= (y 2)) (> (x 1) (y 1)))
+			     (= (y 1)) true
+			     (= (y 2)) (> (x 1) (y 1))))))
+	(dotimes (i 30)
+	  (! "tput el")
+	  (when (setf x (pop OUT))
+	    (unless (> (x 1)) (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)