/* Module 'newsHTML' - by iri : http://www.irizone.net */
/* version 1.0 - juillet 2004 - copyleft iri           */

typeof head  = S;;
typeof foot  = S;;
typeof body  = S;;
typeof msg   = [S r1];;
typeof lbody = [S r1];;
typeof url      = S;;
typeof pathdate = S;;
typeof pathnews = S;;
  
defcom Cnews      = news S;;
defcom Copen      = open S;;
defcom CaddC      = addC S S;;
defcom CopenAdmin = openAdmin;;


/*
  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"*/url::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
  };_showconsole;_DMSevent this "url" http_url nil; req;;
    
/* 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 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 -> [port server] in
  (set http_svr = server;
   set http_port = port)
;;




fun html()=
  let strcatn
      "<html>"::
      "<head>\n<title>"::
      head::
      "</title>\n<meta http-equiv="::
      "Content-Type"::
      "content="::
      "text/html; charset=iso-8859-1"::
      ">\n</head>\n\<body "::
      body::
      ">\n"::
      (
       let 0 -> i in
       let "" -> s in
       (while i < (sizelist msg) do
          (set s = strcat strcat s nth_list msg i "<br>\n";
           set i = i+1);
        s))::
      "<br>"::
      (strcatn "<a href='"::foot::"'>"::foot::"</a>"::nil)::
      "</body></html>"::
      nil
              -> content in
  _storepack content pathnews;;
  
fun cbOpen (from, action, param, others, tag)=
/*  _on _masterchannel Copen [url];*/
/*  _openbrowserhttp strcatn "file://d:\\scol\\cache\\24bf645250ac2805"::url::nil;*/
  
  _openbrowserhttp strcatn "http://localhost"::(itoa http_port)::url::nil;
/*  _DMSevent this "url" http_url nil;*/
  _DMSevent this "shown" nil nil;;

fun cbEdit (from, action, param, others, tag)=
  _DMSsend this CopenAdmin [];;  

fun cbClose()=
  closeHTTPserver http_svr;;
  
fun IniDMI(param)=
  set url = strcatn /*"http://"::"127.0.0.1"::*/"/tmp/newshtml/"::(strlowercase DMSname)::".html"::nil;
  set pathnews = strcatn "tmp/newshtml/"::(strlowercase DMSname)::".html"::nil;
  set pathdate = strcatn "tmp/newshtml/"::(strlowercase DMSname)::".date"::nil;
  let lineextr param -> [Phead[Pfoot[Pbgcolor[Ptext[Plink[Pvlink[Palink _]]]]]]] in
  (
   set head = Phead;
   set foot = Pfoot;
   set body = strcatn "bgcolor=\""::(itoh atoi Pbgcolor)::"\" text=\""::(itoh atoi Ptext)::"\" link=\""::(itoh atoi Plink)::"\" vlink=\""::(itoh atoi Pvlink)::"\" alink=\""::(itoh atoi Palink)::"\""::nil;
   set lbody = Pbgcolor::Ptext::Plink::Pvlink::Palink::nil;
   if head == nil then
     set head = strcat DMSname " last news"
   else
     nil;
   _DMSsend this Cnews [_getpack _checkpack pathdate];
   let gmtime time -> [_ _ _ d m y _ _] in
   _storepack strcatn "["::(itoa d)::":"::(itoa m)::":"::(itoa y)::"]"::nil pathdate;
   _DMSdefineActions this ["show" @cbOpen]::
                          ["edit" @cbEdit]::
                          nil;
   _DMSregister this @cbClose;
  );
  _IniHelp;
  0;;        
  
fun __news(s)=
  set msg = lineextr s;
  html;;

/* fun [S] I */
fun cbEndAdd(s, m)=
  if s == nil then
    nil                                     /* changement non validé */
  else
    _DMSsend this CaddC [zip s zip m];;     /* changement validé (bouton OK) */
    
fun getSetting(file)=
  linebuild head::foot::(linebuild lbody)::file::nil;;
    
fun __editOk(file, content)=
  iniWinAdmin _channel DMSwin nil nil 430 260 "News - Settings" @cbEndAdd getSetting file content 0;;