#!/usr/local/bin/newlisp
#

# This program attaches to a tap interface for the purpose of noticing
# activity via network traffic. The program serves as a virtual host
# that receives duplicated packets, and analyses them to select those
# that indicate activity.
# Optional arguments:
# -t tap = use the given tap rather than "tap0".

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

# The following is for Devuan GNU+Linux
(constant 'LIBC SITE:libc)
(import LIBC "ioctl" "int" "int" "long" "void*" )
(import LIBC "perror" "void" "char*" )
(import LIBC "ntohl" "int" "int" )
(import LIBC "ntohs" "int" "int" )
(import LIBC "htons" "int" "int" )
(import LIBC "htonl" "int" "int" )

# Report low level system error and exit
(define (die s) (perror s) (exit 1))

# Utility function to find a command line argument key and optionally
# the subsequent value, if a non-nil default value is given.
(define (mainarg k (v nil))
  (let ((a (member k (main-args))))
    (if (null? a) v (nil? v) true (null? (1 a)) v (a 1))))

# Set logging mode.
# Open the tap named by "-t tapX" on the command line, or "tap0" byt
# default. Then make a TUNSETIFF call to initialize it (as
# IFF_TAP|IFF_NO_PI).
(constant
 'listener-log-ip SITE:listener.log.ip
 'IFNAME SITE:listener.tap
 'PORTS SITE:listener.ports
 'IFD (open SITE:tundev "u")
 'ACTNAMEFMT "%d%02d%02d-network.dat"
 'ACTDIR SITE:listener.activity.dir
 'ACTFILEFMT (format "%s/%s" ACTDIR ACTNAMEFMT )
)
(unless (number? IFD) (die "open"))
(unless (zero? (ioctl IFD 0x400454ca (pack "s16 u s22" IFNAME 0x1002 "")))
  (die (string "set " IFNAME)))

# The TCP ports of interest

# Set up for optional tracking of IP addresses
(define counter:counter nil)

# This function accumulates packet size per ip+port, for monitored the
# ports. This accumulates traffic in both directions.
(define (track-data) ; buffer
  (write-line 2 "track-data")
  (let ((ips (explode (unpack "bbbb bbbb" ((+ 12 14) buffer)) 4)))
    (dotimes (i 2)
      (when (member (ports i) PORTS)
        (let ((k (string (join (map string (ips i)) ".") "." (ports i))))
          (counter x (+ (length buffer) (or (counter x) 0))))))))

(define (track-data-reset)
  (map delete (symbols counter)))

(track-data-reset)

# Mark the minute of t as an active minute. More exactly, it issues a
# mark if it now is more than 60 seconds from the last issued mark.
# This funcion collates all given ips, and it extends the log line
# with the list of ips used during the minute.
(setf next-mark 0 packet-count 0)
     
(define (mark-active t) ; buffer
  (when listener-log-ip (track-data))
  (inc packet-count)
  ;(write-line 2 (string (list t packet-count ports (counter))))
  (when (>= t next-mark)
    (let ((d (format ACTFILEFMT (0 3 (date-list t))))
          (c (map string (counter))))
      (append-file d (string t " " packet-count " " (join c " ") "\n"))
      (setf next-mark (+ t 60) packet-count 0)
      (when listener-log-ip (track-data-reset))
      )))

# Handle an ARP request. This picks up IP address from the request.
# The MAC address is formed from the IP address with 2 before and 2
# after.
(define (arp-request-handler) ; buffer
  (letn ((MYIP (unpack "bbbb" (38 buffer))) (MYMAC (flat (list 2 MYIP 2))))
    (write IFD (pack "bbbbbb bbbbbb u u u b b u bbbbbb bbbb bbbbbb bbbb"
                     (flat (list (unpack "bbbbbb" (6 buffer))
                                 MYMAC
                                 (map htons '(0x0806 0x1 0x0800 ))
                                 0x06 0x04
                                 (htons 0x2)
                                 MYMAC MYIP
                                 (unpack "bbbbbb bbbb" (22 buffer))
                                 ))
                     ))))

# Handle an ARP packet. It recognizes the ARP command involved, and
# dispatches to the associated handler, if any.
(define (arp-handler) ; buffer
  (case (ntohs ((unpack "u" (20 buffer)) 0)) ; ARP command
    (0x0001 (and arp-request-handler (arp-request-handler)))
    (true nil) ; ignore
    ))

# Handle a TCP packet. It reviews the ports involved, and if any is
# among the interesting ports, then it marks activity together with ip
# and port of sender and receiver.
(define (tcp-handler) ; buffer ihl
  (let ((ports (map ntohs (unpack "uu" ((+ ihl 14) buffer)))))
    (when (intersect ports PORTS) (mark-active (date-value)))))

(define (udp-handler) ; buffer ihl
  (let ((ports (map ntohs (unpack "uu" ((+ ihl 14) buffer)))))
    (when PORTS (intersect ports PORTS) (mark-active (date-value)))))

# Handle an IPv4 packet. It recognises the IPv4 protocol concerned,
# and dispatches to the associated handler, if any.
(define (ipv4-handler) ; buffer
  (let ((ihl (* (& 0x0F ((unpack "b" (14 buffer)) 0)) 4)))
    (case ((unpack "b" (23 buffer)) 0) ; protocol
      (0x01 (and icmp-handler (icmp-handler)))
      (0x02 (and igmp-handler (igmp-handler)))
      (0x04 (and ipip-handler (ipip-handler)))
      (0x06 (and tcp-handler (tcp-handler)))
      (0x11 (and udp-handler (udp-handler)))
      (true nil) ; ignore
      )
    ))

# This function handles an Ethernet packet by recognising the packet
# type, and dispatch to the associated handler, if any.
(define (handle-packet) ; buffer
  (when (> n 14)
    (case (ntohs ((unpack "u" (12 buffer)) 0)) ; Ethertype
      (0x0806 (and arp-handler (arp-handler)))
      (0x0800 (and ipv4-handler (ipv4-handler)))
      (0x86DD (and ipv6-handler (ipv6-handler)))
      (true nil) ; ignore all else
      )))

# Read and handle a packet from the tap. The program handles ARP
# requests by emitting an appropriate ARP response, and it handles TCP
# packets to certain ports, which are seen as indications of activity.
(define (handle-tap)
  (let ((buffer "")(n nil))
    (if (setf n (read IFD buffer 8000)) (handle-packet)
      (begin (write-line 2 (format "IFD error")) (exit 1)))))

# This function gets invoked prior to the interactive prompt. It'll
# listen for data on the tap, and handle that, and also wake up every
# second, so as to allow a timer effect to be set up.
(define (ioselect s)
  (letn ((fds (list IFD)) (fdx nil))
    (until (member 0 (setf fdx (or (net-select fds "r" 10000000) '())))
      (when fdx (handle-tap))))
  nil)

(prompt-event ioselect)
(close 0)
(while true (ioselect))