From 7c604eab18157df6b5dbbc2f7862cb931aacc930 Mon Sep 17 00:00:00 2001 From: Ralph Ronnquist Date: Mon, 8 May 2023 11:13:59 +1000 Subject: [PATCH] Move into separate projects at git.rrq.au --- arper.conf | 2 - arper.lsp | 193 ------------------------------------------ arper.lsp.8.adoc | 94 --------------------- coproc.lsp | 132 ----------------------------- enitool.lsp | 155 ---------------------------------- hobby-http.adoc | 13 --- hobby-http.lsp | 50 ----------- humancss.lsp | 86 ------------------- pinwin.lsp | 215 ----------------------------------------------- pinwin.md | 33 -------- taplet.lsp | 171 ------------------------------------- taplet.md | 13 --- 12 files changed, 1157 deletions(-) delete mode 100644 arper.conf delete mode 100755 arper.lsp delete mode 100644 arper.lsp.8.adoc delete mode 100644 coproc.lsp delete mode 100755 enitool.lsp delete mode 100644 hobby-http.adoc delete mode 100755 hobby-http.lsp delete mode 100755 humancss.lsp delete mode 100644 pinwin.lsp delete mode 100644 pinwin.md delete mode 100644 taplet.lsp delete mode 100644 taplet.md diff --git a/arper.conf b/arper.conf deleted file mode 100644 index 06b3282..0000000 --- a/arper.conf +++ /dev/null @@ -1,2 +0,0 @@ -133.133.133.133 20:ff:00:00:00:00 -133.133.0.133 20:ff:00:00:00:02 diff --git a/arper.lsp b/arper.lsp deleted file mode 100755 index 10ac388..0000000 --- a/arper.lsp +++ /dev/null @@ -1,193 +0,0 @@ -#!/usr/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 pathname for -;; 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))) - (MYMAC (MAP (string (4 4 h)))) ) - (when MYMAC - (write IFD - (pack-bytes - (flat (list - # Ethernet header (14 bytes) - (unpack "bbbbbb" (6 buffer)) - MYMAC - (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/arper.lsp.8.adoc b/arper.lsp.8.adoc deleted file mode 100644 index 0c7d53f..0000000 --- a/arper.lsp.8.adoc +++ /dev/null @@ -1,94 +0,0 @@ -= arper.lsp(8) -:doctype: manpage -:revdate: {sys:date "+%Y-%m-%d %H:%M:%S"} -:COLON: : -:EQUALS: = - -== NAME - -arper.lsp - Emulate ipv4 presence on a tap by responding to ARP and ICMP. - -== SYNOPSIS - -*./arper.lsp* *-t* _tap_ _conf__ - -== DESCRIPTION - -The *arper.lsp* program implements ARP and ICMP responding on a given -_tap_ interface for a selection of ipv4 addresses as specified in the -given configuration file. This emulates the presence of one or more -ipv4 hosts, as if the _tap_ was interfacing a network. - -The configuration file has lines of "ipv4 mac comment" to declare -pairs of IP and MAC addresses to emulate. - -Note that the _tap_ must be configured separately. - -== EXAMPLE - -=== Emulating a single host - -The configuration, "single", is as follows: ----- - 192.168.1.2 02:00:00:00:00:02 some "random" host ----- - -Commandline: ----- -# ./arper.lsp -t tap0 single & -# ifconfig tap0 192.168.1.1/24 up -# ping -n 192.168.1.2 -# fg^C ----- - -=== Emulating three host on local network - -The configuration, "triple", is as follows: ----- - 192.168.1.2 02:00:00:00:00:02 some "random" host - 192.168.1.20 02:00:00:00:00:02 another "random" host - 192.168.1.200 02:00:00:00:00:02 and another "random" host ----- - -Commandline: ----- -# ./arper.lsp -t tap0 single & -# ifconfig tap0 192.168.1.1/24 up -# ping -c 3 -n 192.168.1.2 -# ping -c 3 -n 192.168.1.20 -# ping -c 3 -n 192.168.1.22 -# ping -c 3 -n 192.168.1.200 -# fg^C ----- - -Note that +192.168.1.22+ is not emulated. - -=== Emulating hosts on several network - -The configuration, "triss", is as follows: ----- - 192.168.1.2 02:00:00:00:00:02 some "random" host - 192.168.2.2 02:00:00:00:00:02 another "random" host - 192.168.3.2 02:00:00:00:00:02 and another "random" host ----- - -Commandline: ----- -# ./arper.lsp -t tap0 single & -# ifconfig tap0 192.168.1.1/24 up -# ip addr add 192.168.2.1/24 dev tap0 -# ip addr add 192.168.3.1/24 dev tap0 -# ping -c 3 -n 192.168.1.2 -# ping -c 3 -n 192.168.2.2 -# ping -c 3 -n 192.168.3.2 -# fg^C ----- - -=== NOTES - -The *arper.lsp* script is prepared for handling ipv6 packets, but it -does not include any Neighbor Discovery activity. - -== AUTHOR - -Copyright 2021 Ralph Ronnquist diff --git a/coproc.lsp b/coproc.lsp deleted file mode 100644 index 016b1b0..0000000 --- a/coproc.lsp +++ /dev/null @@ -1,132 +0,0 @@ -;; Utility module for coprocesses in newlisp -;; -;; This is a convenience implementation for running a sub process with -;; its stdio via pipes. It is somewhat similar to the standard -;; function but the utility combines the process -;; PID together with its stdin/stdout into a FOOP object for onwards -;; interactions. The command is passed as a command line to -;; /bin/sh and allows passing in environment. Further, the startup -;; includes closing the unused file descriptors. -;; -;; @syntax: (coproc cmd [ env ] ) -;; Start a coprocess and returns its representation which is a FOOP -;; object: ([coproc] PID outfd infd) -;; -;; The given command is passed to "sh -c 'cmd'" sub process -;; through a fork+execve scheme. The argument should be a -;; pointer to a null-terminated array of pointers to environment -;; NUL-terminated strings of format "NAME=VALUE". (The caller must -;; take care of providing existing pointers. -;; -;; @syntax: (:put0 coproc str ) -;; Write to the given . Returns the number of bytes -;; written. -;; -;; @syntax: (:puts coproc str ) -;; Write followed by newline to the given . Returns the -;; number of bytes written. -;; -;; @syntax: (:gets coproc [ limit [ waitms ]] ) -;; Read one line from the given or up to bytes -;; (default 100000) with up to millisceonds delay (default -;; 100) before reading. -;; -;; @syntax: (:pug coproc str [ limit [ waitms ]] ) -;; Write with :puts, then read once with :gets and return that. -;; -;; @syntax: (:pugs coproc str [ limit [ waitms ]] ) -;; Write with :puts, then read repeatedly with :gets collating -;; its returned lines into a list until :gets retuns nil. Returns the -;; list of lines. -;; -;; @syntax: (:running? coproc [ timeout ]) -;; Check if coproc is running, i.e., that its stdin is still open. - -(context 'coproc) - -(constant 'LIBC6 "/lib/x86_64-linux-gnu/libc.so.6") -(import LIBC6 "execve" "int" - "void*" ; pathname - "void*" ; argv[] - "void*" ; env[] - ) -(import LIBC6 "dup2" "int" - "int" ; oldfd - "int" ; newfd - ) -(import LIBC6 "poll" "int" - "void*" ; struct pollfd *fds - "int" ; nfds_t nfds - "int" ; timeout - ) - -(constant 'F_GETFD 1) - -; is a 64-bit char** variable, rather than a function -(import LIBC6 "environ") - -; Return the 64-bit value of environ -(define (environ@) ((unpack "Lu" (address environ)) 0)) - -; Pack a list of void* pointers into an array with a final null -; pointer added. -(define (pack-ptrs PTRS) - (pack (dup "Lu" (+ 1 (length PTRS))) (append PTRS (list 0)))) - -; Prepare the binary data setup for calling execve to execute -; via "sh -c 'exec '" and the given environment . If -; is , then the current process environment is used, otherwise -; it should be a list of name-value pairs (strings). -(define (wrapper cmd IO ENV) - (letn ((ARGS (list "/bin/sh" "-c" (string "exec " cmd))) - (ARGV (pack-ptrs (find-all nil ARGS (address $it) !=))) - (EV (if (list? ENV) (map (curry format "%s=%s") ENV))) - (ENVP (if (= true ENV) (environ@) - EV (pack-ptrs (find-all nil EV (address $it) !=)))) - ) - (map dup2 (list (IO 0 0) (IO 1 1) (IO 1 1)) '(0 1 2)) - (map close (flat IO)) - (execve "/bin/sh" ARGV (or ENVP 0)) - (exit 1))) - -; Create a coproc FOOP object which holds PID and pipe ends. -(define (coproc:coproc cmd ENV) - (let ((IO (list (pipe) (pipe)))) - (list (context) - (fork (wrapper cmd IO ENV)) - (begin (close (IO 0 0)) (close (IO 1 1)) (IO 0 1)) - (IO 1 0)))) - -; Wait up to for input from the coproc, then read one line of -; up to bytes and return. The final newline, if any, is -; chopped off. -(define (gets limit waitms) - (let ((buffer "") - (delay (if (number? waitms) (* waitms 1000) 100000)) - (maxsize (if (number? limit) limit 1000000)) - ) - (and (net-select (self 3) "r" delay) - (read (self 3) buffer maxsize "\n") - (if (empty? buffer) buffer - (!= "\n" (buffer -1)) buffer - (chop buffer)) - ))) - -; Write to the coproc. -(define (put0 str) - (write (self 2) str (length str))) - -; Write to the coproc plus a newline. -(define (puts str) - (write-line (self 2) str (length str))) - -; First :puts, then :gets -(define (pug str limit waitms) (puts str) (gets limit waitms)) - -; First :puts, then collect :gets until nil -(define (pugs str limit waitms) (puts str) (collect (gets limit waitms))) - -; Poll the stdin pipe -(define (running? (timeout 1)) - (let ((FDS (pack "Lu" (self 2)))) - (>= 0 (poll FDS 1 timeout)))) diff --git a/enitool.lsp b/enitool.lsp deleted file mode 100755 index af06741..0000000 --- a/enitool.lsp +++ /dev/null @@ -1,155 +0,0 @@ -#!/usr/bin/newlisp -# -# Helper tool to browse and edit the ifupdown configuration -# uses iselect, ed, nano and sudo -# -# Extra iselect commands: -# # = toggle commenting of configuration block -# d = delete empty line -# e = edit the whole file -# -# right-arrow or return = follow to sourced file, or edit the current block -# left-arrow or q = go up or exit - -(signal 2 (fn (x) (exit))) - -(when (!= "0" (if (exec "id -u") ($it 0) "")) - (let ((SUDO (if (exec "command -v sudo") ($it 0) "/usr/bin/sudo")) - (ED (format "env EDITOR=%s" (or (env "EDITOR") "nano"))) ) - (wait-pid (process (join (flat (list SUDO ED (main-args))) " "))) - (exit 0))) - -(constant - ;; all "block starters", including blank lines - 'ENI-KEY '( "iface" "mapping" "auto" "allow-\\w*" "rename" - "source" "source-directory" "$") - ;; regex to identify block starters - 'ENI-HEAD (format "^\\s*#?\\s*(%s)" (join ENI-KEY "|")) - 'ENI-COMMENT "^\\s*#" - 'EDITOR (or (env "EDITOR") "nano") - 'PROC (if (exec (format "command -v %s" EDITOR)) ($it 0) "/bin/nano") - ) - -(define (is-eni-key PAT S) - (when (regex PAT S 0) true)) - -(define (is-eni-comment S) - (is-eni-key ENI-COMMENT S)) - -(define (istrue? A B) - (list A B) (= A B true)) - -(define (eni-starters) ; DATA - (flat (ref-all ENI-HEAD DATA is-eni-key))) - -;; Pull out the block headed by the B line. If this head is a blank -;; line, then the block includes preceeding comment and the blank line -;; only. Otherwise it includes preceeding comment, head line and the -;; following mix of non-head lines and comment lines (i.e. up to next -;; head line). FROM is the line after the prior block, and it is moved -;; to end of this block. -(define (sub-divide-DATA B (E (length DATA))) ; DATA FROM - (let ((SLICE (fn (F B E) (append (list F B E) (slice DATA F (- E F)))))) - (SLICE FROM B (set 'FROM (if (empty? (DATA B)) (+ B 1) E))))) - -;; Read the "interfaces file" and split up into its "blocks" -;; * ( | )* -(define (read-eni NAME) - (letn ((DATA (parse (read-file NAME) "\n")) - (BEG (eni-starters)) - (FROM 0)) - (setf LASTENI (map sub-divide-DATA BEG (1 BEG))) - ;;(map println LASTENI) - ;;(read-line) - LASTENI - )) - -(define (add-selector X) - (cons (format "%s" (X 0) (X 1)) (2 X))) - -;; Find the definition block spanning line I in file FILE -(define (find-block I FILE) - ;;(println (list 'find-block I FILE)) - (exists (fn (B) (< I (B 2))) (read-eni FILE))) - -############################################################ -### Interactive actions - -## PATH holds interactive state as a stack of [pos file] -(setf PATH '(( 0 "/etc/network/interfaces" )) ) - -; Edit a file -(define (edit-file I FILE) - (wait-pid (process (format "%s +%d %s" PROC (int I) FILE)))) - -(define (ensure-newline TXT) - (if (empty? TXT) "" (ends-with TXT "\n") TXT (string TXT "\n"))) - -(define (update-file B E TXT FILE) - (let ((DATA (parse (read-file FILE) "\n"))) - (write-file TXT (string (join (0 B DATA) "\n" true) - (ensure-newline (read-file TXT)) - (join (E DATA) "\n"))) - (exec (format "mv %s %s" TXT FILE)) - )) - -(define (key-command-select I FILE) ; PATH - (letn ((BLOCK (find-block (- (int I) 1) FILE)) - (TMP "/tmp/enitool/tmp.conf") - (HEAD (BLOCK (- (BLOCK 1) (BLOCK 0) -3))) - (TAG (or (and (regex "^#?(\\w*) (.*)" HEAD 0) $1) "#")) - (VALUE $2)) - (case TAG - ("source" (push (list 0 VALUE) PATH)) - (true (write-file TMP (join (3 BLOCK) "\n" true)) - (let ((F (file-info TMP 6))) - (edit-file 1 TMP) - (when (!= F (file-info TMP 6)) - (update-file (BLOCK 0) (BLOCK 2) TMP FILE))) - )) - )) - -(define (delete-block-maybe I FILE) - (let ((BLOCK (find-block (- (int I) 1) FILE)) - (TMP "/tmp/enitool/tmp.conf")) - (when (= (3 BLOCK) '("")) - (exec (format "ed -s %s" FILE) - (format "%dd\nw\n" (+ 1 (BLOCK 0))))))) - -(define (toggle-commenting I FILE) - (let ((BLOCK (find-block (- (int I) 1) FILE)) - (TMP "/tmp/enitool/tmp.conf")) - (letn ((H (- (BLOCK 1) (BLOCK 0))) - (TXT (3 BLOCK)) - (toggle (if (starts-with (TXT H) "#") - (fn (X) (if (starts-with X "#") (1 X) X)) - (fn (X) (string "#" X))))) - (write-file TMP (ensure-newline - (string (join (0 H TXT) "\n" true) - (join (map toggle (H TXT)) "\n")))) - (update-file (BLOCK 0) (BLOCK 2) TMP FILE) - ))) - -(define (command-dispatch CMD FILE) - (when (regex "([^:]+):([^:]+):(\\S*)\\s*(.*)" CMD 0) - (setf (PATH 0 0) (int $1)) - (cond - ((member $2 '("KEY_RIGHT" "RETURN")) (key-command-select $1 FILE)) - ((= $2 "d") (delete-block-maybe $1 FILE)) - ((= $2 "#") (toggle-commenting $1 FILE)) - ((= $2 "e") (edit-file $1 FILE)) - ))) - -(define (iselect POS FILE) - (exec (format "iselect -n '%s' -t '%s' -a -P -K '-k#' -kd -ke -p %d < %s" - "enitool" FILE (int POS) FILE))) - -(change-dir "/etc/network") -(make-dir "/tmp/enitool") - -(while PATH - (if (apply iselect (PATH 0)) - (command-dispatch ($it 0) (PATH 0 1)) - (pop PATH))) - -(exit 0) diff --git a/hobby-http.adoc b/hobby-http.adoc deleted file mode 100644 index b476ecf..0000000 --- a/hobby-http.adoc +++ /dev/null @@ -1,13 +0,0 @@ -hobby-http.lsp -============== - -This script utilizes newlisp's built-in HTTP service for serving a -directory tree. Run as - - $ newlisp hobby-http.lsp -c -http -d $PORT -w $ROOT - -It limits to handling GET and HEAD requests. - -See http://www.newlisp.org/downloads/manual_frame.html for details on -newlisp. - diff --git a/hobby-http.lsp b/hobby-http.lsp deleted file mode 100755 index 33b8da7..0000000 --- a/hobby-http.lsp +++ /dev/null @@ -1,50 +0,0 @@ -#!/usr/bin/newlisp -# -# Simple HTTP service for a directory tree. Start with: -# -# newlisp hobby-http.lsp -c -http -d $PORT -w $TREE -# -# Note that it does not make automatic file indexes of directories, -# and it only shows the files that are there. Some files are handled -# by their file extension, such as: .avi, .cgi, .css, .gif, .htm, -# .html, .jpg, .js, .mov, .mp3,.mpg, .pdf, .png, .wav, .zip. Those -# files are served with appropriate mime types, except .cgi which if -# executable will be executed as a near CGI 1.1 script. Other files -# are served with type "text/plain". - -; Exit on ^C -- not cleanly -(signal 2 (fn (x) (write-line 2 "Exiting") (close 3) (exit 0))) - -; Resolve the root path -(constant 'HERE (real-path ((match '(* "-w" ? *) (main-args)) 1))) - -; Map absolute path -(define (actual PATH) - (if (starts-with PATH "/") (string HERE PATH) PATH)) - -; Rewriting rules: add ".html" or "/index.html" to request path where -; that results in an actual file. -(define (maybe-html PATH) - (let ((P0 (actual PATH)) (HTML nil)) - (if (find ".." PATH) PATH - true - (if (file? (string P0 ".html")) (string PATH ".html") - (file? (string P0 "/index.html")) - (string PATH (if (ends-with PATH "/") "" "/") "index.html") - PATH ) - PATH ))) - -; Apply rewriting rules for some requests -(define (tag-on-html X) - (write-line 2 (string "> " X )) - (setf X (if (and (string? X) (regex "^([^\\s]+) ([^ ]+) (.+)" X 0)) - (let ((A $1) (B $2) (C $3)) - (format "%s %s %s\r\n" A (maybe-html B) C) X))) - (write-line 2 (string "< " X)) - X) - -(define (filter-request X) - (if (starts-with X "(GET|HEAD)" 0) (tag-on-html X) - "GET /403.html HTTP/1.1")) - -(command-event filter-request) diff --git a/humancss.lsp b/humancss.lsp deleted file mode 100755 index e17bff5..0000000 --- a/humancss.lsp +++ /dev/null @@ -1,86 +0,0 @@ -#!/usr/local/bin/newlisp -# -# Stream filter that reads css and writes it out, stylished. run with -# -# newlisp humancss.lsp < bad.css > good.css -# -# Not actually pretty-printing, but merely adding indentation and newlines. - -;(signal 2 (fn (x) (exit 0))) - -(setf IN '()) - -;; Load the CSS file as an array of single-character strings -(while (setf LINE (read-line)) (extend IN (explode LINE) '("\n"))) -(setf IN (array (length IN) IN)) ; This should speed of indexed access -(setf LAST (- (length IN) 1)) - -;; Coalsce comments and strings into units -(define (coalesce START END) ; exclusive - (when (< END (length IN)) - (setf (IN START) (join (array-list (START (- END START) IN)))) - (while (< (inc START) END) (setf (IN START) "")))) - -(define (coalesce-block-comment i) - (let ((STAR nil) (END nil)) - (for (j (+ 2 i) LAST 1 END) - (if STAR (if (= "/" (IN j)) (setf END j) (setf STAR nil)) - (= "*" (IN j)) (setf STAR true))) - (when END (coalesce i (+ 1 END))))) - -(define (coalesce-line-comment i) - (let ((END (find "\n" IN nil i))) - (when END (coalesce i (+ 1 END))))) - -(define (index-of-any OPTS START) - (if (> START LAST) nil - (if (find OPTS (START IN) (fn (X Y) (member Y X))) (+ START $it)))) - -(define (coalesce-string i) ; (IN i) is the string character - (let ((END nil)) - (for (j (+ 1 i) LAST 1 END) - (if (= "\\" (IN j)) (coalesce j (+ 2 j)) - (= (IN i) (IN j)) (setf END (+ 1 j)))) - (when END (coalesce i END)))) - -; Coalesce comments, meta-quotes and strings -(let ((SLASH nil)) - (for (i 0 LAST) - (if (= "\\" (IN i)) (begin (coalesce i (+ 2 i)) (setf SLASH nil)) - SLASH (begin (case (IN i) - ("*" (coalesce-block-comment (- i 1))) - ("/" (coalesce-line-comment (- i 1))) - (true nil)) - (setf SLASH nil)) - (= "/" (IN i)) (setf SLASH true) - (= "\"" (IN i)) (coalesce-string i) - (= "'" (IN i)) (coalesce-string i) - ))) - -(define (indent TXT n) - (join (clean empty? (parse TXT "\n")) (string "\n" (dup " " n)))) - -; Coalesce blocks recursively, adding a newline to it -(define (coalesce-block i (DEPTH 0)) - ;(write-line 2 (string "block level " DEPTH " from " i)) - (let ((j 0) (END nil)) - (for (j (+ 1 i) LAST 1 END) - (case (IN j) - ("{" (coalesce-block j (+ 1 DEPTH))) - ("}" (setf END j)) - (true nil))) - (when END - (setf (IN i) " {\n") - (coalesce i END) - (setf (IN i) (indent (IN i) DEPTH)) - (extend (IN i) (if (ends-with (IN i) "\n") "}\n" "\n}\n")) - (setf (IN END) "") - ))) - -(for (i 0 LAST) (when (= ";" (IN i)) (setf (IN i) ";\n"))) - -(for (i 0 LAST) (when (= "{" (IN i)) (coalesce-block i 1))) - -(write 1 (join (array-list IN))) - -(exit 0) diff --git a/pinwin.lsp b/pinwin.lsp deleted file mode 100644 index b4ee85f..0000000 --- a/pinwin.lsp +++ /dev/null @@ -1,215 +0,0 @@ -#!/usr/local/bin/newlisp -# Copyright 2018, Ralph Ronnquist - -; This newlisp script is a "daemon" to make the right-hand monitor (in -; a horizontal Xinerama set up) "sticky". The script listens to X -; events so as to discover that a window is moved, and acts on it when -; it's placed. Specifically, when a window is placed to the right of -; the EDGE, it is pinned to be on all workspaces, and when it's placed -; to the left of the EDGE, it's unpinnned to be on the current -; workspace only. -; -; https://tronche.com/gui/x/xlib/ -; http://refspecs.linuxfoundation.org/LSB_3.1.1/LSB-Desktop-generic/LSB-Desktop-generic/libx11-ddefs.html -; https://specifications.freedesktop.org/wm-spec/1.3/index.html -; https://www.x.org/archive/X11R7.7/doc/man/man3/Xinerama.3.xhtml - -; Set up to die on ^C -(define (die x) (exit 0)) (signal 2 die) - -; Utility to return the first of a series of terms. -(define (prog1) (args 0)) - -; Read macro for the address at a byte offset into block

. -(macro (p@ P N) (+ (address P) N)) - -; Utility to unpack a packed binary array at

of layout -; records with fields each. -(define (unpack-array s w n p) (explode (unpack (dup s n) p) w)) - -; Making them available in all contexts. -(global 'prog1 'p@ 'unpack-array) - -(context 'MAIN:X11) ; API for libX11.so -(constant 'LIB "/usr/lib/x86_64-linux-gnu/libX11.so") ; Devuan 2.0 - -(import LIB "XDefaultRootWindow" "void*" - "void*" ; display - ) -(import LIB "XFree" "void" - "void*" ; data - ) -(import LIB "XGetWindowProperty" "int" - "void*" "void*" "long" ; display, window, property(atom) - "long" "long" "int" "long" ; long_offset, long_length, delete, req_type - "void*" "void*" ; actual_type_return, actual_format_return - "void*" "void*" ; nitems_return, bytes_after_return - "void*" ; prop_return - ) -(struct 'XGetWindowProperty_return - "long" ; actual_type_return - "int" ; actual_format_return - "long" ; nitems_return - "long" ; bytes_after_return - "void*" ; prop_return - ) -(import LIB "XInternAtom" "long" - "void*" "char*" "int" ; display, atom_name, only_if_exists - ) -(import LIB "XNextEvent" "void" - "void*" "void*" ; display, window - ) -(import LIB "XSendEvent" "int" - "void*" "void*" ; display, window - "int" "long" "void*" - ) -(import LIB "XOpenDisplay" "void*" - "void*" ; display - ) -(import LIB "XQueryTree" "int" - "void*" "void*" ; display, window - "void*" "void*" ; root_return, parent_return - "void*" "void*" ; children_return, nchildren_return - ) -(struct 'XQueryTree_return - "long" "long" ; root_return, parent_return - "long" "int" ; children_return, nchildren_return - ) -(import LIB "XSelectInput" "void" - "void*" "void*" "long" ; display, window, mask - ) -(struct 'XConfigureEvent - "int" "long" "int" ; type, serial, send_event - "void*" "void*" "void*" ; display, event, window - "int" "int" "int" "int" "int" ; x, y, width, height, border_width - "void*" "int" ; above, override_redirect - ) -(struct 'XCrossingEvent - "int" "long" "int" ; type, serial, send_event - "void*" "void*" "void*" "void*" ; display, window, root, subwindow - "long" ; time - "int" "int" "int" "int" ; x, y, x_root, y_root - "int" "int" ; mode, detail - "int" "int" "int" ; same_screen, focus, state - ) -(struct 'XClientMessageEvent - "int" "long" "int" ; type, serial, send_event - "void*" "void*" "void*" "void*" ; display, window - "long" "int" ; message_type, format - "long" "long" "long" "long" "long" ; data - ) - -; Initializing the X client, and defining some constants. -(constant - 'display (XOpenDisplay 0) - 'root (XDefaultRootWindow display) - '_NET_CURRENT_DESKTOP (XInternAtom display "_NET_CURRENT_DESKTOP" 1) - '_NET_WM_DESKTOP (XInternAtom display "_NET_WM_DESKTOP" 1) - 'LeaveWindowMask (<< 1 5) - 'SubstructureNotifyMask (<< 1 19) - 'PropertyChangeMask (<< 1 22) - 'LeaveNotify 8 - 'ConfigureNotify 22 - ) - -; Utility wrapping for XNextEvent. The "event" argument is the union -; of all possible event types, which all fit in a block of 24 long -; integers (192 bytes). -(define (nextEvent) - (let ((e (dup "\000" 192))) (XNextEvent display (p@ e 0)) e )) - -; Utility to map an X layer window to its "application window", which -; is the last child of the X layer window. This uses XQueryTree which -; has many return values (see XQueryTree_return). Note that the -; returned children array (r 2) is malloc-ed, and it needs to be -; XFree-ed. -(define (app-window w) - (let ((r (pack XQueryTree_return 0 0 0 0))) - (when (!= (XQueryTree display w (p@ r 0) (p@ r 8) (p@ r 16) (p@ r 24))) - (setf r (unpack XQueryTree_return r)) - (prog1 (if (!= (r 3)) ((unpack-array "Lu" 1 (r 3) (r 2)) -1 0)) - (XFree (r 2)))))) - -; Utility to obtain a long-valued property (atom named) from a window. -(define (get-property w a) - (let ((r (pack XGetWindowProperty_return 0 0 0 0 0))) - (when (XGetWindowProperty display w a 0 1 0 0 - (p@ r 0) (p@ r 8) (p@ r 16) (p@ r 24) (p@ r 32)) - (setf r (last (unpack XGetWindowProperty_return r))) - (when (!= r) (prog1 ((unpack "ld" r) 0) (XFree r) ))))) - -; Utility to obtain the current workspace. This is maintained as a -; property of the root window. (Called "desktop" in ancient times) -(define (current-workspace) (get-property root _NET_CURRENT_DESKTOP ) ) - -; Utility to obtain the worskpace property of a window. -(define (window-workspace w) (and w (get-property w _NET_WM_DESKTOP )) ) - -; Utility to set the workspace property for a window. Note that the -; targeted "application window" to pin or unpin is actually a child of -; the given X layer window (or "window manager window"). -(define (set-window-workspace w dt) - (let ((aw (app-window w))) - (and aw (!= dt (window-workspace aw)) - (XSendEvent display root 0 PropertyChangeMask - (pack XClientMessageEvent 33 0 0 display aw - _NET_WM_DESKTOP 32 dt 2 0 0 0) )) )) - -(context 'MAIN:Xinerama) ; API for libXinerama.so -(constant 'LIB "/usr/lib/x86_64-linux-gnu/libXinerama.so.1") ; Devuan 2.0 - -(import LIB "XineramaQueryScreens" "void*" ; XineramaScreenInfo* - "void*" ; Display *display - "void*" ; int *number - ) -(struct 'XineramaScreenInfo - "int" ; monitor index - "short int" "short int" "short int" "short int" ; x, y, width, height - ) - -; Utility to obtain the list of monitor physical dimensions -; Returns: ((id x y w h) ... ) -(define (queryScreens) - (letn ((e (pack "lu" 0)) - (p (XineramaQueryScreens X11:display (p@ e 0))) - (n ((unpack "lu" e) 0))) - (when (!= n) (prog1 (unpack-array "luuuuu" 5 n p) (X11:XFree p))) - )) - -(context MAIN) ; ---- The main application starts here ---- - -(setf - EDGE ((Xinerama:queryScreens) 0 3) ; width of monitor 0 - window nil ; last moved window and position (id x y) - ) - -; Handle XConfigureEvent by capturing window id and top-left -; coordinates. These events are issued while a window is moved. The -; last of them thus tells the last placement of the moved window. -(define (Configure e) - (setf window (select (unpack X11:XConfigureEvent e) 5 6 7))) - -; Handle XCrossingEvent events, identifying the "ungrab event" after -; having moved a window (i.e., releasing it at its last placement). At -; then, the most recently moved window is reviewed for placement, and -; its "workspace placement property" is set depending on where the -; window is relative to EDGE; either to the current workspace, or to -; -1, which means "all workspaces". -(define (Leave e) - (when (and window (= (& (last (unpack X11:XCrossingEvent e)) 0x100))) - (X11:set-window-workspace (window 0) - (if (>= (window 1) EDGE) -1 (X11:current-workspace))) )) - - ; Set up to receive certain events only. -(X11:XSelectInput - X11:display X11:root (| X11:SubstructureNotifyMask X11:LeaveWindowMask )) - -; Handle X events until the cows go home. -(letex ((L X11:LeaveNotify) (C X11:ConfigureNotify)) - (while (setf e (X11:nextEvent)) - (case ((unpack "lu" e) 0) ; the event type - ( L (Leave e)) - ( C (Configure e)) - (true nil)) )) - -(exit) diff --git a/pinwin.md b/pinwin.md deleted file mode 100644 index d683da8..0000000 --- a/pinwin.md +++ /dev/null @@ -1,33 +0,0 @@ -pinwin - making the side monitor sticky -======================================= - -This is a pair of scripts acting as an X event daemon that recognizes -window movements and "pins" windows when moved to the side monitor, -whereas windows moved to the main monitor are "unpinned". - -A pinned window shows up on all workspaces, whereas an unpinned one -stays on a single workspace. - -I think some window managers might support the "pin windows on side -monitor" function already, but I couldn't find this for my xfce4. - -Note that the newlisp script `pinwin.lsp` implements the assumption -that the side monitor is to the right of the main monitor. Any other -set up will require an appropriate adjustment. - -BUILD -===== - -Note that daemonizing shell script `pinwin.sh` expects the embedded -binary, `pinwin`, which is made using the `-x` argument to newlisp. For -example: - - $ newlisp -x pinwin.lsp pinwin - $ chmod a+x pinwin - -RUN -=== - -The daemon is run as a detached process. For example: - - $ ( ./pinwin.sh & ) diff --git a/taplet.lsp b/taplet.lsp deleted file mode 100644 index 819999a..0000000 --- a/taplet.lsp +++ /dev/null @@ -1,171 +0,0 @@ -#!/usr/local/bin/newlisp -# Copyright 2017, Ralph Ronnquist - -;; 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 -ip -;; where 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) diff --git a/taplet.md b/taplet.md deleted file mode 100644 index c661bfa..0000000 --- a/taplet.md +++ /dev/null @@ -1,13 +0,0 @@ -taplet -====== - -This is a program to simulate ARP and ICMP responding hosts under a tap. - - Usage: taplet -t -ip - -where \ is a comma-separated list of the IP addresses (dotted quads) -that the program should simulate. The program "binds" to the tap, and responds -to ARP requests and ICMP requests. - -The program is a `newlisp` script, and it also lets you operate the `newlisp` -command line, mutiplexed with handling network. -- 2.39.2