--- /dev/null
+#!/usr/local/bin/newlisp
+# Copyright 2017, Ralph Ronnquist <ralph.ronnquist@gmail.com>
+
+;; This program simulates a remote host or subnet attached to a tap,
+;; responding to ARP and ICMP. It does not configure the tap at all,
+;; but listens to network traffic, and responds to ARP requests and
+;; ICMP requests matching to its IP adresses, given on the commmand
+;; line.
+;;
+;; Usage: newlisp taplet.lsp -t <tap> -ip <ip-list>
+;; where <ip-list> is a comma separated list of IP to handle.
+
+# 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))
+
+# Find a command line argument key and optionally the subsequent
+# value, if a non-nil default value is given.
+(define (mainarg k (v nil))
+ (let ((a (member k (main-args))))
+ (if (null? a) v (nil? v) true (null? (1 a)) v (a 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
+ 'IFNAME (mainarg "-t" "tap0")
+ 'MYIPS (map (fn (ip) (map int (parse ip "."))) (parse (mainarg "-ip" "") ","))
+ '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)))
+
+# 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))))
+ (when (member IP MYIPS)
+ (println "ARP request for " IP)
+ (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) MYMAC 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))))
+ (println "ICMP request " (pack-ip (0 4 h)) " --> " (pack-ip (4 4 h)))
+ (when (member (4 4 h) MYIPS)
+ (write IFD
+ (pack-bytes
+ (flat (list
+ # Ethernet header (14 bytes)
+ (unpack "bbbbbb" (6 buffer))
+ 2 (4 4 h) 2
+ (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 pack-ip MYIPS))
+(prompt-event ioselect)
projects / rrq / newlisp / taplet.git / commitdiff