/*
  HTTP server for M3d and Texture Ressources v1.0 - April 2000 - by Jocelyn DUMAY
  october 2001 Macfly : adding box management
*/

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                                         */

/* constantes */
var    http_id      = "SCOL HTTP Ressources server plugin v1.0";;
var    http_root    = "Dms/Tools/HTTPsrvRess/";;
var    http_err     = "/error/code";;


/* server's parameters */
typeof http_port          = I;;       /*server's port*/
var    http_refpath       = "";;       /*server's path for the ressources                   */
var    http_refpath_len   = 0;;
var    http_tmp           = "";;       /*server's temp directory where are all explo files  */
var    http_bmp           = "";;       /*server's temp directory where are concat files     */
var    http_bmp_len       = 0 ;;

var    http_m3d_s         = "";;       /*server's file for m3d's tree                       */
var    http_text_s        = "";;       /*server's file for textures's tree                  */
var    http_box_s         = "";;       /*server's file for box's tree                       */

var    http_m3d_u         = "";;       /*upload's file for m3d's tree                       */
var    http_text_u        = "";;       /*upload's file for textures's tree                  */
var    http_box_u         = "";;       /*upload's file for box's tree                       */

var    http_bmpsize       = 16;;       /*server's size for bmp representation of each file  */
var    http_uploaddir     = "public";;  /*repertoire d'upload                                */
var    http_modelerlib    = "Tools/interiormodeler/lib";;
 
var    DESC_M3D_S         = "exp_m3d_srv.tmp";;
var    DESC_TEXTURE_S     = "exp_text_srv.tmp";;
var    DESC_BOX_S         = "exp_box_srv.tmp";;

var    DESC_M3D_U         = "exp_m3d_up.tmp";;  /* nom du fichier d'upload de M3D     */
var    DESC_TEXTURE_U     = "exp_text_up.tmp";; /* nom du fichier d'upload de Texture */
var    DESC_BOX_U         = "exp_box_up.tmp";;  /* nom du fichier d'upload de Box     */

var    DESC_BMPTEMP       = "bmp";;


/*************** fonctions de gestions des clients connectés ************************************/
typeof http_listid    = [I r1];;         /* id's list of users       */

fun clibyid(i,id)=
  i==id;;

fun http_add_cli(cli)=
  let _DMSgetId cli -> id in
  {
    if (search_in_list http_listid @clibyid id)==nil then 
      set http_listid=id::http_listid
    else nil;
    id
  };;
    
fun http_remove_cli(cli)=
  let _DMSgetId cli -> id in
  set http_listid=removef_from_list http_listid @clibyid id;;

/**************************** fonction de gestion des fichiers en upload sur le server ***************/
fun compExt(s1,s2)=!strcmpi s1 s2;;


fun search_last_point(s)=
  let [(strlen s)-1 0]-> [i res]in
  (
    while i>=0 && (nth_char s i)!='. do 
    set i=i-1;
    i
  )
;;

fun suppDoublon(s1,s2)=
  strcmpi s1 s2;;

/* on vérifie les extension des fichiers Uploader sur le serveur 
: UNIQUEMENT bmp,jpeg,jpg  -> pas de PKG !*/
fun filterExtension(l,ext)=
  if l==nil then 
    nil
  else
    let l -> [f nxt] in
    let search_last_point f -> i in
    if (search_in_list ext @compExt substr f i+1 (strlen f)-i-1)!=nil /*&& (_checkpack strcat f ".vig")!=nil*/ then 
      f::filterExtension nxt ext
    else 
      filterExtension nxt ext
;;

/* on créer une liste des fichiers contenu dans le repertoire public */
/* "elt"::toto.jpg::titi.jpg::nil */
fun crFiles( ref, lf) =
  if lf==nil then 
    nil
  else 
    let lf -> [f nxt] in
    let (strlen ref)+1 -> len in
    ("elt"::(substr f len (strlen f)-len)::nil)::crFiles ref nxt
;;


fun crDirectory( ref, ldir, ext) =
  if ldir==nil then 
    nil
  else 
    let ldir -> [dir nxt] in
    let (strlen ref)+1 -> len in
    let substr dir len (strlen dir)-len -> path in
    let conc crFiles dir filterExtension quicksort _listoffiles dir @suppDoublon ext
             crDirectory dir mirror quicksort _listofsubdir dir @suppDoublon ext
    -> save in
    conc if save!=nil then conc ("dir"::path::"{"::nil)::nil
                           conc save
                                ("}"::nil)::nil
         else nil                           
         crDirectory ref nxt ext
;;

fun crArborescence(f, ref, ext) =
  _storepack zip strbuild conc crFiles ref filterExtension quicksort _listoffiles ref @suppDoublon ext  
                               crDirectory ref mirror quicksort _listofsubdir ref @suppDoublon ext
             f
;;
             

/**************** fonctions de gestion des requetes http recues par le serveur ******************/
var http_header="HTTP/1.0 200 OK\13\10Server: SCOL HTTP server\13\10Content-Type: text/html\13\10\13\10";;  

var h8="00000000";;
var h4="0000";;
fun itoh8(i)= let itoh i -> s in strcat substr h8 0 8-strlen s s;;
fun itoh4(i)= let itoh i -> s in strcat substr h4 0 4-strlen s s;;

fun http_error(code)=
  let strcatn http_root::http_err::(itoa code)::".html"::nil -> error_path in
    strcat http_header _getpack _checkpack error_path;;

fun http_checkfile(file) = /* Si vignette ??? .vig */
  (!strcmpi file http_m3d_s) ||
  (!strcmpi file http_text_s)||
  (!strcmpi file http_box_s) ||
  
  (!strcmpi file http_m3d_u) ||
  (!strcmpi file http_text_u)||
  (!strcmpi file http_box_u) ||
  
  (!strcmpi (substr file 0 http_refpath_len) http_refpath)||
  (!strcmpi (substr file 0 http_bmp_len) http_bmp)||
  (!strcmpi (substr file 0 6) http_uploaddir)||
  (!strcmpi (substr file 0 25) http_modelerlib)
;;


/* parse commands and return [com url id] */
fun http_parse_command(words) =

  let words -> [com [url x]] in
  (
    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
        set url=nil; /* invalid URL */
    
    /* search for cgi params */
    let strfind "?" url 0 -> pos in
    let htoi substr url (pos+2) 8 -> lid in
    let substr url (pos+10) lid -> id in
    [com 
     substr url 0 pos 
     nth_char url (pos+1) 
     atoi substr url (pos+10) lid
     substr url (pos+10+lid) strlen url 
    ]
  )
;;

fun http_getfile(con,f)=
  let _checkpack f -> p in
  if p!=nil && http_checkfile f then 
  {
    HTTPsend con strcat strcat http_header "F" (itoh8 _fileSize p);
    HTTPsendFile con p;
    nil
  }
  else "";;


/* envoie la signature du fichier demandé au client */
fun http_getsign(con, f) =
  
  let _checkpack f -> p in
  if p!=nil && http_checkfile f then 
    let _fileSign p -> sign in
    strcatn http_header::"S"::(itoh8 _fileSize p)::(itoh8 strlen sign)::sign::nil
  else 
    ""
;;


fun crListSubDir(l) =
  if l==nil then 
    nil
  else 
    let l -> [dir nxt] in
    ("dir"::dir::nil)::crListSubDir nxt
;;
    
fun crListFiles(l) =

  if l==nil then 
    nil
  else 
    let l -> [f nxt] in
    ("file"::f::nil)::crListFiles nxt
;;
    

fun http_getdir(con, path) =
  
  if http_checkfile path then
    let zip strbuild conc crListSubDir quicksort _listofsubdir path @suppDoublon
                          crListFiles quicksort _listoffiles path @suppDoublon -> res in
    strcatn http_header::"D"::(itoh8 strlen res)::res::nil
  else 
    ""
;;


/* upload de fichiers (nouvelles ressources) d'un client vers le serveur */
fun http_upload(f, content) =
  
  if http_checkfile f then
  (
    _createpack unzip content _getmodifypack f;
    crArborescence http_m3d_u "public" "m3d"::nil;
    crArborescence http_text_u "public" "jpeg"::"jpg"::"bmp"::nil;
    crArborescence http_box_u "public" "box"::nil;
    strcat http_header "FU" /* sert pour dire au client que tout c'est bien passé au niveau
                               du serveur (tout a bien été uploadé et modifié */
  )
  else
    ""
;;
  
  
fun http_onrequest(con, x, req) =
  let http_parse_command hd strextr req -> [com url c id file] in /* on parse la requete recue */
  if (search_in_list http_listid @clibyid id)==nil then 
    ""
  else 
    if !strcmpi com "GET" then   
      if c=='S then              /* signature */
        http_getsign con file
      else 
        if c=='F then            /* fichiers */
         http_getfile con file
        else 
          if c=='D then          /* repertoire */
            http_getdir con file
          else 
            ""
    else 
      if !strcmpi com "POST" then
        if c=='U then            /* upload */
          http_upload file (substr req (4+strfind "\13\10\13\10" req 0) strlen req)
        else 
          "" 
      else 
        ""
;;


fun http_user_param(id)=
  let if !strcmpi _getress "Firewall" "strong" then _getress "FirewallPort" 
      else (itoa http_port) -> x in                           
  strbuild ("srvadr"::(strcatn "http://"::_hostIP::":"::(if x==nil then itoh4 http_port else x)::"/"::(itoh4 http_port)::"?"::nil
                      )::nil)::
           ("clientid"::(itoa id)::nil)::
           ("srvrefpath"::http_refpath::nil)::
           ("srvm3d"::http_m3d_s::nil):: 
           ("srvtext"::http_text_s::nil)::
           ("srvbox"::http_box_s::nil):: 
           ("srvm3d_u"::http_m3d_u::nil):: 
           ("srvtext_u"::http_text_u::nil)::
           ("srvbox_u"::http_box_u::nil):: 
           ("srvbmpsize"::(itoa http_bmpsize)::nil)::
           nil;;

             
fun getparam(l)=
  if (l==nil) then 0 else
  let l -> [line _tail] in
  {
    let line -> [param x] in
    let x -> [value _] in
      if (!strcmpi param "HTTPport")     then set http_port=atoi value     else 
      if (!strcmpi param "HTTProot")     then {set http_refpath_len=strlen (set http_refpath=value);} else 
      if (!strcmpi param "HTTPtmp")      then {set http_tmp =value;0    }  else
      if (!strcmpi param "HTTPsizebmp")  then set http_bmpsize=atoi value  else 0;
    getparam _tail;
  };;

fun server_close()=
  let getHTTPstats http_svr -> [_cnb _in _out] in
  _fooS strcatn "HTTP Ressources server statitics :\n"::
    "  connections: "::(itoa _cnb)::"\n"::
    "  input : "::(itoa _in)::" bytes\n"::
    "  output: "::(itoa _out)::" bytes"::nil;
  closeHTTPserver http_svr;
  0;;

fun activate(from,cli,action,param,rep)=
  if (!strcmpi action  "register") then
    _DMSevent this cli "registered" http_user_param http_add_cli cli nil
  else if (!strcmpi action "unregister") then
  { http_remove_cli cli;
    0}
  else nil;;

fun remove_last_slash(s)=
  let (strlen s)-1 -> last in
  if ((nth_char s last)=='/) then substr s 0 last
  else s;;

fun IniDMI(param)=
  /*_showconsole;*/

  /* recuperation des parametres */
  getparam strextr _getpack _checkpack param;

  /* strip out any terminating slash */
  set http_root=remove_last_slash http_root;
  let remove_last_slash http_tmp -> tmp in
  {
    set http_text_s   =strcatn tmp::"/"::DESC_TEXTURE_S::nil;
    set http_m3d_s    =strcatn tmp::"/"::DESC_M3D_S::nil;
    set http_box_s    =strcatn tmp::"/"::DESC_BOX_S::nil;
    set http_text_u   =strcatn tmp::"/"::DESC_TEXTURE_U::nil;
    set http_m3d_u    =strcatn tmp::"/"::DESC_M3D_U::nil;
    set http_box_u    =strcatn tmp::"/"::DESC_BOX_U::nil;
    set http_bmp      =strcatn tmp::"/"::DESC_BMPTEMP::nil;
    set http_bmp_len  =strlen http_bmp;
  };

  crArborescence http_m3d_u "public" "m3d"::nil;
  crArborescence http_text_u "public" "jpeg"::"jpg"::"bmp"::nil;
  crArborescence http_box_u "public" "box"::nil;

  /* start server */
  set http_port = if http_port == nil then DMSport + 2 else http_port;  
  set http_svr=startHTTPserver _channel  http_port @http_onrequest nil;
 _DMSregisterDMI this @activate nil nil @server_close;;