From d1f15b6a825ff2c16d64fbdd7722135a11dbbb13 Mon Sep 17 00:00:00 2001 From: Ralph Ronnquist Date: Sat, 30 Jan 2021 07:38:41 +1100 Subject: [PATCH] added --- arper.lsp | 193 ++++++++++++++++++++++++++++++++++++++++++++++++++ phrasehit.lsp | 77 ++++++++++++++++++++ 2 files changed, 270 insertions(+) create mode 100755 arper.lsp create mode 100644 phrasehit.lsp diff --git a/arper.lsp b/arper.lsp new file mode 100755 index 0000000..caf763d --- /dev/null +++ b/arper.lsp @@ -0,0 +1,193 @@ +#!/usr/local/bin/newlisp +# Copyright 2017, Ralph Ronnquist + +;; This program iplements arp responding for selected IP and +;; interfaces. It listens to network traffic on a given tap, then +;; responds to any arp requests as per its configuration. +;; +;; Usage: -t +;; where is the tap to service, and is the pathname for +;; the configuration file. +;; +;; The configuration file has lines of "IP MAC whatever"; other lines +;; are ignored (as comments). + +# 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)) + +# Tell about usage and exit with error. +(define (usage) + (write-line 2 [text];; Usage: -t +;; where is the tap to service, and is the pathnmae fore +;; the configuration file. +[/text] + ) + (exit 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 'CMDARG (if (match '(* "-t" ? ?) (main-args)) (1 $it) nil)) +(when (null? CMDARG) (usage)) + +(constant + 'IFNAME (CMDARG 0) + '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))) + +# Set up the IP map +(define MAP:MAP nil) +(define (decimal x) (int x 0 10)) +(define (hexadecimal x) (int x 0 16)) +(dolist (X (parse (read-file (CMDARG 1)) "\n")) + (when (regex "^\s*([0-9\.]+)\\s+([0-9a-fA-F:]+)" X 0) + (let ((IP $1) (MAC $2)) + (MAP (string (map decimal (parse IP "."))) + (map hexadecimal (parse MAC ":"))) + ))) + +# 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))) + (MAPMAC (MAP (string IP)))) + (when MAPMAC + (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) MAPMAC 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)) +(prompt-event ioselect) +(reset) diff --git a/phrasehit.lsp b/phrasehit.lsp new file mode 100644 index 0000000..dd771c4 --- /dev/null +++ b/phrasehit.lsp @@ -0,0 +1,77 @@ +# This script must be embedded for the arguments to work +# $0 = this program +# $1 = file to review +# $2 = phrase to find + +# Read "file" document, compute and print its least match penalty for +# the given phrase + +;(reader-event (fn (x) (write-line (string x)) x)) + +# Map a UTF8 text into its bigram sequence +(define (bigrams TEXT) + (let ((i -1) (N (utf8len TEXT))) + (map (fn (s) (replace "([?.*])" s (string "\\" $1) 0)) + (clean (fn (x) (< (length x) 2)) + (collect (when (< (inc i) N) (i 2 TEXT))))))) + +# Replace newlines and successions of spaces with single spaces +(define (read-text FILE) + (replace "\\s\\s+" (replace "\n" (read-file FILE) " " 0) " " 0)) + +; Determine the placements for bigram P in DATA after index i. This +; returns the placment options in ascending order. +(define (indexes P DATA (i -1)) + (collect (setf i (find P DATA 1 (inc i))))) + +; Find the first of IL placement lists after i, prepend i to that and +; return. Returns nil if all IL starts at or before i. This is used +; for finding the "best" placement for an antecedent bigram at i, wrt +; the alternative successor bigram "best" placements. +(define (last-before i IL) + (if (find i IL (fn (x y) (< x (y 0)))) (cons i (IL $it)) (list i))) + +; Combine the placement options PL of bigram P relative to best +; placements options of successor bigrams IL. This appends each +; placement option to its "best" successor placement list. The choice +; of dropping this bigram also yields all IL successor placements +; options. The resulting placment options is sorted by ascending first +; placement. +(define (combine P PL IL) + (if (null? PL) IL IL + (sort (append (map (fn (i) (last-before i IL)) PL) IL)) + (map list PL))) + +; Process the bigrams PL to be placed into the text DATA. Returns a +; list of placement lists to indicate alternative ways of placing the +; given bigrams. +(define (chicks PL DATA) + (if (null? PL) (list) + (combine (PL 0) (indexes (PL 0) DATA) (chicks (1 PL) DATA)))) + +; Compute the "gap sum" for the given placement list, which tells how +; much bigrams are separated from each other in the placement list. +; Returns a triplet of 1) the number of discarded bigrams, 2) the +; accumulated separation count and 3) a placment description of where +; and which bigrams are placed. +(define (gapsum L) + (let ((N (- (length PHRASE) (length L)))) + (list N (- (apply + (map - L (cons (L 0) L))) (length L) -1)))) + +;;; Load arguments +(setf + PHRASE (bigrams (main-args 1)) + CLIP (/ (* 45 (length PHRASE)) 100) + ) + +(dolist (FILE (2 (main-args))) + (when (file? FILE) + (setf LINES '() COUNT 0) + (dolist (DATA (parse (read-file FILE) "\n")) + (let ((BEST (if (sort (map gapsum (chicks PHRASE DATA))) (first $it)))) + (inc COUNT) + (when (and BEST (< (BEST 0) CLIP)) + (push (list (append BEST (list COUNT)) DATA) LINES -1)))) + (map (fn (x) (println FILE ":" (x -1))) (sort LINES)))) + +(exit 0) -- 2.39.2