1 #!/usr/local/bin/newlisp
2 # Copyright 2017, Ralph Ronnquist <ralph.ronnquist@gmail.com>
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
10 ;; Usage: newlisp taplet.lsp -t <tap> -ip <ip-list>
11 ;; where <ip-list> is a comma separated list of IP to handle.
13 # Exit on INT, i.e., ^C
14 (signal 2 (fn (x) (exit 0)))
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" )
23 # Report low level system error and exit
24 (define (die s) (perror s) (exit 1))
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))))
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.
36 'IFNAME (mainarg "-t" "tap0")
37 'MYIPS (map (fn (ip) (map int (parse ip "."))) (parse (mainarg "-ip" "") ","))
38 'IFD (open "/dev/net/tun" "u")
40 (unless (number? IFD) (die "open"))
41 (unless (zero? (ioctl IFD 0x400454ca (pack "s16 u s22" IFNAME 0x1002 "")))
42 (die (string "set " IFNAME)))
44 # Pack a pair og bytes into a 16-bit number
45 (define (b2u x) (+ (<< (x 0) 8) (x 1)))
47 # Unpack a short number into two bytes in network order
48 (define (stonb x) (list (& 0xFF (>> x 8)) (& 0xFF x)))
50 # Unpack a 32-bit number into two 16-bit in network order
51 (define (n2u x) (list (& 0xFFFF (>> x 16)) (& 0xFFFF x)))
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)))))))
57 # Pack a byte sequence into a string
58 (define (pack-bytes bytes) (pack (dup "b" (length bytes)) bytes))
60 # Join IP address bytes into a dotted quad string.
61 (define (pack-ip x) (join (map string x) "."))
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))))
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))))
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))
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)))
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)
105 # Ethernet header (14 bytes)
106 (unpack "bbbbbb" (6 buffer))
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))
115 (icmp-header-checksum 0 0 ((+ ihl 18) buffer))
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)))
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)))
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
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
152 # Tap handler. Reads an Ethernet packet from the tap, and invokes the
153 # associated handler.
155 (let ((buffer "") (n nil))
156 (if (setf n (read IFD buffer 8000)) (handle-packet)
157 (die (string "** error reading " IFNAME)))))
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.
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))))
168 # "Main program" starts here
169 (println "IP addresses on " IFNAME ":")
170 (map println (map pack-ip MYIPS))
171 (prompt-event ioselect)