/*********************************************************************

SWAGES
Version 1.0 Alpha

(c) by Matthias Scheutz

WebServer

Last modified: 06-21-03

*********************************************************************/

;;; Preliminary web server (basically implements a mixture of HTTP/1.0
;;; and HTTP/1.1 protocols with a heavy slant on the HTTP/1.0).

global vars
    header =
    '<html><head><meta name="Author" content="Matthias Scheutz">' ><
    '<title>SWAGES - Sim{World/Agent} Grid Experimentation System 1.0 Alpha</title></head>',
    footer =
    '<hr><center>(c) Matthias Scheutz, 2003</center></body></html>',
    serverurl = 'http://' >< myhost >< ':' >< comm_port >< '/',

    ;;; the time interval for autorefresh on pages that need to be updated in seconds
    refreshTIME = 60,

    ;;; whether authentication should be used
    useAUTH = true,
    ;;; whether only one or multiple users are allowed
    singleUSER = true,
    ;;; the currently active user if authentication is on
    authuser = false,
    ;;; the list of allowed users (user/pass encoded in base64)
    allowedusers = [],
;

;;; constants for the web server
lconstant 
     ;;; for debugging: print out lots of comments
     webverbose = false,
     this_dir = sys_fname_path(popfilename),
;
;;; compile the stats utilities
compile(this_dir dir_>< 'extract.p');

/*

access levels include the following functions:

level 1: check status and view general information about ongoing experiments, change user info
level 2: submit and remove own experiments and perform statistics on own experiments
level 3: full

*/

;;; defines the users of the server
define :class simuser;
    ;;; static information
    slot username;                 ;;; user name
    slot fullname;                 ;;; full name of the user
    slot contactinfo='';           ;;; contact info
    slot password ='';             ;;; the base 64 encoded password
    slot accesslevel = 1;          ;;; access level of the user
    slot laston = false;           ;;; when the user was using the system last
    slot loggedon = false;         ;;; whether the user is on
enddefine;

;;; returns either the user record or false if not found
define finduser(user,userlist);
    lvars u;
    fast_for u in userlist do
	returnif(u.username = user)(u);
    endfast_for;
    false
enddefine;

/*
;;; filters text and turns it into simple html
define html_filter( x, rep );
    lvars deal_with_angles = true;
    if x == `\n` then
	rep(`<`); rep(`b`);rep(`r`); rep(`>`);rep(`\n`);
    elseif deal_with_angles and  x == `<` then
	rep(`&`); rep(`l`);rep(`t`);
    elseif deal_with_angles and  x == `>` then
	rep(`&`); rep(`g`);rep(`t`);
    else
	rep(x);
    endif;
enddefine;
*/

;;; replace all items from association list l in s
define replstrlist(s,l);
    lvars item;
    for item in l do
	replstr(s,item(1),item(2))->s;
    endfor;
    s
enddefine;

define toHex(i);
    lvars str;
    lvars h = (i div 16);
    lvars l = (i rem 16);
    consstring(if h > 9 then h+55 else h+48 endif,if l > 9 then l+55 else l+48 endif,2)
enddefine;

;;; takes a three character string, ignores the first
define fromHex(h);
    if h > 96 then h-87 elseif h > 64 then h - 55 else h - 48 endif
enddefine;

;;; takes a string and returns the URL encoded string
define URLencode(str)->newstr;
    lvars newstr = '',charrep = stringin(str), c;
    while ((charrep() ->> c) /= termin) do
    newstr ><
    if (c>47 and c<58) or (c>64 and c<91) or (c>96 and c<123) then
        consstring(c,1)
    else
        '%' >< toHex(c)
    endif -> newstr;
    endwhile;
enddefine;

;;; takes URL enocded string and returns the decoded string
define URLdecode(str)->newstr;
    lvars newstr = '',charrep = stringin(str), c;
    while ((charrep() ->> c) /= termin) do
    newstr ><
    if (c /= `%`) then
        consstring(c,1)
    else
        consstring(fromHex(charrep())*16 + fromHex(charrep()),1)
    endif -> newstr;
    endwhile;
enddefine;


;;; splits a URL posted by POST into fields and values and returns them in a property
define getdata(url,usewordkey)->dataprop;
    ;;; create empty property, use newmapping to allow for = (instead of ==)
    lvars i,dataprop = newmapping([], 10, false, 1);  

    ;;; decode the URL and replace all converted special characters
    ;;;replstrlist(URLdecode(url),[['+' ' ']])->url;
    URLdecode(replstrlist(url,[['+' ' ']]))->url;
    
    ;;; cut off the start and mark the end
    substring(i+1,length(url)-i,url) >< "&" -> url;
    while (issubstring("&",url) ->> i) do
	lvars m = strmember(`=`,url), cat = (if usewordkey then consword(substring(1,m-1,url))
                                                           else substring(1,m-1,url) endif);
	     substring(m+1,i-m-1,url) -> dataprop(cat);
   	if webverbose then npr(dataprop(cat)); endif;
   	substring(i+1,length(url)-i,url) -> url;
    endwhile;
enddefine;

define mimencode(input, output);
	;;; read in characters in the file, and spew out via
	;;; outfile the mime-encoded version

	define lconstant mimecode(num);
		fast_subscrs(num fi_+ 1,
			'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/')
	enddefine;

	lvars
		procedure infile =
			if isstring(input) then discin(input) else input endif,

		procedure outfile =
			if isstring(output) then discout(output) else output endif,

		col = 0, field1, field2, field3, finished = false;

	
	repeat
		infile() -> field1;
		if field1 == termin then
			unless col == 0 then
				outfile(`\n`)
			endunless;
			quitloop();
		endif;
		infile() -> field2;
		if field2 == termin then
			false ->> field2 -> field3;
			true -> finished;
		else
			infile() -> field3;
			if field3 == termin then
				false -> field3;
				true -> finished;
			endif;
		endif;
		;;; we have now read in one, two or three 8 bit characters.
		;;; output four 6 bit characters.
		;;; output first field

		if finished then
			outfile(mimecode(field1 >> 2));
			if field2 then
				outfile(mimecode( ((field1 fi_&& 2:11) fi_<< 4) fi_|| (field2>>4) ) );
				outfile(mimecode( (field2 fi_&& 2:1111) fi_<< 2 ) );
				outfile(`=`);
			else
				outfile(mimecode( (field1 && 2:11) fi_<< 4 ) );
				outfile(`=`);
				outfile(`=`);
			endif;

			outfile(`\n`);
			quitloop();
		else
			;;; output four characters
			outfile(mimecode(field1 >> 2));
			outfile(mimecode( ((field1 fi_&& 2:11) fi_<< 4) fi_|| (field2 >> 4) ) );
			outfile(mimecode( ((field2 fi_&& 2:1111) fi_<< 2) fi_|| (field3 >> 6) ) );
			outfile(mimecode( field3 fi_&& 2:111111 ));
        	col + 4 -> col;
			if col == 72 then
				outfile(`\n`);
				0 -> col
			endif;
		endif;

	endrepeat;

	if outfile == charout then
		sysflush(popdevout);
	elseunless outfile == vedcharinsert then
		outfile(termin);
	endif;

enddefine;

define mimedecode(input, output);
	;;; read in characters in the mimencoded file, and spew out via
	;;; output the mime-encoded version

	define lconstant decode(num) -> char;
		;;; decode character in mime-encoded file. Could be made a lot more
		;;; efficient.
		locchar(num, 1,
			'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/') -> char;
		if char then char fi_- 1 -> char
		else
			mishap('Unexpected character read in', [^num, ^input])
		endif;
		
	enddefine;

	lvars
		procedure infile =
			if isstring(input) then discin(input) else input endif,

		procedure out_char =
			if isstring(output) then discout(output) else output endif,

		field1, field2, field3, field4,
		finished = false,
		;

	define lconstant outfile(char);
		if char == `\r` then
			if out_char == vedcharinsert then
				;;; ignore carriage returns
			else
				out_char(char)
			endif;
		else
			out_char(char);
		endif;
	enddefine;

	repeat

		;;; repeatedly read in a group of four characters and output a group of 3
		infile() -> field1;
		if field1 == `\n` then
			infile() -> field1;
		endif;

		quitif(field1 == termin);

		decode(field1) -> field1;

		;;; Read in remaining 6 bit characters
		;;; to be converted (with field1) to three 8 bit ones.
		infile() -> field2;
		infile() -> field3;
		infile() -> field4;

		if field4 == `=` then
			;;; last group of 4
			outfile( (field1 << 2) fi_|| ((decode(field2) ->> field2) fi_>> 4));
			if field3 == `=` then
				;;; use only field1 and field 2;
			else
				outfile( ((field2 fi_&& 2:1111) fi_<< 4) fi_|| ((decode(field3) ->>field3) >> 2));
			endif;
			quitloop();
		
		else

			outfile( (field1 << 2) fi_|| ((decode(field2) ->> field2) >> 4));
			outfile( ((field2 fi_&& 2:1111) fi_<< 4) fi_|| ((decode(field3) ->> field3) >> 2));
			outfile( ((field3 fi_&& 2:11) fi_<< 6) || decode(field4));
		endif;

	endrepeat;

	if outfile == charout then
		sysflush(popdevout);
	elseunless out_char == vedcharinsert then
		outfile(termin);
	endif;

enddefine;


/*

Response := Status-Line *(( general-header | response-header | entity-header ) CRLF) CRLF [ message-body ] 
Status-Line := HTTP-Version SP Status-Code SP Reason-Phrase CRLF
response-header := Accept-Ranges | Age | ETag | Location | Proxy-Authenticate | Retry-After | Server | Vary | WWW-Authenticate

entity-header := Allow | Content-Encoding | Content-Language | Content-Length | Content-Location | Content-MD5 | Content-Range | Content-Type | Expires | Last-Modified | extension-header

extension-header := message-header

entity-body := *OCTET
entity-body := Content-Encoding( Content-Type( data ) ) 



The entity-length of a message is the length of the message-body before any transfer-codings have been applied. Section 4.4 defines how the transfer-length of a message-body is determined. 



1xx: Informational - Request received, continuing process 
    2xx: Success - The action was successfully received, understood, and accepted 
    3xx: Redirection - Further action must be taken in order to complete the request 
    4xx: Client Error - The request contains bad syntax or cannot be fulfilled 
    5xx: Server Error - The server failed to fulfill an apparently valid request 

The individual values of the numeric status codes defined for HTTP/1.1, and an example set of corresponding Reason-Phrase's, are presented below. The reason phrases listed here are only
recommendations -- they MAY be replaced by local equivalents without affecting the protocol. 

Status-Code := "100" | "101" | "200" | "201" | "202" | "203" | "204" | "205" | "206" | "300" | "301" | "302" | "303" | "304" | "305" | "307" | "400" | "401" | "402" | "403" | "404" | "405" | "406" | "407" | "408" |
"409" | "410" | "411" | "412" | "413" | "414" | "415" | "416" | "417" | "500" | "501" | "502" | "503" | "504" | "505" | extension-code
extension-code := 3DIGIT
Reason-Phrase := *<TEXT, excluding CR, LF> 

      Status-Code    =
            "100"  ; Section 10.1.1: Continue
          | "101"  ; Section 10.1.2: Switching Protocols
          | "200"  ; Section 10.2.1: OK
          | "201"  ; Section 10.2.2: Created
          | "202"  ; Section 10.2.3: Accepted
          | "203"  ; Section 10.2.4: Non-Authoritative Information
          | "204"  ; Section 10.2.5: No Content
          | "205"  ; Section 10.2.6: Reset Content
          | "206"  ; Section 10.2.7: Partial Content
          | "300"  ; Section 10.3.1: Multiple Choices
          | "301"  ; Section 10.3.2: Moved Permanently
          | "302"  ; Section 10.3.3: Found
          | "303"  ; Section 10.3.4: See Other
          | "304"  ; Section 10.3.5: Not Modified
          | "305"  ; Section 10.3.6: Use Proxy
          | "307"  ; Section 10.3.8: Temporary Redirect
          | "400"  ; Section 10.4.1: Bad Request
          | "401"  ; Section 10.4.2: Unauthorized
          | "402"  ; Section 10.4.3: Payment Required
          | "403"  ; Section 10.4.4: Forbidden
          | "404"  ; Section 10.4.5: Not Found
          | "405"  ; Section 10.4.6: Method Not Allowed
          | "406"  ; Section 10.4.7: Not Acceptable

          | "407"  ; Section 10.4.8: Proxy Authentication Required
          | "408"  ; Section 10.4.9: Request Time-out
          | "409"  ; Section 10.4.10: Conflict
          | "410"  ; Section 10.4.11: Gone
          | "411"  ; Section 10.4.12: Length Required
          | "412"  ; Section 10.4.13: Precondition Failed
          | "413"  ; Section 10.4.14: Request Entity Too Large
          | "414"  ; Section 10.4.15: Request-URI Too Large
          | "415"  ; Section 10.4.16: Unsupported Media Type
          | "416"  ; Section 10.4.17: Requested range not satisfiable
          | "417"  ; Section 10.4.18: Expectation Failed
          | "500"  ; Section 10.5.1: Internal Server Error
          | "501"  ; Section 10.5.2: Not Implemented
          | "502"  ; Section 10.5.3: Bad Gateway
          | "503"  ; Section 10.5.4: Service Unavailable
          | "504"  ; Section 10.5.5: Gateway Time-out
          | "505"  ; Section 10.5.6: HTTP Version not supported
          | extension-code

*/
;;; defines the print function for http, which ends each line with CRLF
define hpr(x);
    pr(x><'\r\n');
enddefine;

;;;defclass int32 :32;        ;;; declare a class of 32-bit integers (to give us the fast_subscriptor)

vars procedure response10,response;

;;; protocol for HTTP1.0
define response10wrapped(comm_sock,contenttype,contentencoding,body,statuscode,statusdescription,closesock);
    ;;; redirect output
    ;;; 
    lvars o = 'HTTP/1.0 ' >< statuscode >< ' ' >< statusdescription >< '\r\n';
    if contenttype /= '' then
    	o >< 'Content-Type: ' >< contenttype >< '\r\n' -> o;
    endif;
    if contentencoding /= '' then
        o >< 'Content-Encoding: ' >< contentencoding >< '\r\n' -> o;
    endif;
    if body /= '' then
    	o >< 'Content-Length: ' >< length(body) >< '\r\n' -> o;
	o >< '\r\n' >< body >< '\r\n' -> o;
    else
     	o >< '\r\n' -> o;
    endif;
    dlocal cucharout = discout(comm_sock);
    
    returnif(isclosed(comm_sock));
    if (comm_sock = termin) then
	true->closesock;
    else
	;;;fast_subscrint32(6, fast_subscrv(2,comm_sock)) || 1 -> fast_subscrint32(6, fast_subscrv(2,comm_sock));

	;;; M_UNT_IGNORE_WRITE_ERR = 2:1e0 
	;;; set the device to ignore write errors...
	;;;	comm_sock.D_UNIT_N.UNT_FLAGS || M_UNT_IGNORE_WRITE_ERR -> comm_sock.D_UNIT_N.UNT_FLAGS;
	;;;pr(o);

	/*
	;;; write this is child process, so there won't be a problem when it mishaps...
        if sys_fork(true) then 
	    return;	
        endif;
        ;;; the child writes out the text to the socket
	pr(o);
        sysexit();
*/
	;;; aaron's hack
	define dlocal prmishap(string, list);
            sysclose(comm_sock);
            exitto(response10);
    	enddefine;
	syswrite(comm_sock,o,length(o));
	returnif(isclosed(comm_sock) or comm_sock = termin);
      	sysflush(comm_sock);
    endif;
    if closesock then
    	sysclose(comm_sock);
    endif;
/*    
    if comm_sock /= termin then
     	hpr('HTTP/1.0 ' >< statuscode >< ' ' >< statusdescription);
//    npr('Date: ' >< sysdaytime);
   	if contenttype /= '' then
    	    hpr('Content-Type: ' >< contenttype);
    	endif;
    	if body /= '' then
    	    hpr('Content-Length: ' >< length(body));
    	    hpr('');
    	    hpr(body);
    	endif;
    	sysflush(comm_sock);
    else 
        true->closesock;
    endif;
    if closesock then
    	sysclose(comm_sock);
    endif;
*/
enddefine;
    
define response10(comm_sock,contenttype,body,statuscode,statusdescription,closesock);
    response10wrapped(comm_sock,contenttype,body,statuscode,statusdescription,closesock);
enddefine;

;;; protocol is always HTTP/1.1
define responsewrapped(comm_sock,contenttype,contentencoding,body,statuscode,statusdescription,closesock);
    ;;; MS: 04-07 CHANGED TEMPORARILY to 1.0
 lvars o = 'HTTP/1.0 ' >< statuscode >< ' ' >< statusdescription >< '\r\n';
    if contenttype /= '' then
    	o >< 'Content-Type: ' >< contenttype >< '\r\n' -> o;
    endif;
    if contentencoding /= '' then
        o >< 'Content-Encoding: ' >< contentencoding >< '\r\n' -> o;
    endif;
    if body /= '' then
    	o >< 'Content-Length: ' >< length(body) >< '\r\n' -> o;
	o >< '\r\n' >< body >< '\r\n' -> o;
    else
	o >< '\r\n' -> o;
    endif;
    dlocal cucharout = discout(comm_sock);
    returnif(isclosed(comm_sock));
    if (comm_sock = termin) then
	true->closesock;
    else
	;;;	pr(o);
	;;;	syswrite(comm_sock,o,length(o));
      	;;;sysflush(comm_sock);

/*
        lvars w;
	for w from 1 to length(o) do
	    returnif(isclosed(comm_sock) or comm_sock = termin);
	    syswrite(comm_sock,w,o,1);
	endfor;

	returnif(isclosed(comm_sock) or comm_sock = termin);
*/

	;;;fast_subscrint32(6, fast_subscrv(2,comm_sock)) || 1 -> fast_subscrint32(6, fast_subscrv(2,comm_sock));
        define dlocal prmishap(string, list);
            sysclose(comm_sock);
            exitto(response);
    	enddefine;
	syswrite(comm_sock,o,length(o));
      	sysflush(comm_sock);
    endif;


    if closesock then
    	sysclose(comm_sock);
    endif;
/*
    ;;; redirect output
    dlocal cucharout = discout(comm_sock);
    if comm_sock /= termin then
    hpr('HTTP/1.1 ' >< statuscode >< ' ' >< statusdescription);
//    npr('Date: ' >< sysdaytime);
    if contenttype /= '' then
    	hpr('Content-Type: ' >< contenttype);
    endif;
    if contenttype /= '' then
    	hpr('Content-Type: ' >< contenttype);
    endif;
    if body /= '' then
    	hpr('Content-Length: ' >< length(body));
    	hpr('');
    	hpr(body);
    else
	hpr('');
    endif;
    sysflush(comm_sock);
    else 
        true->closesock;
    endif;
    if closesock then
    	sysclose(comm_sock);
    endif;
*/
enddefine;

define response(comm_sock,contenttype,contentencoding,body,statuscode,statusdescription,closesock);
    responsewrapped(comm_sock,contenttype,contentencoding,body,statuscode,statusdescription,closesock);
enddefine;

;;; send an html page to the client and close the socket afterwards
define sendpage(html,comm_sock);
    ;;;    if not(useAUTH) or authuser then 
    response(comm_sock,'text/html','',html,'411','Content Length',false);
    ;;;    	response(comm_sock,'text/html','',html,'411','Size Required',true);
    ;;;    else
    ;;;response(comm_sock,'text/html','',html,'401','Authentication Required',false);
    ;;;endif;
enddefine;


;;; TODO: SENDING GIFS DOES NOT WORK YET...
;;; AFDD for MIME: Content-Transfer-Encoding: base64
;;; sends a file if it exists, otherwise sends an error message
define sendfile(filepath,comm_sock,useMIME,encodingtype);
    if sys_file_exists(filepath) then
	if useMIME then
	    mimencode(filepath,filepath >< '.mime');
	    filepath >< '.mime' -> filepath;
	endif;
        ;;; open the file and get the file length and read it into tmp
	lvars dev = sysopen(filepath,0,false),
            len = sys_file_stat(dev,initv(1))(1),
            tmp = inits(len);
	;;;	npr('length: ' >< len);
	;;; read file 
	if sysread(dev,tmp,len) < len then
	    ;;; there was a problem
 	    response(comm_sock,'text/html','','<html><head><title>View</title></head><body>Problem with file "' >< filepath 
		     ><'"</body></html>','500','Content Length',false);
	else
	    response(comm_sock,encodingtype,if useMIME then 'base64' else '' endif,tmp,'200','Content Length',false); 
	endif;
	if useMIME and not(sysdelete(filepath)) then
	    if webverbose then npr('Could not delete mime file'); endif;
	endif;
    else
	response(comm_sock,'text/html','','<html><head><title>View</title></head><body>File "' >< filepath 
		 ><'" not found</body></html>','404','Content Length',false);
    endif;
enddefine;

;;; standard http message
define httpmessage(comm_sock,protocol,headerlist,body,statuscode,statusdescription,closesock);
    ;;; redirect output

    lvars o = protocol >< ' ' >< statuscode >< ' ' >< statusdescription >< '\r\n';
    unless null(headerlist) then
	lvars item;
	for item in headerlist do
	    o >< item(1) >< ': ' >< item(2) >< '\r\n' -> o;
	endfor;
    endunless;
    o >< '\r\n' -> o;
    ;;; if a body is present, send it too
    unless body ='' then
	o >< body >< '\r\n' -> o;
    endunless;
    ;;; flush the socket to make sure it is actually sent
    dlocal cucharout = discout(comm_sock);
    returnif(isclosed(comm_sock));
    if (comm_sock = termin) then
	true->closesock;
    else
	;;;pr(o);
	;;;	syswrite(comm_sock,o,length(o));
      	;;;sysflush(comm_sock);
/*	lvars w;
	for w from 1 to length(o) do
	    returnif(isclosed(comm_sock) or comm_sock = termin);
	    syswrite(comm_sock,w,o,1);
	endfor;

	returnif(isclosed(comm_sock) or comm_sock = termin);
*/
	;;;fast_subscrint32(6, fast_subscrv(2,comm_sock)) || 1 -> fast_subscrint32(6, fast_subscrv(2,comm_sock));

        define dlocal prmishap(string, list);
	    ;;;	    npr('MYMIS in httpmessage: ' >< string);
            sysclose(comm_sock);
            exitto(webrequest);
    	enddefine;
	syswrite(comm_sock,o,length(o));
      	sysflush(comm_sock);
    endif;
    if closesock then
    	sysclose(comm_sock);
    endif;

/*  
    dlocal cucharout = discout(comm_sock);
    ;;; compose and send first line
    hpr(protocol >< ' ' >< statuscode >< ' ' >< statusdescription);
    ;;; send header if present
    unless null(headerlist) then
	lvars item;
	for item in headerlist do
	    hpr(item(1) >< ': ' >< item(2));
	endfor;
    endunless;
    ;;; send separator between header and body
    hpr('');
    ;;; if a body is present, send it too
    unless body ='' then
    	hpr(body);
    endunless;
    ;;; flush the socket to make sure it is actually sent
    sysflush(comm_sock);
    ;;; close the socket if necessary
    if closesock then
    	sysclose(comm_sock);
    endif;
*/
enddefine;


/* 
request-header := Accept | Accept-Charset | Accept-Encoding | Accept-Language | Authorization | Expect | 
From | Host | If-Match | If-Modified-Since | If-None-Match | If-Range |
If-Unmodified-Since | Max-Forwards | Proxy-Authorization | Range | Referer | TE | User-Agent

Request := Request-Line *(( general-header | request-header | entity-header ) CRLF) CRLF [ message-body ] 
Method := "OPTIONS" | "GET" | "HEAD" | "POST" | "PUT" | "DELETE" | "TRACE" | "CONNECT" | extension-method
extension-method := token

Request-URI := "*" | absoluteURI | abs_path | authority
*/
;;; parses the header of an HTTP 1.1 request and returns its parts
;;; expects a line repeater as argument
define gethttpitems(comm_sock)->(requestmethod,requesturi,protocol,dataprop,body);
    lvars buf = inits(8192), 
	  len,
	  hline,
	  ;;; this is false by default, so the caller of this method knows that nothing was read
	  requestmethod = false, 
          requesturi = '',
          protocol = '',
          headers = '',
          body='',
	  bodylength = 0;
     
     ;;; aaron's hack
     define dlocal prmishap(string, list);
	    ;;;	    npr('MYMIS in httpmessage: ' >< string);
            sysclose(comm_sock);
	    ;;; put the return parameters on the stack
	    requestmethod;
	    requesturi;
	    protocol;
	    dataprop;
	    body;
            exitto(webrequest);
    	enddefine;

    ;;; don't read anything, if the socket is closed
    returnif(comm_sock = termin);
    ;;; read from the socket into 
/*    while not(sys_input_waiting(comm_sock)) then
	npr('No input available--sending error');
	httpmessage(comm_sock,'HTTP/1.1',[],'','100','Continue',false);
	syssleep(100);
    endwhile;
*/
    if webverbose then npr('Reading input ...  timeout=' >< pop_timeout_secs); endif;

    sysread(comm_sock,buf,length(buf)) -> len;	    
    returnif(comm_sock = termin or len = 0);

    if webverbose then npr('O-LENGTH:'><len); endif;
    if webverbose then npr('ORIGINAL:'><substring(1,len,buf)); endif;
    ;;; extract read substring
    substring(1,len,buf)->hline;
    
    ;;; get rid of leading CR LF
    while subscrs(1,hline) = `\n` or subscrs(1,hline) = `\r` do
	substring(2,length(hline)-1,hline) -> hline;
	returnif(hline = '');		
    endwhile;
    
    ;;; parse first line: requestmethod sp requesturi sp protocol
    lvars i = locchar(` `,1,hline),
	 j = locchar(` `,i+1,hline),
	 k = locchar(`\r`,j,hline),
	 l = locchar(`\n`,j,hline);

    substring(1,i-1,hline) -> requestmethod;
    substring(i+1,j-i-1,hline) -> requesturi;
    substring(j+1,min(k,l)-j-1,hline) -> protocol;
    ;;; if CR and LF are adjacent, then skip them both
    if (k = l + 1 or l = k + 1) then
	substring(k+2,length(hline)-k-1,hline) -> hline;
    else ;;; skip only one
	substring(k+1,length(hline)-k,hline) -> hline;
    endif;

    if webverbose then 
	npr('Method:   ' >< requestmethod);
    	npr('URI:      ' >< requesturi);
	npr('Protocol: ' >< protocol);
    	npr('Rest:     ' >< hline);
    endif;

    ;;; create empty property, use newmapping to allow for = (instead of ==)
    ;;; this will hold the header items
    lvars dataprop = newmapping([], 10, false, 1), cat;  

    ;;; now extract headers and body from restline
    repeat
	;;; check if we reach the end of the header
	;;; otherwise check for keyword and save the string in keyword
	if (locchar(`:`,1,hline) ->> i) then
	    substring(1,i-1,hline) -> cat;
	    if webverbose then npr('located header: ' >< cat); endif;
	    ;;; we found a header item, so there needs to be a CR at some point
	    ;;; otherwise the message is incomplete
	    while (not(locchar(`\n`,i+1,hline) ->> j)) do	    
		if webverbose then npr('NO NEWLINE, sending continuation message'); endif;
		;;; acknowledge the receipt of stuff so far
		response(comm_sock,'','','','100','Continue',false);
		;;; now read in more
		returnif(comm_sock = termin);
		sysread(comm_sock,buf,length(buf)) -> len;
		if webverbose then 
		    npr('Len:'><len);
		    npr('Mes:'><substring(1,len,buf));
		endif;
    		;;; check if the socket was closed or if the length of reading was 0 and set it to false
    		;;; so the caller will know what to do
    		if(comm_sock = termin or len = 0) then
		    false -> comm_sock;
		    return;
    		endif;
		;;; otherwise append new stuff to left over and continue with header parsing
		hline >< substring(1,len,buf)->hline;
	    endwhile;
	    ;;; get the property out, check if there is a LF at then end and get rid of it
	    if subscrs(j-1,hline) = `\r` then
	    	substring(i+1,j-i-2,hline) -> dataprop(cat);
		if webverbose then npr('Data-2: ' >< substring(i+1,j-i-2,hline)); endif;
	    else
		substring(i+1,j-i-1,hline) -> dataprop(cat);
		if webverbose then npr('Data-1: ' >< substring(i+1,j-i-1,hline)); endif;
	    endif;
	    ;;; check if it was a "Content-length" message, then we need to store the value for the body length
	    if cat = 'Content-length' or cat = 'Content-Length' then
		if webverbose then npr('Storing length for body'); endif;
		strnumber(dataprop(cat)) -> bodylength;
	    endif;		
	    ;;; if there are no lines left, then we haven't seen the end of the headers yet...
    	    if (length(hline)<=j) then
	    	;;; otherwise the message is incomplete
		if webverbose then npr('NO END OF HEADER, sending continuation message'); endif;
		;;; acknowledge the receipt of stuff so far
		response(comm_sock,'','','','100','Continue',false);
		;;; now read in more
  		returnif(comm_sock = termin);
		sysread(comm_sock,buf,length(buf)) -> len;
		if webverbose then 
		    npr('Len:'><len);
		    npr('Mes:'><substring(1,len,buf));
		endif;
    		;;; check if the socket was closed or if the length of reading was 0 and set it to false
    		;;; so the caller will know what to do
    		if(comm_sock = termin or len = 0) then
		    false -> comm_sock;
		    return;
    		endif;
		;;; otherwise append new stuff to left over and continue with header parsing
		hline >< substring(1,len,buf)->hline;
	    endif;
	    ;;; check for items that extend over several lines (indicated by leading white spaces)
	    while subscrs(j+1,hline) = ` ` or subscrs(j+1,hline) = `\t` do
		j -> i;
		locchar(`\n`,i+1,hline) -> j;	    
	    	;;; get the property out, check if there is a LF at then end agnd get rid of it
	    	if subscrs(j-1,hline) = `\r` then
	    	    dataprop(cat) >< substring(i+1,j-i-2,hline) -> dataprop(cat);
	    	else
		    dataprop(cat) >< substring(i+1,j-i-1,hline) -> dataprop(cat);
	    	endif;
		quitif(hline = '');
	    endwhile;
	    ;;; get rid of the header: item pair
	    substring(j+1,length(hline)-j,hline) -> hline;
	else ;;; no headers left, get the body if there is any	    
	    ;;; check if there is CR LF--if not, the header is not finished yet, so read more bytes in
	    if subscrs(1,hline) /= `\n` and subscrs(1,hline) /= `\r` then
		if webverbose then npr('HEADERS NOT FINISHED, sending continuation message'); endif;
		;;; acknowledge the receipt of stuff so far
		response(comm_sock,'','','','100','Continue',false);
		;;; now read in more
  		returnif(comm_sock = termin);
		sysread(comm_sock,buf,length(buf)) -> len;
		if webverbose then 
		    npr('Len:'><len);
		    npr('Mes:'><substring(1,len,buf));
		endif;
    		;;; check if the socket was closed or if the length of reading was 0 and set it to false
    		;;; so the caller will know what to do
    		if(comm_sock = termin or len = 0) then
		    false -> comm_sock;
		    return;
    		endif;
		;;; append new stuff to left over and continue with header parsing
		hline >< substring(1,len,buf)->hline;
	    else ;;; we reached the body
	    	;;; get rid of leading CR LF--could be made much more efficient
	    	while subscrs(1,hline) = `\n` or subscrs(1,hline) = `\r` do
		    substring(2,length(hline)-1,hline) -> hline;
	    	    quitif(hline = '');		
	    	endwhile;
	    	if webverbose then npr('Getting body directly, length: ' >< length(hline)); endif;
		/*	    deststring(hline);
	    for i from 1 to +0 do
		==>
	    endfor;
*/
		;;; neeed to keep track of how many bytes we need to get...
	    	hline -> body;
		while length(body) < bodylength do
		    if webverbose then npr('BODY NOT FINISHED, sending continuation message'); endif;
		    ;;; acknowledge the receipt of stuff so far
		    response(comm_sock,'','','','100','Continue',false);
		    ;;; now read in more
  		    returnif(comm_sock = termin);
		    sysread(comm_sock,buf,length(buf)) -> len;
		    if webverbose then
			npr('Len:'><len);
		    	npr('Mes:'><substring(1,len,buf));
		    endif;
    		    ;;; check if the socket was closed or if the length of reading was 0 and set it to false
    		    ;;; so the caller will know what to do
    		    if(comm_sock = termin or len = 0) then
		    	false -> comm_sock;
		    	return;
    		    endif;
		    ;;; append new stuff to the body
		    body  >< substring(1,len,buf)-> body;
		endwhile;
	    	quitloop;
	    endif;
	endif;
    endrepeat;
    if webverbose then
    	npr('Headers:  ' >< datalist(dataprop));
    	npr('Body:     ' >< body);
    endif;
enddefine;

/*
global vars Grequestmethod,Grequesturi,Gprotocol,Gdataprop,Gbody;

;;; this is a wrapper that puts all the stack variables in global ones, so we can recover from a problem
define wrappergethttpitems(comm_sock)->(requestmethod,requesturi,protocol,dataprop,body);

enddefine;
*/

;;; takes a property and updates the system variables
define updatedata(dataprop);
    lvars item;
    for item in datalist(dataprop) do
	;;;	npr(item);
	if item(2) = 'true' then true
    	elseif item(2) = 'false' then false
    	else (strnumber(item(2)) or item(2))
    	endif -> valof(item(1));
    endfor;
enddefine;

;;; makes an HTML page of the SERVER menu out of the server web, where "which" indicates the submenu level
;;; "addmenu" if not false, is a list with two element lists, the first is the link, the second the name of a return menu
define makemenu(web,addmenu)->html;
    lvars html = '<html><head></head><body>', item;
    for item in web do
	;;; check the length to figure out what kind of entry it is
        if length(item)=4 then
	    ;;; submenu, put in a link to this frame (ignore the rest)
	    html >< '<a href="' >< hd(item) >< '">' >< item(2) >< '</a><br>' -> html;	    
        elseif length(item)=3 then
	    ;;; regular item, put in the link
	    html >< '<a target="dynamic" href="' >< hd(item) >< '">' >< item(2) >< '</a><br>' -> html;
	elseif length(item) = 1 then
	    ;;; put the item in as is 
	    html >< hd(item) -> html;
	else
	    ;;; whatever else it is, we don't know it, so put a separator
	    html >< '<hr>'-> html;
	endif;
    endfor;
    if addmenu then
        for item in addmenu do
        ;;; add reference to return menu in this frame
            html >< '<hr><a href="' >< item(1) >< '">' >< item(2) >< '</a>' -> html;
        endfor;
    endif;
    html >< '</body></html>' -> html;
enddefine;

;;; searches a menu tree for the corresponding item and returns it: if it is a submenu, the html is returned, otherwise the process is returned
define getmenuitemdata(web,which,addmenu);
    lvars item;
    for item in web do
	;;; check if it is a menu item with a process (and not a separator, say)
        if length(item) = 3 then
	    ;;; if the first entry is the required one, then it is a process, so return it
	    returnif(isstartstring('/'><item(1),which))(item(3));
	;;; now check if it is a submenu
	elseif length(item) = 4 then
	    ;;; if item is a submenu, then produce submenu and return html
            returnif(isstartstring('/'><item(1),which))(makemenu(item(4),addmenu));
	    ;;; otherwise we need to recurse
	    lvars temp = getmenuitemdata(item(4),which,conspair([%item(1),item(2)%],addmenu));
	    ;;; if the return value is false, then the search needs to go on, otherwise the item was found, so return it
	    returnif(temp)(temp);
	endif;
    endfor;
    ;;; if we got here, we did not find it, so return false
    false
enddefine;


;;; TODO: this should be able to produce all kinds of elements not only input text fields...
;;; makes an HTML form with variables and values in text fields, using GET as a submission method
;;; uses text and variable names from the argument association list
;;; the first entyr is the name as it appears, the second the variable, the third the type of value
;;; handles booleans too
define makeform(varlist,formname,formmethod,contenttype,actionurl,buttontext,evalitem)->html;
    lvars html = '<form NAME="' >< formname >< 
                 '" ENCTYPE="' >< contenttype >< '" METHOD="' >< formmethod ><
                 '" ACTION="' >< actionurl >< '"><table WIDTH="600">',item;
    for item in varlist do
	if length(item)=3 then
            html >< '<tr><td align="right">' >< item(1) >< '</td><td>' -> html;
	    ;;; check what items there
            ;;; bool only makes sense together with eval, so simply take value...
	    if item(3)="bool" then
                html >< '<select NAME="' >< item(2) >< '">' -> html;
                if valof(item(2)) then
                    html >< '<OPTION selected>true</OPTION><OPTION>false</OPTION></select>' -> html;
                else
                    html >< '<OPTION selected>false</OPTION><OPTION>true</OPTION></select>' -> html;
                endif;
            else
  	        html >< '<input NAME="' >< if evalitem then item(2) else item(1) endif 
                >< '" VALUE="' >< if evalitem then valof(item(2)) else item(2) endif >< '">' -> html;
	    endif;
            html >< '</td></tr>' -> html;
	else
	    ;;; put in the first item into the html directly
	    html >< item(1)-> html;	    
	endif;
    endfor;
    html >< '</table><p><input TYPE="Submit" VALUE="' >< buttontext >< '" onclick="document.' ><
         formname >< '.submit()">' -> html;
    html >< '<input TYPE="reset" VALUE="Erase"></form>' -> html;
enddefine;

;;; returns the html for the main frame, puts "header" up top
define mainframe(content)->html;
    lvars html = header;
    ;;; for no frame version
    html >< '<FRAMESET ROWS="15%,*"><FRAME SRC="title" NAME=TITLE SCROLLING=NO>' -> html;
    html >< '<FRAMESET COLS="200,*"><FRAME NAME="fixed" SRC="mainmenu">' -> html;
    html >< '<FRAME NAME="dynamic" SRC="' >< content >< '"></FRAMESET></FRAMESET>' -> html;
    html >< '<NOFRAMES><h1 align=center><blink>Frame ALERT!</blink></h1><p>' -> html;
    html >< 'You need a browser that supports frames to view this document</p></NOFRAMES>' -> html;
    html >< '</html>' -> html;
enddefine;

;;; returns the title frame
define maketitle()->html;
    lvars html = '<html><head></head><body>' ><
       '<h1>SWAGES 1.0 alpha Web Server</h1><br></body></html>';
enddefine;

;;; this deals with all webrequests, where web contains the structure of the web site
;;; the format is: [[url name procedure] [url name procedure] ...] 
;;; where the procedure takes the whole url and whether it is update or not as input and returns a page
define webrequest(es,comm_sock,web);
    ;;; create a 8k buffer
    lvars buf = inits(8192), len;
    ;;; get a line repeater
    ;;;lvars line_rep = line_repeater(comm_sock,8192);

    ;;; keep the connection alive
    repeat
    	;;; otherwise parse the message (NOTE: need to create a substring of the actual message!)
    	lvars (requestmethod,requesturi,protocol,headerprop,body) = gethttpitems(comm_sock);
	;;; quit if there was no actual request
	returnif(requestmethod = false);
	returnif(isclosed(comm_sock));

	;;; FOR NOW: ONLY USE BASIC AUTHENTICATION!!!  (SHOULD BE SWITCHED TO DIGEST)
	;;; check for authentication: if turned on and if there is already a user, check if it is the same
	if useAUTH then
	    if webverbose then
	    	npr('****** AUTH ******');
	    endif;
	    ;;; a user is already logged on, check if it is the same
 	    if authuser then
	    	if (headerprop('Authorization') /= authuser) then 
		    if webverbose then
		    	npr('System in use by other user');
		    endif;
		    httpmessage(comm_sock,'HTTP/1.0',[['WWW-Authenticate' 'Basic']],'','401','Authorization required',true);
		    return;
		else
		    if webverbose then npr('User authenticated'); endif;
		endif;
	    ;;; nobody is currently logged on, check if the user has permission
	    else
		lvars newuser = headerprop('Authorization');
		;;; if the user is not allowed, authentication is requested again...
		if lmember_=(newuser,allowedusers) then
		    if webverbose then npr('User found'); endif;
		    newuser -> authuser;
		else
		    if webverbose then npr('User NOT found'); endif;
		    httpmessage(comm_sock,'HTTP/1.0',[['WWW-Authenticate' 'Basic']],'','401','Authorization required',true);
		    return;
		endif;
	    endif;
	endif;

    	;;; get content
    	if requestmethod = 'GET' then
	    if webverbose then npr('** get request'); endif;
	    ;;; check whether it is the main page
	    if requesturi = '/' or requesturi = '/index.html' or requesturi = '/index.htm' then
		if webverbose then npr('Sending main page'); endif;
		response(comm_sock,'text/html','',mainframe('/home'),'200','OK',true);
		return;
	    ;;; dynamically generate menu if requested
	    elseif requesturi = '/mainmenu' then
		if webverbose then npr('Sending menu'); endif;
		response(comm_sock,'text/html','',makemenu(web,false),'200','OK',true);
		return;
            ;;; user-defined pages 
	    elseif requesturi = '/title' then
		if webverbose then npr('Sending title'); endif;
		response(comm_sock,'text/html','',maketitle(),'200','OK',true);
		return;
	    elseif isendstring('.gif',requesturi) then		
	    	;;; send the requested image encoded as image/gif
		sendfile(substring(2,length(requesturi)-1,requesturi),comm_sock,true,'image/gif');		
	    else
		;;; now try to get the requested page
                lvars found = getmenuitemdata(web,requesturi,[['mainmenu' 'Main menu']]);
		;;; if it was found, check whether it was submenu or process
		if found then
		    if isstring(found) then
			;;; it was a submenu
			if webverbose then npr('Sending submenu'); endif;
			response(comm_sock,'text/html','',found,'200','OK',true);
			return;
		    else
		    	;;; it was a process, so check if the URI contains data and pass it on
			if locchar(`?`,1,requesturi) then
		    	    sendpage(found(es,body,requesturi),comm_sock);
			else
		    	    sendpage(found(es,body,false),comm_sock);
			endif;
       	    	    endif;
		else
		    ;;; not found, send an error message
	    	    sendpage('<html><body>The requested page<pre>' >< buf >< 
                      	     '</pre>is not available</body></hmtl>',comm_sock);
	    	endif;
	    endif;
	;;; process the POST request
    	elseif requestmethod = 'POST' then
    	    if webverbose then npr('** post request'); endif;
	    ;;;npr('Body: ' >< body);
	    ;;; check the URL
            lvars found = getmenuitemdata(web,requesturi,[['mainmenu' 'Main menu']]);
	    if found then
		unless isstring(found) then
		    ;;; check if body is empty, in which case we need to send another request to the client
		    ;;; and wait for the 2nd part
		    if webverbose then npr(body=''); endif;
		    if body = '' then
			;;;			if protocol = 'HTTP/1.0' then
		    	response(comm_sock,'','','','411','Length required',false);
			;;;			endif;
		    	;;; now get the body
		    	;;; NOTE: there may be more header info!!!
		    	if webverbose then npr('Getting the body...'); endif;
		    	lvars c = `\n`, cl='', i=0, nbytes;
			
			;;; now read header - value pairs until "Content-length"
		    	;;; skip over leading white space
			while not(isstartstring('Content-Length',cl) or isstartstring('Content-length',cl)) do
			    0 -> i;
  			    returnif(comm_sock = termin);
		    	    while c= `\n` or c= `\r` do getc(comm_sock)->c endwhile;
		    	    consstring(
		    	      	       while c/= `\n` and c/= `\r` do
				       	   c;
				       	   i + 1 -> i;
  					   returnif(comm_sock = termin);
				       	   getc(comm_sock) ->c;
		              	       endwhile, i) -> cl;
		    	    if webverbose then npr('HEADERLINE:'><cl); endif;
			endwhile;
			;;; there should now be an empty line separating the headers from the body
			;;; TODO: if not, then we need to read more headers...
		    	while c= `\n` or c= `\r` do returnif(comm_sock = termin); getc(comm_sock)->c endwhile;
		    	if (locchar(`:`,1,cl) ->> i) then
	    		    ;;;substring(1,i,cl) -> cat;
	    		    strnumber(substring(i+1,length(cl)-i,cl)) -> nbytes;
			    if webverbose then npr('Num: '>< nbytes); endif;
  			    returnif(comm_sock = termin);
			    lvars actread = sysread(comm_sock,buf,nbytes);
			    consstring(c,1) >< substring(1,actread,buf) -> body;
			    while actread < nbytes - 1 do
			    	if webverbose then npr('Read: '>< actread); endif;
			    	nbytes - actread -> nbytes;
			    	response(comm_sock,'','','','100','Continue',false);
				returnif(comm_sock = termin);
			    	sysread(comm_sock,buf,nbytes) -> actread;
			    	body >< substring(1,actread,buf) -> body;
			    endwhile;
			    if webverbose then npr('Final read: '>< actread); endif;
		    	else
			    ;;; SHOULD NOT BE HERE...
			    if webverbose then 
			    	npr('DID NOT GET NUMBER OF BYTES');
			    endif;
			    returnif(comm_sock = termin);
			    sysread(comm_sock,buf,length(buf)) -> len;
		    	    buf->body;
		    	endif;
		    endif;
		    ;;; now pass the body on to the function dealing with the page
		    if protocol = 'HTTP/1.0' then
			if webverbose then npr('HTTP/1.0 PROBLEM'); endif;
			if comm_sock = termin then
		    	    if webverbose then npr('ATTENTION http 1.0 problem...'); endif;
			else
			    response(comm_sock,'text/html','',found(es,body,true),'200','OK',true);
			endif;
			return;
		    else ;;; keep connection open
			response(comm_sock,'text/html','',found(es,body,true),'200','OK',true);
			return;
		    endif;
		    
/*   lvars s=substring(issubstring('10001/submit',buf),len-issubstring('10001/submit',buf),buf);
		    npr(s);
		    npr('L = ' >< length(s));
		    deststring(s);
		    for i from 1 to +0 do
			==>
		    endfor;
*/
		;;;		return;
	    	else
		    ;;; it was a submenu request with POST???
		    if webverbose then npr('Sending submenu'); endif;
		    response(comm_sock,'text/html','',found,'200','OK',true);
		    return;
	    	endunless;
	    else
		;;; not found, so send an error message
	    	sendpage('<html><body>The requested page<pre>' >< 
                     	 '</pre>is not available</body></hmtl>',comm_sock);
	    endif;
    	    ;;; send acknowledgement page	
    	else
	    if webverbose then npr('UNKNOWN REQUEST:' >< requestmethod); endif;
     		;;; unknown request
	    sendpage('UNKNOWN REQUEST: '>< requestmethod,comm_sock);
    	endif;
    endrepeat;
enddefine;

;;;------------------------- here come the dynamically generated web pages ---------------------------------
;;; these functions are put into the web table, from which the menu is generated
;;; arguments are: experiments server,body sent by client,boolean indicating GET (false) or POST (true) mode

;;; the server home page
define process_home(es,buf,update)->html;
    dlocal lfchar = '<br>';
    lvars html = '<html><head><META HTTP-EQUIV=refresh content=' >< refreshTIME >< '></head><body>' ><
	 '<h2>Server Status:</h2><table>';
    ;;; TODO: provide status information about experiments, hosts, etc.
    html >< '<tr><td align="LEFT">Participating hosts:</td><td align="LEFT">' ><  length(es.hostlist) >< '</td></tr>' -> html;
    html >< '<tr><td align="LEFT">Running experiments:</td><td align="LEFT">' ><  length(es.runningexps) >< '</td></tr>' -> html;
    html >< '<tr><td align="LEFT">Finished experiments:</td><td align="LEFT">' ><  datalength(es.finishedexps) >< '</td></tr></table>' -> html;
    lvars q = es.queuedexperiments;
    if null(q) then
	html >< 'There are currently no queued experiments' -> html;
    else
	html >< 'Queued experiments (name,priority):<br>' -> html;
	html >< accumulate(concatenate,[],maplist(q,procedure(x);hd(x) >< ' ' >< hd(tl(x)) >< lfchar;endprocedure)) -> html;
    endif;
    html >< '</body></html>' -> html;
enddefine;

;;; this processes the setup, needs to check if it is updated or not
;;; and returns a page
define process_setup(es,body,update)->html;
    lvars html = '<html><head></head><body><h2>Setup Server Parameters</h2>' ><
    	 ;;; check if update
    	 if update then
	     updatedata(getdata(body,true));
	     'Server parameters updated'
    	 else    ;;; display request
	     makeform([ 		       
	               ['<tr><td colspan=2><hr></td></tr>']
		       % if serverOS="solaris" then
            	       	     ['Run path:'      runpathsolaris      path];
		       	     ['PING path:'     pingpathsolaris     path];
		       	     ['PING arguments:'pingargssolaris     path];
		       	     ['SSH path:'      sshpathsolaris      path];
            	       	     ['SSH arguments:' sshargssolaris      path];
		       	     ['SCP path:'      scppathsolaris      path];
            	       	     ['SCP arguments:' sspargssolaris      path];
			 else
            	       	     ['Run path:'        runpathlinux      path];
		       	     ['PING path:'       pingpathlinux     path];
		       	     ['PING arguments:'  pingargslinux     path];
		       	     ['SSH path:'        sshpathlinux      path];
            	       	     ['SSH arguments:'   sshargslinux      path];
		       	     ['SCP path:'        scppathlinux      path];
            	       	     ['SCP arguments:'   scpargslinux      path];
			 endif %
    		       ['Scratch for host checks:' testhostfilescratch path]
		       ['<tr><td colspan=2><hr></td></tr>']
		       ['Waiting for ssh (sec.):'  SSHTIMEOUT  nat]
		       ['Waiting for scp (sec.):'  SCPTIMEOUT  nat]
 		       ['Waiting for host check (sec.):' TESTHOSTTIMEOUT  nat]
		       ['Waiting for migration (sec.):'   MAXMIGRATIONTIME nat]
		       ['<tr><td colspan=2><hr></td></tr>']
		       ['Interval for waiting for host (sec.):' WAITINGFORHOSTS  nat]
		       ['Interval for host checks (sec.):' HOSTCHECKFREQ  nat]
		       ['Interval for watch dog (sec.):' WATCHDOGINTERVAL nat]
		       ['Pause after scheduling (sec.):'  SCHEDULETIME  nat]
   		       ['Server page refresh rate (sec.)' refreshTIME nat]
		       ['<tr><td colspan=2><hr></td></tr>']
		       ['Check hosts regularly:'       mustCHECKHOSTS  bool]
    		       ['Generate testhost script:'        generateTESTHOSTSCRIPT bool]
 		       ['Interactive (web) mode:'      interactiveMODE bool]
                       ['Ignore unknown keyword:' ignoreUNKNOWNKEYWORD bool]
                       ['Save server state:'     saveSERVERSTATE bool]
    		       ['Use authentication'   useAUTH bool]
    		       ['Single user mode' singleUSER bool]
		       ['<tr><td colspan=2><hr></td></tr>']
		       ],'setupform','POST','application/x-www-form-urlencoded','setup','Update',true)
	     ;;;'multipart/form-data','setup')
    	 endif >< '</body></html>';
enddefine;	     

;;; this displays the list of available hosts
define process_available(es,body,update)->html;
    dlocal pop_asts_enabled = false;;
    lvars html = '<html><head><META HTTP-EQUIV=refresh content=' >< refreshTIME >< '></head><body><h2>Available Hosts</h2>',hlst,item;
    ;;; turn off interrupts
    [% lvars host;
       fast_for host in es.hostlist do
	   ;;; if host has been checked at least once and is marked available, it should be available
    	   if host.lastchecked and host.available then
	       host
	   endif
       	   endfast_for %] -> hlst;
    true -> pop_asts_enabled;
    if null(hlst) then
	html >< 'There are currently no hosts available' -> html;
    else
	html >< '<table WIDTH="400"><tr><td align="right">Host</td><td align="left">Clients</td></tr>' -> html;
    	for item in hlst do
            html >< '<tr><td align="right">' >< item.name >< '</td>' -> html;
            html >< '<td align="left">' >< item.clients >< '</td></tr>' -> html;
    	endfor;
    	html >< '</table>' -> html;
    endif;
    html >< '</body></html>' -> html;
enddefine;	     

;;; this displays the current experiment, 
define process_current(es,body,update)->html;
    lvars html = '<html><head><META HTTP-EQUIV=refresh content=' >< refreshTIME >< '></head><body><h2>Current Experiment(s)</h2><pre>';
    ;;; make the print routine use HTML line breaks
    ;;;dlocal lfchar = '<br>\n';
    ;;; get experiment info 
    html >< accumulate(concatenate,[],maplist(es.runningexps,printexperiment)) ><
         '</pre></body></html>' -> html;
enddefine;	     

;;; this displays the list of all hosts
define process_allhosts(es,body,update)->html;
    lvars html = '<html><head></head><body><h2>All Hosts</h2><pre>';
    ;;; get host info
    dlocal lfchar = '\n';
    html >< accumulate(concatenate,[],maplist(es.hostlist,printhostinfo)) ><
         '</pre></body></html>' -> html;
enddefine;

;;; this displays the list of hosts in use
define process_usedhosts(es,body,update)->html;
    dlocal lfchar = '\n';
    lvars html = '<html><head><META HTTP-EQUIV=refresh content=' >< refreshTIME >< '></head><body><h2>Hosts in Use</h2><pre>';
    ;;; get host info
    ;;;dlocal lfchar = '<br>\n';
    html >< accumulate(concatenate,[],maplist(datalist(es.allclients),procedure(x);if x(2).status /= "FINISHED"
					      then lvars usedhst = x(2).onhost; if usedhst then usedhst.name >< lfchar else '' endif  else '' endif endprocedure)) >< '</pre></body></html>' -> html;
enddefine;

;;; this displays the results of experiments
define process_view(es,body,update)->html;
    ;;; display the chosen experiment
    if update then
	;;; update contains the URI with the name of the experiment to be displayed
	lvars 	i = locchar(`?`,1,update),
	     dataprop = getdata(substring(i+1,length(update)-i,update),false),
	     efilepath = dataprop('which'),	     
	     html = '',
	     dev,
	     len,
	     tmp;

	;;; if the file exists then
	if sys_file_exists(efilepath) then
	    ;;; check if it is the results file...
	    if isendstring('html',efilepath) then
	    	;;; open the experiment result file for reading only
	    	;;;	     lrptr = line_repeater(sysopen(ename,0,false),1000),
	    	sysopen(efilepath,0,false) -> dev;
	    	;;; get the file length and read it into tmp
	    	sys_file_stat(dev,initv(1))(1) -> len;
	    	;;; create a buffer
	    	inits(len) -> tmp;
	    	;;;	npr('length: ' >< len);
	    	;;; read file 
	    	if sysread(dev,tmp,len) < len then
	    	    ;;; there was a problem
	    	    '<html><head></head><body><h2>View</h2>Problem reading file</body></html>' -> html;
 	    	else
	    	    ;;; npr('READ: ' >< tmp);
	    	    html >< tmp -> html;
	    	endif;
	    else
                '<html><head></head><body><h2>View</h2>File "' >< efilepath ><'" not found</body></html>' -> html;
	    endif;
	else 	;;; check if the experiments is stored
	    lvars exfile = (es.finishedexps)(URLdecode(efilepath));
	    if exfile then		
	    	;;; otherwise simply print the experiment info		
		'<html><head></head><body><h2>View</h2><pre>' >< printexperiment(datafile(exfile)) >< '</pre></body></html>' -> html;
	    else
	    	'<html><head></head><body><h2>View</h2>Experiment ' >< URLdecode(efilepath) >< ' not found.</pre></body></html>' -> html;
	    endif;
	endif;
	;;; this is a complete html file, so read it in
/*	     while (lrptr() -> tmp) /= termin do

	endwhile;
*/
    else ;;; display a list of completed experiments
    	lvars html = '<html><head></head><body><h2>Available Hosts</h2>', item;
	if datalength(es.finishedexps) = 0 then
	    html >< 'There are currently no finished experiments.' -> html;
	else
	    html >< '<table WIDTH="400">' -> html;
	    html >< '<tr><td>Info</td><td>Results</td></tr>' -> html;
    	    for item in datalist(es.finishedexps) do		
		;;; add the item
            	html >< '<tr><td align="left"><a href="/view?which=' >< URLencode(item(1)) >< '">' >< item(1) >< '</a></td>' -> html;
		;;; if there is an <expname>.html file in the same directory which should have the results then put a link to it too
		if sys_file_exists(item(2)><'.html') then
            	    html >< '<td align="left"><a href="/view?which=' >< URLencode(item(2) >< '.html') >< '">Results</a></td></tr>' -> html;
		else
            	    html >< '</tr>' -> html;
		endif;
    	    endfor;    
	    html >< '</table>' -> html;
	endif;
    	html >< '</body></html>' -> html;
    endif;
enddefine;

;;; this loads a finished experiment into the server's finished experiment lists
define process_restore(es,body,update)->html;
    lvars html = '<html><head></head><body><h2>Restore Experiment</h2>';
    ;;; display the chosen experiment
    if update then
	lvars dataprop = getdata(body,false),
	     efilepath = dataprop('Filepath:');
	
        ;;; add the experiment to the finished experiments list
	if sys_file_exists(efilepath) then
	    lvars ex = loadexperiment(es,efilepath);
	    efilepath -> (es.finishedexps)(ex.name);
	    ;;;npr('EXP NAME: ' >< ex.name);
	    html >< 'Experiment '>< ex.name ><' restored' -> html;
	else
	    html >< 'Restore failed: experiment '><ex.name><' NOT found!' -> html;
	endif;
    else ;;; experiment to be restored
 	lvars html = '<html><head></head><body><h2>Restore Experiment</h2>Please enter the complete filepath to the experiment you wish to restore';
    	html >< makeform([['Filepath:' '' path]],
                         'restoreform','POST','application/x-www-form-urlencoded','restore','Restore',false)->html;
    endif;
    html >< '</body></html>' -> html;
enddefine;

;;; allows the user to submit a new experiment
;;; expects an experiment startup list, identical in format to the one passed to setup in simworld server
define process_submit(es,body,update)->html;
    lvars html = '<html><head></head><body><h2>Submit Experiment</h2>';
    if update then
	lvars dataprop = getdata(body,false),
	     expdata = dataprop('expdata');
	if webverbose then
	    npr('EXPDATA: --------------------------------------');
	    npr(expdata);
	endif;
	;;; first compile the data in a separate pop process just to see if it works ok
	;;; NOTE: this allows users to do arbitrary things on the server!!!
	    ;;;	npr('BEFORE SYNTAX CHECK');
	    ;;;	sysobey(poppth >< ' ":' >< expdata >< '"');
	    ;;;npr('AFTER SYNTAX CHECK');
	    ;;; MS: 05/02 temporary hack since sysobey above caused problems
	;;;0 -> pop_status;
	;;;if pop_status = 0 then
 	    lvars experror = enqueueexperiment(es,compile(stringin(expdata)));
	    if isstring(experror) then
		html >< 'Problem with experiment: ' >< experror >< '<br>Experiment NOT submitted' -> html;
	    else
	    	html >< 'Data received, experiment submitted' -> html;
	    endif;
	    ;;;else
    	    ;;;html >< 'Syntax error, experiment NOT submitted' -> html;
	    ;;;endif;
    else
	;;; produce a text area where experiment parameters can be inserted
	html >< '<form NAME="submitexp" ENCTYPE="application/x-www-form-urlencoded" METHOD="POST" ' >< 
	              'ACTION="submit"><textarea name="expdata" rows="30" cols="75"></textarea>' >< 
                      '<p><input TYPE="Submit" VALUE="Submit" onclick="document.submitexp.submit()">' ><
		      '<input TYPE="reset" VALUE="Erase"></form>' -> html;
    endif;
    html >< '</body></html>' -> html;
enddefine;


define process_dopop11(es,body,update)->html;
    lvars html = '<html><head></head><body><h2>POP11 Command Interface<br>USE AT YOUR OWN RISK!</h2>';
    if update then
	lvars dataprop = getdata(body,false),
	     expdata = dataprop('expdata');
	if webverbose then
	    npr('EXPDATA: --------------------------------------');
	    npr(expdata);
	endif;
	;;; first compile the data in a separate pop process just to see if it works ok
	;;; NOTE: this allows users to do arbitrary things on the server!!!
	    ;;;	npr('BEFORE SYNTAX CHECK');
	    ;;;	sysobey(poppth >< ' ":' >< expdata >< '"');
	    ;;;npr('AFTER SYNTAX CHECK');
	    ;;; MS: 05/02 temporary hack since sysobey above caused problems
	;;;0 -> pop_status;
	;;;if pop_status = 0 then
	html >< '<h3>Output:</h3><pre>' >< compile(stringin(expdata)) >< '</pre>' -> html;
    endif;
    ;;; produce a text area where experiment parameters can be inserted
    html >< '<form NAME="submitexp" ENCTYPE="application/x-www-form-urlencoded" METHOD="POST" ' >< 
	              'ACTION="dopop11"><textarea name="expdata" rows="20" cols="75"></textarea>' >< 
                      '<p><input TYPE="Submit" VALUE="Compile" onclick="document.submitexp.submit()">' ><
		      '<input TYPE="reset" VALUE="Erase"></form></body></html>' -> html;
enddefine;


;;; allows the user to submit a new experiment
define process_dostats(es,body,update)->html;
    ;;; display the chosen experiment
    if update then
	lvars dataprop = getdata(body,false),
	     alpha = strnumber(dataprop('Alpha:')),
	     ename = dataprop('Experiment name:'),
	     ;;; get the stat cats out of the string and transform them into a list of words
	     statcats = maplist(sysparse_string(dataprop('Statcat list:')),consword),
	     agents = maplist(sysparse_string(dataprop('Agent list:')),consword),
	     measures = maplist(sysparse_string(dataprop('Measure list:')),consword),
	     precision = strnumber(dataprop('Precision:'));

	;;; check if the experiments is stored
	lvars exfile = (es.finishedexps)(ename);

	if not(precision) then
	    lvars html = '<html><head></head><body><h2>Compute Statistics</h2>Need number for precision: '><dataprop('Precision:')><'</body></html>';
	elseif not(alpha) then
	    lvars html = '<html><head></head><body><h2>Compute Statistics</h2>Need number for alpha: '><dataprop('Alpha:')><'</body></html>';
	elseif exfile then
	    ;;; load the experiment
	    ;;;npr(exfile);	    
	    ;;;npr('EXISTS: ' >< sys_file_exists(exfile));
	    lvars ex = datafile(exfile);
	    ;;; now check for consistency
	    lvars html = '<html><head></head><body><h2>New Statistics</h2>', 
		 err=false,
		 ;;; load the first client, do we need to/ should we check if file exists???
	    	 st = datafile((ex.clients)(1).experiment),
	 	 ;;; get the categories and sort them alphabetically
	 	 catkeys = nc_listsort(delete("agents",getkeys(st)),alphabefore),
	 	 ;;; get the agent types
	 	 typekeys = nc_listsort(getallagenttypes(st,catkeys),alphabefore);

	    html >< accumulate(concatenate,'',maplist(agents,
						       procedure(x); 
						       	   unless member(x,typekeys) then
							       ;;; CHECK THIS!!!
							       true -> err;
 							       'Agent type not found in simulation: ' >< x else '' endunless
						       endprocedure)) >< '<br>' -> html;
	    html >< accumulate(concatenate,'',maplist(statcats,
						       procedure(x); 
							   ;;; this should be obtained automatically from the stats class...
						       	   unless member(x,[mean variance stdev stderr conflower confupper sig]) then	
							       ;;; CHECK THIS!!!
							       true -> err;
 							       'Unsupported statistics category: ' >< x else '' endunless
						       endprocedure)) >< '<br>' -> html;
	    html >< accumulate(concatenate,'',maplist(measures,
						       procedure(x); 
						       	   unless member(x,catkeys) then
							       ;;; CHECK THIS!!!
							       true -> err;
 							       'Unsupported measure category: ' >< x else '' endunless
						       endprocedure)) >< '<br>' -> html;

	    ;;; now compute the stats...	    
	    if err then
		html >< '</body></html>' -> html;
		return;
	    endif;
	    ;;; now produce the stats file
/*
	    exfile >< '.html'=>
	    measures=>
	    [% [%exfile% usebasicstats] <> agents %]=>
	    statcats=>
	    alpha=>
	    maplist(agents,procedure(x);nicify(x) endprocedure)=> 
	    precision=>
*/
	    ;;; do this is in separate thread
	    if exists_thread(exfile >< '.stats') then
		lvars html = '<html><head></head><body><h2>Compute Statistics</h2>Statistics for this experiment are currently computed<br>' >< 
		     'Please submit request again later</body></html>';
            else
	    	start_thread(exfile >< '.stats',100,
		 	     procedure(outfilename,categories,data,statcategories,alphavalues,agnames,printprecision);
			     	 summary(outfilename,categories,data,statcategories,alphavalues,agnames,printprecision);
		 	     endprocedure,
		 	     [% exfile,measures,[% [%exfile% usebasicstats] <> agents %],statcats,alpha,
                            	maplist(agents,procedure(x);nicify(x) endprocedure),precision %]);	
	    
	    	;;; and give the user a pointer to it
	    	lvars html = '<html><head></head><body><h2>New Statistics</h2>Computing statistics...<br>' >< 
		     'Please be patient, this may take a while<p>';
	    endif;
	else
	    lvars html = '<html><head></head><body><h2>Compute Statistics</h2>Could not find experiment '><ename><', restore first!</body></html>';
	endif;
    else ;;; experiment on which stats are to be performed
 	lvars html = '<html><head></head><body><h2>Compute Statistics</h2>Please enter the experiment you wish to restore';
    	html >< makeform([['Experiment name:' '' string]['Alpha:' '0.05' real]['Precision:' '2' int]['Statcat list:' 'mean' todo]
 			  ['Agent list:' '' todo]['Measure list:' 'alive' todo]],
                         'dostatsform','POST','application/x-www-form-urlencoded','dostats','Calculate',false)->html;
    	html >< '</body></html>' -> html;
    endif;
enddefine;


;;; this displays the results of experiments
define process_logout(es,buf,update)->html;
    lvars html = '<html><head></head><body><h2>Logout</h2>You have successfuly logged out';
    html >< '</body></html>' -> html;
    ;;; reset the authorized user
    false -> authuser;
enddefine;

;;; NEEDS TO BE FINISHED
;;; allows users to edit the host information
define process_edithost(es,body,update)->html;
    lvars html = '<html><head></head><body><h2>Edit Host</h2>' ><
    	 ;;; check if update
    	 if update then
	     updatedata(getdata(body,true));
	     'Server parameters updated'
    	 else    ;;; display request
	     makeform([ 		       
	               ['Host name:'          name       string]
    		       ['IP address:'         IP         string]
    		       ['OS on host:'         OS         string]
    		       ['Number of CPUs:'     cpusonhost nat]
    		       ['Usage policy:'       availcrit  string]
		       ['Path to simulation:' simpath    path]
		       ['Path to POP:'        poppath    path]
		       ['Path to scratch:'    scratch    path]		      
		       ],'setupform','POST','application/x-www-form-urlencoded','setup','Update',true)
	     ;;;'multipart/form-data','setup')
    	 endif >< '</body></html>';
enddefine;

;;; allows users to dequeue an experiment
define process_dequeue(es,body,update)->html;
    lvars html = '<html><head></head><body><h2>Warning:</h2>This function is not implemented.</body></html>';
enddefine;

define process_adduser(es,body,update)->html;
    lvars html = '<html><head></head><body><h2>Warning:</h2>This function is not implemented.</body></html>';
enddefine;

define process_deleteuser(es,body,update)->html;
    lvars html = '<html><head></head><body><h2>Warning:</h2>This function is not implemented.</body></html>';
enddefine;

define process_edituser(es,body,update)->html;
    lvars html = '<html><head></head><body><h2>Warning:</h2>This function is not implemented.</body></html>';
enddefine;

define process_password(es,body,update)->html;
/*
<FORM NAME="LoginForm" METHOD=POST ACTION="urlToInvoke">  <P>User name: <INPUT TYPE="text" NAME="userName" SIZE="10">  <P>Password: <INPUT TYPE="password" NAME="password" SIZE="12" VALUE="treasure">  <INPUT TYPE="hidden" NAME="DefaultPass" VALUE="treasure">  <P><INPUT TYPE="submit" VALUE="Log in">  <INPUT TYPE="button" VALUE="Cancel" onClick="window.close()"> </form>
*/
    lvars html = '<html><head></head><body><h2>Warning:</h2>This function is not implemented.</body></html>';
enddefine;

;;; allows users to dequeue an experiment
define process_dequeue(es,body,update)->html;
    lvars html = '<html><head></head><body><h2>Warning:</h2>This function is not implemented.</body></html>';
enddefine;

;;; this displays the results of experiments
define process_shutdown(es,buf,update)->html;
    ;;; start the killer thread
    start_thread('killer',10,
		 procedure();
		     sleep_thread(5);
    		     kill_all_threads();
		 endprocedure,
		 []);
   lvars html = '<html><head></head><body><h2>Warning:</h2>Server will shut down momentarily.<br>Good bye</body></html>';
enddefine;

;;; the layout of the web server and the menu created from it
global vars 
    serverweb = [
		 ['home'      'Server home'         ^process_home]
                 []
    		 ['server'    'Server operations'   ^false
                  [
		   ['setup'     'Server setup'        ^process_setup]
		   []
	 	   ['dopop11'   'Pop11'               ^process_dopop11]
		   []
	 	   ['shutdown'  'Shutdown server'     ^process_shutdown]
		   ]
                  ]
                 []
		 ['hosts'     'Host operations'      ^false 
		  [             
      		   ['available' 'Available hosts'     ^process_available]
    		   ['allhosts'  'All hosts'           ^process_allhosts]
    		   ['usedhosts' 'Hosts in use'        ^process_usedhosts]
                   []
		   ['edithost'  'Edit host'           ^process_edithost]
		   ]
		  ]
                 []
    		 ['exps'       'Experiments'         ^false
                  [
		   ['current'   'Current experiment(s)'   ^process_current]
    		   ['submit'    'Submit experiment(s)'    ^process_submit]
		   ['dequeue'   'Dequeue experiment'   ^process_dequeue]
		   ]
                  ]
                 []
    		 ['stats'     'Statistics'          ^false
                  [
		   ['view'      'View results'        ^process_view]
		   []
		   ['restore'   'Restore experiments'  ^process_restore]
		   []
		   ['dostats'   'Perform statistics'  ^process_dostats]
		   ]
                  ]
                 []
		 ['users'       'User management'     ^false
                  [  
		   ['adduser'    'Add user'            ^process_adduser]
		   ['deleteuser' 'Delete user'         ^process_deleteuser]
		   ['edituser'   'Edit user'           ^process_edituser]
		   ['password'   'Change password'     ^process_password]
		   ]
                  ]
		 []
		 ['logout'    'Logout'              ^process_logout]
    		],
    ;





/*  CODE FOR COOKIES...

"<META HTTP-EQUIV=\"SET-COOKIE\" CONTENT=\"cookiename=" + Cookievalue +"; path=/;
expires=Thu, 01-Jan-2009 12:00:00 GMT\">"


<script>
function ReadCookie (CookieName) {
  var CookieString = document.cookie;
  var CookieSet = CookieString.split (';');
  var SetSize = CookieSet.length;
  var CookiePieces
  var ReturnValue = "";
  var x = 0;

  for (x = 0; ((x < SetSize) && (ReturnValue == "")); x++) {

    CookiePieces = CookieSet[x].split ('=');

    if (CookiePieces[0].substring (0,1) == ' ') {
      CookiePieces[0] = CookiePieces[0].substring (1, CookiePieces[0].length);
    }

    if (CookiePieces[0] == CookieName) {
      ReturnValue = CookiePieces[1];
    }

  }

  document.forms[0].elements[1].value = ReturnValue;;

}
</script>


<HTML>
<HEAD>
<TITLE>Read a cookie </TITLE>
<!-- code from Negrino, p. 226, to be used in conjunction with "set_a_cookie"-->

</HEAD>

<BODY >
<h1>
<script language="JavaScript">

if (document.cookie != ""){
document.write("Hello, "+document.cookie.split("=")[1])
}

</script></h1>
</BODY>
</HTML>



function getCookie(NameOfCookie)
{

// First we check to see if there is a cookie stored.
// Otherwise the length of document.cookie would be zero.

if (document.cookie.length > 0)
{

// Second we check to see if the cookie's name is stored in the
// "document.cookie" object for the page.

// Since more than one cookie can be set on a
// single page it is possible that our cookie
// is not present, even though the "document.cookie" object
// is not just an empty text.
// If our cookie name is not present the value -1 is stored
// in the variable called "begin".

begin = document.cookie.indexOf(NameOfCookie+"=");
if (begin != -1) // Note: != means "is not equal to"
{

// Our cookie was set.
// The value stored in the cookie is returned from the function.

begin += NameOfCookie.length+1;
end = document.cookie.indexOf(";", begin);
if (end == -1) end = document.cookie.length;
return unescape(document.cookie.substring(begin, end)); }
}
return null;

// Our cookie was not set.
// The value "null" is returned from the function.

}

function setCookie(NameOfCookie, value, expiredays)
{

// Three variables are used to set the new cookie.
// The name of the cookie, the value to be stored,
// and finally the number of days until the cookie expires.
// The first lines in the function convert
// the number of days to a valid date.

var ExpireDate = new Date ();
ExpireDate.setTime(ExpireDate.getTime() + (expiredays * 24 * 3600 * 1000));

// The next line stores the cookie, simply by assigning
// the values to the "document.cookie" object.
// Note the date is converted to Greenwich Mean time using
// the "toGMTstring()" function.

document.cookie = NameOfCookie + "=" + escape(value) +
((expiredays == null) ? "" : "; expires=" + ExpireDate.toGMTString());
}


function delCookie (NameOfCookie)
{

// The function simply checks to see if the cookie is set.
// If so, the expiration date is set to Jan. 1st 1970.

if (getCookie(NameOfCookie)) {
document.cookie = NameOfCookie + "=" +
"; expires=Thu, 01-Jan-70 00:00:01 GMT";
}
}



<FORM NAME="LoginForm" METHOD=POST ACTION="urlToInvoke">  <P>User name: <INPUT TYPE="text" NAME="userName" SIZE="10">  <P>Password: <INPUT TYPE="password" NAME="password" SIZE="12" VALUE="treasure">  <INPUT TYPE="hidden" NAME="DefaultPass" VALUE="treasure">  <P><INPUT TYPE="submit" VALUE="Log in">  <INPUT TYPE="button" VALUE="Cancel" onClick="window.close()"> </form>

*/


