/*******************************************/
/* _mhttpons.pkg : _on by http :-)         */
/* by Marc Barilley                        */
/* inspired by work done by Sylvain Huet   */
/* supports switch beetween _on / HTTPsend */
/*******************************************/

/* <private> */
fun http_serverByPort_s (node, port)=
  node.Http_Chn_Server_port == port;;

fun clibyticket_s (node, ticket)=
  node.Http_Server_Client_Node_ticket == ticket;;

fun clibychannel_s (node, channel)=
  node.Http_Server_Client_Node_uchannel == channel;;

fun clibyconx_s (node, conx)=
  node.Http_Server_Client_Node_globHTTPcon == conx;;

fun http_closeAllClients_s (l)=
  if l==nil
  then
    0
  else
    let l -> [c next] in
    {
      _fooS "  je fais le script _closed";
      _scriptc c.Http_Server_Client_Node_uchannel "_closed";
      _fooS "  je tue le canal";
      _killchannel c.Http_Server_Client_Node_uchannel;
      http_closeAllClients_s next;
    };;




fun flush_http_s (c)=
  _fooS "flush_http_s";
  if c.Http_Server_Client_Node_globHTTPcon == nil
  then
  {
    _fooS strcat "  no connection to client " itoa c.Http_Server_Client_Node_ticket;
    nil
  }
  else
  {
    if (strlen c.Http_Server_Client_Node_bufout) > 0
    then
    {
      _fooS strcatn "  sending \""::http_header::c.Http_Server_Client_Node_bufout::"\" to client "::(itoa c.Http_Server_Client_Node_ticket)::nil;
      HTTPsend c.Http_Server_Client_Node_globHTTPcon strdup strcat http_header c.Http_Server_Client_Node_bufout;
      closeHTTPcon c.Http_Server_Client_Node_globHTTPcon;
      set c.Http_Server_Client_Node_globHTTPcon = nil;
      set c.Http_Server_Client_Node_bufout = "";
    }
    else
    {
      _fooS strcat "  nothing to send to client " itoa c.Http_Server_Client_Node_ticket;
      nil
    };
    c
  };;

fun add_http_s (c, bufout, cmd)=
  _fooS "add_http_s";
  set c.Http_Server_Client_Node_bufout = 
    strcat c.Http_Server_Client_Node_bufout strcat itoh8 strlen cmd cmd;
  c;;

fun rflTimeOut_http_s (t, c)=
  _fooS "rflTimeOut_http_s";
  _fooS strcat "  dernier signe de vie du client : " (ctime c.Http_Server_Client_Node_lasttime);
  _fooS strcat "  heure actuelle : " ctime time;
  _deltimer t;
  set c.Http_Server_Client_Node_timeOutTimer = nil;
  _fooS "  je fais le script _closed";
  _scriptc c.Http_Server_Client_Node_uchannel "_closed";
  _fooS "  je tue le canal";
  _killchannel c.Http_Server_Client_Node_uchannel;
  set c.Http_Server_Client_Node_attachedServer.Http_Chn_Server_clients = remove_from_list c.Http_Server_Client_Node_attachedServer.Http_Chn_Server_clients c;;
  

fun cbclose_http_s (conx, serv)=
  _fooS "cbclose_http_s";
  let search_in_list serv.Http_Chn_Server_clients @clibyconx_s conx -> c in
  if c==nil
  then
    nil
  else if c.Http_Server_Client_Node_timeOutTimer == nil
  then
  {
    set c.Http_Server_Client_Node_timeOutTimer =
      _rfltimer _starttimer _channel serv.Http_Chn_Server_timeout @rflTimeOut_http_s c
  }
  else
    nil
  ;;

fun http_connex_s (serv, conx)=
  _fooS "http_connex_s";
  set serv.Http_Chn_Server_clienttickets = serv.Http_Chn_Server_clienttickets+1;
  let mkHttp_Server_Client_Node
    [
      serv
      conx
      nil
      ""
      serv.Http_Chn_Server_clienttickets
      http_header
      0
      nil
      time
    ]
  -> c in
  {
    set c.Http_Server_Client_Node_uchannel = _openchannel nil nil serv.Http_Chn_Server_env;
    set serv.Http_Chn_Server_clients = c::serv.Http_Chn_Server_clients;
    _scriptc
      c.Http_Server_Client_Node_uchannel
      strcatn
        "_load \"dms/lib/httpon/_mhttponpres.pkg\"\n"::
        "initHttpUnpluggedChannel "::(itoh serv.Http_Chn_Server_port)::"\n"::
        nil;
    rflHTTPclose conx @cbclose_http_s serv;
    add_http_s c c.Http_Server_Client_Node_bufout "connectionACCEPT";
    let strcat "__http_syscmd_init_connexion_ticket " itoh serv.Http_Chn_Server_clienttickets -> t in
      add_http_s c c.Http_Server_Client_Node_bufout t;
    _scriptc c.Http_Server_Client_Node_uchannel serv.Http_Chn_Server_script;
    flush_http_s c;
  };
  "";;

fun http_reconnex_s (serv, conx, url)=
  _fooS "http_reconnex_s";
  let htoi substr url 7 8 -> ticket in
  if ticket==nil
  then
  {
    _fooS "  ticket==nil";
    ""
  }
  else
    let search_in_list serv.Http_Chn_Server_clients @clibyticket_s ticket -> c in
    if c==nil
    then
    {
      _fooS strcat "  client not found. ticket==" (itoa ticket);
      ""
    }
    else
    {
      _deltimer c.Http_Server_Client_Node_timeOutTimer;
      set c.Http_Server_Client_Node_lasttime = time;
      set c.Http_Server_Client_Node_timeOutTimer = nil;
      set c.Http_Server_Client_Node_globHTTPcon = conx;
      rflHTTPclose conx @cbclose_http_s serv;
      flush_http_s c;
      nil
    };;

fun http_receive_s (conx, serv, url, cmd)=
  _fooS "http_receive_s";
  let htoi substr url 7 8 -> ticket in
  if ticket==nil
  then
  {
    _fooS "  pas de ticket dans l'url.";
    strcat http_header "NOFIS";
  }
  else
  {
    _fooS strcat "  ticket==" itoa ticket;
    let search_in_list serv.Http_Chn_Server_clients @clibyticket_s ticket -> c in
    if c==nil
    then
    {
      _fooS "  ticket non atribue.";
      strcat http_header "NOFIS";
    }
    else
      let htoi substr url 15 4 -> n in
      (
        if n==c.Http_Server_Client_Node_num
        then
          if c.Http_Server_Client_Node_uchannel==nil
          then
          (
            _fooS "  unplugged channel du client vaut nil.";
            strcat http_header "NOFIS";
          )
          else
          (
            /* resynchronisation avec le client. il est toujours en vie. */
            if c.Http_Server_Client_Node_globHTTPcon == nil
            then
            {
              _deltimer c.Http_Server_Client_Node_timeOutTimer;
              set c.Http_Server_Client_Node_timeOutTimer =
                _rfltimer _starttimer _channel serv.Http_Chn_Server_timeout @rflTimeOut_http_s c;
            }
            else
              nil;
            set c.Http_Server_Client_Node_lasttime = time;
            set c.Http_Server_Client_Node_num = c.Http_Server_Client_Node_num+1;
            _scriptc c.Http_Server_Client_Node_uchannel cmd;
            strcat http_header "FIS";
          )
        else
        (
          _fooS "  mauvais numero de message.";
          strcat http_header "NOFIS";
        )
      );
  };;

fun cb_http_request_s (conx, serv, req)=
  _fooS "cb_http_request_s";
  let hd strextr req -> l in
  let l->[com [url _]] in
  {
    _fooS strcat "  com==" com;
    _fooS strcat "  url==" url;
    if (nth_char url 5)=='?
    then
      if (!strcmpi com "GET")
      then
        let nth_char url 6 -> c in
          if c=='C then http_connex_s serv conx
          else if c=='R then {http_reconnex_s serv conx url; nil}
/*
          else if c=='X then http_getapplet
          else if c=='A then getfileapplet packsusers substr url 7 strlen url
*/
          else ""
      else if (!strcmpi com "POST")
      then
      {
        _fooS strcat "  cmd==" (substr req (4+strfind "\13\10\13\10" req 0) strlen req);
        let nth_char url 6 -> c in
          if c=='S
          then
            http_receive_s conx serv url (substr req (4+strfind "\13\10\13\10" req 0) strlen req)
          else ""
      }
      else ""
    else ""
  }
;;


/* <public> */
fun http_setserver (env, port, script)=
  _fooS "http_setserver";
  let
    mkHttp_Chn_Server_Struct
    [
      nil
      port
      script
      env
      0
      nil
      120000
    ]
  -> s in
  {
    set s.Http_Chn_Server_server = startHTTPserver _channel port @cb_http_request_s s;
    set http_servers_list = s::http_servers_list;
    s
  };;

fun http_closeserver (serv)=
  closeHTTPserver serv.Http_Chn_Server_server;
  http_closeAllClients_s serv.Http_Chn_Server_clients;
  set http_servers_list = remove_from_list http_servers_list serv;
  0;;

fun http_setservertimeout (serv, timeout)=
  set serv.Http_Chn_Server_timeout = timeout;
  serv;;