1 #!/usr/local/bin/newlisp
2 # Copyright 2017, Ralph Ronnquist <ralph.ronnquist@gmail.com>
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.
8 ;; Usage: -t <tap> <conf>
9 ;; where <tap> is the tap to service, and <conf> is the pathname for
10 ;; the configuration file.
12 ;; The configuration file has lines of "IP MAC whatever"; other lines
13 ;; are ignored (as comments).
15 # Exit on INT, i.e., ^C
16 (signal 2 (fn (x) (exit 0)))
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" )
25 # Report low level system error and exit
26 (define (die s) (perror s) (exit 1))
28 # Tell about usage and exit with error.
30 (write-line 2 [text];; Usage: -t <tap> <conf>
31 ;; where <tap> is the tap to service, and <conf> is the pathnmae fore
32 ;; the configuration file.
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))
45 'IFD (open "/dev/net/tun" "u")
50 (unless (zero? (ioctl IFD 0x400454ca (pack "s16 u s22" IFNAME 0x1002 "")))
51 (die (string "set " IFNAME)))
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 ":")))
64 # Pack a pair og bytes into a 16-bit number
65 (define (b2u x) (+ (<< (x 0) 8) (x 1)))
67 # Unpack a short number into two bytes in network order
68 (define (stonb x) (list (& 0xFF (>> x 8)) (& 0xFF x)))
70 # Unpack a 32-bit number into two 16-bit in network order
71 (define (n2u x) (list (& 0xFFFF (>> x 16)) (& 0xFFFF x)))
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)))))))
77 # Pack a byte sequence into a string
78 (define (pack-bytes bytes) (pack (dup "b" (length bytes)) bytes))
80 # Join IP address bytes into a dotted quad string.
81 (define (pack-ip x) (join (map string x) "."))
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))))
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))))
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))))
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))
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)))
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 (println "ICMP request " (pack-ip (0 4 h)) " --> " (pack-ip (4 4 h)))
122 (when (member (4 4 h) MYIPS)
126 # Ethernet header (14 bytes)
127 (unpack "bbbbbb" (6 buffer))
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))
136 (icmp-header-checksum 0 0 ((+ ihl 18) buffer))
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)))
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)))
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
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
173 # Tap handler. Reads an Ethernet packet from the tap, and invokes the
174 # associated handler.
176 (let ((buffer "") (n nil))
177 (if (setf n (read IFD buffer 8000)) (handle-packet)
178 (die (string "** error reading " IFNAME)))))
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.
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))))
189 # "Main program" starts here
190 (println "IP addresses on " IFNAME ":")
192 (prompt-event ioselect)