/* DirectoryRegister Server - Jan 2000 - Sylvain Huet */
/* main part */
/* 1.0 */


typeof author=S;;
typeof email=S;;
typeof password=S;;
typeof picture=S;;
typeof urlscol=S;;
typeof urlhttp=S;;
typeof lang=S;;
typeof timeout=I;;
typeof msg=S;;

typeof ch=Chn;;
typeof address=S;;
typeof port=I;;
typeof ip=S;;

var scriptgh ="_load \"Dms/CommTools/DirReg/gh.pkg\"\n";;
var scriptreg ="_load \"Dms/CommTools/DirReg/dirreg.pkg\"\n";;

var filename="dir_logfile.txt";;

fun _logfile(msg)=0;;
/* _appendpack (strbuild (DMSname::(ctime time)::msg)::nil) _getmodifypack filename;;*/
 
/* getting the ip address of the server */
typeof localserver=Srv;;

fun startserver(i,maxport)=
 if i>=maxport then nil
 else
 (set localserver=_setserver _envchannel ch i nil;
  if localserver==nil then startserver i+1 maxport
  else i);;

defcom Smain=main S I;;

fun startgethostname(ad)=
 let startserver 10000 10100 -> p in
 if p==nil then
 (_fooS "## cannot start local server for gethostbyname";
  nil)
 else /* start remote gethostbyname */
  _newmachine (strcat "gh" ad) (strcat scriptgh mkscript Smain [ad p]) nil 256000;;


/* start registering */
var fRegistering=0;;
var timeRegistering=0;;
typeof chnRegistering=Chn;;

/* fun endRegistering()=set fRegistering=0;; */

fun endRegistering()=
    set ip=nil; 
    set fRegistering=0;;


fun launchRegister()=
 _logfile "launchregister"::(itoa fRegistering)::nil;
 
 if fRegistering && (ip!=nil) && (time-timeRegistering)>120 then
 (set fRegistering=0;
  _killchannel chnRegistering;
  _logfile "timeout"::nil)
 else nil;
 if fRegistering then nil  /* still registering ? -> nothing */
 else if ip!=nil then 
 (_logfile "openchannel"::nil;
  if nil==(set chnRegistering =_openchannel strcat strcat ip ":" itoa port scriptreg _envchannel ch)
  then (_logfile "failure"::nil;nil)
  else
  (set fRegistering=1;
   set timeRegistering=time))
 else
 (set fRegistering=1;
  startgethostname address);;
 
fun activate(from,cli,action,param,rep)=
 if !strcmp action "update" then
 (_logfile "update"::(itoa sizelist DMSclients)::nil;
  launchRegister)
 else nil;;

fun clock(a,b)=launchRegister;;

/* get the ip address from the remote gethostbyname */
fun __defip(x)=
 if ip!=nil then nil /* protect server */
 else
 (set ip=x;
  _closeserver localserver;
  set localserver=nil;
  set fRegistering=0;
  if ip==nil then nil else launchRegister);
 _closechannel;;

/* start the periodic registering */
fun startclock()=
 clock nil nil;
 _rfltimer (_starttimer ch timeout*60000) @clock nil;
 0;;

/* test wether an address is an IP address */

fun isIP(s,i)=
 if i>=strlen s then 1
 else let nth_char s i-> a in
 if a!='. && (a<'0 || a>'9) then 0
 else isIP s i+1;;

fun testIP(ad)= isIP ad 0;;


/* parse the server string : port and address
   start the remote gethostbyname if address is not ip */
fun parseserver(server)=
 let strfind ":" server 0 -> j in
 if j==nil then
 (_fooS strcatn "## "::server::" is not a correct address"::nil;
  nil)
 else let substr server 0 j -> ad in
 let atoi substr server j+1 strlen server -> x in
 if x==nil || x<=0 then
 (_fooS strcatn "## "::server::" is not a correct address"::nil;
  nil)
 else
 (set port=x;
  if testIP ad then set ip=ad
  else set address=ad;
  startclock);;


fun DirRegInit(l)=
 set author=getInfo l "author";
 set email=getInfo l "email";
 set password=getInfo l "password";
 set picture=getInfo l "picture";
 set urlscol=getInfo l "urlscol";
 set urlhttp=getInfo l "urlhttp";
 set lang=getInfo l "lang";
 set timeout=atoi getInfo l "timeout";
 set msg=getInfo l "msg";
 if timeout<1 then set timeout=1 else nil;
 parseserver getInfo l "server";;
 
 
fun IniDMI(param)=
/* _showconsole;*/
 set ch=_channel;
 DirRegInit strextr _getpack _checkpack param;
 _DMSregisterDMI this @activate nil nil nil;;

/* cryptage */
fun BigSizebis(n,b,i)=
 if (BigCmp b n) >0 then i
 else BigSizebis n BigAdd b b i+1;;

fun BigSize(n)= BigSizebis n BigFromAsc "1" 0;;

fun CRPcryptone(l,p,g,y,k,i1)=
 if l==nil then nil else
 let l->[m nxt] in
  (BigToStringn (BigExpn g k p) i1)::
  (BigToStringn (BigMuln (BigExpn y k p) m p) i1)::CRPcryptone nxt p g y k i1;;

fun CRPfindK(p)=
 let BigFromAsc "1" -> un in
 let BigMod BigRand p -> k in
 if (BigCmp BigPgcd BigSub p un k un)==0 then k
 else CRPfindK p;;

fun CRPcrypt(s,pub)=
 let pub->[p g y] in
 let ((BigSize p)-1)>>3 -> nbyte in
 let CRPfindK p -> k in
 strcatn CRPcryptone (BigListFromString s nbyte) p g y k nbyte+1;;

fun crypt(s,k)=
 if s==nil then nil
 else let hd strextr k->[p [g [y _]]] in
 CRPcrypt s [BigFromString p BigFromString g BigFromString y];;