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

         scolsys.h : routines de gestion de package de scol
*/
//
// Modification history:
//
//$ ER(09/07/2001): Add testDureeLicense function to compare current date to utilisation period
//				    turn SERVERM calls to SERVER && MUTUALISE in SCsendCapacity and SCchecksign functions
//$ FA(06/08/2001): Add the SPGetModifDate() function that returns the date (as a tuple) when a file 
//                  was last modified
//
//$ LB (30/05/2002) : defined an empty SCsendCapacity for the ClubHouse server
//
//
//$LB (13/10/2004) : _loadS : an equivalent to _load, but from a String 
//

#include "scolPrerequisites.h"
#include "common/vscol.h"


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

#if SCOL_PLATFORM == SCOL_PLATFORM_WINDOWS
#	include <io.h>
#	include <direct.h>
#else
	// Linux version
#	include <sys/types.h>
#	include <sys/stat.h>
#	include <dirent.h>
#	include <time.h>
#	include "OS_specific/linux/scolFindData.h"
#endif

#include "cipher.h"
#include "md5.h"
#include "scolMMemory.h"
#include "mbytec2.h"     // refers to MBdeftab()
#include "listlab.h"
#include "loadpak.h"     // refers to PKloader() and PKaddpak() 
#include "scol.h"
#include "scolsign.h"
#include "scolpack.h"
#include "fifo.h"        // refers to SCsendpile()
#include "vm/mbytec.h"

//$BLG - v4.6a6: Trying to fix Cannot Write File error ... 
//This initially was for SPappendpack.
int BLG_SlashToBackslash(char *name)
{
	int len;
	int i;
	
	len = strlen(name);
	for(i=0;i<len;i++)
	{
		if (name[i] == '/') name[i] = '\\';
	}
	
	return 0;
}

//$BLG - v5.2.06: Add
int BLG_BackslashToSlash(char *name)
{
	int len;
	int i;
	
	len = strlen(name);
	for(i=0;i<len;i++)
	{
		if (name[i] == '\\') name[i] = '/';
	}
	
	return 0;
}


/* activation du cache */
int SCcacheActivate(mmachine m)
{
  MMechostr(MSKDEBUG, "Cache Activation\n");
  Firstpack = Cachepack;
  return MMpush(m, 0);
}


//$BLG
int SCisCacheActivated(mmachine m)
{
	int ret = 0;
	if (Firstpack == Cachepack) ret++;
	return MMpush(m, ret<<1);
}


//$BLG - v5.2.06: Add
int BLG_DeleteFiles(char *path)
{
	int res;
	long h;
	struct _finddata_t fileinfo;
	char buf[512];
	int ret;
	
	//MMechostr(0, "  Directory: %s\n", path);
	
	ret = 1;
	sprintf(buf, "%s/*.*", path);
	h = _findfirst(buf, &fileinfo );
	res = h;
	while (res != -1)
	{
		sprintf(buf, "%s/%s", path, fileinfo.name);
		if (fileinfo.attrib & _A_SUBDIR)
		{
			if (strcmp(fileinfo.name, ".") && strcmp(fileinfo.name, ".."))
			{
				if (!BLG_DeleteFiles(buf))
				{
					MMechostr(0, "  Can't remove directory (NOT_EMPTY): %s\n", buf);
					ret = 0;
				}
				else
					if (!RemoveDirectory(buf))
					{
						MMechostr(0, "  Can't remove directory (ERROR %d): %s\n", (int)GetLastError(), buf);
						ret = 0;
					}
			}
		}
		else
		{
			if (fileinfo.attrib & _A_RDONLY)
			{
				if (!SetFileAttributes(buf, (fileinfo.attrib ^ _A_RDONLY)))
				{
					MMechostr(0, "  Can't delete file (READ_ONLY): %s\n", buf);
					ret = 0;
				}
				else
					if (!DeleteFile(buf))
					{
						MMechostr(0, "  Can't delete file (^READ_ONLY): %s\n", buf);
						ret = 0;
					}
			}
			else
				if (!DeleteFile(buf))
				{
					MMechostr(0, "  Can't delete file (?IN_USE?): %s\n", buf);
					ret = 0;
				}
		}
		res = _findnext(h, &fileinfo);
	}
	if (h != -1) _findclose(h);
	
	return ret;
}

//$BLG - v5.2.06: Add
int SCcacheClear(mmachine m)
{
	char buf[512];
	int ret;

	MMechostr(0, "> _cacheClear() - Start\n");

	if (Cachepack == NULL)
		{ MMpush(m, NIL); return 0; }

	strcpy(buf, Cachepack->path);
	BLG_BackslashToSlash(buf);
	buf[(strlen(Cachepack->path) - 1)] = 0;		// Removing last '/'
	ret = BLG_DeleteFiles(buf);
	
	MMpush(m, ret<<1);
	
	MMechostr(0, "< _cacheClear() - End\n");
	
	return 0;
}


/* ajout d'un chemin à la partition en cours */
int SPrefinePartition(mmachine m)
{
  int p, k;
  p = MMget(m, 0)>>1;
  if ((p == NIL) || (Cachepack == Firstpack)) return 0;
  
  k = SPrefinePack(Firstpack, MMstartstr(m, p));
  return 0;
}


/* ajout d'un chemin à la n-ieme partition */
int SPrefineNthPartition(mmachine m)
{
  int p, k, n;
  packdir f;

  n = MMpull(m)>>1;
  p = MMget(m,0)>>1;
  if ((n < 0) || (p == NIL)) return 0;
  
  f = Firstpack;
  while((f) && (n))
  {
	  f = f->next;
	  n--;
  }
  k = SPrefinePack(f, MMstartstr(m, p));
  return 0;
}


//$BB
/* add a scol partition */
int SPaddPartition(mmachine m)
{
  int type, part;
  
  type = MMpull(m)>>1;
  part = MMget(m,0)>>1;
  if ((type <= 0) || (type > 2) || (part == NIL) || (Firstpack == Cachepack)) {MMset(m, 0, NIL); return 0;};
  
  SPregistPart((MMstartstr(m, part)), "", type);
  SPinitpack();
  
  MMset(m, 0, 1);
  return 0;
}


//$BB
/* add a scol partition */
int SPremovePartition(mmachine m)
{
  if (Firstpack == Cachepack) {MMpush(m, NIL); return 0;};
  SPunRegistPart();
  SPinitpack();
  
  MMpush(m, 1);
  return 0;
}


/* verification de la presence d'un package
  en 0 : nom complet
 -> en 0 : 1 si present, 0 si absent */
int SPcheckpack(mmachine m)
{
  int p, k;
  char name[SIZESIGN];
  char buf[SIZESIGN];

  p = MMget(m,0)>>1;
  if (p == NIL) 
    return 0;
  
  k = SPgettypsign(MMstartstr(m, p));
  if ((k == TYPESNONE) && ((ScolRights & R_RIGHTS) == 0))
  {
    MMset(m, 0, NIL);
    return 0;
  }
  else if (k == TYPESENV)
  {
    SPgetname(MMstartstr(m, p), name);
	  p = MMfetch(m, MMgetglobal(m, OFFSCCUR)>>1, OFFCHANENV);
    if (MMpush(m, p)) return MERRMEM;
    
    if (k = SCsignenv(m)) 
      return k;

    sprintf(name, "%s$%s", name, MMstartstr(m, MMpull(m)>>1));
	  p = MMget(m, 0)>>1;
	  if (strcmp(name, MMstartstr(m, p)))
	  {
		  MMset(m, 0, NIL);
		  return 0;
	  }
  }
  else if (k == TYPESMACH)
  {
    SPgetname(MMstartstr(m, p), name);
	  if (k = SCsignmachine(m))
      return k;
	  
    sprintf(name, "%s&%s", name, MMstartstr(m, MMpull(m)>>1));
	  p = MMget(m, 0)>>1;
	  if (strcmp(name, MMstartstr(m, p)))
	  {
		  MMset(m, 0, NIL);
		  return 0;
	  }
  }
  else if (k == TYPESCOOKIES)
  {
    SPgetname(MMstartstr(m, p), name);
    sprintf(buf, "%s;%s", name, cookies);
	  if (strcmp(buf, MMstartstr(m, p)))
	  {
		  MMset(m, 0, NIL);
		  return 0;
	  }
  }
  
  if (SPfindfile(Firstpack, MMstartstr(m, p), NULL, name) == -1)
  {
    MMset(m, 0, NIL);
    return 0;
  }
  
  MMpull(m);
  return Mpushstrbloc(m, name);
}


/* definition du suffixe cookies
  en 0 : nom cookies 
  -> inchange */
int SPsetCookies(mmachine m)
{
  int p;
  char *c;

  if (cookies[0]) return 0;
  
  p = MMget(m, 0)>>1;
  if (p == NIL) return 0;
  
  c = MMstartstr(m, p);
  if ((*c) && (strlen(c) < 63)) strcpy(cookies, c);
  return 0;
}


/* stockage d'un package depuis la bande memoire
  en 0 : nom complet   1 : string package
 -> 0 : 0 si succes, -1 sinon */
int SPstorepack(mmachine m)
{
  int p, typs, n, k;
  char name[SIZESIGN], sign[SIZESIGN], sign2[SIZESIGN];
  FILE *g;
  int ret;

  p = MMpull(m)>>1;
  if (p == NIL)
  {
    MMset(m, 0, -1*2);
    return 0;
  }

  strcpy(sign, MMstartstr(m, p));
  SPgetname(sign, name);
  typs = SPgettypsign(sign);
  if ((typs == TYPESNONE) && ((ScolRights & W_RIGHTS) == 0))
  {
    MMset(m, 0, -1*2);
    return 0;
  }

  if ((typs == TYPESLOGIC) && ((ScolRights & K_RIGHTS) == 0))
  {
    MMset(m, 0, -1*2);
    return 0;
  }

  p = MMget(m, 0)>>1;
  if ((p == NIL) || (typs < 0))
  {
    MMset(m, 0, -1*2);
    return 0;
  }

  /* verification de la signature */
  n = MMsizestr(m, p);
  SCsign(m, MMstartstr(m, p), n, name, typs, sign2);
  if (strcmp(sign, sign2))
  {
    MMset(m, 0, -1*2);
    //MMechostr(0,"%s %s\n",sign,sign2);
    return 0;
  }
  
  p = MMget(m, 0)>>1;

  k = SPaddfile(Firstpack, sign2, n, name);
  //MMechostr(0, "_storepack k:%d\n", k);
  if ((k) || ((g = fopen(name, "wb")) == NULL))
  {
    //$BLG - Tracking
    MMechostr(0, "_storepack IF\n");
    MMset(m, 0, -1*2);
    if ((k != -1) && (Firstpack == Cachepack))
	  {
		  MMechostr(MSKRUNTIME, "Cache file : %s\n", name);
		  return MERRFILE;
	  }

	  return 0;
  }

  ret = fwrite(MMstartstr(m, p), 1, n, g);
  
  fclose(g);

  MMset(m,0,0);
  return 0;
}


//$BLG - v5.22: Add
// Décryptage d'un fichier crypté par méthode Cipher
// Decrypts a file crypted through Cipher method
// fun [S S] I
// Params: source & destination files
// Return: 0 or nil if problem
int SPuncypherpack(mmachine m)
{
  int psrc, pdst;
  char partname[SIZESIGN], fullname[SIZESIGN];
  char *buf;
  int isrcsz;
  FILE *f;
  
  
  //Retrieving params
  pdst = MMpull(m)>>1;
  psrc = MMpull(m)>>1;
  if ((pdst == NIL) || (psrc == NIL))
  {
  	MMpush(m, NIL);
  	return 0;
  }

	//Retrieving source file name from partition name
	strcpy(partname, MMstartstr(m, psrc));
  sprintf(fullname, "%s%s", Firstpack->path, partname);
  //MMechostr(0, "_uncypherpack - src: \n%s \n%s\n", partname, fullname);
  
  f = fopen(fullname, "rb");
  if (f == NULL)
  {
  	MMechostr(0, "_uncypherpack - cannot open src file: %s\n", fullname);
  	MMpush(m, NIL);
  	return 0;
  }
  
  fseek(f, 0, SEEK_END);
  isrcsz = ftell(f);
  
  fseek(f, 0, SEEK_SET);
  buf = (char *)malloc(isrcsz+1);
  if (buf == NULL)
  {
  	MMechostr(0, "_uncypherpack - cannot allocate buffer\n");
  	fclose(f);
  	MMpush(m, NIL);
  	return 0;
  }
  
  fread(buf, 1, isrcsz, f);
  fclose(f);
  buf[isrcsz] = 0;
  
  uncipher(buf, isrcsz);
  
  //Retrieving destination file name from partition name
	strcpy(partname, MMstartstr(m, pdst));
  sprintf(fullname, "%s%s", Firstpack->path, partname);
  //MMechostr(0, "_uncypherpack - dst: \n%s \n%s\n", partname, fullname);
  
  f = fopen(fullname, "wb");
  if (f == NULL)
  {
  	MMechostr(0, "_uncypherpack - cannot open dst file: %s\n", fullname);
  	free(buf);
  	MMpush(m, NIL);
  	return 0;
  }
  
  fwrite(&buf[4], 1, isrcsz-4, f);
  fclose(f);
  
  free(buf);

  MMpush(m,0);
  return 0;
}


/* préparation d'un fichier modifiable
 en 0 : nom complet
 -> 0 : type W si succes, NIL sinon */
int SPgetmodifypack(mmachine m)
{
  int p,typs,k;
  char name[SIZESIGN],sign[SIZESIGN],sign2[SIZESIGN];

  p=MMget(m,0)>>1;
  if (p==NIL) return 0;
  strcpy(sign,MMstartstr(m,p));
  SPgetname(sign,name);
  typs=SPgettypsign(sign);
  if ((typs==TYPESNONE)&&((ScolRights&W_RIGHTS)==0))
  {
      MMset(m,0,NIL);
      return 0;
  }
  if (typs != TYPESLOGIC)
  {
		/* verification de la signature */
		SCsign(m, NULL, 0, name, typs, sign2);
		if (strcmp(sign, sign2))
		{
	      MMset(m, 0, NIL);
	      return 0;
	  }
  }
  k = SPaddfile(Firstpack, sign, 0, name);
  MMpull(m);
  if (k < -1)
  {
	  //$BLG - Tracking
    //MMechostr(0, "_getmodifypack\n");
	  MMechostr(MSKRUNTIME, "file : %s\n", name);
	  return MERRFILE;
  }
  if (k) return MMpush(m, NIL);
  return Mpushstrbloc(m, name);
}


/* creation d'un package
  en 0 : nom W   1 : string package
 -> 0 : 0 si succes, -1 sinon */
int SPcreatepack(mmachine m)
{
  int p,n;
  char *name;
  FILE *g;

  p=MMpull(m)>>1;
  if (p==NIL)
  {
	  MMset(m,0,-1*2);
	  return 0;
  }
  name=MMstartstr(m,p);
  
  p=MMget(m,0)>>1;
  if (p==NIL)
    {
      MMset(m,0,-1*2);
      return 0;
    }
  n=MMsizestr(m,p);
  if ((g=fopen(name,"wb"))==NULL)
  {
    MMset(m,0,-1*2);
    //$BLG - Tracking
    //MMechostr(0, "_createpack\n");
    if (Firstpack==Cachepack)
	  {
		  MMechostr(MSKRUNTIME,"Cache file : %s\n",name);
		  return MERRFILE;
	  }
	  return 0;
  }
  fwrite(MMstartstr(m,p),1,n,g);
  fclose(g);

  MMset(m,0,0);
  return 0;
}


/* append d'un package
  en 0 : nom W   1 : string package
 -> 0 : 0 si succes, -1 sinon */
int SPappendpack(mmachine m)
{
  int p,n;
  char *name;
  FILE *g;

  //$BLG - v4.6a5 : Add
  int stop = 0;
  int max  = 256;
  g = NULL;

  // Filename
  p=MMpull(m)>>1;
  if (p==NIL)
  {
	  MMset(m,0,-1*2);
	  return 0;
  }
  name=MMstartstr(m,p);
  
  //$BLG - v4.6a6: Trying to fix Cannot Write File error ...
  BLG_SlashToBackslash(name);
  
  //String that must be appended to file
  p=MMget(m,0)>>1;
  if (p==NIL)
  {
    MMset(m,0,-1*2);
    return 0;
  }
  n=MMsizestr(m,p);
  
  //$BLG - v4.6a5: Not understanding why but this function seems to crash regularly ... (Scol error, not system error)
  /*
  if ((g=fopen(name,"a+b"))==NULL)
  {
    MMset(m,0,-1*2);
    //$BLG - Tracking
    MMechostr(0, "_appendpack\n");    
    if (Firstpack==Cachepack)
	  {
		  MMechostr(MSKRUNTIME,"Cache file : %s\n",name);
		  return MERRFILE;
	  }
	  return 0;
  }
  */
  while ((g == NULL) && (stop < max))
  {
  	g = fopen(name,"a+b");
  	stop += 1;
  };
  if (g==NULL)
  {
    MMset(m,0,-1*2);
    //$BLG - Tracking
    //MMechostr(0, "_appendpack\n");    
    if (Firstpack==Cachepack)
	  {
		  MMechostr(MSKRUNTIME,"Cache file : %s\n",name);
		  return MERRFILE;
	  }
	  return 0;
  }

  fwrite(MMstartstr(m,p),1,n,g);
  fclose(g);

  MMset(m,0,0);
  return 0;
}

/* conversion W -> P */
int SPWtoP(mmachine m)
{
	return 0;
}

/* chargement d'un package en memoire (sans traitement particulier)
  en 0 : chemin complet
 -> en 0 : chaine contenant le package (nil si absent)
*/
#if SCOL_PLATFORM == SCOL_PLATFORM_WINDOWS
	int SPgetpack(mmachine m)
	{
	  int p,l,s,size;
	  HANDLE g;
	  char *ch;
	  int res;

	  p=MMget(m,0)>>1;
	  if ((p==NIL)||((g=CreateFile(MMstartstr(m,p),GENERIC_READ,FILE_SHARE_READ,NULL,
		  OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL,NULL))==INVALID_HANDLE_VALUE))
		{
		  MMset(m,0,NIL);
		  return 0;
		}
	  size=GetFileSize(g,NULL);

	  l=(size+4)>>2;
	  s=MMmalloc(m,l+1,TYPEBUF); if (s==NIL) return MERRMEM;
	  MMsetsizestr(m,s,size);
	  ch=MMstartstr(m,s);
	  ReadFile(g,ch,size,&res,NULL);
	  CloseHandle(g);
	  ch[size]=0;

	  MMset(m,0,s+s+1);
	  return 0;
	}
#elif SCOL_PLATFORM == SCOL_PLATFORM_LINUX
	int SPgetpack(mmachine m)
	{
	  int p,k,l,s,size;
	  char buf[1024];
	  FILE *g;
	  char *ch;

	  p=MMget(m,0)>>1;
	  if ((p==NIL)||((g=fopen(MMstartstr(m,p),"rb"))==NULL))
		{
		  MMset(m,0,NIL);
		  return 0;
		}
	  size=0;
	  do
		{
		  k=fread(buf,1,1024,g);
		  size+=k;
		}
	  while(k==1024);
	  fseek(g,0,SEEK_SET);

	  l=(size+4)>>2;
	  s=MMmalloc(m,l+1,TYPEBUF); if (s==NIL) return MERRMEM;
	  MMsetsizestr(m,s,size);
	  ch=MMstartstr(m,s);
	  fread(ch,1,size,g);
	  fclose(g);
	  ch[size]=0;

	  MMset(m,0,s+s+1);
	  return 0;
	}
#else
	// TODO_MAC
	int SPgetpack(mmachine m){return 0;}
#endif


/* destruction d'un fichier */
int SPdeletepack(mmachine m)
{
  char buf1[SIZESIGN];
  char buf2[SIZESIGN];
  int q;
  packdir p;

  q=MMget(m,0)>>1;
  if ((q==NIL)||(Firstpack==Cachepack)||(MMsizestr(m,q)>=SIZESIGN)) return 0;
  strcpy(buf1,MMstartstr(m,q));
  SPslashtoback(buf1);
  SPkillmaj(buf1);

  p=Firstpack; /* cherche le fichier dans les partitions en ecriture */
  while(p)
  {
    if ((p->quota!=-1)&&(p->path))
    {
		  strcpy(buf2,p->path);
		  SPslashtoback(buf2);
		  SPkillmaj(buf2);
		  //MMechostr(1,"compare %s\n        %s\n",buf1,buf2);
		  if (!strncmp(buf1,buf2,strlen(buf2)))
		  {
			#if SCOL_PLATFORM == SCOL_PLATFORM_WINDOWS
	  		  DeleteFile(MMstartstr(m,q));
        	#elif SCOL_PLATFORM == SCOL_PLATFORM_LINUX
			  unlink(MMstartstr(m,q));
        	#else
			  // TODO_MAC
        	#endif
			MMset(m,0,NIL);
			return 0;
		  }
    }
    p=p->next;
  }
  return 0;
}

/* chargement (et compilation) d'un package sur le canal courant 
 le nom du package est dans la pile */
int SPloadpakbis(mmachine m)
{
  int k,t;
  char path[SIZESIGN];

  t=MMgetglobal(m,OFFSCCUR);  /* empiler l'environnement courant */
  if (t==NIL) return MERRTYP;
  t=MMfetch(m,t>>1,OFFCHANENV);
  if (MMpush(m,t)) return MERRMEM;

  t=MMget(m,1);
  if (t==NIL) return 0;

  if (SPfindfile(Firstpack,MMstartstr(m,t>>1),NULL,path))
    {
      MMechostr(0,"%s : not found\n",MMstartstr(m,t>>1));
      return MERRNF;
    }
  if (k=PKloader(m,path,MMstartstr(m,t>>1))) return k;  /* package magma */

  t=MMgetglobal(m,OFFSCCUR);  /* stocker le nouvel environnement */
  MMstore(m,t>>1,OFFCHANENV,MMget(m,0));
  return 0;
}

int SPloadpak(mmachine m)
{
  int pp,k;

  pp=MMgetPP(m);
  k=SPloadpakbis(m);
  MMsetPP(m,pp);
  MMset(m,0,k*2);
  return k;
}

//$BB test pkg
int SPtestpakbis(mmachine m, char * elogs)
{
  int k,t,c;
  char path[SIZESIGN];

  c=MMgetglobal(m,OFFSCCUR);  /* empiler l'environnement courant */
  if (c==NIL) return MERRTYP;
  t=MMfetch(m,c>>1,OFFCHANENV);
  if (MMpush(m,t)) return MERRMEM;

  t=MMget(m,1);
  if (t==NIL) return 0;

  if (SPfindfile(Firstpack,MMstartstr(m,t>>1),NULL,path))
    {
      MMechostr(0,"%s : not found\n",MMstartstr(m,t>>1));
      return MERRNF;
    }
  k=PKtest(m,path,MMstartstr(m,t>>1),elogs);  /* package magma */
  
  MMpull(m);

  return k;
}

//$BB test pkg
int SPtestpak(mmachine m)
{
  int k;
	char elogs[16384];
	sprintf (elogs, "");

  k=SPtestpakbis(m, elogs);
  
  MMpull(m);

	if (k)
		Mpushstrbloc(m, elogs);
	else
		MMpush(m, NIL);
  return 0;
}

//$BB test pkg
int SPtestpakbisS(mmachine m, char* elogs)
{
  int k, t, tfile, tdata;

  //empiler l'environnement courant
  t = MMgetglobal(m, OFFSCCUR);
  if (t == NIL)         return MERRTYP;
  t = MMfetch(m, t>>1, OFFCHANENV);
  if (MMpush(m, t))     return MERRMEM;

  tfile = MMget(m, 1);
  if (tfile == NIL)     return 0;
  tdata = MMget(m, 2);
  if (tdata == NIL)     return 0;

  k = PKtestS(m, MMstartstr(m, tdata>>1), MMstartstr(m, tfile>>1), elogs);

  MMpull(m);

  return k;
}

//$BB test pkg
int SPtestpakS(mmachine m)
{
  int s, k;
  char filename[256];
	char elogs[16384];
	sprintf (elogs, "");

  // get the current tickcount
  MMpush(m, Msearchinsyspak(m, "_tickcount"));
  Minterpreter(m);
  s = MMpull(m)>>1;

  // get a temporary filename
  sprintf(&filename[0], "blg/tmp/tmp%d.pkg", s);
  Mpushstring(m, filename);
  
  k=SPtestpakbisS(m, elogs);
	//MMechostr(0, ">>>>>>>>>>> debug %s", elogs);

	MMpull(m);
	if (k)
		Mpushstrbloc(m,elogs);
	else
		MMpush(m, NIL);
  
  return 0;
}

//$BLG: same as SPloadpakbis, but used with _loadS/SPloadpakS (see below)
int BLG_SPloadpakbisS(mmachine m)
{
  int k, t, tfile, tdata;

  //empiler l'environnement courant
  t = MMgetglobal(m, OFFSCCUR);
  if (t == NIL)         return MERRTYP;
  t = MMfetch(m, t>>1, OFFCHANENV);
  if (MMpush(m, t))     return MERRMEM;

  tfile = MMget(m, 1);
  if (tfile == NIL)     return 0;
  tdata = MMget(m, 2);
  if (tdata == NIL)     return 0;

  if (k = BLG_PKloaderS(m, MMstartstr(m, tdata>>1), MMstartstr(m, tfile>>1))) return k;

  // stocker le nouvel environnement
  t = MMgetglobal(m,OFFSCCUR);
  MMstore(m, t>>1, OFFCHANENV, MMget(m, 0));
  return 0;
}

//
//$LB (13/10/2004)
//
// _loadS
//
// an equivalent to _load, but from a String 
//
//$BLG: New version without temporary file (original version can be found below)
//      Note that we still specify a "virtual" temporary filename to reference the package
int SPloadpakS(mmachine m)
{
  int s, pp, k;
  char filename[256];

  // get the current tickcount
  MMpush(m, Msearchinsyspak(m, "_tickcount"));
  Minterpreter(m);
  s = MMpull(m)>>1;

  // get a temporary filename
  sprintf(&filename[0], "blg/tmp/tmp%d.pkg", s);
  Mpushstring(m, filename);

  pp = MMgetPP(m);
  
  k = BLG_SPloadpakbisS(m);

  MMsetPP(m, pp);
  MMset(m, 0, k*2);
  
  return k;
}
// Original version based on a temporary file
/*
int SPloadpakS (mmachine m)
{
int s,pp,k;
char filename[256];

  // get the current tickcount
  MMpush(m,Msearchinsyspak(m,"_tickcount"));
  Minterpreter(m);
  s = MMpull(m)>>1;

  // get a temporary filename
  //$BLG
  //$BLG Note: Do not ask me why but the first "argument", be it a directory (tmp/) or a name (tmp) isn't taken into account...
  //           The temporary file was created in the Partition.
  //sprintf (&filename[0], "tmp/tmp%d.pkg", s);
  sprintf (&filename[0], "blg/tmp/tmp%d.pkg", s);
  Mpushstring (m, filename);

  // call storepack to copy the string into the file
  MMpush(m,Msearchinsyspak(m,"_storepack"));
  Minterpreter(m);

  MMpull(m);
  Mpushstring (m, filename);

  // then load the pack
  pp=MMgetPP(m);
  k=SPloadpakbis(m);

  MMsetPP(m,pp);
  MMset(m,0,k*2);
  
  return k;
}
*/


/* calcul du nom complet d'un fichier present en bande memoire
  en 0: string type (caractere separateur), 1:nom clair 2:string package
 -> 0 : nom complet si succes, nil sinon */
int SPgetlongname(mmachine m)
{
  int p,typs;
  char name[SIZESIGN],sign[SIZESIGN];

  p=MMpull(m)>>1;
  if (p==NIL)
  {
    MMpull(m);
    MMset(m,0,NIL);
    return 0;
  }
  typs=SPgettypsign(MMstartstr(m,p));
  p=MMpull(m)>>1;
  if (p==NIL)
  {
    MMset(m,0,NIL);
    return 0;
  }
  strcpy(name,MMstartstr(m,p));

  p=MMget(m,0)>>1;
  if (p==NIL)
  {
    //MMechostr(0, "SPgetlongname NIL\n");
    MMset(m,0,NIL);
    return 0;
  }

	//MMechostr(0, "SPgetlongname %s %d\n", MMstartstr(m,p), MMsizestr(m,p));

  /* verification de la signature */
  if (SCsign(m,MMstartstr(m,p),MMsizestr(m,p),name,typs,sign)==-1)
  {
    MMset(m,0,NIL);
    return 0;
  }
  MMpull(m);
  return Mpushstrbloc(m,sign);
}

/* calcul de la signature d'un fichier, sans passer par la memoire scol */
int SPfileSign(mmachine m)
{
  int q,i;
  char bufs[1024];
  char sign[SIZESIGN];
  FILE *fd;

  q=MMpull(m)>>1;
  if (q==NIL) return MMpush(m,NIL);

  if (fd=fopen(MMstartstr(m,q),"rb"))
  {
	  SCincSignInit();
	  do
	  {
		  i=fread(bufs,1,1024,fd);
		  SCincSign(bufs,i,NULL);
	  }
	  while(i==1024);
	  strcpy(sign,"#");
	  SCincSign(NULL,0,&sign[1]);
	  fclose(fd);
	  return Mpushstrbloc(m,sign);
  }
  return MMpush(m,NIL);
}

//$BLG - v5.24: Add
//_filemd5 - fun [P] S
//MD5 file signing
int SPfilemd5(mmachine m)
{
  int q, i;
  unsigned char bufs[1024], digest[16];
  /* char sign[SIZESIGN]; */
  FILE *fd;
  MD5_CTX context;
  int /* p ,*/ l, s, sl;
  char *cp;
  unsigned char c, c1, c2;

  q = MMget(m, 0);
  if (q == NIL) 
  	return 0;

  l = 32;
  sl = (l+4)>>2;
  s = MMmalloc(m, sl+1, TYPEBUF); 
  if (s == NIL) 
  	return MERRMEM;

  // in case of GC after MMmalloc
	q = MMget(m, 0);
	q >>= 1;

  m->tape[s+SizeHeader] = l;
  cp = (char*) &m->tape[s+SizeHeader+1];
	cp[l] = 0;
  
  if (fd = fopen(MMstartstr(m, q), "rb"))
  {
	  MD5Init(&context);
	  while (i = fread(bufs, 1, 1024, fd))
			MD5Update(&context, bufs, i);
		MD5Final(digest, &context);
	  fclose(fd);
	  
		for (i = 0; i < 16; i++)
		{
			c = digest[i];
			c1 = c>>4;
			if (c1 <= 9)
				cp[i*2] = (unsigned char)(c1 + 48);
			else
				cp[i*2] = (unsigned char)(c1 + 97 - 10);
			c2 = c&15;
			if (c2 <= 9)
				cp[(i*2)+1] = (unsigned char)(c2 + 48);
			else
				cp[(i*2)+1] = (unsigned char)(c2 + 97 - 10);
		}
	  
	  MMset(m, 0, s+s+1);
	  return 0;
  }

  MMset(m, 0, NIL);
  return 0;
}


/* calcul de la taille d'un fichier, sans passer par la memoire scol */
#if SCOL_PLATFORM == SCOL_PLATFORM_WINDOWS
	int SPfileSize(mmachine m)
	{
		HANDLE f;
		int res,q;
	
		q=MMpull(m)>>1;
		if (q==NIL) return MMpush(m,NIL);
		f=CreateFile(MMstartstr(m,q),GENERIC_READ,FILE_SHARE_READ,NULL,
			OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL,NULL);
		if (f==INVALID_HANDLE_VALUE) return MMpush(m,NIL);
		SetFilePointer(f,0,NULL,FILE_END);
		res=SetFilePointer(f,0,NULL,FILE_CURRENT);
		CloseHandle(f);
		return MMpush(m,res*2);
	}
#elif SCOL_PLATFORM == SCOL_PLATFORM_LINUX
	int SPfileSize(mmachine m)
	{
		FILE *f;
		int res,q;
	
		q=MMpull(m)>>1;
		if (q==NIL) return MMpush(m,NIL);
		f=fopen(MMstartstr(m,q),"rb");
		if (f==NULL) return MMpush(m,NIL);
		fseek(f,0,SEEK_END);
		res=ftell(f);
		fclose(f);
		return MMpush(m,res*2);
	}
#else
	// TODO_MAC
  	int SPfileSize(mmachine m){return 0;}
#endif

/* chargement d'un package hard sur le canal courant 
 le nom du package est dans la pile */
int SCloadhardbis(mmachine m)
{
  int k,t;
  char *name;

  t=MMgetglobal(m,OFFSCCUR);  /* empiler l'environnement courant */
  if (t==NIL) return 0;
  t=MMfetch(m,t>>1,OFFCHANENV);
  if (k=MMpush(m,t)) return k;

  t=MMget(m,1);
  if (t==NIL) return 0;
  name=MMstartstr(m,t>>1);
  
  t=Msearchpak(m,MMgetglobal(m,OFFSCSYS),name);
  if (t==NIL) return MERRNF;

  if (k=MMpush(m,t+t+1)) return k;  /* package systeme */
  if (k=PKaddpak(m)) return k;

  t=MMgetglobal(m,OFFSCCUR);  /* stocker le nouvel environnement */
  MMstore(m,t>>1,OFFCHANENV,MMget(m,0));
  return 0;
}


#if SCOL_PLATFORM == SCOL_PLATFORM_WINDOWS
	/*
	Returns the date (as a tuple) when the file was last modified
	[0] file path
	(Windows version)
	*/
	int SPGetModifDate(mmachine m)
	{
	  SEWORD     path = SEPOP(m);
	  HANDLE     hFile;
	  FILETIME   ft;
	  SYSTEMTIME st;

	  // Returns nil if argument path is nil
	  if (path == NIL) {
		SECHECK(SEPUSH(m, NIL));
		return MERROK;
	  }
	  if ((hFile = CreateFile(SESTR(m, SEW2P(path)), GENERIC_READ, FILE_SHARE_READ, 
		  NULL, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL)) == INVALID_HANDLE_VALUE) {
		SECHECK(SEPUSH(m, NIL));
		return MERROK;
	  }
	  if (!GetFileTime(hFile, NULL, NULL, &ft)) {
		SECHECK(SEPUSH(m, NIL));
		return MERROK;
	  }
	  if (!FileTimeToSystemTime(&ft, &st)) {
		SECHECK(SEPUSH(m, NIL));
		return MERROK;
	  }
	  CloseHandle(hFile);
	  SECHECK(SEPUSH(m, SEI2W(st.wYear)));
	  SECHECK(SEPUSH(m, SEI2W(st.wMonth)));
	  SECHECK(SEPUSH(m, SEI2W(st.wDay)));
	  SECHECK(SEPUSH(m, SEI2W(st.wDayOfWeek)));
	  SECHECK(SEPUSH(m, SEI2W(st.wHour)));
	  SECHECK(SEPUSH(m, SEI2W(st.wMinute)));
	  SECHECK(SEPUSH(m, SEI2W(st.wSecond)));
	  SECHECK(SEPUSH(m, SEI2W(st.wMilliseconds)));
	  SECHECK(SEPUSH(m, SEI2W(8)));
	  SECHECK(SENEWTUPLE(m));
	  return MERROK;
	}
#else
	/*
	Returns the date (as a tuple) when the file was last modified
	[0] file path
	(ANSI-based version)
	*/
	int SPGetModifDate(mmachine m)
	{
	  SEWORD      path = SEPOP(m);
	  struct stat st;
	  struct tm*  tm;

	  // Returns nil if argument path is nil
	  if (path == NIL) {
		SECHECK(SEPUSH(m, NIL));
		return MERROK;
	  }
	  if (stat(SESTR(m, SEW2P(path)), &st)) {
		SECHECK(SEPUSH(m, NIL));
		return MERROK;
	  }
	  tm = localtime(&st.st_mtime);
	  SECHECK(SEPUSH(m, SEI2W(tm->tm_year+1900)));
	  SECHECK(SEPUSH(m, SEI2W(tm->tm_mon+1)));
	  SECHECK(SEPUSH(m, SEI2W(tm->tm_mday)));
	  SECHECK(SEPUSH(m, SEI2W(tm->tm_wday+1)));
	  SECHECK(SEPUSH(m, SEI2W(tm->tm_hour)));
	  SECHECK(SEPUSH(m, SEI2W(tm->tm_min)));
	  SECHECK(SEPUSH(m, SEI2W(tm->tm_sec)));
	  SECHECK(SEPUSH(m, SEI2W(0)));
	  SECHECK(SEPUSH(m, SEI2W(8)));
	  SECHECK(SENEWTUPLE(m));
	  return MERROK;
	}
#endif


int SCloadhard(mmachine m)
{
  int pp,k;

  pp=MMgetPP(m);
  k=SCloadhardbis(m);
  MMsetPP(m,pp);
  MMset(m,0,k*2);
  return k;
}


char *SCGetName(char *name)
{
    int i,k;

    i=k=0;
    while(name[i])
    {
        if ((name[i]=='\\')||(name[i]=='/')) k=i+1;
        i++;
    }
	return &name[k];
}

/* signature d'un environnement */
int SCsignenv(mmachine m)
{
  int p;
  char *s;
  char sign[32];

  SCincSignInit();
  p=MMpull(m);
  while((p!=NIL)&&(p!=MMgetglobal(m,OFFSCBASE)))
    {
      s=SCGetName((char*)MMstart(m,MMfetch(m,MMfetch(m,p>>1,OFFLVAL)>>1,OFFPKNAME)>>1));
      SCincSign(s,strlen(s)+1,NULL);
	  p=MMfetch(m,p>>1,OFFLNEXT);
    }
  SCincSign(NULL,0,sign);
  return Mpushstrbloc(m,sign);
}

/* signature de la machine */
int SCsignmachine(mmachine m)
{
  int p,q;
  char *s;
  char sign[32];

  SCincSignInit();
  q=MMgetglobal(m,OFFSCCHAN);
  while(q!=NIL)
    {
      p=MMfetch(m,MMfetch(m,q>>1,OFFLVAL)>>1,OFFCHANENV);
      while((p!=NIL)&&(p!=MMgetglobal(m,OFFSCBASE)))
        {
          s=SCGetName((char*)MMstart(m,MMfetch(m,MMfetch(m,p>>1,OFFLVAL)>>1,OFFPKNAME)>>1));
          SCincSign(s,strlen(s)+1,NULL);
	      p=MMfetch(m,p>>1,OFFLNEXT);
        }
      q=MMfetch(m,q>>1,OFFLNEXT);
    }
  SCincSign(NULL,0,sign);
  return Mpushstrbloc(m,sign);
}

int SCgetress(mmachine m);

/* routine interceptant un message "__checksign" */
int SCchecksign(mmachine m)
{
  int p,k;
  char buf[256];
  char *c; 

  if (Mpushstrbloc(m,"License")) return MERRMEM;
  if (k=SCgetress(m)) return k;
  p=MMpull(m);
  if ((p==NIL)||(MMsizestr(m,p>>1)<10)) c="No_license";
  else c=MMstartstr(m,p>>1)+8;

  sprintf(buf,"__version \"%s\" %x %x \"%s\"",VERSION_NAME,MAXSOCKS,maxsock,c);

  if (Mpushstring(m,buf)) return MERRMEM;
  c=(char*)MMstart(m,MMget(m,0)>>1);
  p=strlen(c)+1;
  c[0]=(p-2)&255;
  c[1]=((p-2)>>8)&255;
  return SCsendpile(m);
}



#ifdef SERVER
extern int socklife;


//$ LB (30/05/2002) : defined an empty SCsendCapacity for the ClubHouse server
// $ LB (31/01/2005) : SCOL_FREE
#if defined (CLUBHOUSE_SERVER) || defined (SCOL_FREE)
/* routine envoyant la capacité courante au Superviseur */
int SCsendCapacity(mmachine m)
{return 0;}
#else


/* routine envoyant la capacité courante au Superviseur */
int SCsendCapacity(mmachine m)
{
  int p,k;
  char buf[128];
  char *c;


//$ ER(09/07/01) SCsendCapacity was previously defined on two versions, upon the SERVERM or SERVERS constant
//				 Here I merged the two version in one and manage the running with the MUTUALISE variable
	if (MUTUALISE)
	{
		sprintf(buf,"__@c%d",maxsock-1);

		if (MMpush(m,MMgetglobal(m,OFFSCCUR))) return MERRMEM;
		k=0;
		if (!SCselectcanal(m,socklife))
		{
			if (Mpushstring(m,buf)) return MERRMEM;
			c=(char*)MMstart(m,MMget(m,0)>>1);
			p=strlen(c)+1;
			c[0]=(p-2)&255;
			c[1]=((p-2)>>8)&255;
			k=SCsendpile(m);
		}
	} else
	{
		sprintf(buf,"__@c%d",SCgetnbsocket(m));
		if (MMpush(m,MMgetglobal(m,OFFSCCUR))) return MERRMEM;
		k=0;
		if (!SCselectcanal(m,socklife))
		{
			if (Mpushstring(m,buf)) return MERRMEM;
			c=(char*)MMstart(m,MMget(m,0)>>1);
			p=strlen(c)+1;
			c[0]=(p-2)&255;
			c[1]=((p-2)>>8)&255;
			k=SCsendpile(m);
		}
	}

	MMsetglobal(m,OFFSCCUR,MMpull(m));       /* repositionne environnement */
	return k;
}  
#endif
#endif


#if SCOL_PLATFORM == SCOL_PLATFORM_WINDOWS
	/* retourne la liste des fichiers d'un répertoire */
	int SClistoffiles(mmachine m)
	{
		int res,p,n,k,i;
		long h;
		struct _finddata_t fileinfo;
		char buf[1024],shortbuf[1024];
		packdir pk;

		p=MMpull(m)>>1;
		if (p==NIL) return MMpush(m,NIL);
		if (MMsizestr(m,p)>512) return MMpush(m,NIL);
		strcpy(shortbuf,MMstartstr(m,p));
		if ((Firstpack==Cachepack)&&(strncmp(shortbuf,"public/",7))&&(strcmp(shortbuf,"public"))) return MMpush(m,NIL);
		p=strlen(shortbuf);

		if (shortbuf[0]=='/') return MMpush(m,NIL);
		if ((p)&&(!SPisname(shortbuf[0],0))) return MMpush(m,NIL);
		for(i=1;i<p;i++) if (!SPisname(shortbuf[i],shortbuf[i-1])) return MMpush(m,NIL);

		if ((p)&&(shortbuf[p-1]=='/')) shortbuf[p-1]=0;

		p=strlen(shortbuf);
		n=0;
		pk=Firstpack;

		while(pk)
		{
			shortbuf[p]=0;
			if (p) sprintf(buf,"%s%s/*.*",pk->path,shortbuf);
			else sprintf(buf,"%s*.*",pk->path);
			h=_findfirst(buf,&fileinfo );
			res=h;
			while(res!=-1)
			{
				if (p) sprintf(shortbuf+p,"/%s",fileinfo.name);
				else sprintf(shortbuf+p,"%s",fileinfo.name);
				if (!(fileinfo.attrib&16))
				{
					SPkillmaj(shortbuf);
					if (k=Mpushstrbloc(m,shortbuf)) return k;
					n++;
				}
				res=_findnext(h,&fileinfo );
			}
			if (h!=-1) _findclose(h);
			pk=pk->next;
		}
		if (MMpush(m,NIL)) return MERRMEM;
		for(i=0;i<n;i++)
		{
			if (MMpush(m,2*2)) return MERRMEM;
			if (k=MBdeftab(m)) return k;
		}
		return 0;
	}


	/* retourne la liste des sous-répertoires d'un répertoire */
	int SClistofsubdir(mmachine m)
	{
		int res,p,n,k,i;
		long h;
		struct _finddata_t fileinfo;
		char buf[1024],shortbuf[1024];
		packdir pk;
	
		p=MMpull(m)>>1;
		if (p==NIL) return MMpush(m,NIL);
		if (MMsizestr(m,p)>512) return MMpush(m,NIL);
		strcpy(shortbuf,MMstartstr(m,p));
		if ((Firstpack==Cachepack)&&(strncmp(shortbuf,"public/",7))&&(strcmp(shortbuf,"public"))) return MMpush(m,NIL);
		p=strlen(shortbuf);
	
		if (shortbuf[0]=='/') return MMpush(m,NIL);
		if ((p)&&(!SPisname(shortbuf[0],0))) return MMpush(m,NIL);
		for(i=1;i<p;i++) if (!SPisname(shortbuf[i],shortbuf[i-1])) return MMpush(m,NIL);
	
		if ((p)&&(shortbuf[p-1]=='/')) shortbuf[p-1]=0;
	
		p=strlen(shortbuf);
		n=0;
		pk=Firstpack;
	
		while(pk)
		{
			shortbuf[p]=0;
			if (p) sprintf(buf,"%s%s/*.*",pk->path,shortbuf);
			else sprintf(buf,"%s*.*",pk->path);
			h=_findfirst(buf,&fileinfo );
			res=h;
			while(res!=-1)
			{
				if (p) sprintf(shortbuf+p,"/%s",fileinfo.name);
				else sprintf(shortbuf+p,"%s",fileinfo.name);
				if (fileinfo.attrib&16)
				{
					if (strcmp(fileinfo.name,".")&&strcmp(fileinfo.name,".."))
					{
						SPkillmaj(shortbuf);
						if (k=Mpushstrbloc(m,shortbuf)) return k;
						n++;
					}
				}
				res=_findnext(h,&fileinfo );
			}
			if (h!=-1) _findclose(h);
			pk=pk->next;
		}
		if (MMpush(m,NIL)) return MERRMEM;
		for(i=0;i<n;i++)
		{
			if (MMpush(m,2*2)) return MERRMEM;
			if (k=MBdeftab(m)) return k;
		}
		return 0;
	}
#elif SCOL_PLATFORM == SCOL_PLATFORM_LINUX
	int SClistoffiles(mmachine m)
	{
		int p,q,n,k,i;
		long h;
		DIR *d;
		struct dirent *dp;
		struct stat typ;
		char buf[1024],shortbuf[1024];
		packdir pk;
	
		p=MMpull(m)>>1;
		if (p==NIL) return MMpush(m,NIL);
		if (MMsizestr(m,p)>512) return MMpush(m,NIL);
		strcpy(shortbuf,MMstartstr(m,p));
		if ((Firstpack==Cachepack)&&(strncmp(shortbuf,"public/",7))&&(strcmp(shortbuf,"public"))) return MMpush(m,NIL);
		p=strlen(shortbuf);
	
		if ((p)&&(!SPisname(shortbuf[0],0))) return MMpush(m,NIL);
		for(i=1;i<p;i++) if (!SPisname(shortbuf[i],shortbuf[i-1])) return MMpush(m,NIL);
	
		if ((p)&&(shortbuf[p-1]=='/')) shortbuf[p-1]=0;
	
		SPkillmaj(shortbuf);
		p=strlen(shortbuf);
		n=0;
		pk=Firstpack;
	
		while(pk)
		{
			shortbuf[p]=0;
			if (p) sprintf(buf,"%s%s",pk->path,shortbuf);
			else sprintf(buf,"%s",pk->path);
			d=opendir(buf);
			q=strlen(buf);
			if (d)  while(dp=readdir(d))
			{
				if (p) sprintf(shortbuf+p,"/%s",dp->d_name);
				else sprintf(shortbuf+p,"%s",dp->d_name);
				sprintf(buf+q,"/%s",dp->d_name);
				stat(buf,&typ);
				if ((typ.st_mode&S_IFMT)!=S_IFDIR)
				{
					SPkillmaj(shortbuf);
					if (k=Mpushstrbloc(m,shortbuf)) return k;
					n++;
				}
			}
			if (d) closedir(d);
			pk=pk->next;
		}
		if (MMpush(m,NIL)) return MERRMEM;
		for(i=0;i<n;i++)
		{
			if (MMpush(m,2*2)) return MERRMEM;
			if (k=MBdeftab(m)) return k;
		}
		return 0;
	}

	int SClistofsubdir(mmachine m)
	{
		int p,q,n,k,i;
		long h;
		DIR *d;
		struct dirent *dp;
		struct stat typ;
		char buf[1024],shortbuf[1024];
		packdir pk;
	
		p=MMpull(m)>>1;
		if (p==NIL) return MMpush(m,NIL);
		if (MMsizestr(m,p)>512) return MMpush(m,NIL);
		strcpy(shortbuf,MMstartstr(m,p));
		if ((Firstpack==Cachepack)&&(strncmp(shortbuf,"public/",7))&&(strcmp(shortbuf,"public"))) return MMpush(m,NIL);
		p=strlen(shortbuf);
	
		if ((p)&&(!SPisname(shortbuf[0],0))) return MMpush(m,NIL);
		for(i=1;i<p;i++) if (!SPisname(shortbuf[i],shortbuf[i-1])) return MMpush(m,NIL);
	
		if ((p)&&(shortbuf[p-1]=='/')) shortbuf[p-1]=0;
	
		SPkillmaj(shortbuf);
		p=strlen(shortbuf);
		n=0;
		pk=Firstpack;
	
		while(pk)
		{
			shortbuf[p]=0;
			if (p) sprintf(buf,"%s%s",pk->path,shortbuf);
			else sprintf(buf,"%s",pk->path);
			d=opendir(buf);
			q=strlen(buf);
			if (d)  while(dp=readdir(d))
			{
				if (p) sprintf(shortbuf+p,"/%s",dp->d_name);
				else sprintf(shortbuf+p,"%s",dp->d_name);
				sprintf(buf+q,"/%s",dp->d_name);
				stat(buf,&typ);
				if ((typ.st_mode&S_IFMT)==S_IFDIR)
					if (strcmp(dp->d_name,".")&&strcmp(dp->d_name,".."))
					{
						SPkillmaj(shortbuf);
						if (k=Mpushstrbloc(m,shortbuf)) return k;
						n++;
					}
			}
			if (d) closedir(d);
			pk=pk->next;
		}
	
		if (MMpush(m,NIL)) return MERRMEM;
		for(i=0;i<n;i++)
		{
			if (MMpush(m,2*2)) return MERRMEM;
			if (k=MBdeftab(m)) return k;
		}
		return 0;
	}
#else
	// TODO_MAC
  int SClistoffiles(mmachine m){return 0;}
  int SClistofsubdir(mmachine m) {return 0;}
#endif


/* nom de l'utilisateur */
int SCusername(mmachine m)
{
	char buf[128];

	buf[0]=0;
	/*	GetUserName(buf,127);
	 */
	return Mpushstrbloc(m,buf);
}

/* nom de l'ordinateur */
int SCcomputername(mmachine m)
{
	char buf[128];

	buf[0]=0;
	/*GetComputerName(buf,127);
	 */
	return Mpushstrbloc(m,buf);
}

#if SCOL_PLATFORM == SCOL_PLATFORM_WINDOWS
	/* deplace les fichiers du cache dans un sous-repertoire */
	int SCmovecache(mmachine m)
	{
		int res,p,n,i;
		long h;
		struct _finddata_t fileinfo;
		char bufdir[1024],shortbuf[1024];
		char bufsrc[1024],bufdst[1024];
		packdir pk;

		p=MMget(m,0)>>1;
		if (p==NIL) return 0;
		if (MMsizestr(m,p)>512) return 0;
		strncpy(shortbuf,MMstartstr(m,p),16);
		shortbuf[16]=0;
		p=strlen(shortbuf);
		if ((p==0)||(shortbuf[0]=='/')) return 0;
		if ((p)&&(!SPisname(shortbuf[0],0))) return 0;
		for(i=1;i<p;i++) if (!SPisname(shortbuf[i],shortbuf[i-1])) return 0;
		if ((p)&&(shortbuf[p-1]=='/')) shortbuf[p-1]=0;

		n=0;
		pk=Cachepack;

		sprintf(bufdst,"%s%s",pk->path,shortbuf);
		_mkdir(bufdst);

		sprintf(bufdir,"%s*.*",pk->path);
		h=_findfirst(bufdir,&fileinfo );
		res=h;
		while(res!=-1)
		{
			if ((strcmp(fileinfo.name,shortbuf))&&(strcmp(fileinfo.name,"."))&&(strcmp(fileinfo.name,"..")))
			{
				sprintf(bufsrc,"%s%s",pk->path,fileinfo.name);
				sprintf(bufdst,"%s%s/%s",pk->path,shortbuf,fileinfo.name);
				MoveFile(bufsrc,bufdst);
			}
			res=_findnext(h,&fileinfo );
		}
		if (h!=-1) _findclose(h);
		return 0;
	}
#elif SCOL_PLATFORM == SCOL_PLATFORM_LINUX
	/* 
	deplace les fichiers du cache dans un sous-repertoire 
	*/
	int SCmovecache(mmachine m)
	{
		// TODO_LINUX
		return 0;
	}
#else
	// TODO_MAC
  int SCmovecache(mmachine m){return 0;}
#endif



/* -----------------------------------------

  TRAITEMENT DE LA TRACE

---------------------------------------- */

#include "bignum.h"

/* decryptage d'une clef de fichier de clef
- s_code est une chaîne hexadécimale contenant la clef
- s_primal_key est une chaîne hexadécimale codant un grand nombre premier
- pi_datedebut pointe vers un entier dans lequel on retourne la datedebut (nombre de jours depuis le 1er jan 1970)
- pi_periode pointe vers un entier dans lequel on retourne la periode de validité en jours (0 si illimitée)
retourne :
- 0 si Ok
- -1 si mauvaise clef

détail :
 on effectue le calcul suivant : Inv code mod primal_key
 le résultat doit être compris entre 2^32 et 2^33, sinon on retourne -1
 on retourne les 32 premiers bits
*/
int getFromKey(char *s_code, char *s_primal_key, int *pi_datedebut, int *pi_periode)
{
	short key[SIZEV];
	short primal[SIZEV];
	short res[SIZEV];
	int i;
	
	CRfromAsc(s_code,key);
	CRfromAsc(s_primal_key,primal);
	
	CRinv(key,primal,res);

	for(i=3;i<SIZEV;i++) if (res[i]) return -1;
	if (res[2]!=1) return -1;

	*pi_datedebut=(res[1]&0xffff);
	*pi_periode=(res[0]&0xffff);
	return 0;
}

/*
lit la trace T : recherche la première trace compatible
- s_tracename est une chaîne contenant le nom de la clef
- s_tracekey est une chaîne hexadécimale codant un grand nombre premier
- s_buf est une chaîne d'au moins 32 octets, dans laquelle la trace va être retournée

la fonction retourne :
- 0 si OK, et dans ce cas, la trace est dans le s_buf
- -1 sinon : trace non présente

*/
int readT(char *s_tracename, char *s_tracekey,  int *pi_datedebut, int *pi_periode)
{
#if SCOL_PLATFORM == SCOL_PLATFORM_WINDOWS
	FILE *f;
	char trace[32];
	char filename[1024];
    char keyname[1024];
	char s_buf[1024];
    int msize;
	int res;
	uint i;

	if (strlen(s_tracename)>16) return -2;	// nom trop long
	strcpy(trace,s_tracename);
	for(i=0;i<strlen(trace);i++) if ((trace[i]<48)||(trace[i]>57)) return -2;	// nom composé d'autre chose que de chiffres

	// première trace
    res = GetWindowsDirectory ( filename , 1024 );
    if ((res>0)&&(res<1024))
	{
		sprintf(filename+strlen(filename),"\\%s.ini",trace);
        /* lit le fichier */ 
        if ((f=fopen( filename,"rb"))!=NULL)
		{
			s_buf[0]=0;
			fgets(s_buf,32,f);
			fclose(f);
			if (getFromKey(s_buf,s_tracekey,pi_datedebut,pi_periode)==0) return 0;
		}
	}

	// seconde trace
	for(i=0;i<strlen(trace);i++) trace[i]+=49;	// on passe de '0' à 'a', et donc de '9' à 'j'

    res = GetSystemDirectory ( filename , 1024 );
    if ((res>0)&&(res<1024))
	{
		sprintf(filename+strlen(filename),"\\%s.dll",trace);
        /* lit le fichier */ 
        if ((f=fopen( filename,"rb"))!=NULL)
		{
			s_buf[0]=0;
			fgets(s_buf,32,f);
			fclose(f);
			if (getFromKey(s_buf,s_tracekey,pi_datedebut,pi_periode)==0) return 0;
		}
	}

	// troisième trace
	for(i=0;i<strlen(trace);i++) trace[i]+=10;	// on passe de 'a' à 'k', et donc de 'j' à 't'

	sprintf(keyname,"SOFTWARE\\CryoNetworks\\%s",trace);
	msize=32;
    if (RegQueryValue(HKEY_LOCAL_MACHINE,keyname,s_buf,&msize)==ERROR_SUCCESS)
	{
		if (getFromKey(s_buf,s_tracekey,pi_datedebut,pi_periode)==0) return 0;
	}
#endif	
	return -1;
}

/* lit une trace cachée dans la machine */
int SCreadTrace(mmachine m)
{
	int p,q;
	int debut,periode;

	p=MMpull(m)>>1;	// prime number
	q=MMpull(m)>>1;	// name

	if ((p==NIL)||(q==NIL)) return MMpush(m,NIL);

	if (readT(MMstartstr(m,q),MMstartstr(m,p),&debut,&periode)) return MMpush(m,NIL);

	if (MMpush(m,debut<<1)) return MERRMEM;
	if (MMpush(m,periode<<1)) return MERRMEM;
	if (MMpush(m,2<<1)) return MERRMEM;
	return MBdeftab(m);
}