#!/usr/bin/newlisp
#
# Open a raw socket to sniff an interface; output to stdout

(signal 2 (fn (x) (exit 0)))

(context 'LIBC6)
(constant 'library "/lib/x86_64-linux-gnu/libc.so.6")
(import library "ioctl" "int" "int" "long" "void*" )
(import library "perror" "void" "char*" )
(import library "fdopen" "void*" "int" "char*" )
(import library "setbuf" "void" "void*" "void*" )
(import library "ntohs" "int" "int" )
(import library "htons" "int" "int" )
(import library "inet_addr" "void*" "void*")
(import library "socket" "int" "int" "int" "int")
(import library "setsockopt" "int" "int" "int" "int" "void*" "int")
(import library "perror" "void" "char*")
(setf bind-socket (import library "bind" "int" "int" "void*" "int"))

(define (die)
  (perror (join (map string (args)) " "))
  (exit 1))

(letex ((AF_INET 2)
        (SOCK_RAW 10)
        (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_ALL))

  (define (bind-to-device FD IFACE)
    (when (!= (setsockopt FD SOL_SOCKET SO_BINDTODEVICE IFACE (length IFACE)))
      (die "setsockopt bind to device"))
    (when (!= (setsockopt FD SOL_SOCKET SO_BROADCAST (pack "lu" 1) 4))
      (die "setsockopt broadcast"))
    0)

  ) ; end letex

(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)
  (LIBC6:die "socket"))

(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)
  (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)