/*
  HTTP server 1.0 - May 1999 - by Vincent CARON
  SCS gestion des help HTML des modules - Nov 1999 - by Patrice FAVRE
  adapted for SCS 2 - Jul 2000 
*/

typeof http_clid =S;;			/* client identification */
typeof http_svr  =HTTPserver;;
typeof http_url  =S;;     /* requested url */
typeof http_path =S;;     /* requested file path */
typeof http_cgi  =S;;     /* CGI parameters (GET & POST) */
typeof http_com  =S;;     /* HTTP command */
typeof http_len  =I;;     /* post data bytes counter */
typeof http_host =S;;     /* host name */
var    http_port =80;;
var    http_id   ="SCOL HTTP server plugin v1.0";;
var    http_root ="";;
var    http_err  ="/Dms/Scs/help/code";;

var HTTP_DEFAULT="index.html";;

var MIME_TYPES=["htm" "text/html"]::["html" "text/html"]::
  ["gif"  "image/gif"]::
  ["jpg"  "image/jpeg"]::
  ["png"  "image/png"]::
  ["txt"  "text/plain"]::
  ["mpg"  "video/mpeg"]::
  ["mpeg" "video/mpeg"]::
  ["avi"  "video/x-ms-video"]::
  ["mov"  "video/quicktime"]::
  ["au"   "audio/basic"]::
  ["wav"  "audio/x-wav"]::
  ["mid"  "audio/mid"]::
  ["mp3"  "audio/x-mpeg"]::
  ["ra"   "audio/x-pn-realaudio"]::
  ["ram"  "audio/x-pn-realaudio"]::nil;;

fun file_extension(fname)=
  let strfind "." fname 0 -> pos in
  if (pos==nil) then fname else
    file_extension substr fname pos+1 (strlen fname)-pos-1;;

fun http_codestr(code)=
  if (code==200) then "OK" else
  if (code==301) then "Moved permanently" else
  if (code==302) then "Moved temporarily" else
  if (code==400) then "Bad request" else
  if (code==404) then "Not found" else
  if (code==501) then "Not implemented" else
  "";;

fun _mimetype(l,ext)=
  if (l==nil) then "applicaton/x-unknown" else
    let l -> [_head _tail] in
    let _head -> [lext ltype] in
    if (!strcmpi ext lext) then ltype else
      _mimetype _tail ext;;

fun mimetype(fname)=
  _mimetype MIME_TYPES file_extension fname;;


/*
  compose the HTTP answer header
*/
fun http_header(code,data)=
  strcatn "HTTP/1.0 "::(itoa code)::" "::(http_codestr code)::"\13\10"::
          "Server: "::http_id::"\13\10"::
  {
    if ((code==301) || (code==302)) then
      strcat "Location: " http_url
    else
      strcatn "Content-Type: "::(mimetype http_path)::"\13\10"::
              "Content-Length: "::(itoa strlen data)::nil;
  }
  ::"\13\10\13\10"::nil;;


/*
  returns HTTP error with HTML code if available
*/
fun http_error(code)=
  set http_path=strcatn http_root::http_err::(itoa code)::".html"::nil;
  let _getpack _checkpack http_path -> html in
    strcat (http_header code html) html;;


/*
  the main job !
*/
fun http_fetch()=
  set http_path=strcat http_root http_url;
  let _checkpack http_path -> file in
  {
    if (file==nil) then
    {
      /* maybe a folder ? */
      set file=_checkpack (strcatn http_path::"/"::HTTP_DEFAULT::nil);
      if (file==nil) then
        /* nope, so file not found */
        http_error 404
      else
      {
        /* yep, this is a folder, send redirection to browser */
        set http_url=strcat http_url "/";
        http_header 302 nil;
      }
    }
    else
      /* retrieve file */
      let _getpack file -> data in
        strcat (http_header 200 data) data;
  };;
  


/*
  parse "COMMAND url HTTP/1.x", check URL.
*/
fun http_parse_command(words)=
  let words -> [com x] in
  let x -> [url x] in
/*  let x -> [ver _] in ... (unused) */
  {
    set http_com=com;
    if ((nth_char url 0)=='/) then nil else
    if (!strcmpi (substr url 0 7) "http://") then
    {
      /* url is (incorrectly) "http://mysite[/path]" */
      let strfind "/" url 7 -> pos in
      if (pos==nil) then
        set url="/"
      else
        set url=substr url pos (strlen url)-pos;
    }
    else
      /* invalid URL */
      set url=nil;
    /* search for cgi params */
    let strfind "?" url 0 -> pos in
    if (pos==nil) then
      set http_url=url
    else
    {
      set http_url=substr url 0 pos;
      set http_cgi=substr url (pos+1) (strlen url)-pos-1;
    };
    /* append default file name if folder */
    if ((nth_char http_url (strlen http_url)-1)=='/) then
      set http_url=strcat http_url HTTP_DEFAULT
    else nil;
  };;

/*
  parse the "param: value" lines
*/
fun http_parse_header(lines)=
  let lines -> [_head _tail] in
  if (_head==nil) then 0 else
    let _head -> [param x] in
    let linebuild x -> value in
    {
      if (!strcmpi param "Content-Length:") then
        set http_len=atoi value
      else if (!strcmpi param "Host:") then
        {set http_host=value; 0}
      else 0;
      http_parse_header _tail;
    };;


/*
  get the POST data bytes (after header)
*/
fun http_readpost(req)=
  let strfind "\13\10\13\10" req 0 -> pos in
  if (pos==nil) then
    set http_cgi=""
  else
    set http_cgi=substr req (pos+4) http_len;;


/* HTTPserver reflex */
fun http_onrequest(con,x,req)=
/*  _showconsole;
  _fooS strcat "HTTP request from " (getHTTPclientIP con); 
  _fooS req;
  let getHTTPstats http_svr -> [_cnb _in _out] in
   _fooS strcatn "stats: "::(itoa _cnb)::" "::(itoa _in)::" "::(itoa _out)::nil; */
  set http_cgi="";
  set http_len=0;
  let strextr req -> lines in
  {
    http_parse_command hd lines;
    /* check if client is local */
    if !strcmp http_clid substr http_url 1 strlen http_clid then
    {
    	set http_url=substr http_url (strlen http_clid)+1 (strlen http_url)-(strlen http_clid)-1;
    	if ((!strcmpi http_com "GET") || (!strcmpi http_com "POST")) then
    	{
      	if (http_url==nil) then
        	http_error 400
      	else
      	{
        	http_parse_header  tl lines;
        	if ((!strcmpi http_com "POST") && (http_len>0)) then
          	http_readpost req else nil;
        	/* from here, fetch the file */
        	http_fetch;
      	};
    	}
    	else
      	/* unknown command */
      	http_error 501;
     }
     else http_error 400
  };;
    
/* try to run a server testing different ports from port to port+range */
fun _RunHttpServer (port,range) =
  if range<0 then nil
  else let startHTTPserver _channel http_port @http_onrequest nil -> server in
       if server!=nil then [port server]
       else _RunHttpServer (port+1) (range-1)
;;

fun _IniHelp()=
	set http_port=1298;
	set http_root=".";
	set http_clid=substr _getlongname itoa time "" "#" 1 50;
  /* start server */
  let _RunHttpServer http_port 20 -> [_ server] in
  set http_svr = server
;;