/*************************************************************************************************/
/* Desc:Download And Upload Library in relation with an HTTP Ressources Server                   */
/* Written: J.Dumay                                                                              */
/* Date   : 20-04-2000                                                                           */
/* Version: 1.0                                                                                  */
/* Fonctions en export:                                                                          */
/*      DLinit                                                                                   */
/*      DLsign                                                                                   */
/*      DLdownload                                                                               */
/*      DLupload                                                                                 */
/*************************************************************************************************/

/*********************** Fonctions relatives au download general *************************/


/* structure generale de download */
struct DL=[
  DLinet        :INET,                        /* la socket http                             */
  DLnbretry     :I,                           /* nombre de retry                            */
  DLprior       :I,                           /* priorite du download                       */
  DLlinkedDL    :[DL r1],                     /* liste des download linke à cet objet       */
  DLmend        :fun [] I,                    /* methode de fin                             */
  DLgetInetParam:fun [DLsystem] [S S S],      /* methode de recup des parametres de la req  */
  DLcbget       :fun [DLsystem DL S I] I,     /* methode de reception de chaines            */
  DLreset       :fun [] I,                    /* methode de reset de la requete             */
  DLcomp        :fun [] [S r1]                /* methode de comparaison de deux reqs        */
] mkDL;;

/* structure pourle systeme general */
struct DLsystem=[
  DLlist    :[DL r1],                         /* liste des downloads restants             */
  DLlistall :[DL r1],                         /* liste de tous les downloads en cours     */
  DLsrvurl  :S,                               /* adresse du serveur de ressources         */
  DLid      :S,                               /* identifiant du client                    */
  DLnb      :I                                /* nombre de download en cours              */
]mkDLsystem;;

typeof DLsytemC=DLsystem;;
var    DLmax   =5;;
var    DLmaxretry =5;;

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;;


/*******************************************
Fonction de creation d'un requete
********************************************/
fun DLnew(prior)=
  mkDL[nil DLmaxretry prior nil nil nil nil nil nil];;

/*******************************************
Fonction ajoutant une requete à la liste
des requete en fonction de la priorité
********************************************/
fun DLappend(l,a)=
 if l==nil then a::nil
 else let l->[b n] in
 if a.DLprior < b.DLprior then a::l
 else b::DLappend n a;;

/*******************************************
Fonction ajoutant un download en fin de la
liste des downloads
********************************************/
fun DLconc(l,a)=
  if l==nil then a::nil
  else let l->[b n] in
    b::DLconc n a;;

/*******************************************
Fonction de fin de reception du download
********************************************/
proto DLend=fun [DL DLsystem] I;;
fun DLend(dl, sys) =
  
  set sys.DLlistall=remove_from_list sys.DLlistall dl;
  exec dl.DLmend with [];
  apply_on_list dl.DLlinkedDL @DLend sys;
  set dl.DLlinkedDL=nil;
  0
;;


/*******************************************
Fonction de destruction du download en cours
********************************************/
fun DLkillcurr(sys,dl)=
  set sys.DLnb=sys.DLnb-1;
  INETStopURL dl.DLinet;
  0;;

/*******************************************
Fonction de reessai de download
********************************************/
fun DLretry(sys,dl)=
  if dl.DLnbretry>0 then
  { set dl.DLnbretry=dl.DLnbretry-1;
    exec dl.DLreset with [];
    set sys.DLlist=dl::sys.DLlist;
    0
  }
  else DLend dl sys;;

/*******************************************
Fonction callback de reception d'une
requete http
********************************************/
fun cbDLget(inet, p, s, reason) =
  let p -> [dl sys] in
  exec dl.DLcbget with [sys dl s reason]
;;

/*******************************************
Fonction de gestion des requetes http
********************************************/
fun constDLprocess(sys) =

  if sys.DLlist==nil then  
    0
  else
    let hd sys.DLlist -> curDL in
    if sys.DLnb<DLmax then
    (
      set sys.DLlist=tl sys.DLlist;
      let exec curDL.DLgetInetParam with [sys] -> param in /* récupération des paramètres pour requete HTTP */
      if param==nil then
      (
        DLend curDL sys;
        DLkillcurr sys curDL;
        constDLprocess sys;
      )
      else
        let param -> [v url content] in
        if (set curDL.DLinet = INETGetURLex DMSserver v url content 0 @cbDLget [curDL sys])==nil then /* envoie de la requete HTTP au serveur*/
        (
          _fooS "### dynEditor - HTTP error on function constDLprocess";
          nil
        )
        else
          set sys.DLnb=sys.DLnb+1;
    )
    else 
      nil
;;


fun recurseDLcomp(ls,lc)=
  if ls==nil then 1
  else if !strcmp hd ls hd lc then
    recurseDLcomp tl ls tl lc
  else 0;;

/*******************************************
Fonction de comparaison de deux downloads
********************************************/
fun DLlistcomp(dls,dlc)=
  let exec dls.DLcomp with [] -> ls in
  let exec dlc.DLcomp with [] -> lc in
  if (sizelist ls)!=(sizelist lc) then 0
  else
    recurseDLcomp ls lc;;

/*******************************************
Fonction d'ajout d'un download au system
********************************************/
fun DLadd(sys, dl) =
  
  let search_in_list sys.DLlistall @DLlistcomp dl -> dlr in
  if dlr==nil then
  ( /* le download n'existe pas deja */
    set sys.DLlistall=DLconc sys.DLlistall dl;
    set sys.DLlist=DLappend sys.DLlist dl
  )
  else
    /* le download existe deja */
    set dlr.DLlinkedDL=dl::dlr.DLlinkedDL;
  constDLprocess sys;;


/**************************** Fonctions relatives au download de fichier *************************/
/* structure de download de fichier */
struct DLF=[
  DLFname    :S,                              /* nom du fichier en cours de download        */
  DLFsign    :S,                              /* signature du fichier                       */
  DLFfile    :W,                              /* fichier physique                           */
  DLFsize    :I,                              /* taille du fichier                          */
  DLFinit    :fun [I] I,                      /* cb d'initialisation du process de download */
  DLFproc    :fun [I] I,                      /* cb en cours de process                     */
  DLFloaded  :fun [S] I,                      /* cb de fin de download du fichier           */
  DLFdone    :I                               /* taille deja recue                          */
]mkDLF;;

/* fonction de comparaison */
fun DLFcomp(d)=
  "DLF"::d.DLFname::nil;;

/* fonction de reset */
fun DLFreset(d)=
  set d.DLFdone=nil;
  _createpack "" d.DLFfile;
  0
;;

/* fonction de fin de download */
fun DLFend(d) =
  
  exec d.DLFloaded with [d.DLFname]
;;

/* fonction renvoyant les parametres de la requete http */
proto DLFgetInetParam=fun [DLsystem DLF] [S S S];;
fun DLFgetInetParam(sys, d) =
  if d.DLFname==nil then 
    nil
  else
    ["GET" (strcatn sys.DLsrvurl::"F"::sys.DLid::d.DLFname::nil) nil]
;;

/* callback de reception d'un fichier */
fun DLFcbget(sys, dl, s, reason, f) =
  
  let strlen s -> len in
  set f.DLFdone=if f.DLFdone==nil then
                (
                  exec f.DLFinit with [f.DLFsize];
                  set s=substr s 9 len-9;
                  len-9
                )
                else f.DLFdone+len;

  _appendpack s f.DLFfile;

  /* execution de la callback d'avancement du download */
  exec f.DLFproc with [f.DLFdone];

  if (reason==0) then 
    nil
  else 
    if (reason==1) then
    (
      /* fin de download -> verif de la signature */
      if !strcmp f.DLFsign _fileSign _checkpack f.DLFname then 
        DLend dl sys
      else 
        DLretry sys dl;

      /* on continue le processus de download */
      DLkillcurr sys dl;
      constDLprocess sys
    )
    else
    (
      _fooS "error on download file";
      DLretry sys dl;
      DLkillcurr sys dl;
      constDLprocess sys
    )
;;

/* fonction de creation */
fun DLFnew(f, sign, size, init, process, loaded) =
  
  let DLnew 1 -> dl in
  let mkDLF[f sign (_getmodifypack f ) size init process loaded nil] -> dlf in
  (
    set dl.DLmend=mkfun1 @DLFend dlf;
    set dl.DLgetInetParam=mkfun2 @DLFgetInetParam dlf;
    set dl.DLcbget=mkfun5 @DLFcbget dlf;
    set dl.DLreset=mkfun1 @DLFreset dlf;
    set dl.DLcomp=mkfun1 @DLFcomp dlf;
    dl
  )
;;



/*********************** Fonctions relatives de recuperation de signatures *************************/
/* structure de recuperation de la signature */
struct DLS=[
  DLSname    :S,                              /* nom du fichier                             */
  DLSsign    :S,                              /* signature du fichier                       */
  DLSsize    :I,                              /* taille du fichier                          */
  DLSgetsign :fun [S S I] I                   /* cb lors de la reception de la signature    */
]mkDLS;;


/* fonction de comparaison */
fun DLScomp(s)=
  "DLS"::s.DLSname::nil
;;

/* fonction de cb de fin de reception de la signature */
fun DLSend(f)=
  exec f.DLSgetsign with [f.DLSname f.DLSsign f.DLSsize]
;;

/* fonction de reset */
fun DLSreset(s)=
  set s.DLSsize=nil;
  set s.DLSsign=nil;
  0
;;

/* fonction qui créer les composants de la requete http :
 la commande 'GET' et le nom du fichier pour vérification de signature */
proto DLSgetInetParam=fun [DLsystem DLS] [S S S];;
fun DLSgetInetParam(sys, f) =
  if f.DLSname==nil then 
    nil
  else
    ["GET" strcatn sys.DLsrvurl::"S"::sys.DLid::f.DLSname::nil nil]
;;


/* callback de reception d'une signature de la part du serveur */
fun DLScbget(sys, dl, s, reason, sig) =
  
  if ( reason == 0 ) then /* en cour de reception aupres du serveur */
  ( 
    set sig.DLSsign = strcat sig.DLSsign s;
    0
  )
  else 
    if ( reason == 1 ) then /* fin de la reception aupres du serveur */
    (
      set dl.DLinet=nil;
      set sig.DLSsign = strcat sig.DLSsign s;

      /* evaluation de la signature et de la taille du fichier */
      set sig.DLSsize = htoi substr sig.DLSsign 1 8;
      let htoi substr sig.DLSsign 9 8 -> lensign in
      set sig.DLSsign = substr sig.DLSsign 17 lensign; /* on récupère la signature du fichier */

      DLend dl sys; /*execute à nouveau un DLadd pour uploader le fichier si celui-ci à une signature différente */

      /* on continue le processus de download */
      DLkillcurr sys dl;
      constDLprocess sys
    )
    else /* erreur de communication aupres du serveur */
    (
      _fooS "error on download signature";
      DLretry sys dl;
      DLkillcurr sys dl;
      constDLprocess sys
    )
;;

/* fonction de creation d'un DL de signature */
fun DLSnew(f, get) =
  
  let DLnew 0 -> dl in
  let mkDLS[f nil nil get] -> dls in
  (
    set dl.DLmend=mkfun1 @DLSend dls;
    set dl.DLgetInetParam=mkfun2 @DLSgetInetParam dls;
    set dl.DLcbget=mkfun5 @DLScbget dls;
    set dl.DLreset=mkfun1 @DLSreset dls;
    set dl.DLcomp=mkfun1 @DLScomp dls;
    dl
  )
;;





/*********************** fonctions relatives à l'upload d'un fichier *********************/

/* structure pour l'upload de fichier */
struct DLU=[
  DLUname         :S,                         /* nom du fichier à uploader                  */
  DLUcontent      :S,                         /* contenu                                    */
  DLUrecept       :S,                         /* chaine en reception                        */
  DLUsigncontent  :S,                         /* signature du contenu du fichier            */
  DLUendUpload    :fun [I] I                  /* cb de fin d'upload                         */
]mkDLU;;


/* fonction de comparaison */
fun DLUcomp(up) =

  "DLU"::up.DLUname::up.DLUsigncontent::nil
;;


/* fonction de cb de fin de reception du fichier sur le serveur */
fun DLUend(up) =
  /* 1 si upload de M3d et Texture, Si vignette = 0?? pas sur !! */
  exec up.DLUendUpload with [if !strcmp up.DLUrecept "FU" then 1 else 0] 
;;


/* fonction de reset */
fun DLUreset(up) =

  set up.DLUrecept=nil;
  0
;;


/* fonction renvoyant les parametres de la requete http */
proto DLUgetInetParam=fun [DLsystem DLU] [S S S];;
fun DLUgetInetParam(sys, up) =
  if up.DLUname==nil then 
    nil
  else
    ["POST" strcatn sys.DLsrvurl::"U"::sys.DLid::up.DLUname::nil zip up.DLUcontent]
;;


fun DLUcbget(sys, dl, s, reason, up) =
 
  if reason == 0 then
  (
    set up.DLUrecept = strcat up.DLUrecept s;
    0
  )
  else 
    if reason == 1 then
    ( 
      set up.DLUrecept = strcat up.DLUrecept s; /* MODIF pour recup de 'FU'*/
      DLend dl sys;
      DLkillcurr sys dl;
      constDLprocess sys
    )
    else
    (
      _fooS "error on upload file";
      DLretry sys dl;
      DLkillcurr sys dl;
      constDLprocess sys
    )
;;


/* fonction de creation */
fun DLUnew(f, content, sign, end) =
  
  let DLnew 0 -> dl in
  let mkDLU[f content nil sign end] -> dls in
  (
    set dl.DLmend=mkfun1 @DLUend dls;
    set dl.DLgetInetParam=mkfun2 @DLUgetInetParam dls;
    set dl.DLcbget=mkfun5 @DLUcbget dls;
    set dl.DLreset=mkfun1 @DLUreset dls;
    set dl.DLcomp=mkfun1 @DLUcomp dls;
    dl
  )
;;





/****************** fonctions relatives à la demande d'un dir sur le serveur *********************/

/* structure pour la demande de dir */
struct DLD=[
  DLDpath         :S,                         /* dir                                        */
  DLDrecept       :S,                         /* contenu recu                               */
  DLDsize         :I,                         /* taille totale du fichier                   */
  DLDdone         :I,                         /* taille recue                               */
  DLDdir          :[S r1],                    /* liste des sous repertoires                 */
  DLDfiles        :[S r1],                    /* liste de fichiers                          */
  DLDinit         :fun [I] I,                 /* cb de debut du process de reception        */
  DLDproc         :fun [I] I,                 /* cb en cours de process                     */
  DLDendDir       :fun [[S r1] [S r1]] I      /* cb de fin de dir sur le serveur            */
]mkDLD;;

/* fonction de comparaison */
fun DLDcomp(d)=
  "DLD"::d.DLDpath::nil
;;

/* fonction de fin de reception */
fun DLDend(d)=
  exec d.DLDendDir with [d.DLDdir d.DLDfiles]
;;

/* fonction de reset */
fun DLDreset(d)=
  set d.DLDrecept=nil;
  set d.DLDsize=nil;
  set d.DLDdone=nil;
  set d.DLDdir=nil;
  set d.DLDfiles=nil;
  0
;;


/* fonction renvoyant les parametres de la requete http */
proto DLDgetInetParam=fun [DLsystem DLD] [S S S];;
fun DLDgetInetParam(sys,d)=
  if d.DLDpath==nil then 
    nil
  else
    ["GET" strcatn sys.DLsrvurl::"D"::sys.DLid::d.DLDpath::nil nil]
;;


fun analyseArbo(l,d)=

  let hd l -> s in
  if s==nil then 
    nil
  else 
    if !strcmp s "dir" then
      set d.DLDdir=(nth_list l 1)::d.DLDdir
    else 
      if !strcmp s "file" then
        set d.DLDfiles=(nth_list l 1)::d.DLDfiles
      else 
        nil;
  0
;;


/* callback de reception de l'arborescence */
fun DLDcbget(sys, dl, s, reason, d) =

  set d.DLDrecept=strcat d.DLDrecept s;

  let strlen d.DLDrecept -> len in
  set d.DLDdone=if len>=9 && d.DLDsize==nil then
                (
                  /* reception de la taille du fichier */
                  set d.DLDsize=htoi substr d.DLDrecept 1 8;
                  exec d.DLDinit with [d.DLDsize];
                  set d.DLDrecept=substr d.DLDrecept 9 len-9;
                  len-9
                )
                else 
                  d.DLDdone+len;

  /* envoie de l'avancement si la taille a deja ete recue */
  if d.DLDsize!=nil then
    exec d.DLDproc with [d.DLDdone]
  else 
    nil;

  if reason==0 then 
    nil
  else 
    if reason==1 then
    (
      apply_on_list strextr unzip d.DLDrecept @analyseArbo d;
      DLend dl sys;
      DLkillcurr sys dl;
      constDLprocess sys
    )
    else
    (
      _fooS "error on receiving directory";
      DLretry sys dl;
      DLkillcurr sys dl;
      constDLprocess sys
    )
;;


/* fonction de cration */
fun DLDnew(path, init, process, end) =
  
  let DLnew 0 -> dl in
  let mkDLD[path nil nil nil nil nil init process end] -> dls in
  (
    set dl.DLmend=mkfun1 @DLDend dls;
    set dl.DLgetInetParam=mkfun2 @DLDgetInetParam dls;
    set dl.DLcbget=mkfun5 @DLDcbget dls;
    set dl.DLreset=mkfun1 @DLDreset dls;
    set dl.DLcomp=mkfun1 @DLDcomp dls;
    dl
  )
;;


/***********************************    Fonction ajout Upload ou DL en interne   ******************************/


/******************************************
Fonction d'ajout d'un download de fichier
apres reception de sa signature
*******************************************/
fun addDLdownload(file,sign,size,param)=
  let param -> [init process loaded] in
  if strcmp _fileSign _checkpack file sign then
    DLadd DLsytemC DLFnew file sign size init process loaded
  else
    exec loaded with [file];;


/******************************************
Fonction d'ajout d'un upload de fichier
apres reception de sa signature
*******************************************/
fun addDLupload(file, sign, size, param) =
  
  let param -> [content endupload] in
  let _getlongname content "" "#" -> newsign in /* on récupère la signature du fichier que l'on a en local */
  if strcmp newsign sign then /* si la signature ne correspond pas avec celle qu'il y a sur le serveur, on upload le fichier */
    DLadd DLsytemC DLUnew file content newsign endupload
  else
    exec endupload with [1] /* sinon on retourne dans le fichier dyneditor.expl.pkg avec 1 pour continuer l'execution */
;;





/************************************** Fonctions externes ( Upload ,DL ...) ***********************/



/*******************************************
Fonction d'initialisation du systeme de
download
********************************************/
fun DLinit(srvurl, id) =

  dyndebg "dyneditor.downloadc.pkg"::"DLinit"::nil;
  set DLsytemC=mkDLsystem[nil nil srvurl (strcat itoh8 strlen id id) 0]
;;


/*******************************************
Fonction de demande de signature
d'un fichier
Execute la fonction passes en parametre
à la fin du chargement
********************************************/
fun DLsign(file,endsign)=
  if file==nil then 
    nil
  else
    DLadd DLsytemC DLSnew file endsign
;;


/*******************************************
Fonction de download d'un fichier
execute la fonction passes en parametre
à la fin du chargement
*******************************************/
fun DLdownload(file, init, process, loaded) =
 
  if file==nil then
    nil
  else
    DLadd DLsytemC DLSnew file mkfun4 @addDLdownload [init process loaded]
;;


/***************************************
Upload d'un fichier 'file' dont le contenu est 'content'
Execute la fonction 'addDLupload'(upload le fichier) 
une fois la signature vérifiée.
Une fois le fichier Uploader execute 'endupload' en fin d'upload (voir dyneditor.expl.pkg)
****************************************/
fun DLupload(file, content, endupload) =
  
  if file==nil then 
    nil
  else
    if content == nil then
    (
      _DLGMessageBox _channel nil (_loc this "UPLOAD_ERROR" nil) (_loc this "EMPTY_FILE" file::nil) 0;
      exec endupload with [1];
      nil
    )
    else
      DLadd DLsytemC DLSnew file mkfun4 @addDLupload [content endupload] 
;;


/***************************************
Fonction de recuperation de l'
arborescence d'un repertoire
Execute la fonction de fin de reception
****************************************/
fun DLgetDir(dir, endrecept) =

  if dir==nil then 
    nil
  else
    DLadd DLsytemC DLDnew dir nil nil endrecept
;;