/* This source file is part of Scol For the latest info, see http://www.scolring.org Copyright (c) 2010 Stephane Bisaro, aka Iri This program is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA, or go to http://www.gnu.org/copyleft/lesser.txt For others informations, please contact us from http://www.scolring.org/ */ #include "standard_library.h" static void returnMd5 (struct md5_ctx *ctx, FILE *f, unsigned char **s) { md5_init (ctx); while (!feof (f)) { ctx->size += fread (ctx->buf + ctx->size, 1, MD5_BUFFER - ctx->size, f); md5_update (ctx); } md5_final (*s, ctx); fclose (f); return; } static int maxlen (char * s, int maxi) { int len; len = strlen (s); return (len > maxi) ? maxi : len; } static void scol_formatoption (char **out, char * s, mmachine m, int arg) { if ((s[0] == 's')) { /*char *tmp; tmp = MMstartstr (m, arg); out = (char **) realloc (out, sizeof (char) * (strlen (tmp) + 1)); sprintf (*out, "%s", MMstartstr (m, arg));*/ sprintf (*out, "%s", MMstartstr (m, arg>>1)); } else if ((s[0] == 'd')) { /*char tmp[10]; snprintf (tmp, 10, "%d", arg); out = (char **) realloc (out, sizeof (tmp) + 1); snprintf (*out, 10, "%s", tmp);*/ snprintf (*out, 10, "%d", arg>>1); } /*sprintf (*out, "%d", arg);*/ else if ((s[0] == 'f')) sprintf (*out, "%f", FGET (arg)); else if ((s[0] == 'x')) sprintf (*out, "%x", arg>>1); else if ((s[0] == '.')) { if (isdigit (s[1])) { if (s[2] == 's') sprintf (*out, "%.d%s", s[1], MMstartstr (m, arg>>1)); } } else if ((isdigit (s[0])) && (isalpha (s[1]))) sprintf (*out, "%d%c", s[0], s[1]); else *out = NULL; return; } /** * \brief strextrS : fun [S S] [S [S r1]] * limit line size : STANDARDLIBRARY_MAXCHARINLINE - 1 * if separator is nil, separator = " " (space) * if string is nil, return nil * We can compact this function more ... */ int SCOLstrextrS (mmachine m) { int ms, msep; char * s, * sep; char * line; char * lines[STANDARDLIBRARY_MAXCHARINLINE]; char * word; int len, i, j, k, id = 0; MMechostr (MSKDEBUG, "SCOLstrextrS : entering\n"); msep = MTOP (MMpull (m)); ms = MTOP (MMpull (m)); if (ms == NIL) { MMechostr (MSKDEBUG, "SCOLstrextrS error : string is nil\n"); MMpush (m, NIL); return 0; } if (msep == NIL) sep = " "; /* space */ else sep = MMstartstr (m, msep); /* strchr */ s = MMstartstr (m, ms); line = strtok (s, "\n"); if (line == NULL) { Mpushstrbloc (m, s); MMpush (m, NIL); MMpush (m, ITOM (2)); MBdeftab (m); return 0; } len = maxlen (line, STANDARDLIBRARY_MAXCHARINLINE-1); lines[id] = (char *) malloc (sizeof (char) * len+1); strncpy (lines[id], line, len); lines[id][len] = '\0'; while (lines[id] != NULL) { id++; line = strtok (NULL, "\n"); if (line != NULL) { len = maxlen (line, STANDARDLIBRARY_MAXCHARINLINE-1); lines[id] = (char *) malloc (sizeof (char) * len+1); strncpy (lines[id], line, len); lines[id][len] = '\0'; } else lines[id] = NULL; } for (i = 0; i <= id; i++) { j = 0; word = strtok (lines[i], sep); if (word != NULL) { Mpushstrbloc (m, word); while (word != NULL) { j++; word = strtok (NULL, sep); if (word != NULL) Mpushstrbloc (m, word); } MMpush (m, NIL); for (k = 0; k < j ; k++) { MMpush (m, ITOM (2)); MBdeftab (m); } } } MMpush (m, NIL); for (i = 0; i < id; i++) { /*free (*(lines+id));*/ free (lines[id]); MMpush (m, ITOM (2)); MBdeftab (m); } return 0; } /** * \brief listextr : . * extract a sublist from a list, between two indices * example : 0::1::2::3::4::5::6::7::nil 2 4 return 2::3::4::nil * if an index is < 0, its value begins at the end */ int SCOLlistextr (mmachine m) { int mini, maxi; int mlist, mlisttmp; int element; int size = 0, i = 0; MMechostr (MSKDEBUG, "SCOLlistextr : entering\n"); maxi = MTOI (MMpull (m)); mini = MTOI (MMpull (m)); mlist = MMpull (m) >> 1; if (mlist == NIL) { MMechostr (MSKDEBUG, "SCOLlistextr error : list is nil\n"); MMpush (m, NIL); return 0; } /* size of the list */ if ((mini < 0) || (maxi < 0)) { mlisttmp = mlist; while (mlisttmp != NIL) { size++; mlisttmp = MMfetch (m, mlisttmp, 1)>>1; } } if (mini < 0) mini = size+mini-1; if (maxi < 0) maxi = size+maxi-1; if (mini > maxi) { MMechostr (MSKDEBUG, "SCOLlistextr error : bads values\n"); MMpush (m, NIL); return 0; } while (mlist != NIL) { if (i < mini) { i++; mlist = MMfetch (m, mlist, 1)>>1; } else if (i <= maxi) { element = MMfetch (m, mlist, 0)>>1; MMpush (m, PTOM (element)); i++; mlist = MMfetch (m, mlist, 1)>>1; } else break; } if (mlist == NIL) maxi = i-1; /* if maxi > sizelist */ MMpush (m, NIL); for (i = mini; i <= maxi; i++) { MMpush (m, ITOM (2)); MBdeftab (m); } return 0; } /** * \brief strfind2List : Recherche une sous-chaine dans une chaine. Retourne une liste des positions trouvées ou nil * * \param I : position : position à partir de laquelle commerncer la recherche * \param S : sous-chaine à rechercher * \param S : chaine dans laquelle rechercher * \return [I r1] : liste des positions * */ int SCOLstrfind2List (mmachine m) { int mstring, msearch, mpos; int len, n = 0, k = 0; size_t r; char *string, *search, *rs; MMechostr (MSKDEBUG, "SCOLstrfind2List : entering\n"); mpos = MTOI (MMpull (m)); msearch = MTOP (MMpull (m)); mstring = MTOP (MMpull (m)); if ((msearch == NIL) || (mstring == NIL)) { MMechostr (MSKDEBUG, "SCOLstrfind2List error : data is nil\n"); MMpush (m, NIL); return 0; } string = MMstartstr (m, mstring); search = MMstartstr (m, msearch); len = strlen (string); if (mpos < 0) mpos = len + mpos; else if (mpos > len) mpos = len; rs = strstr (string+mpos, search); while (rs != NULL) { r = strlen (string) - strlen (rs) + 1; string = string + r; MMpush (m, ITOM (k+r-1)); k += r; n++; rs = strstr (string, search); } MMpush (m, NIL); for (k = 0; k < n; k++) { MMpush (m, ITOM (2)); MBdeftab (m); } return 0; } /** * \brief strfindAnyChar : Recherche la première occurence d'un des caractères d'une chaine 'motif' * dans une chaine 'chaine'. * * \param mmachine * \return [I S] : position de la première occurence trouvée et caractère correspondant * * Stack : * Satge 0 : I : position : position à partir de laquelle commerncer la recherche * Stage 1 : S : chaine contenant les caractères à rechercher * Stage 2 : S : chaine dans laquelle rechercher * retour : [I S] : tuple : position de la première occurence trouvée et caractère correspondant * ou nil si rien de trouvé */ int SCOLstrfindAnyChar (mmachine m) { int mstring, msearch,mpos; int len; char *string, *search, *rs; MMechostr (MSKDEBUG, "SCOLstrfindAnyChar : entering\n"); mpos = MTOI (MMpull (m)); msearch = MTOP (MMpull (m)); mstring = MTOP (MMpull (m)); if ((msearch == NIL) || (mstring == NIL)) { MMechostr (MSKDEBUG, "SCOLstrfindAnyChar error : data is nil\n"); MMpush (m, NIL); return 0; } string = MMstartstr (m, mstring); search = MMstartstr (m, msearch); len = strlen (string); if (mpos < 0) mpos = len + mpos; else if (mpos > len) mpos = len; rs = strpbrk (string + mpos, search); if (rs == NULL) MMpush (m, NIL); else { char *out; out = malloc (sizeof (char) * 2); out[0] = rs[0]; out[1] = '\0'; MMpush (m, ITOM (strlen (string) - strlen (rs))); /*rs[1] = '\0'; Mpushstrbloc (m, rs); *//* no, in this case, string is modified too ... */ Mpushstrbloc (m, out); MMpush (m, ITOM (2)); MBdeftab (m); free (out); } return 0; } /** * \brief strncat : Concatène deux chaînes avec au maximum une certaine longueur pour la seconde * * Stack : * Satge 0 : I : longueur maximale pour la concaténation de la seconde chaine * Stage 1 : S : seconde chaîne * Stage 2 : S : première chaîne * retour : S : chaîne concaténée */ int SCOLstrncat (mmachine m) { int ms1, ms2, mn; int len; char *s1, *s2, *s; MMechostr (MSKDEBUG, "SCOLstrncat : entering\n"); mn = MTOI (MMpull (m)); ms2 = MTOP (MMpull (m)); ms1 = MTOP (MMpull (m)); if (mn < 0) { MMechostr (MSKDEBUG, "SCOLstrncat error : size is negative\n"); MMpush (m, NIL); return 0; } if ((ms1 == NIL) && (ms2 == NIL)) { MMechostr (MSKDEBUG, "SCOLstrncat error : strings are nil\n"); MMpush (m, NIL); return 0; } if (ms1 == NIL) { MMechostr (MSKWARNING, "SCOLstrncat warning : first string is nil\n"); Mpushstrbloc (m, MMstartstr (m, ms2)); return 0; } if (ms2 == NIL) { MMechostr (MSKWARNING, "SCOLstrncat warning : second string is nil\n"); Mpushstrbloc (m, MMstartstr (m, ms1)); return 0; } s1 = MMstartstr (m, ms1); s2 = MMstartstr (m, ms2); len = sizeof (char) * (strlen (s1) + mn); s = malloc (len + 1); strcpy (s, s1); strncat (s, s2, mn); s[len] = '\0'; Mpushstrbloc (m, s); free (s); return 0; } /** * \brief strtruncate : Tronque une chaîne et la modifie dynamiquement * * Stack : * Satge 0 : I : longueur * Stage 1 : S : chaîne à modifier dynamiquement * retour : S : même chaîne */ int SCOLstrtruncate (mmachine m) { int mstring, mlen; int len; char * string; MMechostr (MSKDEBUG, "SCOLstrtruncate : entering\n"); mlen = MTOI (MMpull (m)); mstring = MTOP (MMget (m, 0)); string = MMstartstr (m, mstring); if (mlen > strlen (string)) len = strlen (string); else if (mlen <= 0) len = strlen (string) + mlen; else len = mlen; string = (char *) realloc (string, sizeof (char) * len + 1); string[len] = '\0'; MMstore (m, mstring, 0, (int) string); return 0; } /** * \brief strsignal : Return the name corresponding to a signal number * * Scol prototype : fun [I] S */ int SCOLstrsignal (mmachine m) /* fonction non standard */ #if defined(__STDC__) /*#ifdef __USE_XOPEN2K8*/ { MMechostr (MSKDEBUG, "SCOLstrsignal : entering\n"); MMpull (m); MMpush (m, NIL); return 0; } #else { int msignal; char *name; MMechostr (MSKDEBUG, "SCOLstrsignal : entering\n"); msignal = MTOI (MMpull (m)); if ((msignal == NIL) || (msignal < 0)) /* test sur nil inutile puisque < 0 */ { MMechostr (MSKDEBUG, "SCOLstrsignal error : signal invalid\n"); MMpush (m, NIL); return 0; } name = strsignal (msignal); if (name == NULL) /* certains systèmes mais pas Linux */ MMpush (m, NIL); else Mpushstrbloc (m, name); return 0; } #endif /* In scol.c */ /* !! This function already exists to kernel, don't add !! */ static int foo(mmachine m, char* s) { MMputs(MSKFOO, s); /*$ FA(06/08/2001): use new MMputs() function*/ return MERROK; } /* gcc : warning: dereferencing type-punned pointer will break strict-aliasing rules optimisation ambiguë pour -O2 ou supérieur. voir au niveau du kernel si intégré */ /* #define FGET(val) (*(float*)&(val))*/ /* cf macros.h */ /** \brief _fooF : . */ int SCfooF (mmachine m) { int i; i = (MMget(m, 0)); if (i == NIL) return foo(m, "NIL\n"); else { char s[38]; int res; snprintf (s, 38, "%f", (double) FGET (i)); if ((res = foo (m, s))) return res; return foo (m, "\n"); } return 0; } /** \brief _fooFn : . */ int SCfooFn (mmachine m) { int i, n; n = MTOI (MMpull (m)); i = MMget(m, 0); if (i == NIL) return foo(m, "NIL\n"); else { char s[32]; int res; double f; char format[6]; sprintf (format, "%%.%df", n); f = (double) FGET (i); snprintf (s, 32, format, f); if ((res = foo (m, s))) return res; return foo (m, "\n"); } return 0; } /* in myloop.cpp (windows), unix*.c (linux) */ /* OLD function */ /* int SCOLstrF (mmachine m) { int mformat, margs; int k = 0, i = 0, nbargs = 0, tmp; size_t size = 65536; char *format, *string; char * s = NULL, *s2 = NULL; int *args; MMechostr (MSKDEBUG, "SCOLstrF : entering\n"); tmp = margs = MMpull (m)>>1; mformat = MTOP (MMpull (m)); if (mformat == NIL) { MMechostr (MSKDEBUG, "SCOLstrF error : format is nil\n"); MMpush (m, NIL); return 0; } if (margs == NIL) { MMechostr (MSKDEBUG, "SCOLstrF warning : args is nil\n"); Mpushstrbloc (m, MMstartstr (m, mformat)); return 0; } while (tmp != NIL) { nbargs += 1; tmp = MMfetch (m, tmp, 1)>>1; } args = malloc (sizeof (int) * nbargs); while (margs != NIL) { args[i] = MMfetch (m, margs, 0); i++; margs = MMfetch (m, margs, 1)>>1; } format = MMstartstr (m, mformat);; size = strlen (format); string = (char *) malloc (sizeof (char) + 1); string[0] = '\0'; s = (char *) malloc (sizeof (char) * 2048); s2 = (char *) malloc (sizeof (char) + 1); i = 0; while (nbargs > 0) { k = lib_string_indexstr (format, "%"); if (k >= 0) { scol_formatoption (&s, format+k+1, m, args[i]); s2 = (char *) realloc (s2, sizeof (char) *k + 1); snprintf (s2, k+1, "%s", format); string = (char *) realloc (string, sizeof (char) * (strlen (string) + k + strlen (s) + 1)); sprintf (string, "%s%s%s", string, s2, s); format = format+k+2; i++; nbargs--; } } string = (char *) realloc (string, sizeof (char) * (strlen (string) + strlen (format) + 1)); strcat (string, format); Mpushstrbloc (m, string); free (args); free (string); free (s); free (s2); return 0; }*/ char * scol_sprintf (char *string, char *format, mmachine m, int mtuple) { int me; int lentuple, len, k, i = 0; char *s, *s2; s = (char *) malloc (sizeof (char) * 2048); s2 = (char*) malloc (sizeof (char)+1); lentuple = MMsize (m, mtuple); while (i < lentuple) { k = lib_string_indexstr (format, "%"); if (k >= 0) { me = MMfetch (m, mtuple, i); if (me != NIL) scol_formatoption (&s, format+k+1, m, me); else s[0] = '\0'; s2 = (char *) realloc (s2, sizeof (char) * (k + 1)); snprintf (s2, k+1, "%s", format); string = (char *) realloc (string, (sizeof (char) * (strlen (string) + k + strlen (s) + 1))); sprintf (string, "%s%s%s", string, s2, s); format = format+k+2; i++; } } len = strlen (string) + strlen (format); string = (char *) realloc (string, sizeof (char) * (len + 1)); strcat (string, format); string[len] = '\0'; free (s); free (s2); return string; } /** \brief sprintf : . */ /** * \brief strF : Like a C sprintf standard function - fun [S u0] S * * Stack * stage 0 : u0 : tuple - values * stage 1 : S : string * return : S : thenew string * * * On pourrait utiliser directement la fonction standard snprintf * on construit les arguments en fonction des valeurs du tuple * ce serait peut être plus rapide. voir ;-) */ int SCOLstrF (mmachine m) { int mtuple, mformat; char *format, *string; MMechostr (MSKDEBUG, "SCOLstrF : entering\n"); mtuple = MMpull (m); mformat = MMpull (m); if (mformat == NIL) { MMechostr (MSKDEBUG, "SCOLstrF error : format is nil\n"); MMpush (m, NIL); return 0; } if (mtuple == NIL) /* nothing to do */ { Mpushstrbloc (m, MMstartstr (m, MTOP (mformat))); return 0; } format = MMstartstr (m, MTOP (mformat)); string = (char *) malloc (sizeof (char)+1); string[0] = '\0'; string = scol_sprintf (string, format, m, MTOP (mtuple)); Mpushstrbloc (m, string); free (string); return 0; } /* TODO : Vérifier le flag */ /** \brief printf : . */ int SCOLprintf (mmachine m) { int mtuple, mformat, mflag; char *format, *string; MMechostr (MSKDEBUG, "SCOLprintf : entering\n"); mflag = MTOI (MMpull (m)); mtuple = MMpull (m)>>1; mformat = MTOP (MMpull (m)); if (mformat == NIL) { MMechostr (MSKDEBUG, "SCOLprintf error : format is nil\n"); MMpush (m, NIL); return 0; } if (mtuple == NIL) /* nothing to do */ { Mpushstrbloc (m, MMstartstr (m, mformat)); return 0; } format = MMstartstr (m, mformat); string = (char *) malloc (sizeof (char)+1); string[0] = '\0'; string = scol_sprintf (string, format, m, mtuple); MMechostr (mflag, string); Mpushstrbloc (m, string); free (string); return 0; } /** \brief strreplace : . */ int SCOLstrReplace (mmachine m) { int mstring, mbefore, mafter, mpos; const char *pos; char *string, *before, *after, *out; size_t posOut, longOut, sizeOut; MMechostr (MSKDEBUG, "SCOLstrReplace : entering\n"); mpos = MTOI (MMpull (m)); mafter = MTOP (MMpull (m)); mbefore = MTOP (MMpull (m)); mstring = MTOP (MMpull (m)); if ((mstring == NIL) || (mafter == NIL)) { MMechostr (0, "SCOLstrReplace error : string or after is nil\n"); MMpush (m, NIL); return 0; } if (mbefore == NIL) { MMechostr (0, "SCOLstrReplace warning : substring is nil\n"); Mpushstrbloc (m, MMstartstr (m, mstring)); return 0; } string = MMstartstr (m, mstring); before = MMstartstr (m, mbefore); after = MMstartstr (m, mafter); if (mpos < 0) mpos = strlen (string) + mpos; pos = strstr (string+mpos, before); if (pos == NULL) /* before not found, return string */ { Mpushstrbloc (m, string); return 0; } longOut = (size_t) pos - (size_t) string; sizeOut = longOut + strlen (after) + 1; out = (char *) malloc (sizeof (char) * sizeOut); posOut = 0; strncpy (out + posOut, string, longOut); posOut += longOut; string = pos + strlen (before); longOut = strlen (after); strncpy (out + posOut, after, longOut); posOut += longOut; pos = strstr (string, before); while (pos != NULL) { longOut = (size_t) pos - (size_t) string; sizeOut += longOut + strlen (after); out = (char *) realloc (out, sizeOut); strncpy (out + posOut, string, longOut); posOut += longOut; string = pos + strlen (before); longOut = strlen (after); strncpy (out + posOut, after, longOut); posOut += longOut; pos = strstr (string, before); } longOut = strlen (string) + 1; sizeOut += longOut; out = (char *) realloc (out, sizeOut); strncpy (out + posOut, string, longOut); Mpushstrbloc (m, out); free (out); return 0; } #define DIV 1024 /* converts Bytes to KBytes */ int SCOLmemoryInfos (mmachine m) { #if ((defined _WIN32) || (defined __WIN32__)) MEMORYSTATUSEX ms; MMechostr (MSKDEBUG, "SCOLmemoryInfos entering\n"); ms.dwLength = sizeof (ms); if (!GlobalMemoryStatusEx (&ms)) { MMechostr (MSKDEBUG, "SCOLmemoryInfos error\n"); MMpush (m, NIL); return 0; } MMpush (m, ITOM (ms.dwMemoryLoad)); /* the approximate percentage of physical memory that is in use */ MMpush (m, ITOM (ms.ullTotalPhys/DIV)); /* the amount of actual physical memory */ MMpush (m, ITOM (ms.ullAvailPhys/DIV)); /* the amount of physical memory currently available */ MMpush (m, ITOM (ms.ullTotalPageFile/DIV)); /* the current committed memory limit for the system or the current process, whichever is smaller */ MMpush (m, ITOM (ms.ullAvailPageFile/DIV)); /* the maximum amount of memory the current process can commit */ MMpush (m, ITOM (ms.ullTotalVirtual/DIV)); /* the size of the user-mode portion of the virtual address space of the calling process */ MMpush (m, ITOM (ms.ullAvailVirtual/DIV)); /* the amount of unreserved and uncommitted memory currently in the user-mode portion of the virtual address space of the calling process */ MMpush (m, ITOM (ms.ullAvailExtendedVirtual/DIV)); /* always 0 */ MMpush (m, ITOM (8)); MBdeftab (m); #else MMechostr (MSKDEBUG, "SCOLmemoryInfos is not set to this operating system\n"); MMpush (m, NIL); #endif return 0; } int SCOLpowerInfos (mmachine m) { #if ((defined _WIN32) || (defined __WIN32__)) struct _SYSTEM_POWER_STATUS ps; MMechostr (MSKDEBUG, "SCOLpowerInfos entering\n"); if (!GetSystemPowerStatus (&ps)) { MMechostr (MSKDEBUG, "SCOLpowerInfos error\n"); MMpush (m, NIL); return 0; } MMpush (m, ITOM (ps.ACLineStatus)); /* The AC power status. 0 : offline, 1 : online, 255 : unknown */ MMpush (m, ITOM (ps.BatteryFlag)); /* The battery charge status */ MMpush (m, ITOM (ps.BatteryLifePercent)); /* The percentage of full battery charge remaining */ MMpush (m, ITOM (ps.BatteryLifeTime)); /* The number of seconds of battery life remaining */ MMpush (m, ITOM (ps.Reserved1)); /* Always 0 */ MMpush (m, ITOM (5)); MBdeftab (m); #else MMechostr (MSKDEBUG, "SCOLpowerInfos is not set to this operating system\n"); MMpush (m, NIL); #endif return 0; } int SCOLmemoryMinMax (mmachine m) { #if ((defined _WIN32) || (defined __WIN32__)) HANDLE h; SIZE_T a, b; MMechostr (MSKDEBUG, "SCOLmemoryMinMax entering\n"); h = GetCurrentProcess (); if (!GetProcessWorkingSetSize(h, &a, &b)) { MMechostr (MSKDEBUG, "SCOLmemoryMinMax error\n"); MMpush (m, NIL); return 0; } MMpush (m, ITOM (a/DIV)); MMpush (m, ITOM (b/DIV)); MMpush (m, ITOM (2)); MBdeftab (m); #else MMechostr (MSKDEBUG, "SCOLmemoryMinMax is not set to this operating system\n"); MMpush (m, NIL); #endif return 0; } /* Prototype : fun [] [S S S S] * on MS Windows : - operating system - service pack - build number - architecture (32/64 bit) * GNU/Linux : - operating system - kernel / release - os version - architecture * others systems - nil - nil - nil - nil */ int SCOLosInfos (mmachine m) { #if ((defined _WIN32) || (defined __WIN32__)) /* see http://msdn.microsoft.com/en-us/library/ms724833%28v=VS.85%29.aspx */ OSVERSIONINFOEX osi; SYSTEM_INFO si; char build[80]; MMechostr (MSKDEBUG, "SCOLosInfos entering\n"); memset (&osi, 0, sizeof (OSVERSIONINFOEX)); osi.dwOSVersionInfoSize = sizeof (OSVERSIONINFOEX); if (!GetVersionEx ((OSVERSIONINFO*) &osi)) { MMechostr (MSKDEBUG, "SCOLosInfos error\n"); MMpush (m, NIL); return 0; } memset (&si, 0, sizeof (SYSTEM_INFO)); GetSystemInfo (&si); if (VER_PLATFORM_WIN32_NT == osi.dwPlatformId && osi.dwMajorVersion > 4) { if (osi.dwMajorVersion == 6) { if (osi.dwMinorVersion == 0) { if (osi.wProductType == VER_NT_WORKSTATION) Mpushstrbloc (m, "Microsoft Windows Vista"); else Mpushstrbloc (m, "Microsoft Windows Server 2008"); } else if (osi.dwMinorVersion == 1) { if (osi.wProductType == VER_NT_WORKSTATION) Mpushstrbloc (m, "Microsoft Windows Seven"); else Mpushstrbloc (m, "Microsoft Windows Server 2008 R2"); } else Mpushstrbloc (m, "Microsoft Windows"); } else if (osi.dwMajorVersion == 5 && osi.dwMinorVersion == 2) { if (osi.wProductType == VER_NT_WORKSTATION && si.wProcessorArchitecture == PROCESSOR_ARCHITECTURE_AMD64) Mpushstrbloc (m, "Microsoft Windows XP Professional x64"); else Mpushstrbloc (m, "Microsoft Windows"); } else if (osi.dwMajorVersion == 5 && osi.dwMinorVersion == 1 ) { if (osi.wSuiteMask & VER_SUITE_PERSONAL) Mpushstrbloc (m, "Microsoft Windows XP Home"); else Mpushstrbloc (m, "Microsoft Windows XP Professional"); } else if (osi.dwMajorVersion == 5 && osi.dwMinorVersion == 0) Mpushstrbloc (m, "Microsoft Windows 2000"); else Mpushstrbloc (m, "Microsoft Windows"); } else Mpushstrbloc (m, "Microsoft Windows"); /* service pack */ if (strlen (osi.szCSDVersion) > 0 ) Mpushstrbloc (m, osi.szCSDVersion); else MMpush (m, NIL); /* build number */ snprintf (build, 80, "%d", (int) osi.dwBuildNumber); Mpushstrbloc (m, build); /* architecture */ if (osi.dwMajorVersion >= 6) { if (si.wProcessorArchitecture == PROCESSOR_ARCHITECTURE_AMD64) Mpushstrbloc (m, "64-bit"); else Mpushstrbloc (m, "32-bit"); } else if (osi.dwMajorVersion == 5 && osi.dwMinorVersion == 2 && osi.wProductType == VER_NT_WORKSTATION && si.wProcessorArchitecture == PROCESSOR_ARCHITECTURE_AMD64) Mpushstrbloc (m, "64-bit"); else MMpush (m, NIL); #elif ((defined linux) || (defined __linux)) struct utsname u; MMechostr (MSKDEBUG, "SCOLosInfos entering\n"); if (uname (&u) == -1) { MMechostr (MSKDEBUG, "SCOLosInfos error : %d %s\n", errno, strerror (errno)); MMpush (m, NIL); return 0; } Mpushstrbloc (m, u.sysname); Mpushstrbloc (m, u.release); Mpushstrbloc (m, u.version); Mpushstrbloc (m, u.machine); #else MMechostr (MSKDEBUG, "SCOLosInfos is not set to this operating system\n"); MMpush (m, NIL); MMpush (m, NIL); MMpush (m, NIL); MMpush (m, NIL); #endif MMpush (m, ITOM (4)); MBdeftab (m); return 0; } int SCOLgetUserName (mmachine m) { MMechostr (MSKDEBUG, "SCOLgetUserName entering\n"); #if ((defined _WIN32) || (defined __WIN32__)) Mpushstrbloc (m, getenv("USERNAME")); #elif ((defined linux) || (defined __linux)) Mpushstrbloc (m, getenv("USER")); #else MMechostr (MSKDEBUG, "SCOLgetUserName is not set to this operating system\n"); MMpush (m, NIL); #endif return 0; } int SCOLgetUserRealName (mmachine m) { MMechostr (MSKDEBUG, "SCOLgetUserRealName entering\n"); #if ((defined _WIN32) || (defined __WIN32__)) Mpushstrbloc (m, getenv("USERNAME")); #elif ((defined linux) || (defined __linux)) struct passwd *p; p = getpwnam (getenv("USER")); if (p == NULL) { MMechostr (MSKDEBUG, "SCOLgetUserRealName error : %d %s\n", errno, strerror (errno)); Mpushstrbloc (m, getenv("USER")); return 0; } Mpushstrbloc (m, p->pw_gecos); endpwent (); /* utile ? */ #else MMechostr (MSKDEBUG, "SCOLgetUserRealName is not set to this operating system\n"); MMpush (m, NIL); #endif return 0; } int SCOLgetScolPath (mmachine m) { char *buffer = NULL; MMechostr (MSKDEBUG, "SCOLgetScolPath entering\n"); buffer = getcwd (buffer, 0); if (buffer == NULL) { MMechostr (MSKDEBUG, "SCOLgetScolPath error : %d %s\n", errno, strerror (errno)); MMpush (m, NIL); return 0; } Mpushstrbloc (m, buffer); free (buffer); return 0; } int SCOLsleep (mmachine m) { int mseconds; #if ((defined _WIN32) || (defined __WIN32__)) int seconds = 1000; MMechostr (MSKDEBUG, "SCOLsleep entering\n"); mseconds = MTOI (MMpull (m)); if (mseconds >= 0) seconds = mseconds * 1000; Sleep (seconds); MMpush (m, 0); #elif ((defined linux) || (defined __linux)) unsigned int s; int seconds = 1; MMechostr (MSKDEBUG, "SCOLsleep entering\n"); mseconds = MTOI (MMpull (m)); if (mseconds >= 0) seconds = mseconds; s = sleep (seconds); MMpush (m, s); #else MMechostr (MSKDEBUG, "SCOLsleep is not set to this operating system\n"); MMpush (m, NIL); #endif return 0; } int SCOLsearchFile (mmachine m) { int mpath, mname; char *path = NULL, *name = NULL, *buffer = NULL; MMechostr (MSKDEBUG, "SCOLsearchFile entering\n"); mname = MMpull (m); mpath = MMpull (m); if (mpath == NIL) { MMechostr (MSKDEBUG, "SCOLsearchFile error : path is nil\n"); MMpush (m, NIL); return 0; } if (mname == NIL) { MMechostr (MSKDEBUG, "SCOLsearchFile error : name is nil\n"); MMpush (m, NIL); return 0; } path = strdup (MMstartstr (m, MTOP (mpath))); if (path[strlen (path)-1] == SEP) path [strlen(path)-1] = '\0'; name = MMstartstr (m, MTOP (mname)); buffer = malloc (sizeof (char) * SIZESIGN); /* buffer = lib_string_scan_dir_file (dir, name, path, buffer);*/ if (!(lib_string_scan_dir_file2 (path, name, &buffer))) Mpushstrbloc (m, buffer); else MMpush (m, NIL); free (buffer); free (path); return 0; } int SCOLcheckDirectory (mmachine m) { int mdir; char *d = NULL; DIR *dir; MMechostr (MSKDEBUG, "SCOLcheckDirectory entering\n"); mdir = MMpull (m); if (mdir == NIL) { MMechostr (MSKDEBUG, "SCOLcheckDirectory error : name is nil\n"); MMpush (m, NIL); return 0; } d = malloc (sizeof (char) * SIZESIGN); if (d == NULL) { MMechostr (MSKDEBUG, "SCOLcheckDirectory memory error\n"); MMpush (m, NIL); return 0; } snprintf (d, SIZESIGN-1, "%s%s", spPartition->user, #if ((defined _WIN32) || (defined __WIN32__)) replaceChar ( #endif MMstartstr (m, MTOP (mdir)) #if ((defined _WIN32) || (defined __WIN32__)) , '/', '\\') #endif ); dir = opendir (d); if (dir == NULL) { MMechostr (MSKDEBUG, "SCOLcheckDirectory with user partition : %s opened error : %d %s\n", d, errno, strerror (errno)); snprintf (d, SIZESIGN-1, "%s%s", spPartition->admin, MMstartstr (m, MTOP (mdir))); dir = opendir (d); if (dir == NULL) { MMechostr (MSKDEBUG, "SCOLcheckDirectory with admin partition : %s opened error : %d %s\n", d, errno, strerror (errno)); MMpush (m, NIL); free (d); return 0; } } if (closedir (dir) == -1) MMechostr (MSKDEBUG, "SCOLcheckDirectory closed error : %d %s\n", errno, strerror (errno)); Mpushstrbloc (m, d); free (d); d = NULL; return 0; } int SCOLcreateDirectory (mmachine m) { int mpath, mname; int k; char *buffer = NULL; MMechostr (MSKDEBUG, "SCOLcreateDirectory entering\n"); mname = MMpull (m); mpath = MMpull (m); if (mname == NIL) { MMechostr (MSKDEBUG, "SCOLcreateDirectory error : name is nil\n"); MMpush (m, NIL); return 0; } if (mpath == NIL) { MMechostr (MSKDEBUG, "SCOLcreateDirectory error : path is nil\n"); MMpush (m, NIL); return 0; } buffer = malloc (sizeof (char) * SIZESIGN); k = lib_string_isLastChar (MMstartstr (m, MTOP (mpath)), SEP); if (!k) k = snprintf (buffer, SIZESIGN-1, "%s%s", MMstartstr (m, MTOP (mpath)), MMstartstr (m, MTOP (mname))); else k = snprintf (buffer, SIZESIGN-1, "%s%c%s", MMstartstr (m, MTOP (mpath)), SEP, MMstartstr (m, MTOP (mname))); #if ((defined _WIN32) || (defined __WIN32__)) k = mkdir (buffer); #else k = mkdir (buffer, S_IRWXU|S_IRWXG|S_IROTH); /* read, write, execute/search by owner and by his group; read permission, others */ #endif if (!k) MMpush (m, 0); else MMpush (m, NIL); return 0; } int SCOLgetModifyDir (mmachine m) { int mpath; char *d = NULL; MMechostr (MSKDEBUG, "SCOLgetModifyDir entering\n"); mpath = MMpull (m); if (mpath == NIL) { MMechostr (MSKDEBUG, "SCOLgetModifyDir error : path is nil\n"); MMpush (m, NIL); return 0; } d = malloc (sizeof (char) * SIZESIGN); snprintf (d, SIZESIGN-1, "%s%s", spPartition->user, #if ((defined _WIN32) || (defined __WIN32__)) replaceChar ( #endif MMstartstr (m, MTOP (mpath)) #if ((defined _WIN32) || (defined __WIN32__)) , '/', '\\') #endif ); Mpushstrbloc (m, d); free (d); return 0; } int SCOLdeleteDirectory (mmachine m) { int mpath; #if ((defined _WIN32) || (defined __WIN32__)) char msg[SIZESIGN]; #endif MMechostr (MSKDEBUG, "SCOLdeleteDirectory entering\n"); mpath = MMpull (m); if (mpath == NIL) { MMechostr (MSKDEBUG, "SCOLdeleteDirectory error : path is nil\n"); MMpush (m, NIL); return 0; } #if ((defined _WIN32) || (defined __WIN32__)) snprintf (msg, SIZESIGN, "Do you want remove this empty directory ?\n%s", MMstartstr (m, MTOP (mpath))); if (MessageBox (NULL, msg, "!! Question !!", MB_YESNO|MB_ICONINFORMATION|MB_TOPMOST) != IDYES) { MMechostr (MSKDEBUG, "SCOLdeleteDirectory error : user refuses\n"); MMpush (m, NIL); return 0; } #endif if (!rmdir (MMstartstr (m, MTOP (mpath)))) { MMpush (m, 0); return 0; } MMechostr (MSKDEBUG, "SCOLdeleteDirectory error : %d %s\n", errno, strerror (errno)); MMpush (m, NIL); return 0; } int SCOLgetSourceMd5 (mmachine m) { int mchannel; int env, eltenv, i, n = 0; char name[SIZESIGN]; char *fullname; unsigned char *fmd5; char smd5[SIZESIGN]; FILE *f; struct md5_ctx ctx; MMechostr (MSKDEBUG, "SCOLgetSourceMd5 entering\n"); mchannel = MMget (m, 0); if (mchannel == NIL) { MMechostr (MSKDEBUG, "SCOLgetSourceMd5 error : channel is nil\n"); MMpush (m, NIL); return 0; } fmd5 = malloc (sizeof (char) * 21); fullname = malloc (sizeof (char) * SIZESIGN); env = MMfetch (m, mchannel>>1, OFFCHANENV); MMpull (m); /* channel */ eltenv = MMfetch (m, env>>1, OFFLVAL); while (eltenv != NIL) { strncpy (name, (char*) MMstart (m, MMfetch (m, eltenv>>1, OFFPKNAME)>>1), SIZESIGN); snprintf (fullname, SIZESIGN-1, "%s%s", spPartition->admin, name); #if ((defined _WIN32) || (defined __WIN32__)) fullname = replaceChar (fullname, '/', '\\'); #endif f = fopen (fullname, "r"); if (f == NULL) { snprintf (fullname, SIZESIGN-1, "%s%s", spPartition->user, name); #if ((defined _WIN32) || (defined __WIN32__)) fullname = replaceChar (fullname, '/', '\\'); #endif f = fopen (fullname, "r"); if (f == NULL) break; } strcpy (smd5, ""); strcpy ((char *) fmd5, ""); returnMd5 (&ctx, f, &fmd5); for (i = 0; i < 16; i++) snprintf (smd5, SIZESIGN-1, "%s%02x", smd5, fmd5[i]); Mpushstrbloc (m, name); Mpushstrbloc (m, smd5); MMpush (m, ITOM (2)); MBdeftab (m); env = MMfetch (m, env>>1, OFFLNEXT); eltenv = MMfetch (m, env>>1, OFFLVAL); n++; } free (fullname); free (fmd5); MMpush (m, NIL); for (i = 0; i < n; i++) { MMpush (m, ITOM (2)); MBdeftab (m); } return 0; } int SCOLgetFileMd5 (mmachine m) { int mpath; int i; unsigned char *fmd5; char smd5[SIZESIGN]; FILE *f; struct md5_ctx ctx; MMechostr (MSKDEBUG, "SCOLgetFileMd5 entering\n"); mpath = MMpull (m); if (mpath == NIL) { MMechostr (MSKDEBUG, "SCOLgetFileMd5 error : path is nil\n"); MMpush (m, NIL); return 0; } f = fopen (MMstartstr (m, MTOP (mpath)), "r"); if (f == NULL) { MMechostr (MSKDEBUG, "SCOLgetFileMd5 error : unable to open the file\n"); MMpush (m, NIL); return 0; } fmd5 = malloc (sizeof (char) * 20); memset (fmd5, 20, '\0'); returnMd5 (&ctx, f, &fmd5); memset (smd5, '\0', SIZESIGN); for (i = 0; i < 16; i++) snprintf (smd5, SIZESIGN-1, "%s%02x", smd5, fmd5[i]); Mpushstrbloc (m, smd5); free (fmd5); return 0; } int SCOLgetStringMd5 (mmachine m) { int mstring; int i, len; unsigned char out[16]; char smd5[SIZESIGN]; unsigned char *s; MMechostr (MSKDEBUG, "SCOLgetStringMd5 entering\n"); mstring = MMpull (m); if (mstring == NIL) { MMechostr (MSKDEBUG, "SCOLgetStringMd5 error : the string is nil\n"); MMpush (m, NIL); return 0; } s = (unsigned char *) MMstartstr (m, MTOP (mstring)); len = MMsizestr (m, MTOP (mstring)); s[len-1] = '\0'; md5 (s, 2*len, out); for (i = 0; i < 16; i++) snprintf (smd5, SIZESIGN-1, "%s%02x", smd5, out[i]); Mpushstrbloc (m, smd5); return 0; } int SCOLgetScolMd5 (mmachine m) { return 0; } /* Le test sur la validité du "fichier" suivant de l'environnement est nécessaire car une fois la liste des packages terminées, l'environnement contient les fonctions des APIs Scol chargées et ne vaut par conséquent pas nil */ int SCOLgetPackages (mmachine m) { int mchannel; int env, eltenv, n = 0; char name[SIZESIGN]; char *buffer; FILE *f; MMechostr (MSKDEBUG, "SCOLgetPackages entering\n"); mchannel = MMget (m, 0); if (mchannel == NIL) { MMechostr (MSKDEBUG, "SCOLgetPackages error : channel is nil\n"); MMpush (m, NIL); return 0; } env = MMfetch (m, mchannel>>1, OFFCHANENV); MMpull (m); /* channel pulled */ buffer = malloc (sizeof (char) * SIZESIGN); eltenv = MMfetch (m, env>>1, OFFLVAL); while (eltenv != NIL) { strncpy (name, (char *) MMstart (m, MMfetch (m, eltenv>>1, OFFPKNAME)>>1), SIZESIGN); snprintf (buffer, SIZESIGN-1, "%s%s", spPartition->admin, name); #if ((defined _WIN32) || (defined __WIN32__)) buffer = replaceChar (buffer, '/', '\\'); #endif f = fopen (buffer, "r"); if (f == NULL) { snprintf (buffer, SIZESIGN-1, "%s%s", spPartition->user, name); #if ((defined _WIN32) || (defined __WIN32__)) buffer = replaceChar (buffer, '/', '\\'); #endif f = fopen (buffer, "r"); if (f == NULL) break; } fclose (f); Mpushstrbloc (m, name); env = MMfetch (m, env>>1, OFFLNEXT); eltenv = MMfetch (m, env>>1, OFFLVAL); n++; } free (buffer); MMpush (m, NIL); for (; n > 0; n--) { MMpush (m, ITOM (2)); MBdeftab (m); } return 0; } /* API definitions */ char* standardlibrary_name[STANDARDLIBRARY_PKG_NB] = { "DP", "DW", "strextrS", "listextr", "strfind2List", "strfindAnyChar", "strncat", "strtruncate", "strsignal", "_fooF", "_fooFn", "strreplace", "strF", "sprintf", /* alias de strF */ "printf", "memoryInfos", "powerInfos", "memoryMinMax", "osInfos", "getUserName", "getUserRealName", "getScolPath", "sleep", "searchFile", "_checkDirectory", "_createDirectory", "_getModifyDirectory", "_deleteDirectory", "getSourceMd5", "getFileMd5", "getStringMd5", "getScolMd5", "getPackages" }; int (*standardlibrary_fun[STANDARDLIBRARY_PKG_NB]) (mmachine m) = { NULL, NULL, SCOLstrextrS, SCOLlistextr, SCOLstrfind2List, SCOLstrfindAnyChar, SCOLstrncat, SCOLstrtruncate, SCOLstrsignal, SCfooF, SCfooFn, SCOLstrReplace, SCOLstrF, SCOLstrF, SCOLprintf, SCOLmemoryInfos, SCOLpowerInfos, SCOLmemoryMinMax, SCOLosInfos, SCOLgetUserName, SCOLgetUserRealName, SCOLgetScolPath, SCOLsleep, SCOLsearchFile, SCOLcheckDirectory, SCOLcreateDirectory, SCOLgetModifyDir, SCOLdeleteDirectory, SCOLgetSourceMd5, SCOLgetFileMd5, SCOLgetStringMd5, SCOLgetScolMd5, SCOLgetPackages }; int standardlibrary_narg[STANDARDLIBRARY_PKG_NB] = { TYPTYPE, TYPTYPE, 2, /* strextrS */ 3, /* listextr */ 3, /* strfind2List */ 3, /* strfindAnyChar */ 3, /* strncat */ 2, /* strtruncate */ 1, /* strsignal */ 1, /* _fooF */ 2, /* _fooFn */ 4, /* strreplace */ 2, /* strF */ 2, /* sprintf */ 3, /* printf */ 0, /* memoryInfos */ 0, /* powerInfos */ 0, /* memoryMinMax */ 0, /* osInfos */ 0, /* getUserName */ 0, /* getUserRealName */ 0, /* getScolPath */ 1, /* sleep */ 2, /* searchFile */ 1, /* _checkDirectory */ 2, /* _createDirectory */ 1, /* _getModifyDirectory */ 1, /* _deleteDirectory */ 1, /* getSourceMd5 */ 1, /* getFileMd5 */ 1, /* getStringMd5 */ 0, /* getScolMd5 */ 1 /* getPackages */ }; char* standardlibrary_type[STANDARDLIBRARY_PKG_NB] = { NULL, NULL, "fun [S S] [[S r1] r1]", /* strextrS */ "fun [[u0 r1] I I] [u0 r1]", /* listextr */ "fun [S S I] [I r1]", /* strfind2List */ "fun [S S I] [I S]", /* strfindAnyChar */ "fun [S S I] S", /* strncat */ "fun [S I] S", /* strtruncate */ "fun [I] S", /* strsignal */ "fun [F] F", /* _fooF */ "fun [F I] F", /* _fooFn */ "fun [S S S I] S", /* strreplace */ /*"fun [S [u0 r1]] S"*/ /* old strF */ "fun [S u0] S", /* strF */ "fun [S u0] S", /* sprintf */ "fun [S u0 I] S", /* printf */ "fun [] [I I I I I I I I]", /* memoryInfos */ "fun [] [I I I I I]", /* powerInfos */ "fun [] [I I]", /* memoryMinMax */ "fun [] [S S S S]", /* osInfos */ "fun [] S", /* getUserName */ "fun [] S", /* getUserRealName */ "fun [] S", /* getScolPath */ "fun [I] I", /* sleep */ "fun [DP S] P", /* searchFile */ "fun [S] DP", /* _checkDirectory */ "fun [DW S] I", /* _createDirectory */ "fun [S] DW", /* _getModifyDirectory */ "fun [DW] I", /* _deleteDirectory */ "fun [Chn] [[S S] r1]", /* getSourceMd5 */ "fun [P] S", /* getFileMd5 */ "fun [S] S", /* getStringMd5 */ "fun [] [[S S] r1]", /* getScolMd5 */ "fun [Chn] [S r1]" /* getPackages */ }; int SCOLinitSTANDARDLIBRARYclass (mmachine m) { int k = 0; MMechostr (MSKDEBUG, "SCOLinitSTANDARDLIBRARYclass library : entering\n"); k = PKhardpak (m, "STANDARDLIBRARYengine", STANDARDLIBRARY_PKG_NB, standardlibrary_name, standardlibrary_fun, standardlibrary_narg, standardlibrary_type); return k; }