arper.lsp

   1 #!/usr/bin/newlisp
   2 # Copyright 2017, Ralph Ronnquist <ralph.ronnquist@gmail.com>
   3
   4 ;; This program iplements arp responding for selected IP and
   5 ;; interfaces. It listens to network traffic on a given tap, then
   6 ;; responds to any arp requests as per its configuration.
   7 ;;
   8 ;; Usage: -t <tap> <conf>
   9 ;; where <tap> is the tap to service, and <conf> is the pathname for
  10 ;; the configuration file.
  11 ;;
  12 ;; The configuration file has lines of "IP MAC whatever"; other lines
  13 ;; are ignored (as comments).
  14
  15 # Exit on INT, i.e., ^C
  16 (signal 2 (fn (x) (exit 0)))
  17
  18 # The following library path is for Devuan GNU+Linux
  19 (constant 'LIBC "/lib/x86_64-linux-gnu/libc.so.6")
  20 (import LIBC "ioctl" "int" "int" "long" "void*" )
  21 (import LIBC "perror" "void" "char*" )
  22 (import LIBC "ntohs" "int" "int" )
  23 (import LIBC "htons" "int" "int" )
  24
  25 # Report low level system error and exit
  26 (define (die s) (perror s) (exit 1))
  27
  28 # Tell about usage and exit with error.
  29 (define (usage)
  30   (write-line 2 [text];; Usage: -t <tap> <conf>
  31 ;; where <tap> is the tap to service, and <conf> is the pathname for
  32 ;; the configuration file.
  33 [/text]
  34    )
  35   (exit 1))
  36
  37 # Pick up tap name and handled IP from the command line, open
  38 # the "tun" device (Devuan GNU+Linux), and initialize it for using the
  39 # given tap name as a tap (not a tun), without packet wrapping.
  40 (constant 'CMDARG (if (match '(* "-t" ? ?) (main-args)) (1 $it) nil))
  41 (when (null? CMDARG) (usage))
  42
  43 (constant
  44  'IFNAME (CMDARG 0)
  45  'IFD (open "/dev/net/tun" "u")
  46  )
  47
  48 (unless (number? IFD)
  49   (die "open"))
  50 (unless (zero? (ioctl IFD 0x400454ca (pack "s16 u s22" IFNAME 0x1002 "")))
  51   (die (string "set " IFNAME)))
  52
  53 # Set up the IP map
  54 (define MAP:MAP nil)
  55 (define (decimal x) (int x 0 10))
  56 (define (hexadecimal x) (int x 0 16))
  57 (dolist (X (parse (read-file (CMDARG 1)) "\n"))
  58   (when (regex "^\s*([0-9\.]+)\\s+([0-9a-fA-F:]+)" X 0)
  59     (let ((IP $1) (MAC $2))
  60       (MAP (string (map decimal (parse IP ".")))
  61            (map hexadecimal (parse MAC ":")))
  62       )))
  63
  64 # Pack a pair og bytes into a 16-bit number
  65 (define (b2u x) (+ (<< (x 0) 8) (x 1)))
  66
  67 # Unpack a short number into two bytes in network order
  68 (define (stonb x) (list (& 0xFF (>> x 8)) (& 0xFF x)))
  69
  70 # Unpack a 32-bit number into two 16-bit in network order
  71 (define (n2u x) (list (& 0xFFFF (>> x 16)) (& 0xFFFF x)))
  72
  73 # Compute 16 bit checksum of a small even number of bytes
  74 (define (checksum bytes)
  75   (apply + (n2u (- (apply + (map b2u (explode bytes 2)))))))
  76
  77 # Pack a byte sequence into a string
  78 (define (pack-bytes bytes) (pack (dup "b" (length bytes)) bytes))
  79
  80 # Join IP address bytes into a dotted quad string.
  81 (define (pack-ip x) (join (map string x) "."))
  82
  83 # Process an IPv4 header byte sequence without checksum by inserting one.
  84 (define (ipv4-header-checksum h)
  85   (flat (list (0 10 h) (stonb (checksum h)) (10 h))))
  86
  87 # Process an ICMP header byte sequence without checksum by inserting one.
  88 (define (icmp-header-checksum t c tail)
  89   (let ((data (unpack (dup "b" (length tail)) tail)))
  90     (flat (list t c (stonb (checksum (flat (list t c data)))) data))))
  91
  92 # ARP request handler. Confirms the targeted IP address is one to
  93 # handle and then issues a corresponding reply. Note: the MAC address
  94 # is formed from the IP address.
  95 (define (arp-request-handler) ; buffer
  96   (letn ((IP (unpack "bbbb" (38 buffer)))
  97          (MYMAC (flat (list 2 IP 2)))
  98          (MAPMAC (MAP (string IP))))
  99     (when MAPMAC
 100       (write IFD (pack "bbbbbb bbbbbb u u u b b u bbbbbb bbbb bbbbbb bbbb"
 101                         (flat (list (unpack "bbbbbb" (6 buffer))
 102                                     MYMAC (map htons '(0x0806 0x1 0x0800 ))
 103                                     0x06 0x04 (htons 0x2) MAPMAC IP
 104                                     (unpack "bbbbbb bbbb" (22 buffer))
 105                                     ))
 106                         )))))
 107
 108 # ARP packet handler. Recognizes the ARP command involved, and for
 109 # some of them, it dispatches to the associated handler, if any.
 110 (define (arp-handler) ; buffer
 111   (case (ntohs ((unpack "u" (20 buffer)) 0)) ; ARP command
 112     (0x0001 (and arp-request-handler (arp-request-handler)))
 113     (true nil) ; ignore
 114     ))
 115
 116 # ICMP request handler. Confirms that the targeted IP is one to
 117 # handle, and then issues a corresponding response.
 118 (define (icmp-request-handler)
 119   (letn ((h (unpack "bbbb bbbb" (26 buffer)))
 120          (n (ntohs((unpack "u" (16 buffer)) 0)))
 121          (MYMAC (MAP (string (4 4 h)))) )
 122     (when MYMAC
 123       (write IFD
 124              (pack-bytes
 125               (flat (list
 126                      # Ethernet header (14 bytes)
 127                      (unpack "bbbbbb" (6 buffer))
 128                      MYMAC
 129                      (stonb 0x0800) ; Type = IPv4
 130                      # IPv4 header (20 bytes, with header checksum)
 131                      (ipv4-header-checksum
 132                       (flat (list 0x45 0 0 n
 133                                   (unpack "bbbbbb" (18 buffer))
 134                                   (4 4 h) (0 4 h))))
 135                      # ICMP header
 136                      (icmp-header-checksum 0 0 ((+ ihl 18) buffer))
 137                      ))
 138               ))
 139       )))
 140
 141 # ICMP packet handler. Recognizes the ICMP type involved and for some
 142 # of them, it dispatches to the associated handler, if any.
 143 (define (icmp-handler)
 144   (case ((unpack "b" ((+ ihl 14) buffer)) 0)
 145     (8 (and icmp-request-handler (icmp-request-handler)))
 146     (true)))
 147
 148 # IPv4 packet handler. Recognises the IPv4 protocol involved, and for
 149 # some of them, it dispatches to the associated handler, if any.
 150 (define (ipv4-handler) ; buffer
 151   (let ((ihl (* (& 0x0F ((unpack "b" (14 buffer)) 0)) 4)))
 152     (case ((unpack "b" (23 buffer)) 0) ; protocol
 153       (0x01 (and icmp-handler (icmp-handler)))
 154       (0x02 (and igmp-handler (igmp-handler)))
 155       (0x04 (and ipip-handler (ipip-handler)))
 156       (0x06 (and tcp-handler (tcp-handler)))
 157       (0x11 (and udp-handler (udp-handler)))
 158       (true nil) ; ignore
 159       )
 160     ))
 161
 162 # Ethernet packet handler. Recognises EtherTYpe involved, and for some
 163 # of them, it dispatches to the associated handler, if any.
 164 (define (handle-packet) ; buffer
 165   (when (> n 14)
 166     (case (ntohs ((unpack "u" (12 buffer)) 0)) ; Ethertype
 167       (0x0806 (and arp-handler (arp-handler)))
 168       (0x0800 (and ipv4-handler (ipv4-handler)))
 169       ;(0x86DD (and ipv6-handler (ipv6-handler)))
 170       (true nil) ; ignore all else
 171       )))
 172
 173 # Tap handler. Reads an Ethernet packet from the tap, and invokes the
 174 # associated handler.
 175 (define (handle-tap)
 176   (let ((buffer "") (n nil))
 177     (if (setf n (read IFD buffer 8000)) (handle-packet)
 178       (die (string "** error reading " IFNAME)))))
 179
 180 # Input handler. Waits for input on the tap or stdin, and invokes the
 181 # associated handler. This is set up as a prompt-event handler, so as
 182 # to multiplex tap handling with newlisp interactive command handling.
 183 (define (ioselect s)
 184   (letn ((fds (list 0 IFD)) (fdx nil))
 185     (until (member 0 (setf fdx (or (net-select fds "r" 10000000) '())))
 186       (when fdx (handle-tap))))
 187   nil)
 188
 189 # "Main program" starts here
 190 (println "IP addresses on " IFNAME ":")
 191 (map println (MAP))
 192 (prompt-event ioselect)
 193 (reset)