** Start of listing of h4int-cmucl.cgi **
#! /bin/sh
/usr/local/bin/lisp -eval '(progn (load "h4int.lisp" :verbose nil) (quit))'
** End of listing of h4int-cmucl.cgi **

Here is the directory entry for that file:
-rwx------  1 rem  user  87 Feb 10  2007 h4int-cmucl.cgi
   ^ Note user execute permission needed for all CGI scripts.

** Start of listing of h4int.lisp **
;; This first part is just emergency bailout stuff, skip to next ;; part

(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)
	    ))

;; This next part is getting the encoded form contents via CGI
;; and then decoding it to an association list. I plan to move this to
;; a separate file eventually. If not interested, skip to next ;; part

(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

;This is analagous to java's StringTokenizer
(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))))

;Will contain (key . val) pairs from decoded HTML FORM:
(defvar g*form-pairs nil)

;; ** End of general CGI-stuff inherited from 3-steps-beyond-Hello-World,
;;    now on with the new stuff for 4 steps beyond CGI Hello World,
;;    i.e. specifically validating integers

;Given a string, check if it's exactly an integer, with optional whitespace
; on either side. Return :OK if it is, otherwise return string describing
; a way that it fails to be properly formatted.
(defun string-check-integer (str)
 (prog (ixdig1 ixnum1 ixjunk1 ixnumz ixjunk2)
    (unless (setq ixdig1 (position-if #'digit-char-p str))
      (return "Not any digit anywhere."))
    (setq ixnum1
      (if (and (< 0 ixdig1)
               (position (elt str (+ -1 ixdig1)) "+-"))
          (+ -1 ixdig1) ixdig1))
    (setq ixjunk1 (position #\Space str :test-not #'eql :end ixnum1))
    (when ixjunk1
      (return (format nil "~A, a junk character '~A'."
                (if (< 0 ixjunk1)
                  (format nil "After the first ~D space~:P" ixjunk1)
                  "Right at the start")
                (elt str ixjunk1))))
    (setq ixnumz (position-if-not  #'digit-char-p str :start ixdig1))
    (unless ixnumz (return :OK))
    (when (setq ixjunk2 (position #\Space str :test-not #'eql :start ixnumz))
      (return (format nil "~A, a junk character '~A'."
                (if (< ixnumz ixjunk2)
                    (format nil "After the number and ~D space~:P" (- ixjunk2 ixnumz))
                    "Immediately after the number")
                (elt str ixjunk2))))
    (return :OK)))

;Given key (name of text field in form), get value, check if integer as above,
; say whether it's good or bad.
(defun key-check-val-int-verbose (key)
  (prog (val chkres)
    ;(format t "g*form-pairs: ~S~%" g*form-pairs)
    (setq val (cadr (assoc key g*form-pairs :test #'equal)))
    (format t "Checking key=~A val=~A ...~%"
      (string-optquote key) (string-optquote val))
    (setq chkres (string-check-integer val))
    (cond ((stringp chkres) (format t "Bad: ~A~%" chkres))
	  ((eq :OK chkres) (format t "Good!~%")
	   (let ((nstart (parse-integer val)))
	     (format t "Counting: ~D ~D ~D ~D~%" nstart (+ 1 nstart)
		     (+ 2 nstart) (+ 3 nstart))))
	  (t (format t "Bug: Strange result from string-check-integer~%")))
    ))

;; ** main (toplevel) program begins here **
(prog (efc cl prstrs prs pairs)
  (format t "Content-type: text/plain;charset=us-ascii~%~%")
  ;;This part deals with decoding the HTML form contents, skip to next ;;
  (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)
  (setq g*form-pairs pairs) ;Set it globally for general use

  ;;** Now the new stuff for 4 steps beyond CGI Hello World (decode integer)
  (format t "** Now on to the real stuff, verifying each text field contains ~
             the representation of an integer...~%")
  (key-check-val-int-verbose "num1")
  (key-check-val-int-verbose "num2")
  (key-check-val-int-verbose "num3")
  (key-check-val-int-verbose "num4")
  (key-check-val-int-verbose "num5")
  (key-check-val-int-verbose "num6")
  (key-check-val-int-verbose "num7")
  (key-check-val-int-verbose "num8")
  )
** End of listing of h4int.lisp **

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