1% luastuff.w
2%
3% Copyright 2006-2013 Taco Hoekwater <taco@@luatex.org>
4%
5% This file is part of LuaTeX.
6%
7% LuaTeX is free software; you can redistribute it and/or modify it under
8% the terms of the GNU General Public License as published by the Free
9% Software Foundation; either version 2 of the License, or (at your
10% option) any later version.
11%
12% LuaTeX is distributed in the hope that it will be useful, but WITHOUT
13% ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
14% FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
15% License for more details.
16%
17% You should have received a copy of the GNU General Public License along
18% with LuaTeX; if not, see <http://www.gnu.org/licenses/>.
19
20@ @c
21
22
23#include "ptexlib.h"
24#include "lua/luatex-api.h"
25
26@ @c
27lua_State *Luas = NULL;
28
29int luastate_bytes = 0;
30
31int lua_active = 0;
32
33@ @c
34void make_table(lua_State * L, const char *tab, const char *mttab, const char *getfunc,
35                const char *setfunc)
36{
37    /* make the table *//* |[{<tex>}]| */
38    lua_pushstring(L, tab);     /* |[{<tex>},"dimen"]| */
39    lua_newtable(L);            /* |[{<tex>},"dimen",{}]| */
40    lua_settable(L, -3);        /* |[{<tex>}]| */
41    /* fetch it back */
42    lua_pushstring(L, tab);     /* |[{<tex>},"dimen"]| */
43    lua_gettable(L, -2);        /* |[{<tex>},{<dimen>}]| */
44    /* make the meta entries */
45    luaL_newmetatable(L, mttab);  /* |[{<tex>},{<dimen>},{<dimen_m>}]| */
46    lua_pushstring(L, "__index");       /* |[{<tex>},{<dimen>},{<dimen_m>},"__index"]| */
47    lua_pushstring(L, getfunc); /* |[{<tex>},{<dimen>},{<dimen_m>},"__index","getdimen"]| */
48    lua_gettable(L, -5);        /* |[{<tex>},{<dimen>},{<dimen_m>},"__index",<tex.getdimen>]| */
49    lua_settable(L, -3);        /* |[{<tex>},{<dimen>},{<dimen_m>}]|  */
50    lua_pushstring(L, "__newindex");    /* |[{<tex>},{<dimen>},{<dimen_m>},"__newindex"]| */
51    lua_pushstring(L, setfunc); /* |[{<tex>},{<dimen>},{<dimen_m>},"__newindex","setdimen"]| */
52    lua_gettable(L, -5);        /* |[{<tex>},{<dimen>},{<dimen_m>},"__newindex",<tex.setdimen>]| */
53    lua_settable(L, -3);        /* |[{<tex>},{<dimen>},{<dimen_m>}]| */
54    lua_setmetatable(L, -2);    /* |[{<tex>},{<dimen>}]| : assign the metatable */
55    lua_pop(L, 1);              /* |[{<tex>}]| : clean the stack */
56}
57
58@ @c
59static
60const char *getS(lua_State * L, void *ud, size_t * size)
61{
62    LoadS *ls = (LoadS *) ud;
63    (void) L;
64    if (ls->size == 0)
65        return NULL;
66    *size = ls->size;
67    ls->size = 0;
68    return ls->s;
69}
70
71@ @c
72static void *my_luaalloc(void *ud, void *ptr, size_t osize, size_t nsize)
73{
74    void *ret = NULL;
75    (void) ud;                  /* for -Wunused */
76    if (nsize == 0)
77        free(ptr);
78    else
79        ret = realloc(ptr, nsize);
80    luastate_bytes += (int) (nsize - osize);
81    return ret;
82}
83
84@ @c
85static int my_luapanic(lua_State * L)
86{
87    (void) L;                   /* to avoid warnings */
88    fprintf(stderr, "PANIC: unprotected error in call to Lua API (%s)\n",
89            lua_tostring(L, -1));
90    return 0;
91}
92
93
94@ @c
95void luafunctioncall(int slot)
96{
97    int i ;
98    int stacktop = lua_gettop(Luas);
99    lua_active++;
100    lua_rawgeti(Luas, LUA_REGISTRYINDEX, lua_key_index(lua_functions));
101    lua_gettable(Luas, LUA_REGISTRYINDEX);
102    lua_rawgeti(Luas, -1,slot);
103    if (lua_isfunction(Luas,-1)) {
104        int base = lua_gettop(Luas); /* function index */
105        lua_pushnumber(Luas, slot);
106        lua_pushcfunction(Luas, lua_traceback); /* push traceback function */
107        lua_insert(Luas, base); /* put it under chunk  */
108        i = lua_pcall(Luas, 1, 0, base);
109        lua_remove(Luas, base); /* remove traceback function */
110        if (i != 0) {
111            lua_gc(Luas, LUA_GCCOLLECT, 0);
112            Luas = luatex_error(Luas, (i == LUA_ERRRUN ? 0 : 1));
113        }
114    }
115    lua_settop(Luas,stacktop);
116    lua_active--;
117}
118
119
120
121
122
123@ @c
124static const luaL_Reg lualibs[] = {
125    {"", luaopen_base},
126    {"package", luaopen_package},
127    {"coroutine", luaopen_coroutine},
128    {"table", luaopen_table},
129    {"io", open_iolibext},
130    {"os", luaopen_os},
131    {"string", luaopen_string},
132    {"math", luaopen_math},
133    {"debug", luaopen_debug},
134    {"unicode", luaopen_unicode},
135    {"zip", luaopen_zip},
136    {"bit32", luaopen_bit32},
137    {"md5", luaopen_md5},
138    {"lfs", luaopen_lfs},
139    {"profiler", luaopen_profiler},
140    {"lpeg", luaopen_lpeg},
141    {NULL, NULL}
142};
143
144
145@ @c
146static void do_openlibs(lua_State * L)
147{
148    const luaL_Reg *lib;
149    for (lib = lualibs; lib->func; lib++) {
150        luaL_requiref(L, lib->name, lib->func, 1);
151    	lua_pop(L, 1);  /* remove lib */
152    }
153}
154
155@ @c
156static int load_aux (lua_State *L, int status) {
157  if (status == 0)  /* OK? */
158    return 1;
159  else {
160    lua_pushnil(L);
161    lua_insert(L, -2);  /* put before error message */
162    return 2;  /* return nil plus error message */
163  }
164}
165
166@ @c
167static int luatex_loadfile (lua_State *L) {
168  int status = 0;
169  const char *fname = luaL_optstring(L, 1, NULL);
170  const char *mode = luaL_optstring(L, 2, NULL);
171  int env = !lua_isnone(L, 3);  /* 'env' parameter? */
172  if (!lua_only && !fname && interaction == batch_mode) {
173     lua_pushnil(L);
174     lua_pushstring(L, "reading from stdin is disabled in batch mode");
175     return 2;  /* return nil plus error message */
176  }
177  status = luaL_loadfilex(L, fname, mode);
178  if (status == LUA_OK) {
179    recorder_record_input(fname);
180    if (env) {  /* 'env' parameter? */
181      lua_pushvalue(L, 3);
182      lua_setupvalue(L, -2, 1);  /* set it as 1st upvalue of loaded chunk */
183    }
184  }
185  return load_aux(L, status);
186}
187
188@ @c
189static int luatex_dofile (lua_State *L) {
190  const char *fname = luaL_optstring(L, 1, NULL);
191  int n = lua_gettop(L);
192  if (!lua_only && !fname) {
193      if (interaction == batch_mode) {
194	  lua_pushnil(L);
195	  lua_pushstring(L, "reading from stdin is disabled in batch mode");
196	  return 2;  /* return nil plus error message */
197      } else {
198	  tprint_nl("lua> ");
199      }
200  }
201  if (luaL_loadfile(L, fname) != 0) lua_error(L);
202  recorder_record_input(fname);
203  lua_call(L, 0, LUA_MULTRET);
204  return lua_gettop(L) - n;
205}
206
207
208@ @c
209void luainterpreter(void)
210{
211    lua_State *L;
212    L = lua_newstate(my_luaalloc, NULL);
213    if (L == NULL) {
214        fprintf(stderr, "Can't create the Lua state.\n");
215        return;
216    }
217    lua_atpanic(L, &my_luapanic);
218
219    do_openlibs(L);             /* does all the 'simple' libraries */
220
221    lua_pushcfunction(L,luatex_dofile);
222    lua_setglobal(L, "dofile");
223    lua_pushcfunction(L,luatex_loadfile);
224    lua_setglobal(L, "loadfile");
225
226    luatex_md5_lua_open(L);
227
228    open_oslibext(L, safer_option);
229/*
230    open_iolibext(L);
231*/
232    open_strlibext(L);
233    open_lfslibext(L);
234
235    /* luasockets */
236    /* socket and mime are a bit tricky to open because
237     they use a load-time  dependency that has to be
238     worked around for luatex, where the C module is
239     loaded way before the lua module.
240     */
241    if (!nosocket_option) {
242        lua_getglobal(L, "package");
243        lua_getfield(L, -1, "loaded");
244        if (!lua_istable(L, -1)) {
245            lua_newtable(L);
246            lua_setfield(L, -2, "loaded");
247            lua_getfield(L, -1, "loaded");
248        }
249        luaopen_socket_core(L);
250        lua_setfield(L, -2, "socket.core");
251        lua_pushnil(L);
252        lua_setfield(L, -2, "socket");  /* package.loaded.socket = nil */
253
254        luaopen_mime_core(L);
255        lua_setfield(L, -2, "mime.core");
256        lua_pushnil(L);
257        lua_setfield(L, -2, "mime");    /* package.loaded.mime = nil */
258        lua_pop(L, 2);          /* pop the tables */
259
260        luatex_socketlua_open(L);       /* preload the pure lua modules */
261    }
262    /* zlib. slightly odd calling convention */
263    luaopen_zlib(L);
264    lua_setglobal(L, "zlib");
265    luaopen_gzip(L);
266
267    /* our own libraries */
268    luaopen_ff(L);
269    luaopen_tex(L);
270    luaopen_token(L);
271    luaopen_newtoken(L);
272    luaopen_node(L);
273    luaopen_texio(L);
274    luaopen_kpse(L);
275    luaopen_callback(L);
276    luaopen_lua(L, startup_filename);
277    luaopen_stats(L);
278    luaopen_font(L);
279    luaopen_lang(L);
280    luaopen_mplib(L);
281    luaopen_vf(L);
282
283    /* |luaopen_pdf(L);| */
284    /* environment table at |LUA_ENVIRONINDEX| needs to load this way: */
285    lua_pushcfunction(L, luaopen_pdf);
286    lua_pushstring(L, "pdf");
287    lua_call(L, 1, 0);
288
289    luaL_requiref(L, "img", luaopen_img, 1);
290    lua_pop(L, 1);
291
292    luaL_requiref(L, "epdf", luaopen_epdf, 1);
293    lua_pop(L, 1);
294
295    /* |luaopen_pdfscanner(L);| */
296    lua_pushcfunction(L, luaopen_pdfscanner);
297    lua_pushstring(L, "pdfscanner");
298    lua_call(L, 1, 0);
299
300    lua_createtable(L, 0, 0);
301    lua_setglobal(L, "texconfig");
302
303    if (safer_option) {
304        /* disable some stuff if --safer */
305        (void) hide_lua_value(L, "os", "execute");
306        (void) hide_lua_value(L, "os", "rename");
307        (void) hide_lua_value(L, "os", "remove");
308        (void) hide_lua_value(L, "io", "popen");
309        /* make io.open only read files */
310        luaL_checkstack(L, 2, "out of stack space");
311        lua_getglobal(L, "io");
312        lua_getfield(L, -1, "open_ro");
313        lua_setfield(L, -2, "open");
314        (void) hide_lua_value(L, "io", "tmpfile");
315        (void) hide_lua_value(L, "io", "output");
316        (void) hide_lua_value(L, "lfs", "chdir");
317        (void) hide_lua_value(L, "lfs", "lock");
318        (void) hide_lua_value(L, "lfs", "touch");
319        (void) hide_lua_value(L, "lfs", "rmdir");
320        (void) hide_lua_value(L, "lfs", "mkdir");
321    }
322    Luas = L;
323}
324
325@ @c
326int hide_lua_table(lua_State * L, const char *name)
327{
328    int r = 0;
329    lua_getglobal(L, name);
330    if (lua_istable(L, -1)) {
331        r = luaL_ref(L, LUA_REGISTRYINDEX);
332        lua_pushnil(L);
333        lua_setglobal(L, name);
334    }
335    return r;
336}
337
338@ @c
339void unhide_lua_table(lua_State * L, const char *name, int r)
340{
341    lua_rawgeti(L, LUA_REGISTRYINDEX, r);
342    lua_setglobal(L, name);
343    luaL_unref(L, LUA_REGISTRYINDEX, r);
344}
345
346@ @c
347int hide_lua_value(lua_State * L, const char *name, const char *item)
348{
349    int r = 0;
350    lua_getglobal(L, name);
351    if (lua_istable(L, -1)) {
352        lua_getfield(L, -1, item);
353        r = luaL_ref(L, LUA_REGISTRYINDEX);
354        lua_pushnil(L);
355        lua_setfield(L, -2, item);
356    }
357    return r;
358}
359
360@ @c
361void unhide_lua_value(lua_State * L, const char *name, const char *item, int r)
362{
363    lua_getglobal(L, name);
364    if (lua_istable(L, -1)) {
365        lua_rawgeti(L, LUA_REGISTRYINDEX, r);
366        lua_setfield(L, -2, item);
367        luaL_unref(L, LUA_REGISTRYINDEX, r);
368    }
369}
370
371
372@ @c
373int lua_traceback(lua_State * L)
374{
375    lua_getglobal(L, "debug");
376    if (!lua_istable(L, -1)) {
377        lua_pop(L, 1);
378        return 1;
379    }
380    lua_getfield(L, -1, "traceback");
381    if (!lua_isfunction(L, -1)) {
382        lua_pop(L, 2);
383        return 1;
384    }
385    lua_pushvalue(L, 1);        /* pass error message */
386    lua_pushinteger(L, 2);      /* skip this function and traceback */
387    lua_call(L, 2, 1);          /* call debug.traceback */
388    return 1;
389}
390
391@ @c
392static void luacall(int p, int nameptr, boolean is_string) /* hh-ls: optimized lua_id resolving */
393{
394    LoadS ls;
395    int i;
396    size_t ll = 0;
397    char *lua_id;
398    char *s = NULL;
399
400    if (Luas == NULL) {
401        luainterpreter();
402    }
403    lua_active++;
404    if (is_string) {
405        const char *ss = NULL;
406        lua_rawgeti(Luas, LUA_REGISTRYINDEX, p);
407        if (lua_isfunction(Luas,-1)) {
408            int base = lua_gettop(Luas);        /* function index */
409            lua_checkstack(Luas, 1);
410            lua_pushcfunction(Luas, lua_traceback);     /* push traceback function */
411            lua_insert(Luas, base);     /* put it under chunk  */
412            i = lua_pcall(Luas, 0, 0, base);
413            lua_remove(Luas, base);     /* remove traceback function */
414            if (i != 0) {
415                lua_gc(Luas, LUA_GCCOLLECT, 0);
416                Luas = luatex_error(Luas, (i == LUA_ERRRUN ? 0 : 1));
417            }
418            lua_active--;
419            return ;
420        }
421        ss = lua_tolstring(Luas, -1, &ll);
422        s = xmalloc(ll+1);
423        memcpy(s,ss,ll+1);
424        lua_pop(Luas,1);
425    } else {
426        int l = 0;
427        s = tokenlist_to_cstring(p, 1, &l);
428        ll = (size_t)l;
429    }
430    ls.s = s;
431    ls.size = ll;
432    if (ls.size > 0) {
433        if (nameptr > 0) {
434            int l = 0; /* not used */
435            lua_id = tokenlist_to_cstring(nameptr, 1, &l);
436            i = lua_load(Luas, getS, &ls, lua_id, NULL);
437            xfree(lua_id);
438        } else if (nameptr < 0) {
439            lua_id = get_lua_name((nameptr + 65536));
440            if (lua_id != NULL) {
441                i = lua_load(Luas, getS, &ls, lua_id, NULL);
442            } else {
443                i = lua_load(Luas, getS, &ls, "=[\\latelua]", NULL);
444            }
445        } else {
446            i = lua_load(Luas, getS, &ls, "=[\\latelua]", NULL);
447        }
448        if (i != 0) {
449            Luas = luatex_error(Luas, (i == LUA_ERRSYNTAX ? 0 : 1));
450        } else {
451            int base = lua_gettop(Luas);        /* function index */
452            lua_checkstack(Luas, 1);
453            lua_pushcfunction(Luas, lua_traceback);     /* push traceback function */
454            lua_insert(Luas, base);     /* put it under chunk  */
455            i = lua_pcall(Luas, 0, 0, base);
456            lua_remove(Luas, base);     /* remove traceback function */
457            if (i != 0) {
458                lua_gc(Luas, LUA_GCCOLLECT, 0);
459                Luas = luatex_error(Luas, (i == LUA_ERRRUN ? 0 : 1));
460            }
461        }
462        xfree(ls.s);
463    }
464    lua_active--;
465}
466
467
468
469@ @c
470void late_lua(PDF pdf, halfword p)
471{
472    (void) pdf;
473    if (late_lua_type(p)==normal) {
474        expand_macros_in_tokenlist(p);      /* sets |def_ref| */
475        luacall(def_ref, late_lua_name(p), false);
476        flush_list(def_ref);
477    } else {
478        luacall(late_lua_data(p), late_lua_name(p), true);
479    }
480}
481
482@ @c
483void luatokencall(int p, int nameptr) /* hh-ls: optimized lua_id resolving */
484{
485    LoadS ls;
486    int i, l;
487    char *s = NULL;
488    char *lua_id;
489    assert(Luas);
490    l = 0;
491    lua_active++;
492    s = tokenlist_to_cstring(p, 1, &l);
493    ls.s = s;
494    ls.size = (size_t) l;
495    if (ls.size > 0) {
496        if (nameptr > 0) {
497            lua_id = tokenlist_to_cstring(nameptr, 1, &l);
498            i = lua_load(Luas, getS, &ls, lua_id, NULL);
499	    xfree(lua_id);
500        } else if (nameptr < 0) {
501            lua_id = get_lua_name((nameptr + 65536));
502            if (lua_id != NULL) {
503                i = lua_load(Luas, getS, &ls, lua_id, NULL);
504            } else {
505                i = lua_load(Luas, getS, &ls, "=[\\directlua]", NULL);
506            }
507        } else {
508            i = lua_load(Luas, getS, &ls, "=[\\directlua]", NULL);
509        }
510        xfree(s);
511        if (i != 0) {
512            Luas = luatex_error(Luas, (i == LUA_ERRSYNTAX ? 0 : 1));
513        } else {
514            int base = lua_gettop(Luas);        /* function index */
515            lua_checkstack(Luas, 1);
516            lua_pushcfunction(Luas, lua_traceback);     /* push traceback function */
517            lua_insert(Luas, base);     /* put it under chunk  */
518            i = lua_pcall(Luas, 0, 0, base);
519            lua_remove(Luas, base);     /* remove traceback function */
520            if (i != 0) {
521                lua_gc(Luas, LUA_GCCOLLECT, 0);
522                Luas = luatex_error(Luas, (i == LUA_ERRRUN ? 0 : 1));
523            }
524        }
525    }
526    lua_active--;
527}
528
529@ @c
530lua_State *luatex_error(lua_State * L, int is_fatal)
531{
532
533    const_lstring luaerr;
534    char *err = NULL;
535    if (lua_isstring(L, -1)) {
536        luaerr.s = lua_tolstring(L, -1, &luaerr.l);
537        err = (char *) xmalloc((unsigned) (luaerr.l + 1));
538        snprintf(err, (luaerr.l + 1), "%s", luaerr.s);
539	last_lua_error = err;
540    }
541    if (is_fatal > 0) {
542        /* Normally a memory error from lua.
543           The pool may overflow during the |maketexlstring()|, but we
544           are crashing anyway so we may as well abort on the pool size */
545        lua_fatal_error(err);
546        /* never reached */
547        xfree(err);
548        lua_close(L);
549        return (lua_State *) NULL;
550    } else {
551        lua_norm_error(err);
552	/* last_lua_error = err so no need to xfree(err) */
553        return L;
554    }
555}
556
557@ @c
558void preset_environment(lua_State * L, const parm_struct * p, const char *s)
559{
560    int i;
561    assert(L != NULL);
562    /* double call with same s gives assert(0) */
563    lua_pushstring(L, s);       /* s */
564    lua_gettable(L, LUA_REGISTRYINDEX); /* t */
565    assert(lua_isnil(L, -1));
566    lua_pop(L, 1);              /* - */
567    lua_pushstring(L, s);       /* s */
568    lua_newtable(L);            /* t s */
569    for (i = 1, ++p; p->name != NULL; i++, p++) {
570        assert(i == p->idx);
571        lua_pushstring(L, p->name);     /* k t s */
572        lua_pushinteger(L, p->idx);     /* v k t s */
573        lua_settable(L, -3);    /* t s */
574    }
575    lua_settable(L, LUA_REGISTRYINDEX); /* - */
576}
577