#!/usr/local/bin/clisp
;
; XML CPU Resource Server (run in Apache HTTP Server cgi-bin)
; Simple Grid Protocol 1.04 - Copyright (c) Brendan Kosowski 2004, 2005, 2015
;
(defvar postq) ; raw cgi post query string
(defvar postl) ; property-list of post variables
(defvar len)
(defvar c)
(defvar asc)
(defvar n)
(defvar subst)
(defvar token)
(defvar fr)

; begin post-query to property-list
(setq postq (read-line))
(setq len (length postq))
(setq subst "")
(setq postl NIL)
(setq n 0)
(loop
	(when (= n len)
		(push subst postl)
		(return)
	)
	(setq c (char postq n))
	(if (or (char= c #\=) (char= c #\&) (char= c #\%) (char= c #\+))
		(progn
			(when (char= c #\=)
				(push (read-from-string (concatenate 'string ":" subst)) postl)
				(setq subst "")
			)
			(when (char= c #\&)
				(push subst postl)
				(setq subst "")
			)
			(when (char= c #\%)

				(setq asc (code-char (read-from-string (concatenate 'string "#x" (subseq postq (+ n 1) (+ n 3))))))
				(setq subst (concatenate 'string subst (string asc)))
				(setq n (+ n 2))
			)
			(when (char= c #\+)
				(setq subst (concatenate 'string subst " "))
			)
		)
		(setq subst (concatenate 'string subst (string c)))
	)
	(setq n (+ n 1))
)
(setq postl (reverse postl))
; end post-query to property-list

(setq fr (open "/home/grid/token.dat" :direction :input))
(setq token (read-line fr))
(close fr)

(if (string= token (getf postl :token))
	(progn
		(format t "Content-type: application/xml~%~%")
		(format t "<?xml version=\"1.0\" encoding=\"iso-8859-1\"?>~%")
		(format t "<output>~%")
		(format t "<copyright>Simple Grid Protocol 1.04 - Copyright (c) Brendan Kosowski 2004, 2005, 2015</copyright>~%")
		(format t "<result>")
		(prin1 (eval (read-from-string (getf postl :eval))))
		(format t "</result>~%</output>")
	)
	(progn
		(format t "Content-type: application/xml~%~%")
		(format t "<?xml version=\"1.0\" encoding=\"iso-8859-1\"?>~%")
		(format t "<output>~%")
		(format t "<copyright>Simple Grid Protocol 1.04 - Copyright (c) Brendan Kosowski 2004, 2005, 2015</copyright>~%")
		(format t "<error>")
		(format t "badToken")
		(format t "</error>~%</output>")
	)
)
