taplet.lsp

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