/* <Scol Technologies License> */
/* Copyright (c) 2003, organization : Scol Technologies Association, owner : Sylvain Huet */
/* For conditions of distribution and use, see copyright notice in dms/l/license.txt */
/* or on 'www.scol-technologies.org' */

/* sDHDMS - mar 00 - by Sylvain HUET */
/* download part */

struct RSdef=
[nameRSdef:S,typeRSdef:I,docRSdef:S,pathRSdef:P,safeRSdef:I,downloadnameRSdef:S]
mkRSdef;;

var RSfile=1;;
var RScontrol=2;;

fun RSbyname(p,name)=!strcmp p.nameRSdef name;;
fun RSbydownloadname(p,name)=!strcmp p.downloadnameRSdef name;;
fun RScontbyname(a,b)=let a->[n _] in !strcmp n b;;

fun _RSregisterflag(d,name,type,doc,flag)=
 if doc==nil then -1
 else let search_in_list d.resDMI @RSbyname name -> f in
  if f!=nil then -1 /* si ressource déjà enregistrée, ne rien faire */
 else let
   if type&RSfile then 
    let _checkpack doc -> f in
    if f==nil then nil
    else 
     let _fileSign f ->sign in
     let _fileSize f -> size in
     let strcatn http_header::"N"::(itoh8 size)::nil -> content in
     let strcat sign name -> downloadname in
     [sign mkRSdef [name type content f flag downloadname]]
   else
     let _getlongname doc "" "#" ->sign in
     let zip doc -> data in
     let strlen data -> size in
     let strcatn http_header::"z"::(itoh8 size)::data::nil -> content in
     let strcat sign name -> downloadname in
     [sign mkRSdef [name type content nil flag downloadname]]
  -> [sign x] in
 if x==nil then nil
 else /* les ressources safe seront téléchargées directement*/
 (set d.resDMI=x::d.resDMI;
  set d.controlDMI=(name::sign::if flag then "d"::nil else nil)::d.controlDMI;
  apply_on_list d.cliDMI @broad Ccatlf [_DMSgetHandle d name sign if flag then "d" else nil];
  0);;

fun _RSregister(d,name,type,doc)=
 _RSregisterflag d name type doc 0;;
fun _RSregistersafe(d,name,type,doc)=
 _RSregisterflag d name type doc 1;;

fun _RSregisterfiles(d,l,typ)=
 if l==nil then 0 else let l->[f n] in
 (let DMIcheckpack d f -> s in  /* HACK pour gerer le register sur le .dat */
   if s==nil then 
    if f!=nil && strcmp f "_" then (_adderror strcat "##cannot register file " f;nil)
    else nil
   else _RSregister d f typ if typ&RSfile then f else _getpack s;
  _RSregisterfiles d n typ);;

fun _RSunregister(d,name)=
 set d.resDMI=remove_from_list d.resDMI
  search_in_list d.resDMI @RSbyname name;
 set d.controlDMI=remove_from_list d.controlDMI
  search_in_list d.controlDMI @RScontbyname name;
 0;;

fun _RSfind(d,name)=
 search_in_list d.resDMI @RSbydownloadname name;;

fun _RSallowClient(d,cli,name)=
 let  search_in_list d.resDMI @RSbyname name -> r in if r==nil then nil
 else set cli.allowedResCLI=r::cli.allowedResCLI;
 0;;

fun http_getfile(con,url)=
/* _fooS strcat "http_getfile " url;*/
 let _DMSgetByHandle htoi substr url 15 4 -> d in
 if d==nil then ""
 else let htoi substr url 7 8 -> x in
 if x==nil then ""
 else let _DMSbyx x -> cli in
 let substr url 19 strlen url -> s in
 let strlen d.pathlocDMI -> sizelocfile in
 if !strcmp substr s (strlen s)-sizelocfile sizelocfile d.pathlocDMI then
  let _getlocfile d cli ->[cont _ ] in if cont==nil then "" else cont
 else let _RSfind d s -> r in
 if r==nil || (r.safeRSdef && !findList cli.allowedResCLI r) then ""
 else if r.typeRSdef&RSfile then
 (HTTPsend con r.docRSdef;
  HTTPsendFile con r.pathRSdef;
  nil)
 else r.docRSdef;;