/*

  Convenience wrapper for swipl's httpd

  Provides     web_server_start/0      - start serving
               web_server_wait/0       - do nothing but serve
               web_server_run/0        - both of the above....
               web_server_stop/0       - stop serving, called
                                         automatically on sigterm/hup

  Uses "port" from app_config/2 as the port number; otherwise makes one up.
  
  You should define some pages with (in module "user"):
  
     web_server_page(FirstPathSegment) or
     web_server_page(FirstPathSegment, Handler)

  The Handler is passed an option list with various information and
  should out the content type header and the materials.  It can throw
  things like:
  	http_reply(not_found(Filename)),
  and 
        http_reply(303, NewAddress)
  if doesn't want to provide a "200 OK" reponse.

  The default handler uses the FirstPathSegment as the name of an html
  serialization function.  So
      web_server_page(foo)
  means access to http://example.org/foo will turn into calls to
      foo(Q, H)
  where H is the returned HTML.

  The default (top, main) page is provided via
      web_server_page('', CustomHandler)

  example:
   [peer(ip(128, 30, 55, 11)),
    input($stream(284822)),
    method(get),
    path(/foo),
    http_version(1-1),
    host(burns.w3.org),
    port(8080),
    user_agent(Mozilla/5.0 (X11; U; Linux i686; en-US; rv:1.7.10) Gecko/20050925 Firefox/1.0.4 (Debian package 1.0.4-2sarge5)),
    accept(text/xml,application/xml,application/xhtml+xml,text/html;q=0.9,text/plain;q=0.8,image/png,<star>/<star>;q=0.5),
    accept_language(en-us,en;q=0.5),
    accept_encoding(gzip,deflate),
    accept_charset(ISO-8859-1,utf-8;q=0.7,*;q=0.7),
    keep_alive(300),
    connection(keep-alive),
    cookie([absence_stuff=group_id&4&chunksize&6&mult&0])
   ]

  
*/

:- module(web_server,
	  [web_server_start/0,
	   web_server_wait/0,
	   web_server_run/0,
	   web_server_stop/0
	  ]).

% :- ensure_loaded(log).
% :- ensure_loaded(thread_util).
thread_set_state(_).
thread_state_call(X) :- X.
log_term(_,_).
log_term(_).
log_message(_,_).

:- multifile user:web_server_page/1.
:- multifile user:web_server_page/2.

:- ensure_loaded(app_config).
:- ensure_loaded(html).

multi_dynamic(Predicate) :-
        dynamic(Predicate),
        multifile(Predicate).

:- multi_dynamic(app_config/2).
:- multi_dynamic(server_down/1).

% pick one httpd; "thread" is used in production, but xpce can make
% some debugging/tracing easier.
:- ensure_loaded(library('http/thread_httpd')).
% :- ensure_loaded(library('http/xpce_httpd')).   
:- ensure_loaded(library(unix)).


web_server_run :-
	web_server_start,
	web_server_wait.

web_server_start :-
	(   app_config(port, PortAtom)
	->  true
	;   PortAtom = '8080'
	),
	(   PortAtom=auto
	->  true
	;   atom_number(PortAtom, Port),
	    print_message(informational,
			  format('starting server on port ~w...', [Port]))
	),
	between(1,100,_X),
	(   catch(
		  http_server(reply_stage_0, [port(Port), workers(8), timeout(10), local(32768), global(32768), trail(4096), arg(1024), stack(1024)]),
		  Err,
		  ( print_message(error, format('server startup error: ~q', Err)),
		      fail
		  )
		 )
	->  true
	;   print_message(warning, format('server failed; sleep and retry...', [Port])),
	    sleep(1),
	    fail
	),
	print_message(informational,
		      format('server ready on port ~a', [Port])),
	atom_number(NewPortAtom, Port),
	retractall(app_config(port, _)),
	assert(app_config(port, NewPortAtom)),
	catch_signals.


catch_signals :-
	on_signal(term, _, web_server_stop),  % perhaps redundant
	on_signal(usr1, _, web_server_stop),
	on_signal(hup, _, web_server_stop).
	
web_server_wait :-
	% catch_signals,
	%print_message(informational,
	%	      format('waiting for shutdown signal (sigUSR1)', [])),
	thread_get_message(quit).

web_server_stop :-
	app_config(port, PortAtom),
	atom_number(PortAtom, Port),
	print_message(informational,
		      format('shutting down port ~a service in response to signal', [Port])),
	http_workers(Port, 0),
	get_time(Start),
	(   between(1, 100, Count),
	    http_workers(Port, W),
	    sleep(0.05),
	    get_time(Now),
	    Dur is Now - Start,
	    (   W=0
	    ->  print_message(informational,
			      format('all workers gone (t=~a sec); normal shutdown', [Dur])),
		halt
	    ;   true
	    ),
	    print_message(informational,
			  format('round ~a: ~w workers after ~a sec...', [Count, W, Dur])),
	    fail
	;   http_workers(Port, W),
	    print_message(informational,
			  format('~w workers remain; halting anyway', [W])),
	    halt
	).



:- dynamic req_start_stats/3.
:- multifile req_start_stats/3.
reply_stage_0(X) :-
	(   server_down(Message)
        ->  Head = [ title('temporary error') ],
	    Body = [h2(Message), p(+serverStatusLine)],
	    format('Content-type: text/html~n~n', []),
            write_html(html(head(Head), body(Body)))
	;   %thread_state_call(reload_program_if_safe),
	    thread_set_state(generating_reply),
	    reply_stage_1(X),
	    thread_set_state(transmit_and_wait)
	).


reply_stage_1(Req) :-
	% print_message(informational, format('~q', [Req])),
	% reject_certain_robots(Req),
	detect_fast_clients(Req),   %  really, this should not apply to static
	%generate_request_uri(ReqId, N),
	gensym(foo, ReqId),
	get_time(StartTime),
	thread_self(Thread),
	thread_statistics(Thread, cputime, CPUStartTime),
	assert(req_start_stats(ReqId, StartTime, CPUStartTime)),
	debug(reply, 'Request ~a: ~q', [ReqId, Req]),
	log_term(http_trace, start(ReqId, StartTime, Thread, Req)),
	%
	% we'll *try* to notice something going wrong and log it and
	% apologize, but some things (like Undefined Procedure) don't
	% get reported back to us.   Bug.  Why is that, even with
	% current_prolog_flag(unknown, error)?   Maybe it's happening
	% in another module?
	%
	catch((	  reply_stage_2(Req, ReqId)
	      ->  Status=okay
	      ;   Status=failed
	      ),
	      Error,
	      copy_term(error(Error), Status)
	     ),
	get_time(EndTime),
	Dur is EndTime-StartTime,
	%thread_statistics(Thread, cputime, CPUEndTime),
	%assert(req_end_stats(ReqId, StartTime, CPUStartTime)),
	%print_message(informational, http(Status, Req, ReqId, N, StartTime, EndTime)),
	log_message(access, http(Status, Req, ReqId, N, StartTime, EndTime)),
	(   (   Status=okay
	    ;   Error = http_reply(_)
	    )
	->  true
	;   % throw(http_reply(not_found(filename_not_accessible)))
	    write_error_page(ReqId, Status),
	    gensym(req_err_, ReqErr),
	    assert(( ReqErr :- possible_reply(Req, ReqId) )),
	    print_message(error, format('ReqErr function ~q asserted', ReqErr)),
	    log_term(http_error,  error(ReqId, Status, Req)),
	    log_term(http_error_retry,
		     (ReqErr :- possible_reply(Req, ReqId)) )
	),
	log_term(http_trace, stop(Dur, ReqId)),
	% thread_high_water(HW),
	% log_term(HW),
	(   ground(Error),
	    Error = http_reply(_)
	->  throw(Error)
	;   true
	).

reject_certain_robots(Req) :-      % quick hack!
	(   memberchk(user_agent(UA), Req),
	    ( UA = 'Mozilla/5.0 (compatible; Googlebot/2.1; +http://www.google.com/bot.html)'
	    ; UA = 'W3C-gsa (Enterprise; GED-00155; team-syslog@w3.org)'
	    )
	->  thread_set_state(told_off_bot),
	    throw(http_reply(not_found(x)))
	; true
	).

client_ip(Req, IP) :-
	 memberchk(x_forwarded_for(IP), Req).
client_ip(Req, IP) :-
	 memberchk(x_fwd_ip_addr(IP), Req).
client_ip(Req, IP) :-
	 /* Need a mod to thread_httpd:server_loop/5 so it puts
         peer(Peer) into the Request list somehow. */
	 memberchk(peer(IP:_), Req).
client_ip(_, ip_not_available).
	
:- multi_dynamic(client_ip_last_request_time/2).
:- multi_dynamic(client_ip_last_idle_period/2).
:- thread_local(my_client_is_fast/0).
:- multi_dynamic(recently_fast_client/1).

%%  detect_fast_clients(+Req)
%%
%%  @@ ONLY WORKS WHEN PROXIED -- see note above on client_ip/2.
%%
%%  assert/retract thread_local predicate my_client_is_fast/0 based
%%  on how close together requests are coming.   Fast clients are
%%  probably robots of some sort.
%%
%%  Of course "fast clients" might also be many users NAT'd onto one IP
%%  address or something, but....   there's no way to tell that a
%%  robot can't get around.    Hrm.
%%
%%  We should perhaps have a harvest throttle, where we lose interest
%%  in harvesting if you're asking for too much.
%%


detect_fast_clients(Req) :-
	with_mutex(detect_fast_clients_mutex,
		   unsafe_detect_fast_clients(Req)).

unsafe_detect_fast_clients(Req) :-
	get_time(Now),
	client_ip(Req, IP),
	retractall(my_client_is_fast),
	(   retract(client_ip_last_request_time(IP, LastTime))
	->  ThisIdle is Now - LastTime,
	    debug(fast_client, 'fast_client: ThisIdle=~w', [ThisIdle]),
	    (   retract(client_ip_last_idle_period(IP, LastIdle))
	    ->  AvgIdle is (ThisIdle + LastIdle) / 2,
		debug(fast_client, 'fast_client: AvgIdle=~w', [AvgIdle]),
		(   recently_fast_client(IP)
		->  Threshhold = 5    % > 5 sec/page to clear your name 
		;   Threshhold = 1    % < 1 sec/page to be tagged "fast"
		),
		debug(fast_client, 'fast_client: Threshhold=~w', [Threshhold]),
		(   AvgIdle < Threshhold
		->  assert(my_client_is_fast),
		    debug(fast_client, 'fast_client: yes!', [])
		    %    not safe while holding mutex - possible deadlock
		    % log_term(fast_client, fast_client(IP, AvgIdle, ThisIdle, LastIdle, Now)),
		;   true
		)
	    ;   true
	    ),
	    assert(client_ip_last_idle_period(IP, ThisIdle))
	;   true
	),
	assert(client_ip_last_request_time(IP, Now)),
	retractall(recently_fast_client(IP)),
	(   my_client_is_fast
	->  assert(recently_fast_client(IP))
	;   true
	).
	    
	
generate_request_uri(ReqId, N) :-     % 6 usec
	flag(request, N, N+1),
	flag(aboutThisRun, Run, Run),
	atom_number(AtomN, N),
	atom_concat('request_', AtomN, Local),
	rdfpage_sub_uri(Run, Local, ReqId).

:- dynamic sent_content_type/1.

ensure_content_type_sent(ReqId, Type) :-
	(   sent_content_type(ReqId)
	->  true
	;   format('Content-type: ~a~n~n', [Type]),
	    debug(replyct, 'sent ~a', [ReqId]),
	    assert(sent_content_type(ReqId))
	).


% shim to allow non +foo BodyPart, without changing all the callers.
write_page(ReqId, BodyPart, Focus) :-
	(   % if new style (+foo or [foo])
	    (   BodyPart = +_
	    ;   BodyPart = [_|_]
	    )
	-> write_page2(ReqId, BodyPart, Focus)
	;  write_page2(ReqId, +BodyPart, Focus)
	),
	!.
write_page(A,B,C) :-
	throw(failed(write_page(A,B,C))).

% new form taking Q instead of ReqId as first arg
write_pageq(_Q, H) :-
	(   H = []
	->  true
	;   memberchk(request_id(ReqId), Q),
	    ensure_content_type_sent(ReqId, 'text/html'),
	    telling(S),
            % set_stream(S, encoding(utf8)), % set a header field about this?
	    write_html(H)
	).


write_error_page(ReqId, Message) :-
	ensure_content_type_sent(ReqId, 'text/html'),
	( app_config(site_title, Title); Title='Site Title'),
	( app_config(release, Release); Release='0.0'), 
	term_to_atom(Message, MA),
	Head = [title([Title, ' ', Release]),
		link(rel='shortcut icon', href='static/favicon'),
		link(rel='stylesheet', href='static/base-style')
	        % we could us BodyPart as the name of a sub-style or something
	       ],
	Body = [h2('Sorry, an internal error has occured'),
		p('The error has been logged for the developers to examine.  There ',
		  'should be no need for you to do anything about it.   We apologize ',
		  'for any inconvenience this error causes you.'),
		p('For reference, the error occured during request ', ReqId),
		p('Error details: ', MA)
	    ],
	write_html(html(head(Head), body(Body))).

%%
%%   possible_reply(+Req, +ReqId)
%%
%%   write some html out for this reply.    written as a whole
%%   bunch of cascading possibility.   some of the logic for
%%   accepting the request is here; some is in sub-goals.  Oh
%%   well.
%%

% this first branch is my new style, but it's not widely used yet.  At
% some point the others should be converted.


user:web_server_page(PathSegment1, web_server_page_default_handler) :-
	user:web_server_page(PathSegment1).

web_server_page_default_handler(Q) :-
	memberchk(first_path_segment(PathSegment1), Q),
	View = PathSegment1,
	ViewQ =.. [View, Q],
	write_pageq(Q, +ViewQ).

reply_stage_2(Req, ReqId) :-
	member(path(Path), Req),
        concat_atom(['', PathSegment1 | _], '/', Path),
	Q =  [request_id(ReqId), first_path_segment(PathSegment1) | Req],
	debug(reply, 'trying path-segment-1=~q', [PathSegment1]),
	(   user:web_server_page(PathSegment1, Handler)
	->  debug(reply, '... Match!   Calling Handler ~q', [Handler]),
	    call(Handler, Q)
	;   debug(reply, '... No Match!   Sending 404', []),
	    ensure_content_type_sent(ReqId, 'text/html'),
	    throw(http_reply(not_found(Path)))
	    % throw(http_reply(not_found(PathSegment))),
	).

% handle POST separately?
% 
possible_reply(Req, _ReqId) :-
	member(method(post), Req),
	member(path(X), Req),
        concat_atom(['', PathSegment1 | _], '/', X),
	PathSegment1 = 'refresh',
	debug(refresh, 'refresh', []),
	http_read_data(Req, Data, []),
	debug(refresh, 'Data: ~q', [Data]),
	memberchk(address=Address, Data),
	memberchk(focus=Focus, Data),
	debug(refresh, 'refresh - webload ~a', [Address]),
	webload(Address, [priority(2), max_age(1), wait(1), retrieval(Ret)]),
	debug(refresh, 'retrieval: ~q', [Ret]),
	self_uri(basic, [focus=Focus, retrieval=Ret], [], To),
	debug(refresh, 'refresh throwing...', [To]),
	throw(http_reply(moved(To))).
	

%possible_reply(Req, ReqId) :-
%	hosting_reply(Req, ReqId).
possible_reply(Req, _ReqId) :-
	member(path(X), Req),
        concat_atom(['/diag', _], X),
        !,
	diagnostic_reply(Req).
possible_reply(Req, ReqId) :-
	member(path('/'), Req),
	!,
	thread_set_state(generating_home_page),
	write_page(ReqId, homeBody(Req), '').
possible_reply(Req, _ReqId) :-
	owned_term_reply(Req).
possible_reply(Req, ReqId) :-
	basic_reply_1(Req, ReqId).
possible_reply(Req, _ReqId) :- 
	member(path('/up'), Req),
	format('Content-type: text/plain~n~n', []),
	semwalker_start_time(T),
	convert_time(T, TA),
	current_prolog_flag(pid, PID),
	format('SemWalker running, pid ~a, started ~a~n',
	       [PID, TA]).
possible_reply(Req, ReqId) :- 
	member(path('/submit'), Req),
	!,
	thread_set_state(submit),
	handle_submit(Req, ReqId).
possible_reply(Req, _ReqId) :-
	member(path(X), Req),
        concat_atom(['/static/', File], X),
        !,
	thread_set_state(static_reply),
	( serve(File) ; throw(static_failed) ), !.
possible_reply(_Req, ReqId) :-
	write_page(ReqId, [h2('Bad site URI.  Kinda like a 404, really.')], '').


:- multifile web_server_predicate/2.

%:-multifile '$messages':translate_message/3.
%'$messages':translate_message(foo, _, _) :-
%     print_message(error, format('*** xxxx', [])).




owned_term_reply(Request) :-
	member(path(X), Request),

	% this is just until rdfpage gets better at recognizing its own pages,
	% or has some proper "groups" implementation
	sub_atom(X, 0, _, _, '/page/'),
	
	app_config(site_uri, SiteURI),
	(   sub_atom(X, 0, 1, _, '/')
	->  sub_atom(X, 1, _, 0, NoSlash)
	;   NoSlash = X
	),
	concat_atom([SiteURI, NoSlash], Full),
	debug(reply, 'M? ~a', [Full]),
	rdfpage_uri(Full),
	debug(reply, 'Sending RDF/XML for ~a', [Full]),
	telling(Stream),
	format('Content-type: application/rdf+xml~n~n', []),
	rdfpage_write(Full, Stream),
	debug(reply, 'Sent RDF/XML for ~a', [Full]).


diagnostic_reply(Request) :-
	debug(reply, diag, []),
	format('Content-type: text/html~n~n', []),
	format('<html>~n', []),
	flag(request, RN, RN),
	write('<h2>Diagnostic Page 17</h3>'),
        write(RN),
        write('-times'),
	format('<table border=1>~n'),
	print_request(Request),
	format('~n</table>~n'),
	format('</html>~n', []).


print_request([]).
print_request([H|T]) :-
	H =.. [Name, Value],
	format('<tr><td>~w<td>~w~n', [Name, Value]),
	print_request(T).


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%
%%    Reify the Request?
%%
%%    Nice for implementing views as RDF Rules; maybe
%%    better performance
%%
%%    We'd still need "Q" in the views for backtrackable
%%    source tracking, I think.
%%

/*
% several of these should have something smarter than 'literal' here,
% something which decodes the values....	
option_name_URI(http_request, input, _, ignore).
option_name_URI(http_request, method, sw:method, literal).
option_name_URI(http_request, path, sw:path, literal).
option_name_URI(http_request, search, sw:search, uri).
option_name_URI(http_request, host, sw:host, literal).
option_name_URI(http_request, user_agent, sw:user_agent, literal).
option_name_URI(http_request, accept, sw:accept, literal).
option_name_URI(http_request, accept_language, sw:accept_language, literal).
option_name_URI(http_request, accept_encoding, sw:accept_encoding, literal).
option_name_URI(http_request, accept_charset, sw:accept_charset, literal).
option_name_URI(http_request, keep_alive, _, ignore).
option_name_URI(http_request, connection, _, ignore).
option_name_URI(http_request, http_version, _, ignore).
option_name_URI(http_request, referer, sw:referer, literal).
option_name_URI(http_request, pragma, sw:pramga, literal).
option_name_URI(http_request, cache_control, sw:cacheControl, literal).
% just ignore the others; maybe we should do something smarter with them?
option_name_URI(http_request, _, _, ignore).

assert_and_deduce_reply(Request, ReqId) :-
	/*
	gensym('blank ', ReqURI),
	% print_message(error, re(Request)),
	rdf_describe_from_options_list(http_request, Request, ReqURI, Triples),
	get_time(Now),
	% get peer name,...?
	triplesToInserts(Triples, Inserts),
	rx(anchor((
		   insert(ReqURI, rdf:type, sw:'Request'),
		   insert(ReqURI, sw:begins, time(Now)),
		   Inserts
		  ), 0)),
	debug(reply, 'Handling request ~a', [ReqURI]),
	/*
	%debug(reply, request_described_as(Triples)),

	do this in tabs?
	
	rxxm((match(Pred, , ),
	     match(ReqURI, Pred, xml_literal(XTree)),
	writexml(XTree)
	    .
	    

	response(ReqURI, XTree),    % this is CLOSE to being an rdf predicate
	xml_wrote(XTree).
	*/
	*/
	basic_reply_1(Request, ReqId).    % still here for now.

*/
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%





/*

  turn  QueryParms     foo=bar
        into Q         foo(bar)
  for safety, type conversion, etc.
*/

basic_reply_1(Request, ReqId) :-
	(  memberchk(path('/basic'), Request)
	;  memberchk(path('/view'), Request)
	),
	!,
	thread_set_state(basic_reply_startup),
	memberchk(search(QueryParms), Request),
	memberchk(focus=Focus, QueryParms),
	(   memberchk(stacking=RawStacking, QueryParms)
	->  concat_atom(Stacking, ',', RawStacking)
	;   Stacking=[],
	    RawStacking=''
	),
	(   memberchk(timeout=TimeoutAtom, QueryParms)
	->  atom_number(TimeoutAtom, Timeout),
	    (Timeout =< 120)
	;   Timeout = 0.5
	),
	(   memberchk(starting=StartingAtom, QueryParms)
	->  atom_number(StartingAtom, Starting)
	;   Starting=1
	),
	(   memberchk(refresh=_, QueryParms)
	->  HarvestOptions=[max_age(1)]
	;   HarvestOptions=[]
	),
	debug(reply, 'its a basic page, focussed on ~q', Focus),
	% we could bundle in the Request   |Request   if we wanted....
	basic_reply_2([focus=Focus, timeout(Timeout), stacking=RawStacking, stacking(Stacking), starting(Starting), harvest_options(HarvestOptions)], ReqId).

basic_reply_2(Q, ReqId) :-
	member(focus=Focus, Q),
	member(timeout(Timeout), Q),
	flag(basic_page_request, N, N+1),
	focus_flags(Focus, FocusFlags),
	debug(reply, 'FocusFlags: ~q', [FocusFlags]),
	%   hrm-- icky icky code
	(   memberchk(load(Address), FocusFlags),
	    \+rdfpage_uri(Address)
	->  memberchk(harvest_options(HarvestOptions), Q),
	    memberchk(timeout(Timeout), Q),
	    thread_state_call(webload(Address, [wait(Timeout), priority(2), retrieval(RR) | HarvestOptions])),
	    writeq(user_error, webload(Address, [wait(Timeout), priority(2), retrieval(RR) | HarvestOptions])),
	    !,  % hrm.
	    log_term(webload, webload(Address))
	;   true
	),
	(   member(prefix_alone(Prefix), FocusFlags),
	    rdf_db:ns(Prefix, Long)
	->  RealQ = [focus=Long | Q]
	;   RealQ = Q
	),
	(   member(qname(Prefix, Suffix), FocusFlags),
	    rdf_db:ns(Prefix, Long),
	    atom_concat(Long, Suffix, Joined)
	->  RealQ2 = [focus=Joined | RealQ]
	;   RealQ2 = RealQ
	),
	debug(reply, 'Q: ~q', [RealQ2]),
	(   member(multiple, FocusFlags)
	->  (   search_reply(Q, ReqId, Focus, FocusFlags)
	    ->  true
	    ;   throw(search_reply_failed)
	    )
	;   thread_set_state(write_basic_page),
	    write_basic_page(RealQ2, ReqId)
	).



siteHead(Focus, H) :-
	app_config(site_title, Title),
	H=div(class=siteHead,
	      h1(class=siteTitle,
		 a(href='http://www.w3.org/', border='0',
		   img(class=siteTitle1, border='0',
		       src='http://www.w3.org/Icons/WWW/w3c_home')
		  ),
		 %'&nbsp;',
		 %a(href='.',
		 %  img(class=siteTitle1, border='0',
		 %      src='http://www.w3.org/2004/05/ontaria-alpha/static/ontaria-bg-48')),
                 %'&nbsp;'  %,
		 a(class=siteTitle2,
		   href='.', Title)
		),
	      div(class=siteControls,
		  a(href='.', 'Home'),
		  a(href='http://projects.semwebcentral.org/forum/?group_id=59', 'Feedback'),
		  a(href='static/help', 'Help')
		 ),
	      +search_form(Focus)
	     ).

siteFoot(ReqID, H) :-
	get_time(Now),
	req_start_stats(ReqID, Start, _StartCPU),
	Time is Now - Start,
	%thread_self(Thread),
	%thread_statistics(Thread, cputime, NowCPU),
	%CPUTime is NowCPU - StartCPU,
	H=div(class=siteFoot,
	      p('Ontaria is an experimental service of the ',
		a(href='http://www.w3.org/', 'World Wide Web Consortium'),
		' as part of the ',
		a(href='http://www.w3.org/2000/01/sw/#daml', 'MIT/CSAIL DAML Project'),
		' under MIT/AFRL cooperative agreement number F30602-00-2-0593.   See ', a(href='static/about', 'about Ontaria')),
	      % p('This site brought to you by the letters W, W, and W.   (Financial support from DARPA.)'),
	      p('Page constructed in ',
	      float(Time,4), ' seconds.'),
	      +if(my_client_is_fast, '  You seem to be loading pages faster than one page per second, so certain slow operations will not be done on your behalf.   Waiting ten seconds will clear this state.')
	     %float(CPUTime,6), ' thread cpu seconds.')
	      ).



/*


http://127.0.0.1:7116/basic?focus=http%3a%2f%2fwww%2ew3%2eorg%2f2004%2f10%2ffamilies%23sister

*/




%%
%%  Write an HTTP Header and send the file, if it exists
%%  as WWW/<FileName>.{jpg,png,html,css,rdf}
%%
%%  ... or if   WWW/<FileName>.header exists, then send it
%%  first as the HTTP response header, and then send along
%%  WWW/<FileName> as the content.   The header file should
%%  at least include a Content-Type header, and may also
%%  include (eg) Cache-Control.  (That's what we want it for:
%%  cache testing.)

serve(FileName) :-
	www_file(FileName, '.headers', HeaderFileName),
	exists_file(HeaderFileName),
	!,
	www_file(FileName, '', FullFileName),
	telling(Telling), 
        open(HeaderFileName, read, Stream1, [type(binary)]),
        copy_stream_data(Stream1, Telling),
	close(Stream1),
	format('~n', []),
        open(FullFileName, read, Stream2, [type(binary)]),
        copy_stream_data(Stream2, Telling),
	close(Stream2).
serve(FileName) :-
	% suffix not given
	mime_type(Suffix, ContentType),
	www_file(FileName, Suffix, FullFileName),
	send_file(FullFileName, ContentType).
serve(FileName) :-
	% suffix given
	mime_type(GivenSuffix, ContentType),
	atom_concat(Prefix, GivenSuffix, FileName),
	mime_type(FoundSuffix, ContentType),
	www_file(Prefix, FoundSuffix, FullFileName),
	send_file(FullFileName, ContentType).
serve(FileName) :-
	www_file(FileName, '.*', FullFileName),
	print_message(informational, format('Nothing like ~q', [FullFileName])),
	send_404(FileName).

% should perhaps come from /etc/mime.types...
mime_type('.jpg', 'image/jpeg').
mime_type('.gif', 'image/gif').
mime_type('.png', 'image/png').
mime_type('.html', 'text/html').
mime_type('.css', 'text/css').
mime_type('.rdf', 'application/rdf+xml').



%%
%%  ... do the work of serve/1; prolog-fail if no such file
%%  so that serve/1 will backtrack and try another.
%%
send_file(FullFileName, ContentType) :-
	exists_file(FullFileName),
	!,  % we're committed; don't try to backtrack to another media type!
        open(FullFileName, read, Stream, [type(binary)]),
	get_time(Now),   % want it in GMT!
	ExpiresTime is Now + 186400, % go long for now -- no timezone support!
	http_header:rfc_date(ExpiresTime, Codes, ""),
	atom_codes(Expires, Codes),
	time_file(FullFileName, LastModTime),
	http_header:rfc_date(LastModTime, LMCodes, ""),
	atom_codes(LM, LMCodes),
        format('Content-Type: ~a~nExpires: ~a GMT~nLast-Modified: ~a GMT~n~n', [ContentType, Expires, LM]),
        %format('Content-Type: ~a~nCache-Control: max-age=3600~nExpires: ~a GMT~nLast-Modified: ~a GMT~n~n', [ContentType, Expires, LM]), %format('Content-Type: ~a~nExpires: Wed, 22 Jul 2004 20:16:01 GMT~nLast-Modified: Tue, 21 Jul 2004 20:30:44~n~n', [ContentType, Expires]),
        telling(Telling),
        copy_stream_data(Stream, Telling),
	close(Stream).

send_404(Filename) :-
	% to really return a 404, we'll need http_wrapper to let us
	% get this through to http_reply.  Sigh.   Temp Hack (error 500,
	% probably, not 404.)
	%    throw(http_reply(server_error(foo2))).
	throw(http_reply(not_found(Filename))).
	
