static int luaI_checkevent (lua_State *L, const char *name, int t) {
int e = luaL_findstring(name, luaT_eventname);
if (e >= IM_N)
luaL_verror(L, "event `%.50s' is deprecated", name);
if (e == IM_GC && t == TAG_TABLE)
luaL_verror(L, "event `gc' for tables is deprecated");
if (e < 0)
luaL_verror(L, "`%.50s' is not a valid event name", name);
return e;
}
void luaL_argerror(int32 numarg, const char *extramsg) {
const char *funcname;
lua_getobjname(lua_stackedfunction(0), &funcname);
if (!funcname)
funcname = "???";
if (!extramsg)
luaL_verror("bad argument #%d to function `%.50s'", numarg, funcname);
else
luaL_verror("bad argument #%d to function `%.50s' (%.100s)", numarg, funcname, extramsg);
}
void luaL_argerror (int numarg, char *extramsg) {
lua_Function f = lua_stackedfunction(0);
char *funcname;
lua_getobjname(f, &funcname);
numarg -= lua_nups(f);
if (funcname == NULL)
funcname = "?";
if (extramsg == NULL)
luaL_verror("bad argument #%d to function `%.50s'", numarg, funcname);
else
luaL_verror("bad argument #%d to function `%.50s' (%.100s)",
numarg, funcname, extramsg);
}
void luaL_arg_check(int cond, int numarg, char *extramsg)
{
if (!cond) {
char *funcname;
lua_getobjname(lua_stackedfunction(0), &funcname);
if (funcname == NULL)
funcname = "???";
if (extramsg == NULL)
luaL_verror("bad argument #%d to function `%s'", numarg, funcname);
else
luaL_verror("bad argument #%d to function `%s' (%s)",
numarg, funcname, extramsg);
}
}
static int io_tmpname (lua_State *L) {
char buff[L_tmpnam];
if (tmpnam(buff) != buff)
return luaL_verror(L, "unable to generate a unique filename");
lua_pushstring(L, buff);
return 1;
}
static int luaB_assert (lua_State *L)
{
luaL_checkany(L, 1);
if (lua_isnil(L, 1))
luaL_verror(L, "assertion failed! %.90s", luaL_opt_string(L, 2, ""));
return 0;
}
static int io_date (lua_State *L) {
const char *s = luaL_opt_string(L, 1, "%c");
time_t t = (time_t)(luaL_opt_number(L, 2, -1));
struct tm *stm;
if (t == (time_t)(-1)) /* no time given? */
t = time(NULL); /* use current time */
if (*s == '!') { /* UTC? */
stm = gmtime(&t);
s++; /* skip `!' */
}
else
stm = localtime(&t);
if (stm == NULL) /* invalid date? */
lua_pushnil(L);
else if (strcmp(s, "*t") == 0) {
lua_newtable(L);
setfield(L, "sec", stm->tm_sec);
setfield(L, "min", stm->tm_min);
setfield(L, "hour", stm->tm_hour);
setfield(L, "day", stm->tm_mday);
setfield(L, "month", stm->tm_mon+1);
setfield(L, "year", stm->tm_year+1900);
setfield(L, "wday", stm->tm_wday+1);
setfield(L, "yday", stm->tm_yday+1);
setfield(L, "isdst", stm->tm_isdst);
}
else {
char b[256];
if (strftime(b, sizeof(b), s, stm))
lua_pushstring(L, b);
else
return luaL_verror(L, "invalid `date' format");
}
return 1;
}
static void DumpConstants(TProtoFunc* tf, FILE* D) {
int i,n;
n = tf->nconsts;
DumpWord(n,D);
for (i=0; i<n; i++) {
TObject* o=tf->consts+i;
switch (ttype(o)) {
case LUA_T_NUMBER:
fputc('N',D);
DumpNumber(nvalue(o),D);
break;
case LUA_T_STRING:
fputc('S',D);
DumpTString(tsvalue(o),D);
break;
case LUA_T_PROTO:
fputc('F',D);
break;
case LUA_T_NIL:
fputc(-ttype(o),D);
break;
default: /* cannot happen */
luaL_verror("cannot dump constant #%d: type=%d [%s]",
i,ttype(o),luaO_typename(o));
break;
}
}
}
static int luaI_checkevent (char *name, char *list[])
{
int e = luaL_findstring(name, list);
if (e < 0)
luaL_verror("`%.50s' is not a valid event name", name);
return e;
}
static FILE *getfile (char *name)
{
lua_Object f = lua_getglobal(name);
if (!ishandler(f))
luaL_verror("global variable `%.50s' is not a file handle", name);
return lua_getuserdata(f);
}
void luaT_setfallback() {
static const char *oldnames [] = { "error", "getglobal", "arith", "order", NULL };
TObject oldfunc;
lua_CFunction replace;
if (!tmFBAdded) {
luaL_addlibtolist(tmFB, (sizeof(tmFB) / sizeof(tmFB[0])));
tmFBAdded = true;
}
const char *name = luaL_check_string(1);
lua_Object func = lua_getparam(2);
luaL_arg_check(lua_isfunction(func), 2, "function expected");
switch (luaO_findstring(name, oldnames)) {
case 0: // old error fallback
oldfunc = errorim;
errorim = *luaA_Address(func);
replace = errorFB;
break;
case 1: // old getglobal fallback
oldfunc = *luaT_getim(LUA_T_NIL, IM_GETGLOBAL);
*luaT_getim(LUA_T_NIL, IM_GETGLOBAL) = *luaA_Address(func);
replace = nilFB;
break;
case 2:
{ // old arith fallback
int32 i;
oldfunc = *luaT_getim(LUA_T_NUMBER, IM_POW);
for (i = IM_ADD; i <= IM_UNM; i++) // ORDER IM
fillvalids(i, luaA_Address(func));
replace = typeFB;
break;
}
case 3:
{ // old order fallback
int32 i;
oldfunc = *luaT_getim(LUA_T_NIL, IM_LT);
for (i = IM_LT; i <= IM_GE; i++) // ORDER IM
fillvalids(i, luaA_Address(func));
replace = typeFB;
break;
}
default:
{
int32 e;
if ((e = luaO_findstring(name, luaT_eventname)) >= 0) {
oldfunc = *luaT_getim(LUA_T_NIL, e);
fillvalids(e, luaA_Address(func));
replace = (e == IM_GC || e == IM_INDEX) ? nilFB : typeFB;
} else {
luaL_verror("`%.50s' is not a valid fallback name", name);
replace = NULL; // to avoid warnings
oldfunc.ttype = LUA_T_NIL; // to avoid warnings
}
}
}
if (oldfunc.ttype != LUA_T_NIL)
luaA_pushobject(&oldfunc);
else
lua_pushcfunction(replace);
}
void luaX_syntaxerror (LexState *ls, char *s, char *token) {
char buff[MAXSRC];
luaL_chunkid(buff, zname(ls->lex_z), sizeof(buff));
if (token[0] == '\0')
token = "<eof>";
luaL_verror("%.100s;\n last token read: `%.50s' at line %d in %.80s",
s, token, ls->linenumber, buff);
}
int OpcodeInfo(TProtoFunc* tf, Byte* p, Opcode* I, const char* xFILE, int xLINE) {
Opcode OP;
Byte* code=tf->code;
int op=*p;
if (p==code)
{
OP.name="STACK";
OP.size=1;
OP.op=STACK;
OP.op_class=STACK;
OP.arg=op;
}
else if (p==code+1)
{
OP.size=1;
if (op>=ZEROVARARG)
{
OP.name="VARARGS";
OP.op=VARARGS;
OP.op_class=VARARGS;
OP.arg=op-ZEROVARARG;
}
else
{
OP.name="ARGS";
OP.op=ARGS;
OP.op_class=ARGS;
OP.arg=op;
}
}
else if (op==NOP)
{
OP.name="NOP";
OP.size=1;
OP.op=NOP;
OP.op_class=NOP;
}
else if (op>=NOPCODES) /* cannot happen */
{
luaL_verror("internal error at %s:%d: bad opcode %d at %d in tf=%p",
xFILE, xLINE,op,(int)(p-code),tf);
return 0;
}
else
{
OP=Info[op];
if (op==SETLIST || op==CLOSURE || op==CALLFUNC)
{
OP.arg=p[1];
OP.arg2=p[2];
}
else if (OP.size == 2) OP.arg = p[1];
else if (OP.size >= 3) OP.arg = READ_LE_UINT16(p + 1);
if (op == SETLISTW) OP.arg2 = p[3];
}
*I=OP;
return OP.size;
}
LUALIB_API void luaL_argerror (lua_State *L, int narg, const char *extramsg) {
lua_Debug ar;
lua_getstack(L, 0, &ar);
lua_getinfo(L, "n", &ar);
if (ar.name == NULL)
ar.name = "?";
luaL_verror(L, "bad argument #%d to `%.50s' (%.100s)",
narg, ar.name, extramsg);
}
static int io_popen (lua_State *L) {
#ifndef POPEN
luaL_verror(L, "`popen' not supported");
return 0;
#else
FILE *f = popen(luaL_check_string(L, 1), luaL_opt_string(L, 2, "r"));
return setnewfile(L, f);
#endif
}
static FILE *getiofile (lua_State *L, const char *name) {
FILE *f;
lua_pushstring(L, name);
lua_rawget(L, lua_upvalueindex(1));
f = tofile(L, -1);
if (f == NULL)
luaL_verror(L, "%s is closed", name);
return f;
}
static int initblock (lua_State *L, const char *seed, int lseed, char *block) {
size_t lkey;
const char *key = luaL_check_lstr(L, 2, &lkey);
if (lkey > MAXKEY)
luaL_verror(L, "key too long (> %d)", MAXKEY);
memset(block, 0, BLOCKSIZE);
memcpy(block, seed, lseed);
memcpy(block+BLOCKSIZE, key, lkey);
return (int)lkey+BLOCKSIZE;
}
void luaT_settagmethod(int32 t, const char *event, TObject *func) {
TObject temp = *func;
int32 e = luaI_checkevent(event, luaT_eventname);
checktag(t);
if (!validevent(t, e))
luaL_verror("settagmethod: cannot change tag method `%.20s' for tag %d",
luaT_eventname[e], t);
*func = *luaT_getim(t,e);
*luaT_getim(t, e) = temp;
}
static FILE *getfilebyref (lua_State *L, IOCtrl *ctrl, int inout) {
FILE *f;
lua_getglobals(L);
lua_getref(L, ctrl->ref[inout]);
lua_rawget(L, -2);
f = gethandle(L, ctrl, -1);
if (f == NULL)
luaL_verror(L, "global variable `%.10s' is not a file handle",
filenames[inout]);
return f;
}
static void DumpString(char* s, int size, FILE* D) {
if (s == NULL)
DumpWord(0,D);
else {
if (NotWord(size))
luaL_verror("string too long (%d bytes): \"%.32s...\"",size,s);
DumpWord(size,D);
for(int i = 0; i < size; ++i)
fputc(s[i] ^ 0xFF, D);
}
}
void luaT_setfallback (void)
{
static char *oldnames [] = {"error", "getglobal", "arith", "order", NULL};
TObject oldfunc;
lua_CFunction replace;
char *name = luaL_check_string(1);
lua_Object func = lua_getparam(2);
luaL_arg_check(lua_isfunction(func), 2, "function expected");
switch (luaL_findstring(name, oldnames)) {
case 0: /* old error fallback */
oldfunc = L->errorim;
L->errorim = *luaA_Address(func);
replace = errorFB;
break;
case 1: /* old getglobal fallback */
oldfunc = *luaT_getim(LUA_T_NIL, IM_GETGLOBAL);
*luaT_getim(LUA_T_NIL, IM_GETGLOBAL) = *luaA_Address(func);
replace = nilFB;
break;
case 2: { /* old arith fallback */
int i;
oldfunc = *luaT_getim(LUA_T_NUMBER, IM_POW);
for (i=IM_ADD; i<=IM_UNM; i++) /* ORDER IM */
fillvalids(i, luaA_Address(func));
replace = typeFB;
break;
}
case 3: { /* old order fallback */
int i;
oldfunc = *luaT_getim(LUA_T_NIL, IM_LT);
for (i=IM_LT; i<=IM_GE; i++) /* ORDER IM */
fillvalids(i, luaA_Address(func));
replace = typeFB;
break;
}
default: {
int e;
if ((e = luaL_findstring(name, luaT_eventname)) >= 0) {
oldfunc = *luaT_getim(LUA_T_NIL, e);
fillvalids(e, luaA_Address(func));
replace = (e == IM_GC || e == IM_INDEX) ? nilFB : typeFB;
}
else {
luaL_verror("`%.50s' is not a valid fallback name", name);
replace = NULL; /* to avoid warnings */
}
}
}
if (oldfunc.ttype != LUA_T_NIL)
luaA_pushobject(&oldfunc);
else
lua_pushcfunction(replace);
}
static void testC (void) {
#define getnum(s) ((*s++) - '0')
#define getname(s) (nome[0] = *s++, nome)
static int locks[10];
lua_Object reg[10];
char nome[2];
char *s = luaL_check_string(1);
nome[1] = 0;
for (;;) {
switch (*s++) {
case '0': case '1': case '2': case '3': case '4':
case '5': case '6': case '7': case '8': case '9':
lua_pushnumber(*(s-1) - '0');
break;
case 'c': reg[getnum(s)] = lua_createtable(); break;
case 'C': { lua_CFunction f = lua_getcfunction(lua_getglobal(getname(s)));
lua_pushcclosure(f, getnum(s));
break;
}
case 'P': reg[getnum(s)] = lua_pop(); break;
case 'g': { int n=getnum(s); reg[n]=lua_getglobal(getname(s)); break; }
case 'G': { int n = getnum(s);
reg[n] = lua_rawgetglobal(getname(s));
break;
}
case 'l': locks[getnum(s)] = lua_ref(1); break;
case 'L': locks[getnum(s)] = lua_ref(0); break;
case 'r': { int n=getnum(s); reg[n]=lua_getref(locks[getnum(s)]); break; }
case 'u': lua_unref(locks[getnum(s)]); break;
case 'p': { int n = getnum(s); reg[n] = lua_getparam(getnum(s)); break; }
case '=': lua_setglobal(getname(s)); break;
case 's': lua_pushstring(getname(s)); break;
case 'o': lua_pushobject(reg[getnum(s)]); break;
case 'f': lua_call(getname(s)); break;
case 'i': reg[getnum(s)] = lua_gettable(); break;
case 'I': reg[getnum(s)] = lua_rawgettable(); break;
case 't': lua_settable(); break;
case 'T': lua_rawsettable(); break;
case 'N' : lua_pushstring(lua_nextvar(lua_getstring(reg[getnum(s)])));
break;
case 'n' : { int n=getnum(s);
n=lua_next(reg[n], (int)lua_getnumber(reg[getnum(s)]));
lua_pushnumber(n); break;
}
default: luaL_verror("unknown command in `testC': %c", *(s-1));
}
if (*s == 0) return;
if (*s++ != ' ') lua_error("missing ` ' between commands in `testC'");
}
}
static int getfield (lua_State *L, const char *key, int d) {
int res;
lua_pushstring(L, key);
lua_gettable(L, -2);
if (lua_isnumber(L, -1))
res = (int)(lua_tonumber(L, -1));
else {
if (d == -2)
return luaL_verror(L, "field `%s' missing in date table", key);
res = d;
}
lua_pop(L, 1);
return res;
}
void luaT_settagmethod (lua_State *L, int t, const char *event, TObject *func) {
TObject temp;
int e;
e = luaI_checkevent(L, event, t);
checktag(L, t);
if (!luaT_validevent(t, e))
luaL_verror(L, "cannot change `%.20s' tag method for type `%.20s'%.20s",
luaT_eventname[e], luaO_typenames[t],
(t == TAG_TABLE || t == TAG_USERDATA) ? " with default tag"
: "");
temp = *func;
*func = *luaT_getim(L, t,e);
*luaT_getim(L, t, e) = temp;
}
void lua_settag(int32 tag) {
checkCparams(1);
luaT_realtag(tag);
switch (ttype(lua_state->stack.top - 1)) {
case LUA_T_ARRAY:
(lua_state->stack.top - 1)->value.a->htag = tag;
break;
case LUA_T_USERDATA:
(lua_state->stack.top - 1)->value.ud.tag = tag;
break;
default:
luaL_verror("cannot change the tag of a %.20s", luaO_typenames[-ttype((lua_state->stack.top - 1))]);
}
lua_state->stack.top--;
}
char *luaL_item_end (char *p)
{
switch (*p++) {
case '\0': return p-1;
case ESC:
if (*p == 0) luaL_verror("incorrect pattern (ends with `%c')", ESC);
return p+1;
case '[': {
char *end = bracket_end(p);
if (end == NULL) lua_error("incorrect pattern (missing `]')");
return end+1;
}
default:
return p;
}
}
static int findlocal (lua_Object func, int arg) {
lua_Object v = lua_getparam(arg);
if (lua_isnumber(v))
return (int)lua_getnumber(v);
else {
char *name = luaL_check_string(arg);
int i = 0;
int result = -1;
char *vname;
while (lua_getlocal(func, ++i, &vname) != LUA_NOOBJECT) {
if (strcmp(name, vname) == 0)
result = i; /* keep looping to get the last var with this name */
}
if (result == -1)
luaL_verror("no local variable `%.50s' at given level", name);
return result;
}
}
/**
* Encrypts a string. Uses the hash function md5 in CFB (Cipher-feedback
* mode).
* @param message: arbitrary binary string to be encrypted.
* @param key: arbitrary binary string to be used as a key.
* @param [seed]: optional arbitrary binary string to be used as a seed.
* if no seed is provided, the function uses the result of
* <code>time()</code> as a seed.
* @return The cyphertext (as a binary string).
*/
static int crypt (lua_State *L) {
size_t lmsg;
const char *msg = luaL_check_lstr(L, 1, &lmsg);
size_t lseed;
const char *seed;
int lblock;
char block[BLOCKSIZE+MAXKEY];
checkseed(L);
seed = luaL_check_lstr(L, 3, &lseed);
if (lseed > BLOCKSIZE)
luaL_verror(L, "seed too long (> %d)", BLOCKSIZE);
/* put seed and seed length at the beginning of result */
block[0] = (char)lseed;
memcpy(block+1, seed, lseed);
lua_pushlstring(L, block, lseed+1); /* to concat with result */
lblock = initblock(L, seed, lseed, block);
codestream(L, msg, lmsg, block, lblock);
lua_concat(L, 2);
return 1;
}
int32 luaI_singlematch (int32 c, const char *p, const char **ep)
{
switch (*p) {
case '.': /* matches any char */
*ep = p+1;
return 1;
case '\0': /* end of pattern; matches nothing */
*ep = p;
return 0;
case ESC:
if (*(++p) == '\0')
luaL_verror("incorrect pattern (ends with `%c')", ESC);
*ep = p+1;
return matchclass(c, (byte)*p);
case '[': {
const char *end = bracket_end(p+1);
int32 sig = *(p+1) == '^' ? (p++, 0) : 1;
if (end == NULL) lua_error("incorrect pattern (missing `]')");
*ep = end+1;
while (++p < end) {
if (*p == ESC) {
if (((p+1) < end) && matchclass(c, (byte)*++p))
return sig;
}
else if ((*(p+1) == '-') && (p+2 < end)) {
p+=2;
if ((byte)*(p-2) <= c && c <= (byte)*p)
return sig;
}
else if ((byte)*p == c) return sig;
}
return !sig;
}
default:
*ep = p+1;
return ((byte)*p == c);
}
}
static void luaI_assert() {
lua_Object p = lua_getparam(1);
if (p == LUA_NOOBJECT || lua_isnil(p))
luaL_verror("assertion failed! %.100s", luaL_opt_string(2, ""));
}