#!/usr/bin/newlisp
# Copyright 2017, Ralph Ronnquist <ralph.ronnquist@gmail.com>

;; This program iplements arp responding for selected IP and
;; interfaces. It listens to network traffic on a given tap, then
;; responds to any arp requests as per its configuration.
;;
;; Usage: -t <tap> <conf>
;; where <tap> is the tap to service, and <conf> is the pathname for
;; the configuration file.
;;
;; The configuration file has lines of "IP MAC whatever"; other lines
;; are ignored (as comments).

# Exit on INT, i.e., ^C
(signal 2 (fn (x) (exit 0)))

# The following library path is for Devuan GNU+Linux
(constant 'LIBC "/lib/x86_64-linux-gnu/libc.so.6")
(import LIBC "ioctl" "int" "int" "long" "void*" )
(import LIBC "perror" "void" "char*" )
(import LIBC "ntohs" "int" "int" )
(import LIBC "htons" "int" "int" )

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

# Tell about usage and exit with error.
(define (usage)
  (write-line 2 [text];; Usage: -t <tap> <conf>
;; where <tap> is the tap to service, and <conf> is the pathname for
;; the configuration file.
[/text]
   )
  (exit 1))

# Pick up tap name and handled IP from the command line, open
# the "tun" device (Devuan GNU+Linux), and initialize it for using the
# given tap name as a tap (not a tun), without packet wrapping.
(constant 'CMDARG (if (match '(* "-t" ? ?) (main-args)) (1 $it) nil))
(when (null? CMDARG) (usage))

(constant
 'IFNAME (CMDARG 0)
 'IFD (open "/dev/net/tun" "u")
 )

(unless (number? IFD)
  (die "open"))
(unless (zero? (ioctl IFD 0x400454ca (pack "s16 u s22" IFNAME 0x1002 "")))
  (die (string "set " IFNAME)))

# Set up the IP map
(define MAP:MAP nil)
(define (decimal x) (int x 0 10))
(define (hexadecimal x) (int x 0 16))
(dolist (X (parse (read-file (CMDARG 1)) "\n"))
  (when (regex "^\s*([0-9\.]+)\\s+([0-9a-fA-F:]+)" X 0)
    (let ((IP $1) (MAC $2))
      (MAP (string (map decimal (parse IP ".")))
           (map hexadecimal (parse MAC ":")))
      )))

# Pack a pair og bytes into a 16-bit number
(define (b2u x) (+ (<< (x 0) 8) (x 1)))

# Unpack a short number into two bytes in network order
(define (stonb x) (list (& 0xFF (>> x 8)) (& 0xFF x)))

# Unpack a 32-bit number into two 16-bit in network order
(define (n2u x) (list (& 0xFFFF (>> x 16)) (& 0xFFFF x)))

# Compute 16 bit checksum of a small even number of bytes
(define (checksum bytes)
  (apply + (n2u (- (apply + (map b2u (explode bytes 2)))))))

# Pack a byte sequence into a string
(define (pack-bytes bytes) (pack (dup "b" (length bytes)) bytes))

# Join IP address bytes into a dotted quad string.
(define (pack-ip x) (join (map string x) "."))

# Process an IPv4 header byte sequence without checksum by inserting one.
(define (ipv4-header-checksum h)
  (flat (list (0 10 h) (stonb (checksum h)) (10 h))))

# Process an ICMP header byte sequence without checksum by inserting one.
(define (icmp-header-checksum t c tail)
  (let ((data (unpack (dup "b" (length tail)) tail)))
    (flat (list t c (stonb (checksum (flat (list t c data)))) data))))

# ARP request handler. Confirms the targeted IP address is one to
# handle and then issues a corresponding reply. Note: the MAC address
# is formed from the IP address.
(define (arp-request-handler) ; buffer
  (letn ((IP (unpack "bbbb" (38 buffer)))
         (MYMAC (flat (list 2 IP 2)))
         (MAPMAC (MAP (string IP))))
    (when MAPMAC
      (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) MAPMAC IP
                                    (unpack "bbbbbb bbbb" (22 buffer))
                                    ))
                        )))))

# ARP packet handler. Recognizes the ARP command involved, and for
# some of them, it 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
    ))

# ICMP request handler. Confirms that the targeted IP is one to
# handle, and then issues a corresponding response.
(define (icmp-request-handler)
  (letn ((h (unpack "bbbb bbbb" (26 buffer)))
         (n (ntohs((unpack "u" (16 buffer)) 0)))
         (MYMAC (MAP (string (4 4 h)))) )
    (when MYMAC
      (write IFD
             (pack-bytes
              (flat (list
                     # Ethernet header (14 bytes)
                     (unpack "bbbbbb" (6 buffer))
                     MYMAC
                     (stonb 0x0800) ; Type = IPv4
                     # IPv4 header (20 bytes, with header checksum)
                     (ipv4-header-checksum
                      (flat (list 0x45 0 0 n
                                  (unpack "bbbbbb" (18 buffer))
                                  (4 4 h) (0 4 h))))
                     # ICMP header
                     (icmp-header-checksum 0 0 ((+ ihl 18) buffer))
                     ))
              ))
      )))

# ICMP packet handler. Recognizes the ICMP type involved and for some
# of them, it dispatches to the associated handler, if any.
(define (icmp-handler)
  (case ((unpack "b" ((+ ihl 14) buffer)) 0)
    (8 (and icmp-request-handler (icmp-request-handler)))
    (true)))

# IPv4 packet handler. Recognises the IPv4 protocol involved, and for
# some of them, it 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
      )
    ))

# Ethernet packet handler. Recognises EtherTYpe involved, and for some
# of them, it dispatches 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
      )))

# Tap handler. Reads an Ethernet packet from the tap, and invokes the
# associated handler.
(define (handle-tap)
  (let ((buffer "") (n nil))
    (if (setf n (read IFD buffer 8000)) (handle-packet)
      (die (string "** error reading " IFNAME)))))

# Input handler. Waits for input on the tap or stdin, and invokes the
# associated handler. This is set up as a prompt-event handler, so as
# to multiplex tap handling with newlisp interactive command handling.
(define (ioselect s)
  (letn ((fds (list 0 IFD)) (fdx nil))
    (until (member 0 (setf fdx (or (net-select fds "r" 10000000) '())))
      (when fdx (handle-tap))))
  nil)

# "Main program" starts here
(println "IP addresses on " IFNAME ":")
(map println (MAP))
(prompt-event ioselect)
(reset)