** Start of listing of h3-cmucl.cgi **
#! /bin/sh
/usr/local/bin/lisp --noinform --no-sysinit --load h3.lisp
** End of listing of h3-cmucl.cgi **

Here is the directory entry for that file:
-rwx------  1 rem  user  70 Nov 13  2021 h3-cmucl.cgi
   ^ Note user execute permission needed for all CGI scripts.

** Start of listing of h3.lisp **
(defun err-quit (str) ;PLAIN header must have been specified before this called
  (format t "~%ERROR *** ~A ***~%ABORTING NOW!~%" str)
  (quit)
  )

(defun missing-envvar-quit (evname)
  (err-quit (format nil "CGI/environment property/variable ~A missing" evname)
	    ))

(defvar g*request-method nil) ;Cached value if non-NIL
(defun request-method ()
  (or g*request-method
      (setq g*request-method (cdr (assoc :REQUEST_METHOD *environment-list*)))
      (missing-envvar-quit :REQUEST_METHOD)
      ))

(defvar g*query-string nil) ;Cached value if non-NIL
(defun cgi-GET-query-string ()
  (or g*query-string
      (setq g*query-string (cdr (assoc :QUERY_STRING *environment-list*)))
      (missing-envvar-quit :QUERY_STRING)
      ))

;Read exactly n bytes from standard input, writing them to a string
; which is returned.
(defun read-n-bytes-to-string (n)
  (prog (nmore os ch)
    (setq nmore n)
    (setq os (make-string-output-stream))
   lp
    (if (not (plusp nmore))
        (return (get-output-stream-string os)))
    (setq ch (read-char *standard-input* nil nil))
    (cond (ch (write-char ch os) (decf nmore) (go lp)))
    (err-quit (format nil "Hit EOF when ~D chars more needed." nmore))    
    )) ; (read-anything-waiting)HelloTest

(defun split-string-per-char (s ch) ;"foo<ch>bar<ch>ply" -> ("foo" "bar" "ply")
  (prog (revres ix0 ix1)
    (setq revres (list)) (setq ix0 0) lp
    (cond ((setq ix1 (position ch s :start ix0))
	   (push (subseq s ix0 ix1) revres)
	   (setq ix0 (+ ix1 1))
	   (go lp)))
    (push (subseq s ix0) revres)
    (return (nreverse revres))))

(defun split-exactly-key-val (pr) ;"key=val" -> ("key" "val") else abort
  (prog (strs)
    (setq strs (split-string-per-char pr #\=))
    (or (= 2 (length strs))
	(err-quit (format nil "~S isn't a key=val pair, has ~D piece~:P ~
			       instead of exactly 2 pieces (split by equal ~
			       signs)" pr (length strs))))
    (return strs)))

(defun decode-single-plus-string (str &key (verbose nil))
  ;   "Cost+was+%24100,+deduct+10%25,+price+now+%2490%2E"
  ;-> "Cost was %24100, deduct 10%25, price now %2490%2E"
  (let ((res (substitute #\Space #\+ str)))
    (and verbose (not (equal str res))
	 (format t "This string ~S contains plus-sign(s),~% changed to ~S~%"
		 str res))
    res))

(defun decode-single-percent-string (str &key (verbose nil))
  ; "Cost was %24100, deduct 10%25, price now %2490%2E"
  ;-> "Cost was $100, deduct 10%, price now $90."
  (prog (tmpstr ix0 ix1 newch) ; 
    (setq tmpstr str) (setq ix0 0)
    lp
    (setq ix1 (position #\% tmpstr :start ix0))
    (cond ((null ix1) (go lz))
	  ((< (length tmpstr) (+ 3 ix1))
	   (err-quit (format nil "Percent too close to end of string: ~S"
			     tmpstr))))
    (setq newch
	  (code-char (parse-integer tmpstr :start (+ 1 ix1) :end (+ 3 ix1)
				    :radix 16)))
    (and verbose (eq str tmpstr) (format t "Original: ~S~%" str))
    (setq tmpstr (format nil "~A~A~A" (subseq tmpstr 0 ix1) newch
                (subseq tmpstr (+ 3 ix1))))
    (and verbose (format t "     -->  ~S~%" tmpstr))
    (setq ix0 (+ ix1 1)) (go lp)
    lz (return tmpstr)
    )) ; (decode-single-percent-string "foo+%25bar+%3Dgar+%25+ply")

;This is equivalent to java.net.URLDecoder.decode(str) except verbose option
(defun url-decode-one-string (str &key (verbose nil))
  (let* ((noplus (decode-single-plus-string str :verbose verbose))
	 (pctgone (decode-single-percent-string noplus :verbose verbose)))
    pctgone))

(defun url-decode-one-pair (pr &key (verbose nil))
  (list (url-decode-one-string (car pr) :verbose verbose)
	(url-decode-one-string (cadr pr) :verbose verbose)))

(defun url-decode-all-pairs (prs &key (verbose nil))
  (mapcar #'(lambda (pr) (url-decode-one-pair pr :verbose verbose)) prs))

;Try to find some way of quoting the string without needing escapes
(defun string-optquote (str)
  (cond ((null (position #\" str))
	 (format nil "~A~A~A" #\" str #\"))
	((null (position #\' str))
	 (format nil "~A~A~A" #\' str #\'))
	((and (null (position #\[ str)) (null (position #\] str)))
	 (format nil "~A~A~A" #\[ str #\]))
	((and (null (position #\{ str)) (null (position #\} str)))
	 (format nil "~A~A~A" #\{ str #\}))
	((null (position #\| str))
	 (format nil "~A~A~A" #\| str #\|))
	((null (position #\` str))
	 (format nil "~A~A~A" #\` str #\`))
	((and (null (position #\< str)) (null (position #\> str)))
	 (format nil "~A~A~A" #\< str #\>))
	((null (position #\* str))
	 (format nil "~A~A~A" "***" str "***"))
	((null (position #\$ str))
	 (format nil "~A~A~A" "$$$" str "$$$"))
	((null (position #\# str))
	 (format nil "~A~A~A" "###" str "###"))
	((null (position #\! str))
	 (format nil "~A~A~A" "!!!" str "!!!"))
	((null (position #\/ str))
	 (format nil "~A~A~A" "///" str "///"))
	((null (position #\\ str))
	 (format nil "~A~A~A" "\\\\\\" str "\\\\\\"))
	(t (err-quit (format nil "This string has all kinds of quotes and ~
				  brackets within it:~%  ~S~%There's nothing ~
				  left to use around the whole string to ~
				  quote *it*~%without requiring the quoting ~
				  character or one of the bracketing ~
				  characters~%to be ~
				  escaped within the string, which is ugly. ~
				  So I give up!"
			     str)))))

(defun report-one-key-val-pair (pair)
  (format t "  The key ~A has the corresponding value ~A.~%"
	  (string-optquote (car pair))
	  (string-optquote (cadr pair))))

;; ** main (toplevel) program begins here **
(prog (efc cl prstrs prs pairs)
  (format t "Content-type: text/plain;charset=us-ascii~%~%")
  (format t "The request method you used was: ~S~%" (request-method))
  (cond ((equal "GET" (request-method))
	 (setq efc (cgi-GET-query-string))
	 (format t "The query string, containing encoded form contents, is:~
                    ~%~S~%" efc)
	 )
	(t
	 (setq cl (cdr (assoc :CONTENT_LENGTH *environment-list*)))
	 (format t "Content length = ~A~%" cl)
	 (setq efc (read-n-bytes-to-string (parse-integer cl)))
	 (format t "The encoded form contents, input via standard input, is:~
                    ~%~S~%" efc)
	 ))
  (cond ((equal "" efc)
	 (format t "The form-contents are empty, so there's nothing further ~
                    to do here.~%")
	 (if (equal "GET" (request-method))
	     (format t "Please edit the URL to include a question ~
                        mark, followed by~%  some key=val pairs, separated by ~
	    	        ampersands.~%"))
	 (return)))
  ;Note: This is the start of the innerds of decode-form-contents inlined here:
  (setq prstrs (split-string-per-char efc #\&))
  (format t "Splitting query string into ~D piece~:P, each of which ~
             should be key=val pair:~%  ~S~%" (length prstrs) prstrs)
  (format t "Making sure each piece really is a key=val pair, and if so then ~
	     splitting~%  each such pair into separate key and val ~
	     strings...~%")
  (setq prs (mapcar #'split-exactly-key-val prstrs))
  (format t "Done: ~S~%" prs)
  (format t "Checking if any key or val needs uudecoding...~%")
  (setq pairs (url-decode-all-pairs prs :verbose t))
  (if (equal prs pairs)
      (format t "(No uudecoding was needed for any key or val string)~%")
    (format t "Decoding of individual key or val strings done, result:~%~S~%"
	    pairs))
  ;That was the end of innerds of decode-form-contents as inline code
  (format t "Now a nicely formatted report about keys and corresponding ~
	     values:~%")
  (mapc #'report-one-key-val-pair pairs)
  (format t "All done! Did it work correctly?~%")
  )
** End of listing of h3.lisp **

Here is the directory entry for that file:
-rw-------  1 rem  user  7470 Feb 28  2007 h3.lisp
   ^ Note user execute permission *not* needed for separate program files.