#!/usr/local/bin/clisp
;
; XML Show Tracking Server (run in Apache HTTP Server cgi-bin)
; (simplified tracking server only executing the "show" command)
; 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)
(defvar fw)
(defvar fl)
(defvar all)

(defun gridlock ()
	(loop
		(setq fl (open "/home/grid/grid.lock" :direction :output :if-exists nil))
		(when fl (return))
	)
	(close fl)
)

(defun gridunlock ()
	(delete-file "/home/grid/grid.lock")
)

(defun purge-old ()

	(gridlock)

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

	(setq all (remove (- (get-universal-time) 40) all :test #'> :key #'third))

	(setq fw (open "/home/grid/grid.dat" :direction :output))
	(prin1 all fw)
	(close fw)

	(gridunlock)
)

; 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
		(purge-old)
		(gridlock)
		(setq fr (open "/home/grid/grid.dat" :direction :input))
		(setq all (read fr))
		(close fr)
		(gridunlock)
		(setq all (sort all #'> :key #'second))
		(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 all)
		(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>")
	)
)
