Parts and their contents

(* mosml/examples/cgi/cgitest.sml
   Retrieve and print all fields from a CGI request.

   Peter Sestoft, 1997-05-07, 1999-04-20
 *)

open Mosmlcgi;

fun output_string(s) =          
    TextIO.output(TextIO.stdOut,"Content-type: text/html\n\n" ^ s ^ "\n\n");

fun showOpt (info, value) = 
    case value of 
	NONE   => print (info ^ " is not available\n<p>")
      | SOME s => app print [info, " = ", s, "\n<p>"]

fun prtseq (pr, sep) xs = 
    let fun h []      = ()
	  | h [x]     = pr x
	  | h (x::xr) = (pr x; print sep; h xr)
    in h xs end

fun showList (info, value) = 
    (print info; print " = "; 
     prtseq (fn s => print s, ",") value; 
     print "\n<p>")

fun adminfo () = 
    (showList ("cgi_fieldnames", cgi_fieldnames);
     showList ("cgi_partnames",  cgi_partnames);
     app showOpt 
     [("cgi_server_software",   cgi_server_software),
      ("cgi_server_name",       cgi_server_name),
      ("cgi_gateway_interface", cgi_gateway_interface),
      ("cgi_server_protocol",   cgi_server_protocol),
      ("cgi_server_port",       cgi_server_port),
      ("cgi_request_method",    cgi_request_method),
      ("cgi_http_accept",       cgi_http_accept),
      ("cgi_http_user_agent",   cgi_http_user_agent),
      ("cgi_http_referer",      cgi_http_referer),
      ("cgi_path_info",         cgi_path_info),
      ("cgi_path_translated",   cgi_path_translated),
      ("cgi_script_name",       cgi_script_name),
      ("cgi_query_string",      cgi_query_string),
      ("cgi_remote_host",       cgi_remote_host),
      ("cgi_remote_addr",       cgi_remote_addr),
      ("cgi_remote_user",       cgi_remote_user),
      ("cgi_remote_ident",      cgi_remote_ident),
      ("cgi_auth_type",         cgi_auth_type),
      ("cgi_content_type",      cgi_content_type),
      ("cgi_content_length",    cgi_content_length),
      ("cgi_annotation_server", cgi_annotation_server),
      ("cgi_http_cookie",       cgi_http_cookie),
      ("cgi_http_forwarded",    cgi_http_forwarded),
      ("cgi_http_host",         cgi_http_host),
      ("cgi_http_proxy_connection", cgi_http_proxy_connection),
      ("cgi_script_filename",   cgi_script_filename),
      ("cgi_document_root",     cgi_document_root),
      ("cgi_server_admin",      cgi_server_admin),
      ("cgi_api_version",       cgi_api_version),
      ("cgi_the_request",       cgi_the_request),
      ("cgi_request_uri",       cgi_request_uri),
      ("cgi_request_filename",  cgi_request_filename),
      ("cgi_is_subreq",         cgi_is_subreq)])
    
fun showpart name =
    let val part = valOf(cgi_part name)
    in
	print ("<H2>Part `" ^ name ^ "'</H2>\n");
	app (fn field => showOpt (field, part_field_string part field))
	    (part_fieldnames part);
	showOpt("Content type", part_type part);
	print "<P><PRE>"; print (part_data part); print "</PRE>"
    end

fun showfield field = showOpt (field, cgi_field_string field)

fun savepart name =
    let val part = valOf (cgi_part name)
    in 
	case part_field_string part "filename" of
	    NONE          => ()
	  | SOME filename => 
		let open BinIO
		    val tmpfile = "/tmp/" ^ filename
		    val os = openOut tmpfile
		in 
		    output (os, Byte.stringToBytes (part_data part));
		    closeOut os;
		    print "<p>Saving file ";
		    print tmpfile;
		    print " (";
		    print (Int.toString (size (part_data part)));
		    print " bytes)"
		end
    end

fun err s = TextIO.output(TextIO.stdErr, s);

val _ = 
    (print "Content-type: text/html\n\n";
     print "<HTML><P><BR CLEAR>";
     (case cgi_partnames of
	  [] => ()
	| _  => (print "<H1>Parts and their contents</H1>";
		 app showpart (* savepart *) cgi_partnames));
     (case cgi_fieldnames of
	  [] => ()
	| _  => (print "<H1>CGI field names and their values</H1>";
		 app showfield cgi_fieldnames));
     print "<H1>Administrative information</h1>";
     adminfo ();
     print "<P><HR>This text was generated by the mosmlcgi \
      \script testcgi.sml on ";
     print (Date.toString(Date.fromTimeLocal(Time.now())));
     print "</BODY></HTML>")
    handle exn => err "An exception occurred"