/*     
      SCOL ENVIRONMENT . Magma 1.0 . 1996 . Sylvain HUET

         scol.c : gestion de l'environnement SCOL
*/
// Modification history:
//
//$ FA(19/04/2001): Opcodes are defined in opcode.h
//$ FA(19/04/2001): Take into account renaming of opcodes
//$ FA(03/05/2001): Temporarily move SCexecXXX functions to exec.cpp
//$ FA(21/05/2001): Debugger integration
//$ FA(01/06/2001): Comment MMpull() after call to SCexeccomm()
//$ FA(06/06/2001): Includes baselib.h
//$ FA(06/06/2001): Debugger integration. Support for channel id and channel user name.
//                  Add notification at channel creation
//$ FA(19/06/2001): Debugger integration. Add support for _fooXXXX mirroring to 
//                  debugger's console
//
//$ LB(20/06/2001): Add  "_definesocksVersion" and "_definesocksAuthentication" scol functions 
//                   to make scol able to specify the socks protocol version and the need of authentication
//$ FA(21/06/2001): Initialisation of debuggger client runtime lists moved after 
//                  initialisation of m->maxpp
//
//$ LB(06/07/2001): Add "base64_encode" and "base64_decode" scol functions
//$ ER(09/07/2001): Update of this file according to the new vscol.h version: move of the SERVERM and SERVERS references
//					to the SERVER && (MUTUALISE/!MUTUALISE)
//					Add functions testDureeLicense and CompNbDayTill2000 to check the utilisation period in the case of a server
//					Add call to testDureeLicense in SCisdead
//					Includes time.h
//					Delete of the "int maxscok=MAXSOCKS" declaration, this initialisation is done in the scolsys.c testLicense function
//					Add declaration of MAXSOCKS,MAXSOCKSE,maxsock, VERSION_NAME
//$ FA(23/07/2001): Initialise OFFSCCHNIDX root. Optimise channel search by socket.
//
//$ ER(27/07/2001): Add "setres scol function"
//$ FA(06/08/2001): Use new MMputs() function to echo strings to the log (and console)
//$ FA(12/11/2001): Replace SCOL_DEBUGGER_AWARE by INCLUDE_DEBUGGER
//$ FA(17/01/2002): Modify SCdelcanal() so that channel external objects are not removed, and
//                  socket is not marked as closed (see SCdestroychannel() function)
//$ FA(24/01/2002): Bug correction: see note in SCdelcanal()
//


#include <stdio.h>
#include <string.h>

#include "mmemory.h"
#include "mbytec.h"
#include "baselib.h"
#include "listlab.h"
#include "loadpak.h"
#include "mainscol.h"
#include "scol.h"
#include "scolsys.h"
#include "fifo.h"
#include "include/socket.h"

#include "include/vscol.h"
#if defined(VERSION_X11) || defined(VERSION_NOX)
#include <sys/time.h>
#include <unistd.h>
#endif
#include "include/common.h"
#include "scolsign.h"
#include "scolpack.h"
#include "scolobj.h"
//$ FA(08/11/2000): Debugger interface
#include "debug.h"
#include "macros.h"
//$ FA(19/04/2001): Opcodes are defined in opcode.h
#include "opcode.h"
//
//$ LB(06/07/2001) : base64 functions
#include "base64.h"
//$ ER(09/07/2001) : time functions
#include "time.h"


#if defined(SERVER)
# define CHANNEL_INDEX_SIZE   307  // bigger hashtable size for server-side VM
#else
# define CHANNEL_INDEX_SIZE   19
#endif
#define CHNIDX_SOCKET         0
#define CHNIDX_CHANNEL        1
#define CHNIDX_NEXT           2


int SCOLuserinit(mmachine m);
int SCinitsyspack(mmachine m);
//$ FA(03/05/2001): Temporarily moved to exec.cpp
int SCexeccommbis(mmachine m, char *comm);
int SCexeccomm(mmachine m,char *comm);
void MMputs(int i, const char* text);
//

//$ FA(23/07/2001): Channel index related functions
uint socketHashCode(int socket);
int channelIndexInsert(mmachine m, SEWORD chn);
int channelIndexRemove(mmachine m, SEWORD chn);
SEWORD channelIndexFind(mmachine m, int socket);
//


int ScolRights=-1;
int ScolSuper=0;
extern int SClocalIPnumber;

//$ ER(09/07/2001): moved from vscol.h, turned from #define constants to variables
int maxsock;
int MAXSOCKS;
int MAXSOCKSE;

//$ ER(10/07/2001): following variables are only used for servers
#ifdef SERVER
short MUTUALISE;
short Debut,Periode;
#endif



static int foo(mmachine m, char* s)
{
  MMputs(MSKFOO, s); //$ FA(06/08/2001): use new MMputs() function
#if defined(INCLUDE_DEBUGGER)
  {
    int res;

    if (res = Mpushstrbloc(m, s))
      return res;
    if (res = DBGEcho(m))
      return res;
  }
#endif
  return MERROK;
}


int SCfooS(mmachine m)
{
  int i;

  i = MMget(m,0);
  if (i == NIL)
    return foo(m, "NIL\n");
  else {
      int res;
      if (res = foo(m, MMstartstr(m, i>>1)))
        return res;
      return foo(m, "\n");
  }
  return 0;
}

int SCfooI(mmachine m)
{
  int i;

  i=MMget(m,0);
  if (i==NIL)
    return foo(m, "NIL\n");
  else {
    char s[10];
    int res;
    sprintf(s, "%x", SEW2I(i));
    if (res = foo(m, s))
      return res;
    return foo(m, "\n");
  }
  return 0;
}


int SCfooIList(mmachine m)
{
  int i,v,res;

  i=MMget(m,0);
  while (i!=NIL)
  {
      v=MMfetch(m,i>>1,OFFLVAL);
      if (v==NIL) {
         if (res = foo(m, "NIL:"))
           return res;
      } else {
        char s[10];
        sprintf(s, "%x", SEW2I(v));
        if (res = foo(m, s))
          return res;
        if (res = foo(m, ":"))
          return res;
      }
      i=MMfetch(m,i>>1,OFFLNEXT);
  }
  return foo(m, "NIL\n");
}

int SCfooSList(mmachine m)
{
  int i,v,res;

  i=MMget(m,0);
  while (i!=NIL)
  {
      v=MMfetch(m,i>>1,OFFLVAL);
      if (v==NIL) {
        if (res = foo(m, "NIL:"))
          return res;
      } else {
        if (res = foo(m, MMstartstr(m,v>>1)))
          return res;
        if (res = foo(m, ":"))
          return res;
      }
      i=MMfetch(m,i>>1,OFFLNEXT);
  }
  return foo(m, "NIL\n");
}


int SCstarterScript(mmachine m)
{
	  return Mpushstrbloc(m,userscript);
}


int MaskEcho=-1;

int Msearchinsyspak(mmachine m, char *name);

extern int indexHard;




//$LB (22/04/2002)
#if defined(VERSION_X11) || defined(VERSION_NOX)
extern int _globalTickcount;
#endif


/* initialisation de l'environnement */
int SCinit(mmachine m,int sizemem)
{
  int k;


  //$LB (22/04/2002) : avoid negative value of tickcount
#if defined(VERSION_X11) || defined(VERSION_NOX)
   struct timeval tm;
   gettimeofday(&tm,NULL);
   _globalTickcount = (tm.tv_sec*1000)+(tm.tv_usec/1000);
#endif


  MMechostr(0,"masque d'affichage : %x\n",MaskEcho);

  MMechostr(MSKTRACE,"initialisation de scol\n");
  if (k=MMinimachine(m,sizemem)) return k;

  OBJinit();

//$ FA(23/07/2001)
  SECHECK(SEPUSH(m, NIL)); // channel index (by socket number)
//$ FA(08/12/2000)
  SECHECK(SEPUSH(m, NIL)); // machine name
  SECHECK(SEPUSH(m, NIL)); // debugger client runtime lists
//
  MMechostr(MSKTRACE,"recherche des repertoires de packages\n");
  Cachepack=NULL;
  SPinitpack();

  SClocalIPnumber=0;
//  if ((ScolRights&M_RIGHTS)==0) SCcacheActivate(m);


  MMechostr(MSKTRACE,"chargement des packages systeme\n");
  if (k=SCinitsyspack(m)) return k;
  MMechostr(MSKTRACE,"fin chargement des packages systeme = %d\n",indexHard);

  if (MMpush(m,NIL)) return MERRMEM; /* liste serveurs */
  if (MMpush(m,NIL)) return MERRMEM; /* liste objets */
  if (MMpush(m,NIL)) return MERRMEM; /* liste ressources */
  if (MMpush(m,NIL)) return MERRMEM; /* liste canaux */
  if (MMpush(m,NIL)) return MERRMEM; /* canal courant */
  m->maxpp=m->pp;
//$ FA(21/06/2001): Initialise debugger client
  if (k = DBGInit(m))
    return k;
//
  return 0;
}

//$ ER(09/07/01)
/* Renvoie le nombre de jour depuis l'annee 2000 */
/* Prend en compte les annees bisextilles */
int CompNbDayTill2000( int Year )
{
	int sum=0,a ;
	for (a=0; a<Year; a++)
		sum+=365+((a % 4)==0 ? 1 : 0);

	return sum;

}


//$ ER(09/07/01)
// Compare current date to utilisation period
// Return 1 if in the period else 0
#ifdef SERVER
int testDureeLicense(void)
{
	int NbDay1970_2000=10957;
	int Limit, Current;
	time_t MyTime;


	time(&MyTime);

	Limit=(CompNbDayTill2000(Debut/365)+Periode);
	Current=(MyTime/86400)-NbDay1970_2000;

	return (Current <= Limit);
}
#endif


/* test de fin de machine */
/* Effectue en même temps l'appel à la fonction de comparaison de la date courante et de la période d'utilisation */
int SCisdead(mmachine m)
{

//$ ER(09/07/01) : call to testDureeLicense to compare current date to the utliisation period
//				   The result is quite lethal since the server acts as if the socket life is down and so shut down
#ifdef SERVER
  if (Periode && !testDureeLicense())
  {
	  MMechostr(MSKTRACE,"Connection impossible pour cause de date limite\n");
		return 1;
  }
#endif


  if (m->err) return m->err;
  if ((MMgetglobal(m,OFFSCSERVER)==NIL)
      &&(MMgetglobal(m,OFFSCCHAN)==NIL))
    return 1;
  return 0;
}

/* encodage des droits dans une chaine de caracteres */
int SCendcodeRights(char *c,int i)
{
    if (i&C_RIGHTS) *(c++)='C';
    if (i&S_RIGHTS) *(c++)='S';
    if (i&D_RIGHTS) *(c++)='D';
    if (i&M_RIGHTS) *(c++)='M';
    if (i&R_RIGHTS) *(c++)='R';
    if (i&W_RIGHTS) *(c++)='W';
    if (i&K_RIGHTS) *(c++)='K';
    *c=0;
    return 0;
}
    
/* definition des droits a partir d'une chaine */
int SCdefineRights(char *c)
{
    int k;

    k=0;
    while(*c)
    {
        if ((*c)=='C') k|=C_RIGHTS;
        if ((*c)=='S') k|=S_RIGHTS;
        if ((*c)=='D') k|=D_RIGHTS;
        if ((*c)=='M') k|=M_RIGHTS;
        if ((*c)=='R') k|=R_RIGHTS;
        if ((*c)=='W') k|=W_RIGHTS;
        if ((*c)=='K') k|=K_RIGHTS;
        c++;
    }
    ScolRights=k;
    return 0;
}


/* creation d'un fichier core */
int SCcore(mmachine m)
{
  return MMpush(m,MMcore(m)*2);
}

/* creation d'une application ex-nihilo */
int SCcreateapplibis(mmachine m,char *corres,char *script)
{
  int k;

  if (k=Mpushstrbloc(m,corres)) return k;
  if (k=Mpushstrbloc(m,script)) return k;
  if (MMpush(m,MMgetglobal(m,OFFSCBASE))) return MERRMEM;
  if (k=SCopenchannel3(m)) return k;
  MMpull(m);
  return 0;
}

int SCcreateappli(mmachine m,char *corres,char *script)
{
  int pp,k;

  pp=MMgetPP(m);
  k=SCcreateapplibis(m,corres,script);
  MMsetPP(m,pp);
  return k;
}

/* retourne le nombre de canaux non unplugged */
int SCgetnbsocket(mmachine m)
{
  int p,n,s;

  n=0;
  p=MMgetglobal(m,OFFSCCHAN);
  while(p!=NIL)
  {
      p>>=1;
      s=SCgetsocket(m,MMfetch(m,p,OFFLVAL));
      if ((s>=0)&&(s!=socklife)&&(!SCtestudp(m,MMfetch(m,p,OFFLVAL)))) n++;
      p=MMfetch(m,p,OFFLNEXT);
  }
/*  MMechostr(MSKTRACE,"nbsockets=%d\n",n);*/
  return n;
}



uint socketHashCode(int socket)
//$ FA(23/07/2001): Return hash code associated to channel socket
{
  uint key = (uint)socket;

  // Since unplugged sockets are already evenly distributed,
  // we do nothing. We apply the hash function to plugged
  // sockets only
  if (key > 0) {
    // Use Thomas Wang's 32-bit mix function
    key += ~(key << 15);
    key ^=  (key >> 10);
    key +=  (key << 3);
    key ^=  (key >> 6);
    key += ~(key << 11);
    key ^=  (key >> 16);
  }
  //MMechostr(MSKTRACE, ">>>>> socket hash code = %u\n", key);
  return key;
}


int channelIndexInsert(mmachine m, SEWORD chn)
//$ FA(23/07/2001): Add channel reference into channel index
{
  uint  bucket;
  int   socket;
  SEINT i;

  SECHECK(SEPUSH(m, chn)); // save channel reference
  i = SEGETSP(m);
  //MMechostr(MSKTRACE, ">>> Inserting channel reference %x into index...\n", SEGET(m, i));
  socket = SCgetsocket(m, SEGET(m, i));
  bucket = socketHashCode(socket) % CHANNEL_INDEX_SIZE;
  //MMechostr(MSKTRACE, ">>>>> bucket = %d\n", bucket);
  // Allocate hashtable bucket array if channel index is nil
  if (SEGETROOT(m, OFFSCCHNIDX) == NIL) {
    SEPTR res;
    int i;
    if ((res = MMmalloc(m, CHANNEL_INDEX_SIZE, TYPETAB)) < 0)
      return res;
    // Initialise all hashtable entries to nil
    for (i = 0; i < CHANNEL_INDEX_SIZE; i++)
      SESTORE(m, res, i, NIL);
    //MMechostr(MSKTRACE, ">>>>> index allocated; root = %x\n", SEP2W(res));
    SESETROOT(m, OFFSCCHNIDX, SEP2W(res)); 
  }
  // Add channel reference into the beginning of the bucket list
  SECHECK(SEPUSH(m, SEI2W(socket)));
  SECHECK(SEPUSH(m, SEGET(m, i)));
  SECHECK(SEPUSH(m, SEFETCH(m, SEW2P(SEGETROOT(m, OFFSCCHNIDX)), bucket)));
  SECHECK(SEPUSH(m, SEI2W(3)));
  SECHECK(SENEWTUPLE(m));
  //MMechostr(MSKTRACE, ">>>>> hash table entry %x\n", SEGETTOP(m, 0));
  SESTORE(m, SEW2P(SEGETROOT(m, OFFSCCHNIDX)), bucket, SEPOP(m));
  SEDROP(m, 1); // drop saved channel reference
  return MERROK;
}


int channelIndexRemove(mmachine m, SEWORD chn)
// FA  23/07/2001  Remove channel reference from channel index
// FA  17/01/2002  Socket is not marked here as closed (see SCdestroychannel())
{
  uint   bucket;
  SEWORD cur;
  SEWORD prv;

  //MMechostr(MSKTRACE, ">>> Removing channel reference %x from index...\n", chn);
  bucket = socketHashCode(SCgetsocket(m, chn)) % CHANNEL_INDEX_SIZE;
  //MMechostr(MSKTRACE, ">>>>> bucket = %d\n", bucket);
  cur = SEFETCH(m, SEW2P(SEGETROOT(m, OFFSCCHNIDX)), bucket);
  prv = NIL;
  while (cur != NIL) {
    SEPTR p = SEW2P(cur);
    if (SEFETCH(m, p, CHNIDX_CHANNEL) == chn) {
      //MMechostr(MSKTRACE, ">>>>> found channel at entry %x\n", cur);
      // Remove index entry from list
      if (prv == NIL)
        SESTORE(m, SEW2P(SEGETROOT(m, OFFSCCHNIDX)), bucket, SEFETCH(m, p, CHNIDX_NEXT));
      else
        SESTORE(m, SEW2P(prv), CHNIDX_NEXT, SEFETCH(m, p, CHNIDX_NEXT)); 
      break;
    }
    prv = cur;
    cur = SEFETCH(m, p, CHNIDX_NEXT);
  }
  return MERROK;
}


SEWORD channelIndexFind(mmachine m, int socket)
//$ FA(23/07/2001): Find the channel for the given socket
{
  uint   bucket;
  SEWORD cur;
  SEWORD chn = NIL;

  if (socket != -1) {
    //MMechostr(MSKTRACE, ">>> Searching for channel...\n");
    bucket = socketHashCode(socket) % CHANNEL_INDEX_SIZE;
    //MMechostr(MSKTRACE, ">>>>> bucket = %d\n", bucket);
    cur = SEFETCH(m, SEW2P(SEGETROOT(m, OFFSCCHNIDX)), bucket);
    while (cur != NIL) {
      SEPTR p = SEW2P(cur);
      if (SEW2I(SEFETCH(m, p, CHNIDX_SOCKET)) == socket) {
        //MMechostr(MSKTRACE, ">>>>> found channel at entry %x\n", cur);
        return SEFETCH(m, p, CHNIDX_CHANNEL);
      }
      cur = SEFETCH(m, p, CHNIDX_NEXT);
    }
  }
  return NIL;
}


int SCaddcanal(mmachine m)
// Add current channel into the list of channels
//$ FA(23/07/2001): Rewritten
{
//$ FA(18/06/2001): Do not add debugger's channel into the list
#if defined(INCLUDE_DEBUGGER)
  int res;
  if (debug.sock == -1)
    return MERROK;
#endif
//
  SECHECK(SEPUSH(m, SEGETROOT(m, OFFSCCUR)));
  SECHECK(SEPUSH(m, SEGETROOT(m, OFFSCCHAN)));
  SECHECK(SEPUSH(m, SEI2W(2)));
  SECHECK(SENEWTUPLE(m));
  SESETROOT(m, OFFSCCHAN, SEPOP(m));

//$ FA(23/07/2001): Add channel into index
  SECHECK(channelIndexInsert(m, SEGETROOT(m, OFFSCCUR)));
//$ FA(29/11/2000): Notify debugger that a new channel has been opened
#if defined(INCLUDE_DEBUGGER)
  SECHECK(SEPUSH(m, SEGETROOT(m, OFFSCCUR)));
  if (res = DBGNotifyChannelOpened(m))
    return res;
#endif
//
  return MERROK;
}


int SCdelcanal(mmachine m, SEWORD chn)
// Deletes the channel from the root channel list
// FA  23/07/2001  Rewritten
// FA  17/01/2002  Channel external objects are removed by caller (SCdestroychannel())
// FA  24/01/2002  Pointer to 'chn' invalid if SCsendCapacity() caused a GC
{
  SEWORD cur = SEGETROOT(m, OFFSCCHAN); //SH000808
  SEWORD prv = NIL;
  
  while (cur != NIL) {
    SEPTR p = SEW2P(cur);
    if (SEHEAD(m, p) == chn) {
      if (prv == NIL)
        SESETROOT(m, OFFSCCHAN, SETAIL(m, p));
      else
        SESETTAIL(m, SEW2P(prv), SETAIL(m, p));
      // Save channel, as the following code may cause a GC
      SECHECK(SEPUSH(m, chn)); //$ FA(24/01/2002)
//$ ER(09/07/01) Turn #ifdef SERVERM into the following line
#ifdef SERVER
		  if (!ScolSuper && !MUTUALISE) 
        SCsendCapacity(m);
#endif
//$ FA(23/07/2001): Remove channel reference from index
      SECHECK(channelIndexRemove(m, SEPOP(m)));
//
      return MERROK;
    }
    prv = cur;
    cur = SETAIL(m, p);
  }
  return MERROK;
}


/* ajout d'un serveur
   le serveur se trouve dans la pile */
int SCaddserver(mmachine m)
{
  int k;

  if (MMpush(m,MMgetglobal(m,OFFSCSERVER))) return MERRMEM;
  if (MMpush(m,2*2)) return MERRMEM;
  if (k=MBdeftab(m)) return k;
  MMsetglobal(m,OFFSCSERVER,MMpull(m));
  return 0;
}

/* suppression d'un server de la liste des server */
int SCdelserver(mmachine m,int server)
{
  int p,q;

  //SH000808
  p=MMgetglobal(m,OFFSCSERVER)>>1;
  q=NIL;
  while(p!=NIL)
  {
	  if (MMfetch(m,p,OFFLVAL)==server)
	  {
		  if (q==NIL) MMsetglobal(m,OFFSCSERVER,MMfetch(m,p,OFFLNEXT));
		  else MMstore(m,q,OFFLNEXT,MMfetch(m,p,OFFLNEXT));
		  return 0;
	  }
	  q=p;
	  p=MMfetch(m,p,OFFLNEXT)>>1;
  }
  //
  return 0;
}

/* dump canaux */
int SCdumpcanal(mmachine m)
{
  int p;

  MMechostr(MSKFOO,">>Dump\n");
  p=MMgetglobal(m,OFFSCCHAN);
  while(p!=NIL)
  {
      p>>=1;
      MMechostr(1,">%d\n",SCgetsocket(m,MMfetch(m,p,OFFLVAL)));
      p=MMfetch(m,p,OFFLNEXT);
  }
  MMechostr(MSKFOO,">>DumpEnd\n");
  return 0;
}


int SCselectcanal(mmachine m, int socket)
// Selects as current the channel corresponding to the given socket
//$ FA(23/07/2001): Rewritten and optimised 
{
  SEWORD chn = channelIndexFind(m, socket);
  if (chn != NIL) {
    SESETROOT(m, OFFSCCUR, chn);
    return MERROK;
  }
  // Oops!
  SESETROOT(m, OFFSCCUR, NIL);
  MMechostr(MSKFOO, "(!) There is no channel for socket %d\n", socket);
  return -1;
}


/* retourne le nombre de canaux unplugged */
int SCgetnbsocketu(mmachine m)
{
  int p,n;

  n=0;
  p=MMgetglobal(m,OFFSCCHAN);
  while(p!=NIL)
  {
      p>>=1;
      if (SCgetsocket(m,MMfetch(m,p,OFFLVAL))<0) n++;
      p=MMfetch(m,p,OFFLNEXT);
  }
  return n;
}

/* positionne le serveur courant par le numero de socket */
int SCgetserver(mmachine m, int socket)
{
  int p;

  p=MMgetglobal(m,OFFSCSERVER);
  while(p!=NIL)
  {
      p>>=1;
      if (SCgetsrvsocket(m,MMfetch(m,p,OFFLVAL))==socket)
      {
          MMsetglobal(m,OFFSCCUR,MMfetch(m,p,OFFLVAL));
          return 0;
      }
      p=MMfetch(m,p,OFFLNEXT);
  }
  MMsetglobal(m,OFFSCCUR,NIL);
  return -1;
}

extern int maxsock; /*FLIC*/

#ifdef SERVERS
int SCsendCapacity(mmachine m);
#endif

int cbsendfull(int i,int s)
{
	int k;
	char buf[256];

	strcpy(buf,"__FullServer");
	k=strlen(buf)-2;
	buf[0]=k&255;
	buf[1]=(k>>8)&255;
	SCKsend(s,buf,k+2);
	SCKclose(s);
	mt_del(i);
	return 0;
}

/* creation d'un canal serveur */
int SCacceptbis(mmachine m,int srv)
{
  int k,s,ip,port,t;
  char buf[128];

//$ ER(09/07/01) : comment: the following is not very useful anymore, because maxsock is now initialized just in the calling fucntion
  if (maxsock+1>MAXSOCKS+1) return -1; /*FLIC*/
  s=(int)SCKaccept(srv,&ip,&port); /* accepter la connexion socket */
  if (s<0) return 0;
  MMechostr(MSKTRACE,"Connection from %x:%x\n",ip,port);
  if ( ((!ScolSuper)&&(SCgetnbsocket(m)>=maxsock)) ||
      ((ScolSuper)&&(SCgetnbsocket(m)>=MAXSOCKSE)) )
  {
	  MMechostr(MSKRUNTIME,"Scol Full\n");
	  mt_start(1000,s,cbsendfull);
	  if (!ScolSuper)
	  {
		  if ((k=MMpush(m,NIL))) return k;
		  t=MMgetglobal(m,OFFSCCUR)>>1;
		  if ((k=MMpush(m,MMfetch(m,t,OFFSRVENV)))) return k; /* env.canal*/
		  if ((k=MMpush(m,2*2))) return k;
		  if ((k=MBdeftab(m))) return k;
		  MMsetglobal(m,OFFSCCUR,MMpull(m));
		  if (k=SCexeccomm(m,"_fullserver")) return k;
//		  MMpull(m);
	  }
	  return 0;
  }

  if (k=SCmakefifo(m)) return k;            /* bloc.fifo */
  
  t=MMgetglobal(m,OFFSCCUR)>>1;
  if (MMpush(m,MMfetch(m,t,OFFSRVENV))) return MERRMEM; /* env.canal*/
//$ FA(08/11/2000)
  SECHECK(SEPUSH(m, NIL));              // user channel name (unspecified)
//$ FA(23/11/2000)
  SECHECK(SEPUSH(m, SEI2W(chnID++)));   // assign channed id
//
  if (MMpush(m,SIZECHAN*2)) return MERRMEM;
  if (k=MBdeftab(m)) return k;

  SCsetsocket(m,MMget(m,0),s);   /* reglage de la socket */
  if (k=Mpushstrbloc(m,SCKgetstringbyip(buf,ip,port))) return k;
  SCsetsockname(m,MMget(m,1)); /* reglage du nom */

  t=MMgetglobal(m,OFFSCCUR)>>1;
  MMsetglobal(m,OFFSCCUR,MMget(m,0));
  MMset(m,0,MMfetch(m,t,OFFSRVSCRIPT));
  if (k=SCscript(m)) return k;
  MMpull(m);

  if (k=SCaddcanal(m)) return k;
//$ ER(09/07/01) : turning of #ifdef SERVERM by the following
#ifdef SERVER
  if ((!ScolSuper)&&(!MUTUALISE)) SCsendCapacity(m);
#endif

  return 0;
}

int SCaccept(mmachine m,int s)
{
  int pp,k;

  pp=MMgetPP(m);
  k=SCacceptbis(m,s);
  MMsetPP(m,pp);
  return k;
}

int SCexecch(mmachine m)
{
	int k,z;

	if ((MMget(m,1)==NIL)||(MMget(m,2)==NIL))
	{
		MMpull(m); MMpull(m);
		MMset(m,0,NIL);
		return 0;
	}
	z=MMget(m,2);
	MMset(m,2,MMgetglobal(m,OFFSCCUR));
	MMsetglobal(m,OFFSCCUR,z);

	k=Minterpreter2(m,kExeccall);
    if (k!=1) return k;
	MMsetglobal(m,OFFSCCUR,MMget(m,1));
	MMset(m,1,MMget(m,0));
	MMpull(m);
	return 0;
}

int SCswitch(mmachine m)
{
	int p,q,l;
	p=MMpull(m);
	l=MMpull(m);
	while(l!=NIL)
	{
		q=MMfetch(m,l>>1,0);
		if ((q!=NIL)&&(MMfetch(m,q>>1,0)==p))
			return MMpush(m,MMfetch(m,q>>1,1));
		l=MMfetch(m,l>>1,1);
	};
	return MMpush(m,NIL);
}

int SCswitchstr(mmachine m)
{
	int p,q,r,l;
	char *c;
	p=MMpull(m);
	l=MMpull(m);
	if (p!=NIL) c=MMstartstr(m,p>>1);
	while(l!=NIL)
	{
		q=MMfetch(m,l>>1,0);
		if (q!=NIL)
		{
			r=MMfetch(m,q>>1,0);
			if (((r==NIL)&&(p==NIL))||((p!=NIL)&&(!strcmp(c,MMstartstr(m,r>>1)))))
				return MMpush(m,MMfetch(m,q>>1,1));
		}
		l=MMfetch(m,l>>1,1);
	};
	return MMpush(m,NIL);
}

int SCswitchstri(mmachine m)
{
	int p,q,r,l;
	char *c;
	p=MMpull(m);
	l=MMpull(m);
	if (p!=NIL) c=MMstartstr(m,p>>1);
	while(l!=NIL)
	{
		q=MMfetch(m,l>>1,0);
		if (q!=NIL)
		{
			r=MMfetch(m,q>>1,0);
			if (((r==NIL)&&(p==NIL))||((p!=NIL)&&
				(!stricmp(c,MMstartstr(m,r>>1)))
				))
				return MMpush(m,MMfetch(m,q>>1,1));
		}
		l=MMfetch(m,l>>1,1);
	};
	return MMpush(m,NIL);
}

int SCtest_exist(mmachine m)
{
	int p,lp;

	p=MMpull(m);
	if (p==NIL) return MMpush(m,NIL);
	lp=MMgetglobal(m,OFFSCCUR);
	if (lp==NIL) return MMpush(m,0);
	lp=MMfetch(m,lp>>1,OFFCHANENV);
	if (lp==NIL) return MMpush(m,0);
	if (NIL==Msearchinpak(m,lp,MMstartstr(m,p>>1))) return MMpush(m,0);
	return MMpush(m,2);
}

int SCsetLogMask(mmachine m)
{
	MaskEcho=MMget(m,0)>>1;
	return 0;
}

int SCisFirstScol(mmachine m)
{
	return MMpush(m,firstScol*2);
}

int SCplatform(mmachine m)
{
#ifdef VERSION_NOX
  return MMpush(m,0);
#endif
#ifdef VERSION_WIN
	return MMpush(m,1*2);
#endif
#ifdef VERSION_X11
  return MMpush(m,2*2);
#endif
#ifdef VERSION_MAC
  return MMpush(m,3*2);
#endif
}

int SCscreendepth(mmachine m)
{
#ifdef VERSION_WIN
	DEVMODE d;

	d.dmSize=sizeof(DEVMODE);
	d.dmDriverExtra=0;
	if (EnumDisplaySettings(NULL,ENUM_CURRENT_SETTINGS,&d))
		return MMpush(m,d.dmBitsPerPel*2);
#endif
	return MMpush(m,0);
}

	
//$ LB : NSCOLSYS : 122 -> 124 : added SCdefinesocksVersion and SCdefinesocksAuthentication functions
//$ LB(06/07/2001) : add base64 scol functions
#define NSCOLSYS 129

char* scolname[NSCOLSYS]=
{"_script","_scriptc","_load","_channel",
 "Env","_closemachine","_envchannel","_setenv",
 "_openchannel","_setserver","_closeserver","_closechannel",
 "_killchannel","_checkpack","_storepack","_getpack",
 "_loadhard","I","S","F",
 "_waitingfifo","_sizewaitingfifo","_channeltime","Comm",
 "_on","P","_getlongname","_servertime",
 "_channelname","Srv","Chn","_channelIP",
 "_channelport","_gethostbyname","_getnamebyIP","_fooS",
 "_fooI","_hostname","_hostIP","_refine",
 "C_Rights","S_Rights","D_Rights","M_Rights",
 "R_Rights","W_Rights","K_Rights","_getrights",
 "_setrights","_sizememory","_newmachine","_masterchannel",
 "_setsocklife","_showconsole","_hideconsole","_signenv",
 "_signmachine","_openbrowserhttp","_version","_getress",
 "_setress","_loadressini","W","_getmodifypack",
 "_createpack","_appendpack","_WtoP","_removepkg",
 "_setsizefifo","_chgchn","_fooSList","_saveressini",
 "_loadusmini","_saveusmini","_defineproxy","_openbrowserhttpP",
 "_setUDP","_sendUDP","_fooIList","_newmachineS",
 "_setchannel","_envfirstname","_freememory","_tickcount",
 "_onX","_setX","_versionname","_cacheActivate",
 "_setCookies","_starterScript","_sendUDPchn","_listoffiles",
 "_listofsubdir","_username","_computername","_copyFile",
 "execch","switch","switchstr","switchstri",
 "_reduceCapacity","_fileSign","_test_exist","_setLogMask",
 "_fileSize","_isFirstScol","_platform","_screendepth",
 "_refine_nth","_movecache","_hostIPall","_setLocalIPnumber",
 "_autodetectproxy","_definesocks","_startExe","_refreshExe",
 "_getExe","_addExe","_delExe","_deletepack",
 "_mix8","_mix16",
 //$ LB
 "_definesocksVersion", "_definesocksAuthentication",
 //
 //$ LB(06/07/2001): Add base64 scol functions
 "base64_encode", "base64_decode",
 //
 "_getValidityPeriod",
 //$ ER(27/07/2001): setuser
 "_setuser",
 //$ FA(06/08/2001)
 "_getmodifdate"
 };


int (*scolfun[NSCOLSYS])(mmachine m)=
{SCscript,SCscriptc,SPloadpak,SCchannel,
 NULL,SCclosemachine,SCenvchannel,SCsetenv,
 SCopenchannel,SCsetserver,SCcloseserver,SCclosechannel,
 SCkillchannel,SPcheckpack,SPstorepack,SPgetpack,
 SCloadhard,NULL,NULL,NULL,
 SCwaitingfifo,SCsizewaitingfifo,SCchanneltime,NULL,
 SCon,NULL,SPgetlongname,SCservertime,
 SCchannelname,NULL,NULL,SCchannelIP,
 SCchannelport,SCgethostbyname,SCgetnamebyIP,SCfooS,
 SCfooI,SChostname,SChostIP,SPrefinePartition,
 (void*)2,(void*)4,(void*)8,(void*)16,
 (void*)32,(void*)64,(void*)128,SCgetrights,
 SCsetrights,SCsizememory,SCnewmachine,(void*)-1,
 SCsetsocklife,SCshowconsole,SChideconsole,SCsignenv,
 SCsignmachine,SCopenbrowserhttp,SCversion,SCgetress,
 SCsetress,SCloadressini,NULL,SPgetmodifypack,
 SPcreatepack,SPappendpack,SPWtoP,SCremovepkg,
 SCsetsizefifo,SCchangeChn,SCfooSList,SCsaveressini,
 SCloadusmini,SCsaveusmini,SCdefineproxy,SCopenbrowserhttpP,
 SCsetUDPserver,SCsendudp,SCfooIList,SCnewmachineS,
 SCsetchannel,SCenvfirstname,SCfreememory,SCtickcount,
 SConX,SCsetX,SCversionname,SCcacheActivate,
 SPsetCookies,SCstarterScript,SCsendudpchn,SClistoffiles,
 SClistofsubdir,SCusername,SCcomputername,SCcopyFile,
 SCexecch,SCswitch,SCswitchstr,SCswitchstri,
 SCreduceCapacity,SPfileSign,SCtest_exist,SCsetLogMask,
 SPfileSize,SCisFirstScol,SCplatform,SCscreendepth,
 SPrefineNthPartition,SCmovecache,SChostIPall,SCsetLocalIPnumber,
 SCdefaultproxy,SCdefinesocks,SCstartExe,SCrefreshExe,
 SCgetExe,SCaddExe,SCdelExe,SPdeletepack,
 SCmix8,SCmix16,
 //$ LB
 SCdefinesocksVersion, SCdefinesocksAuthentication,
 //
 //$ LB(06/07/2001) : base64 functions
 SCbase64_encode, SCbase64_decode,
 //
 SCreadTrace,
 //$ ER(27/07/2001) : setuser function
 SCsetuser,
 //$ FA(06/08/2001)
 SPGetModifDate
 };





int scolnarg[NSCOLSYS]=
{1,2,1,0,
 0,0,1,2,
 3,3,1,0,
 1,1,2,1,
 1,TYPTYPE,TYPTYPE,TYPTYPE,
 1,1,1,TYPTYPE,
 2,TYPTYPE,3,1,
 1,TYPTYPE,TYPTYPE,1,
 1,1,1,1,
 1,0,0,1,
 TYPVAR,TYPVAR,TYPVAR,TYPVAR,
 TYPVAR,TYPVAR,TYPVAR,0,
 1,0,4,TYPVAR,
 1,0,0,1,
 0,1,0,1,
 2,0,TYPTYPE,1,
 2,2,1,1,
 2,2,1,1,
 1,1,3,1,
 3,2,1,3,
 1,1,0,0,
 1,1,0,0,
 1,0,3,1,
 1,0,0,2,
 3,2,2,2,
 1,1,1,1,
 1,0,0,0,
 2,1,0,1,
 0,2,3,0,
 1,2,2,1,
 2,2,
 //$ LB
 1,1,
 //
 //$ LB(06/07/2001) : base64 functions
 1,1,
 //
 2,
 //$ ER(27/07/2001) : setuser function
 1,
 //$ FA(06/08/2001): SPGetModifDate 
 1
 };




char* scoltype[NSCOLSYS]=
{"fun [S] I","fun [Chn S] I","fun [S] I","fun [] Chn",
 NULL,"fun [] I","fun [Chn] Env","fun [Chn Env] I",
 "fun [S S Env] Chn","fun [Env I S] Srv","fun [Srv] I","fun [] I",
 "fun [Chn] I","fun [S] P","fun [S S] I","fun [P] S",
 "fun [S] I",NULL,NULL,NULL,
 "fun [Chn] I","fun [Chn] I","fun [Chn] I",NULL,
 "fun [Chn Comm] I",NULL,"fun [S S S] S","fun [Srv] I",
 "fun [Chn] S",NULL,NULL,"fun [Chn] S",
 "fun [Chn] I","fun [S] S","fun [S] S","fun [S] S",
 "fun [u0] u0","fun [] S","fun [] S","fun[S] S",
 "I","I","I","I",
 "I","I","I","fun [] I",
 "fun [I] I","fun [] I","fun [S S I I] I","Chn",
 "fun [Chn] Chn","fun [] I","fun [] I","fun [Env] S",
 "fun [] S","fun [S] S","fun [] I","fun [S] S",
 "fun [S S] S","fun [] S",NULL,"fun [S] W",
 "fun [S W] I","fun [S W] I","fun [W] P","fun [Env] Env",
 "fun [Chn I] Chn","fun [Chn Chn] Chn","fun [[S r1]] [S r1]","fun [S] S",
 "fun [S] S","fun [S] S","fun [S S S] I","fun [P] P",
 "fun [Env I S] Chn","fun [S Comm] I","fun [[u0 r1]] [u0 r1]","fun [P I I] I",
 "fun [Chn] Chn","fun [Env] S","fun [] I","fun [] I",
 "fun [Comm] Comm","fun [Chn] Chn","fun [] S","fun [] I",
 "fun [S] S","fun [] S","fun [Chn S Comm] I","fun [S] [S r1]",
 "fun [S] [S r1]","fun [] S","fun [] S","fun [P S] P",
 "fun [Chn fun u0 u1 u0] u1","fun [[[u0 u1] r1] u0] u1","fun [[[S u0] r1] S] u0","fun [[[S u0] r1] S] u0",
 "fun [I] I","fun [P] S","fun [S] I","fun [I] I",
 "fun [P] I","fun [] I","fun [] I","fun [] I",
 "fun[S I] S","fun[S] S","fun[][S r1]","fun[I] I",
 "fun[] [S S S]","fun[S S] I","fun[S S S] S","fun[] I",
 "fun[S] [S r1]","fun[S P] I","fun[S S] I","fun[P] P",
 "fun[[[I S] r1] I] [S I]","fun[[[I S] r1] I] [S I]",
 //$ LB
 "fun [S] I", "fun [S] I",
 //
 //$ LB(06/07/2001) : base64 functions
 "fun [S] S", "fun [S] S",
 //
 "fun [S S] [I I]",
 //$ ER(27/07/2001) : setuser function
 "fun [S] I",
 //$ FA(06/08/2001): SPGetModifDate 
 "fun [P] [I I I I I I I I]"
 };


int SCOLloadSYS(mmachine m)
{
    int k;
	k=PKhardpak(m,"scolsys.pkg",NSCOLSYS,scolname,scolfun,scolnarg,scoltype);
    return k;
}