#!/usr/bin/newlisp
#
# Use pcap to sniff out rwhod broadcasts on an interface, and store
# select ones at /var/spool/rwho/rwho.$HOST

(constant
 'HOSTS '("ns1" "ns2" ("borta" "ns3") "ns4" "ns5" "ns6")
 'IFACE "dev1nsd_br"
 )

############################################################
(constant
 'ALIAS (filter list? HOSTS)
 'HOSTS (union (clean list? HOSTS) (map first ALIAS))
 'PCAPLIB "/usr/lib/x86_64-linux-gnu/libpcap.so"
 'PCAP_CHAR_ENC_LOCAL 0
 'PCAP_CHAR_ENC_UTF_8 1
 )

(define (die)
  (write-line 2 (join (map string (args)) " "))
  (exit 1))

(setf ERRBUF (dup "\0" 356))

;(import PCAPLIB "pcap_init" "int" "int" "char*")
(import PCAPLIB "pcap_open_live" "void*" "char*" "int" "int" "int" "char*")
(import PCAPLIB "pcap_loop" "int" "void*" "int" "void*" "void*")

;; syntax helper
(define (estruct NAME)
  (apply struct (cons NAME (map string (flat (args))))))

;; /usr/include/linux/time.h
(struct 'timeval
        "long" ;; seconds
        "long" ;; microseconds */
        )
(struct 'bpf_u_int32 "unsigned int")

;; /usr/include/pcap/pcap.h
(struct 'pcap_pkthdr
        "timeval"       ;; time stamp
        "bpf_u_int32"  ;; length of portion present
        "bpf_u_int32"  ;; length of this packet
        )

(define (pcap_handling RECEIVER (LIMIT 10) (SNAP 500))
  (letn ((RECEIVER_FN RECEIVER)
         (CALLBACK (callback RECEIVER_FN
                              "void"  ;; no return value
                              "void*" ;; userdata
                              "void*" ;; struct pcap_pkthdr*
                              "void*" ;; unsigned char*
                              )))

    (when (= (setf HANDLE (pcap_open_live IFACE SNAP 0 0 ERRBUF)))
      (die "pcap_open_live" ERRBUF))

    (when (!= (setf RET (pcap_loop HANDLE LIMIT CALLBACK 0)))
      (die "pcap_loop" RET))
  ))

(estruct 'macaddr (dup 'byte 6))
(estruct 'ethertype (dup 'byte 2))
(struct 'ether_head
         "macaddr" ;; destination mac
         "macaddr" ;; source mac
         "ethertype" ;; ether type 
         )

(estruct 'ipv4addr (dup 'byte 4))
(struct 'byte2 "byte" "byte")
(struct 'uint16 "unsigned short int") ;
(define (ntohs S) (unpack ">u" (address S)))
(struct 'ipv4_head
        "byte2" ;; Version[4] IHL[4] DSCP[6] ECV[2]
        "uint16" ;; Length[16] (in network byte order!)
        "uint16" ;; Identification
        "uint16" ;; Flags[3] Fragment-offset[13]
        "byte"   ;; TTL
        "byte"   ;; protocol
        "uint16" ;; header-checksum
        "ipv4addr" ;; source IP
        "ipv4addr" ;; destinetion IP
        )

(struct 'udp_head_real
        "uint16" ;; source port (network order)
        "uint16" ;; destination port (network order)
        "uint16" ;; payload length (network order)
        "uint16" ;; checksum (network order)
        )
(constant 'udp_head ">uuuu"); loading data into host order

(unless (directory? "/var/spool/rwho")
  (make-dir "/var/spool/rwho"))

(define (byte-order N)
  (cpymem (pack "lu" (unpack ">lu" (+ BYTES P)) (+ BYTES P) 4)))

  
;; Save rwhod report
(define (receive_rwhod BYTES LEN)
  (let ((HOST ((unpack "s32" (+ BYTES 12)) 0))
        (S0 "s4 lu lu s32 lu lu lu lu")
        (S1 "s8 s8 Lu lu") (I BYTES) (H nil) )
    (when (member HOST HOSTS)
      (when (setf H (lookup HOST ALIAS))
        (setf HOST H)
        (cpymem HOST (+ BYTES 12) (+ 1 (length HOST))))
      (cpymem (pack S0 (unpack (string ">" S0) BYTES)) BYTES 60)
      (inc I 60)
      (while (< I LEN)
        (cpymem (pack S1 (unpack (string ">" S1) I)) I 28)
        (inc I 28))
      (write-file (format "/var/spool/rwho/whod.%s" HOST)
                  (DATA (get-string BYTES LEN)) )
      )))

(define (receive_udp BYTES LEN)
  (let ((HDR (unpack udp_head BYTES)))
    (when (= '(513 513) (0 2 HDR))
      (receive_rwhod (+ BYTES 8) (- LEN 8)))
    ))

(define (receive_ipv4 BYTES LEN REAL)
  (letn ((HDR (unpack ipv4_head BYTES))
         (SZ (* 4 (& (HDR 0 0) 0xf))))
    (when (and (= LEN REAL) (= (HDR 5) 17))
      (receive_udp (+ BYTES SZ) (- LEN SZ))
      )))

(define (receive_packet USERDATA PKTHDR BYTES)
  (let ((HDR (unpack pcap_pkthdr PKTHDR))
        (MAC (unpack ether_head BYTES)))
    (when (and (> (HDR 1 0) 34) (= (dup 255 6) (MAC 0)) (= '(8 0) (MAC 2)))
      (receive_ipv4 (+ BYTES 14) (- (HDR 1 0) 14) (- (HDR 2 0) 14)))
    ))

;;; Main program
(pcap_handling 'receive_packet)

(exit 0)