external/mit/lua/dist/src/loadlib.c

   1 /*      $NetBSD: loadlib.c,v 1.4 2015/10/08 13:21:00 mbalmer Exp $      */
   2
   3 /*
   4 ** Id: loadlib.c,v 1.126 2015/02/16 13:14:33 roberto Exp
   5 ** Dynamic library loader for Lua
   6 ** See Copyright Notice in lua.h
   7 **
   8 ** This module contains an implementation of loadlib for Unix systems
   9 ** that have dlfcn, an implementation for Windows, and a stub for other
  10 ** systems.
  11 */
  12
  13 #define loadlib_c
  14 #define LUA_LIB
  15
  16 #include "lprefix.h"
  17
  18
  19 #include <stdio.h>
  20 #include <stdlib.h>
  21 #include <string.h>
  22
  23 #include "lua.h"
  24
  25 #include "lauxlib.h"
  26 #include "lualib.h"
  27
  28
  29 /*
  30 ** LUA_PATH_VAR and LUA_CPATH_VAR are the names of the environment
  31 ** variables that Lua check to set its paths.
  32 */
  33 #if !defined(LUA_PATH_VAR)
  34 #define LUA_PATH_VAR    "LUA_PATH"
  35 #endif
  36
  37 #if !defined(LUA_CPATH_VAR)
  38 #define LUA_CPATH_VAR   "LUA_CPATH"
  39 #endif
  40
  41 #define LUA_PATHSUFFIX          "_" LUA_VERSION_MAJOR "_" LUA_VERSION_MINOR
  42
  43 #define LUA_PATHVARVERSION              LUA_PATH_VAR LUA_PATHSUFFIX
  44 #define LUA_CPATHVARVERSION             LUA_CPATH_VAR LUA_PATHSUFFIX
  45
  46 /*
  47 ** LUA_PATH_SEP is the character that separates templates in a path.
  48 ** LUA_PATH_MARK is the string that marks the substitution points in a
  49 ** template.
  50 ** LUA_EXEC_DIR in a Windows path is replaced by the executable's
  51 ** directory.
  52 ** LUA_IGMARK is a mark to ignore all before it when building the
  53 ** luaopen_ function name.
  54 */
  55 #if !defined (LUA_PATH_SEP)
  56 #define LUA_PATH_SEP            ";"
  57 #endif
  58 #if !defined (LUA_PATH_MARK)
  59 #define LUA_PATH_MARK           "?"
  60 #endif
  61 #if !defined (LUA_EXEC_DIR)
  62 #define LUA_EXEC_DIR            "!"
  63 #endif
  64 #if !defined (LUA_IGMARK)
  65 #define LUA_IGMARK              "-"
  66 #endif
  67
  68
  69 /*
  70 ** LUA_CSUBSEP is the character that replaces dots in submodule names
  71 ** when searching for a C loader.
  72 ** LUA_LSUBSEP is the character that replaces dots in submodule names
  73 ** when searching for a Lua loader.
  74 */
  75 #if !defined(LUA_CSUBSEP)
  76 #define LUA_CSUBSEP             LUA_DIRSEP
  77 #endif
  78
  79 #if !defined(LUA_LSUBSEP)
  80 #define LUA_LSUBSEP             LUA_DIRSEP
  81 #endif
  82
  83
  84 /* prefix for open functions in C libraries */
  85 #define LUA_POF         "luaopen_"
  86
  87 /* separator for open functions in C libraries */
  88 #define LUA_OFSEP       "_"
  89
  90
  91 /*
  92 ** unique key for table in the registry that keeps handles
  93 ** for all loaded C libraries
  94 */
  95 static const int CLIBS = 0;
  96
  97 #define LIB_FAIL        "open"
  98
  99 #define setprogdir(L)           ((void)0)
 100
 101
 102 /*
 103 ** system-dependent functions
 104 */
 105
 106 /*
 107 ** unload library 'lib'
 108 */
 109 static void lsys_unloadlib (void *lib);
 110
 111 /*
 112 ** load C library in file 'path'. If 'seeglb', load with all names in
 113 ** the library global.
 114 ** Returns the library; in case of error, returns NULL plus an
 115 ** error string in the stack.
 116 */
 117 static void *lsys_load (lua_State *L, const char *path, int seeglb);
 118
 119 /*
 120 ** Try to find a function named 'sym' in library 'lib'.
 121 ** Returns the function; in case of error, returns NULL plus an
 122 ** error string in the stack.
 123 */
 124 static lua_CFunction lsys_sym (lua_State *L, void *lib, const char *sym);
 125
 126
 127
 128
 129 #if defined(LUA_USE_DLOPEN)     /* { */
 130 /*
 131 ** {========================================================================
 132 ** This is an implementation of loadlib based on the dlfcn interface.
 133 ** The dlfcn interface is available in Linux, SunOS, Solaris, IRIX, FreeBSD,
 134 ** NetBSD, AIX 4.2, HPUX 11, and  probably most other Unix flavors, at least
 135 ** as an emulation layer on top of native functions.
 136 ** =========================================================================
 137 */
 138
 139 #include <dlfcn.h>
 140
 141 /*
 142 ** Macro to convert pointer-to-void* to pointer-to-function. This cast
 143 ** is undefined according to ISO C, but POSIX assumes that it works.
 144 ** (The '__extension__' in gnu compilers is only to avoid warnings.)
 145 */
 146 #if defined(__GNUC__)
 147 #define cast_func(p) (__extension__ (lua_CFunction)(p))
 148 #else
 149 #define cast_func(p) ((lua_CFunction)(p))
 150 #endif
 151
 152
 153 static void lsys_unloadlib (void *lib) {
 154   dlclose(lib);
 155 }
 156
 157
 158 static void *lsys_load (lua_State *L, const char *path, int seeglb) {
 159   void *lib = dlopen(path, RTLD_NOW | (seeglb ? RTLD_GLOBAL : RTLD_LOCAL));
 160   if (lib == NULL) lua_pushstring(L, dlerror());
 161   return lib;
 162 }
 163
 164
 165 static lua_CFunction lsys_sym (lua_State *L, void *lib, const char *sym) {
 166   lua_CFunction f = cast_func(dlsym(lib, sym));
 167   if (f == NULL) lua_pushstring(L, dlerror());
 168   return f;
 169 }
 170
 171 /* }====================================================== */
 172
 173
 174
 175 #elif defined(LUA_DL_DLL)       /* }{ */
 176 /*
 177 ** {======================================================================
 178 ** This is an implementation of loadlib for Windows using native functions.
 179 ** =======================================================================
 180 */
 181
 182 #include <windows.h>
 183
 184 #undef setprogdir
 185
 186 /*
 187 ** optional flags for LoadLibraryEx
 188 */
 189 #if !defined(LUA_LLE_FLAGS)
 190 #define LUA_LLE_FLAGS   0
 191 #endif
 192
 193
 194 static void setprogdir (lua_State *L) {
 195   char buff[MAX_PATH + 1];
 196   char *lb;
 197   DWORD nsize = sizeof(buff)/sizeof(char);
 198   DWORD n = GetModuleFileNameA(NULL, buff, nsize);
 199   if (n == 0 || n == nsize || (lb = strrchr(buff, '\\')) == NULL)
 200     luaL_error(L, "unable to get ModuleFileName");
 201   else {
 202     *lb = '\0';
 203     luaL_gsub(L, lua_tostring(L, -1), LUA_EXEC_DIR, buff);
 204     lua_remove(L, -2);  /* remove original string */
 205   }
 206 }
 207
 208
 209 static void pusherror (lua_State *L) {
 210   int error = GetLastError();
 211   char buffer[128];
 212   if (FormatMessageA(FORMAT_MESSAGE_IGNORE_INSERTS | FORMAT_MESSAGE_FROM_SYSTEM,
 213       NULL, error, 0, buffer, sizeof(buffer)/sizeof(char), NULL))
 214     lua_pushstring(L, buffer);
 215   else
 216     lua_pushfstring(L, "system error %d\n", error);
 217 }
 218
 219 static void lsys_unloadlib (void *lib) {
 220   FreeLibrary((HMODULE)lib);
 221 }
 222
 223
 224 static void *lsys_load (lua_State *L, const char *path, int seeglb) {
 225   HMODULE lib = LoadLibraryExA(path, NULL, LUA_LLE_FLAGS);
 226   (void)(seeglb);  /* not used: symbols are 'global' by default */
 227   if (lib == NULL) pusherror(L);
 228   return lib;
 229 }
 230
 231
 232 static lua_CFunction lsys_sym (lua_State *L, void *lib, const char *sym) {
 233   lua_CFunction f = (lua_CFunction)GetProcAddress((HMODULE)lib, sym);
 234   if (f == NULL) pusherror(L);
 235   return f;
 236 }
 237
 238 /* }====================================================== */
 239
 240
 241 #else                           /* }{ */
 242 /*
 243 ** {======================================================
 244 ** Fallback for other systems
 245 ** =======================================================
 246 */
 247
 248 #undef LIB_FAIL
 249 #define LIB_FAIL        "absent"
 250
 251
 252 #define DLMSG   "dynamic libraries not enabled; check your Lua installation"
 253
 254
 255 static void lsys_unloadlib (void *lib) {
 256   (void)(lib);  /* not used */
 257 }
 258
 259
 260 static void *lsys_load (lua_State *L, const char *path, int seeglb) {
 261   (void)(path); (void)(seeglb);  /* not used */
 262   lua_pushliteral(L, DLMSG);
 263   return NULL;
 264 }
 265
 266
 267 static lua_CFunction lsys_sym (lua_State *L, void *lib, const char *sym) {
 268   (void)(lib); (void)(sym);  /* not used */
 269   lua_pushliteral(L, DLMSG);
 270   return NULL;
 271 }
 272
 273 /* }====================================================== */
 274 #endif                          /* } */
 275
 276
 277 /*
 278 ** return registry.CLIBS[path]
 279 */
 280 static void *checkclib (lua_State *L, const char *path) {
 281   void *plib;
 282   lua_rawgetp(L, LUA_REGISTRYINDEX, &CLIBS);
 283   lua_getfield(L, -1, path);
 284   plib = lua_touserdata(L, -1);  /* plib = CLIBS[path] */
 285   lua_pop(L, 2);  /* pop CLIBS table and 'plib' */
 286   return plib;
 287 }
 288
 289
 290 /*
 291 ** registry.CLIBS[path] = plib        -- for queries
 292 ** registry.CLIBS[#CLIBS + 1] = plib  -- also keep a list of all libraries
 293 */
 294 static void addtoclib (lua_State *L, const char *path, void *plib) {
 295   lua_rawgetp(L, LUA_REGISTRYINDEX, &CLIBS);
 296   lua_pushlightuserdata(L, plib);
 297   lua_pushvalue(L, -1);
 298   lua_setfield(L, -3, path);  /* CLIBS[path] = plib */
 299   lua_rawseti(L, -2, luaL_len(L, -2) + 1);  /* CLIBS[#CLIBS + 1] = plib */
 300   lua_pop(L, 1);  /* pop CLIBS table */
 301 }
 302
 303
 304 /*
 305 ** __gc tag method for CLIBS table: calls 'lsys_unloadlib' for all lib
 306 ** handles in list CLIBS
 307 */
 308 static int gctm (lua_State *L) {
 309   lua_Integer n = luaL_len(L, 1);
 310   for (; n >= 1; n--) {  /* for each handle, in reverse order */
 311     lua_rawgeti(L, 1, n);  /* get handle CLIBS[n] */
 312     lsys_unloadlib(lua_touserdata(L, -1));
 313     lua_pop(L, 1);  /* pop handle */
 314   }
 315   return 0;
 316 }
 317
 318
 319
 320 /* error codes for 'lookforfunc' */
 321 #define ERRLIB          1
 322 #define ERRFUNC         2
 323
 324 /*
 325 ** Look for a C function named 'sym' in a dynamically loaded library
 326 ** 'path'.
 327 ** First, check whether the library is already loaded; if not, try
 328 ** to load it.
 329 ** Then, if 'sym' is '*', return true (as library has been loaded).
 330 ** Otherwise, look for symbol 'sym' in the library and push a
 331 ** C function with that symbol.
 332 ** Return 0 and 'true' or a function in the stack; in case of
 333 ** errors, return an error code and an error message in the stack.
 334 */
 335 static int lookforfunc (lua_State *L, const char *path, const char *sym) {
 336   void *reg = checkclib(L, path);  /* check loaded C libraries */
 337   if (reg == NULL) {  /* must load library? */
 338     reg = lsys_load(L, path, *sym == '*');  /* global symbols if 'sym'=='*' */
 339     if (reg == NULL) return ERRLIB;  /* unable to load library */
 340     addtoclib(L, path, reg);
 341   }
 342   if (*sym == '*') {  /* loading only library (no function)? */
 343     lua_pushboolean(L, 1);  /* return 'true' */
 344     return 0;  /* no errors */
 345   }
 346   else {
 347     lua_CFunction f = lsys_sym(L, reg, sym);
 348     if (f == NULL)
 349       return ERRFUNC;  /* unable to find function */
 350     lua_pushcfunction(L, f);  /* else create new function */
 351     return 0;  /* no errors */
 352   }
 353 }
 354
 355
 356 static int ll_loadlib (lua_State *L) {
 357   const char *path = luaL_checkstring(L, 1);
 358   const char *init = luaL_checkstring(L, 2);
 359   int stat = lookforfunc(L, path, init);
 360   if (stat == 0)  /* no errors? */
 361     return 1;  /* return the loaded function */
 362   else {  /* error; error message is on stack top */
 363     lua_pushnil(L);
 364     lua_insert(L, -2);
 365     lua_pushstring(L, (stat == ERRLIB) ?  LIB_FAIL : "init");
 366     return 3;  /* return nil, error message, and where */
 367   }
 368 }
 369
 370
 371
 372 /*
 373 ** {======================================================
 374 ** 'require' function
 375 ** =======================================================
 376 */
 377
 378
 379 static int readable (const char *filename) {
 380   FILE *f = fopen(filename, "r");  /* try to open file */
 381   if (f == NULL) return 0;  /* open failed */
 382   fclose(f);
 383   return 1;
 384 }
 385
 386
 387 static const char *pushnexttemplate (lua_State *L, const char *path) {
 388   const char *l;
 389   while (*path == *LUA_PATH_SEP) path++;  /* skip separators */
 390   if (*path == '\0') return NULL;  /* no more templates */
 391   l = strchr(path, *LUA_PATH_SEP);  /* find next separator */
 392   if (l == NULL) l = path + strlen(path);
 393   lua_pushlstring(L, path, l - path);  /* template */
 394   return l;
 395 }
 396
 397
 398 static const char *searchpath (lua_State *L, const char *name,
 399                                              const char *path,
 400                                              const char *sep,
 401                                              const char *dirsep) {
 402   luaL_Buffer msg;  /* to build error message */
 403   luaL_buffinit(L, &msg);
 404   if (*sep != '\0')  /* non-empty separator? */
 405     name = luaL_gsub(L, name, sep, dirsep);  /* replace it by 'dirsep' */
 406   while ((path = pushnexttemplate(L, path)) != NULL) {
 407     const char *filename = luaL_gsub(L, lua_tostring(L, -1),
 408                                      LUA_PATH_MARK, name);
 409     lua_remove(L, -2);  /* remove path template */
 410     if (readable(filename))  /* does file exist and is readable? */
 411       return filename;  /* return that file name */
 412     lua_pushfstring(L, "\n\tno file '%s'", filename);
 413     lua_remove(L, -2);  /* remove file name */
 414     luaL_addvalue(&msg);  /* concatenate error msg. entry */
 415   }
 416   luaL_pushresult(&msg);  /* create error message */
 417   return NULL;  /* not found */
 418 }
 419
 420
 421 static int ll_searchpath (lua_State *L) {
 422   const char *f = searchpath(L, luaL_checkstring(L, 1),
 423                                 luaL_checkstring(L, 2),
 424                                 luaL_optstring(L, 3, "."),
 425                                 luaL_optstring(L, 4, LUA_DIRSEP));
 426   if (f != NULL) return 1;
 427   else {  /* error message is on top of the stack */
 428     lua_pushnil(L);
 429     lua_insert(L, -2);
 430     return 2;  /* return nil + error message */
 431   }
 432 }
 433
 434
 435 static const char *findfile (lua_State *L, const char *name,
 436                                            const char *pname,
 437                                            const char *dirsep) {
 438   const char *path;
 439   lua_getfield(L, lua_upvalueindex(1), pname);
 440   path = lua_tostring(L, -1);
 441   if (path == NULL)
 442     luaL_error(L, "'package.%s' must be a string", pname);
 443   return searchpath(L, name, path, ".", dirsep);
 444 }
 445
 446
 447 static int checkload (lua_State *L, int stat, const char *filename) {
 448   if (stat) {  /* module loaded successfully? */
 449     lua_pushstring(L, filename);  /* will be 2nd argument to module */
 450     return 2;  /* return open function and file name */
 451   }
 452   else
 453     return luaL_error(L, "error loading module '%s' from file '%s':\n\t%s",
 454                           lua_tostring(L, 1), filename, lua_tostring(L, -1));
 455 }
 456
 457
 458 static int searcher_Lua (lua_State *L) {
 459   const char *filename;
 460   const char *name = luaL_checkstring(L, 1);
 461   filename = findfile(L, name, "path", LUA_LSUBSEP);
 462   if (filename == NULL) return 1;  /* module not found in this path */
 463   return checkload(L, (luaL_loadfile(L, filename) == LUA_OK), filename);
 464 }
 465
 466
 467 /*
 468 ** Try to find a load function for module 'modname' at file 'filename'.
 469 ** First, change '.' to '_' in 'modname'; then, if 'modname' has
 470 ** the form X-Y (that is, it has an "ignore mark"), build a function
 471 ** name "luaopen_X" and look for it. (For compatibility, if that
 472 ** fails, it also tries "luaopen_Y".) If there is no ignore mark,
 473 ** look for a function named "luaopen_modname".
 474 */
 475 static int loadfunc (lua_State *L, const char *filename, const char *modname) {
 476   const char *openfunc;
 477   const char *mark;
 478   modname = luaL_gsub(L, modname, ".", LUA_OFSEP);
 479   mark = strchr(modname, *LUA_IGMARK);
 480   if (mark) {
 481     int stat;
 482     openfunc = lua_pushlstring(L, modname, mark - modname);
 483     openfunc = lua_pushfstring(L, LUA_POF"%s", openfunc);
 484     stat = lookforfunc(L, filename, openfunc);
 485     if (stat != ERRFUNC) return stat;
 486     modname = mark + 1;  /* else go ahead and try old-style name */
 487   }
 488   openfunc = lua_pushfstring(L, LUA_POF"%s", modname);
 489   return lookforfunc(L, filename, openfunc);
 490 }
 491
 492
 493 static int searcher_C (lua_State *L) {
 494   const char *name = luaL_checkstring(L, 1);
 495   const char *filename = findfile(L, name, "cpath", LUA_CSUBSEP);
 496   if (filename == NULL) return 1;  /* module not found in this path */
 497   return checkload(L, (loadfunc(L, filename, name) == 0), filename);
 498 }
 499
 500
 501 static int searcher_Croot (lua_State *L) {
 502   const char *filename;
 503   const char *name = luaL_checkstring(L, 1);
 504   const char *p = strchr(name, '.');
 505   int stat;
 506   if (p == NULL) return 0;  /* is root */
 507   lua_pushlstring(L, name, p - name);
 508   filename = findfile(L, lua_tostring(L, -1), "cpath", LUA_CSUBSEP);
 509   if (filename == NULL) return 1;  /* root not found */
 510   if ((stat = loadfunc(L, filename, name)) != 0) {
 511     if (stat != ERRFUNC)
 512       return checkload(L, 0, filename);  /* real error */
 513     else {  /* open function not found */
 514       lua_pushfstring(L, "\n\tno module '%s' in file '%s'", name, filename);
 515       return 1;
 516     }
 517   }
 518   lua_pushstring(L, filename);  /* will be 2nd argument to module */
 519   return 2;
 520 }
 521
 522
 523 static int searcher_preload (lua_State *L) {
 524   const char *name = luaL_checkstring(L, 1);
 525   lua_getfield(L, LUA_REGISTRYINDEX, "_PRELOAD");
 526   if (lua_getfield(L, -1, name) == LUA_TNIL)  /* not found? */
 527     lua_pushfstring(L, "\n\tno field package.preload['%s']", name);
 528   return 1;
 529 }
 530
 531
 532 static void findloader (lua_State *L, const char *name) {
 533   int i;
 534   luaL_Buffer msg;  /* to build error message */
 535   luaL_buffinit(L, &msg);
 536   /* push 'package.searchers' to index 3 in the stack */
 537   if (lua_getfield(L, lua_upvalueindex(1), "searchers") != LUA_TTABLE)
 538     luaL_error(L, "'package.searchers' must be a table");
 539   /*  iterate over available searchers to find a loader */
 540   for (i = 1; ; i++) {
 541     if (lua_rawgeti(L, 3, i) == LUA_TNIL) {  /* no more searchers? */
 542       lua_pop(L, 1);  /* remove nil */
 543       luaL_pushresult(&msg);  /* create error message */
 544       luaL_error(L, "module '%s' not found:%s", name, lua_tostring(L, -1));
 545     }
 546     lua_pushstring(L, name);
 547     lua_call(L, 1, 2);  /* call it */
 548     if (lua_isfunction(L, -2))  /* did it find a loader? */
 549       return;  /* module loader found */
 550     else if (lua_isstring(L, -2)) {  /* searcher returned error message? */
 551       lua_pop(L, 1);  /* remove extra return */
 552       luaL_addvalue(&msg);  /* concatenate error message */
 553     }
 554     else
 555       lua_pop(L, 2);  /* remove both returns */
 556   }
 557 }
 558
 559
 560 static int ll_require (lua_State *L) {
 561   const char *name = luaL_checkstring(L, 1);
 562   lua_settop(L, 1);  /* _LOADED table will be at index 2 */
 563   lua_getfield(L, LUA_REGISTRYINDEX, "_LOADED");
 564   lua_getfield(L, 2, name);  /* _LOADED[name] */
 565   if (lua_toboolean(L, -1))  /* is it there? */
 566     return 1;  /* package is already loaded */
 567   /* else must load package */
 568   lua_pop(L, 1);  /* remove 'getfield' result */
 569   findloader(L, name);
 570   lua_pushstring(L, name);  /* pass name as argument to module loader */
 571   lua_insert(L, -2);  /* name is 1st argument (before search data) */
 572   lua_call(L, 2, 1);  /* run loader to load module */
 573   if (!lua_isnil(L, -1))  /* non-nil return? */
 574     lua_setfield(L, 2, name);  /* _LOADED[name] = returned value */
 575   if (lua_getfield(L, 2, name) == LUA_TNIL) {   /* module set no value? */
 576     lua_pushboolean(L, 1);  /* use true as result */
 577     lua_pushvalue(L, -1);  /* extra copy to be returned */
 578     lua_setfield(L, 2, name);  /* _LOADED[name] = true */
 579   }
 580   return 1;
 581 }
 582
 583 /* }====================================================== */
 584
 585
 586
 587 /*
 588 ** {======================================================
 589 ** 'module' function
 590 ** =======================================================
 591 */
 592 #if defined(LUA_COMPAT_MODULE)
 593
 594 /*
 595 ** changes the environment variable of calling function
 596 */
 597 static void set_env (lua_State *L) {
 598   lua_Debug ar;
 599   if (lua_getstack(L, 1, &ar) == 0 ||
 600       lua_getinfo(L, "f", &ar) == 0 ||  /* get calling function */
 601       lua_iscfunction(L, -1))
 602     luaL_error(L, "'module' not called from a Lua function");
 603   lua_pushvalue(L, -2);  /* copy new environment table to top */
 604   lua_setupvalue(L, -2, 1);
 605   lua_pop(L, 1);  /* remove function */
 606 }
 607
 608
 609 static void dooptions (lua_State *L, int n) {
 610   int i;
 611   for (i = 2; i <= n; i++) {
 612     if (lua_isfunction(L, i)) {  /* avoid 'calling' extra info. */
 613       lua_pushvalue(L, i);  /* get option (a function) */
 614       lua_pushvalue(L, -2);  /* module */
 615       lua_call(L, 1, 0);
 616     }
 617   }
 618 }
 619
 620
 621 static void modinit (lua_State *L, const char *modname) {
 622   const char *dot;
 623   lua_pushvalue(L, -1);
 624   lua_setfield(L, -2, "_M");  /* module._M = module */
 625   lua_pushstring(L, modname);
 626   lua_setfield(L, -2, "_NAME");
 627   dot = strrchr(modname, '.');  /* look for last dot in module name */
 628   if (dot == NULL) dot = modname;
 629   else dot++;
 630   /* set _PACKAGE as package name (full module name minus last part) */
 631   lua_pushlstring(L, modname, dot - modname);
 632   lua_setfield(L, -2, "_PACKAGE");
 633 }
 634
 635
 636 static int ll_module (lua_State *L) {
 637   const char *modname = luaL_checkstring(L, 1);
 638   int lastarg = lua_gettop(L);  /* last parameter */
 639   luaL_pushmodule(L, modname, 1);  /* get/create module table */
 640   /* check whether table already has a _NAME field */
 641   if (lua_getfield(L, -1, "_NAME") != LUA_TNIL)
 642     lua_pop(L, 1);  /* table is an initialized module */
 643   else {  /* no; initialize it */
 644     lua_pop(L, 1);
 645     modinit(L, modname);
 646   }
 647   lua_pushvalue(L, -1);
 648   set_env(L);
 649   dooptions(L, lastarg);
 650   return 1;
 651 }
 652
 653
 654 static int ll_seeall (lua_State *L) {
 655   luaL_checktype(L, 1, LUA_TTABLE);
 656   if (!lua_getmetatable(L, 1)) {
 657     lua_createtable(L, 0, 1); /* create new metatable */
 658     lua_pushvalue(L, -1);
 659     lua_setmetatable(L, 1);
 660   }
 661   lua_pushglobaltable(L);
 662   lua_setfield(L, -2, "__index");  /* mt.__index = _G */
 663   return 0;
 664 }
 665
 666 #endif
 667 /* }====================================================== */
 668
 669
 670
 671 /* auxiliary mark (for internal use) */
 672 #define AUXMARK         "\1"
 673
 674
 675 /*
 676 ** return registry.LUA_NOENV as a boolean
 677 */
 678 static int noenv (lua_State *L) {
 679   int b;
 680   lua_getfield(L, LUA_REGISTRYINDEX, "LUA_NOENV");
 681   b = lua_toboolean(L, -1);
 682   lua_pop(L, 1);  /* remove value */
 683   return b;
 684 }
 685
 686
 687 static void setpath (lua_State *L, const char *fieldname, const char *envname1,
 688                                    const char *envname2, const char *def) {
 689   const char *path = getenv(envname1);
 690   if (path == NULL)  /* no environment variable? */
 691     path = getenv(envname2);  /* try alternative name */
 692   if (path == NULL || noenv(L))  /* no environment variable? */
 693     lua_pushstring(L, def);  /* use default */
 694   else {
 695     /* replace ";;" by ";AUXMARK;" and then AUXMARK by default path */
 696     path = luaL_gsub(L, path, LUA_PATH_SEP LUA_PATH_SEP,
 697                               LUA_PATH_SEP AUXMARK LUA_PATH_SEP);
 698     luaL_gsub(L, path, AUXMARK, def);
 699     lua_remove(L, -2);
 700   }
 701   setprogdir(L);
 702   lua_setfield(L, -2, fieldname);
 703 }
 704
 705
 706 static const luaL_Reg pk_funcs[] = {
 707   {"loadlib", ll_loadlib},
 708   {"searchpath", ll_searchpath},
 709 #if defined(LUA_COMPAT_MODULE)
 710   {"seeall", ll_seeall},
 711 #endif
 712   /* placeholders */
 713   {"preload", NULL},
 714   {"cpath", NULL},
 715   {"path", NULL},
 716   {"searchers", NULL},
 717   {"loaded", NULL},
 718   {NULL, NULL}
 719 };
 720
 721
 722 static const luaL_Reg ll_funcs[] = {
 723 #if defined(LUA_COMPAT_MODULE)
 724   {"module", ll_module},
 725 #endif
 726   {"require", ll_require},
 727   {NULL, NULL}
 728 };
 729
 730
 731 static void createsearcherstable (lua_State *L) {
 732   static const lua_CFunction searchers[] =
 733     {searcher_preload, searcher_Lua, searcher_C, searcher_Croot, NULL};
 734   int i;
 735   /* create 'searchers' table */
 736   lua_createtable(L, sizeof(searchers)/sizeof(searchers[0]) - 1, 0);
 737   /* fill it with pre-defined searchers */
 738   for (i=0; searchers[i] != NULL; i++) {
 739     lua_pushvalue(L, -2);  /* set 'package' as upvalue for all searchers */
 740     lua_pushcclosure(L, searchers[i], 1);
 741     lua_rawseti(L, -2, i+1);
 742   }
 743 #if defined(LUA_COMPAT_LOADERS)
 744   lua_pushvalue(L, -1);  /* make a copy of 'searchers' table */
 745   lua_setfield(L, -3, "loaders");  /* put it in field 'loaders' */
 746 #endif
 747   lua_setfield(L, -2, "searchers");  /* put it in field 'searchers' */
 748 }
 749
 750
 751 /*
 752 ** create table CLIBS to keep track of loaded C libraries,
 753 ** setting a finalizer to close all libraries when closing state.
 754 */
 755 static void createclibstable (lua_State *L) {
 756   lua_newtable(L);  /* create CLIBS table */
 757   lua_createtable(L, 0, 1);  /* create metatable for CLIBS */
 758   lua_pushcfunction(L, gctm);
 759   lua_setfield(L, -2, "__gc");  /* set finalizer for CLIBS table */
 760   lua_setmetatable(L, -2);
 761   lua_rawsetp(L, LUA_REGISTRYINDEX, &CLIBS);  /* set CLIBS table in registry */
 762 }
 763
 764
 765 LUAMOD_API int luaopen_package (lua_State *L) {
 766   createclibstable(L);
 767   luaL_newlib(L, pk_funcs);  /* create 'package' table */
 768   createsearcherstable(L);
 769   /* set field 'path' */
 770   setpath(L, "path", LUA_PATHVARVERSION, LUA_PATH_VAR, LUA_PATH_DEFAULT);
 771   /* set field 'cpath' */
 772   setpath(L, "cpath", LUA_CPATHVARVERSION, LUA_CPATH_VAR, LUA_CPATH_DEFAULT);
 773   /* store config information */
 774   lua_pushliteral(L, LUA_DIRSEP "\n" LUA_PATH_SEP "\n" LUA_PATH_MARK "\n"
 775                      LUA_EXEC_DIR "\n" LUA_IGMARK "\n");
 776   lua_setfield(L, -2, "config");
 777   /* set field 'loaded' */
 778   luaL_getsubtable(L, LUA_REGISTRYINDEX, "_LOADED");
 779   lua_setfield(L, -2, "loaded");
 780   /* set field 'preload' */
 781   luaL_getsubtable(L, LUA_REGISTRYINDEX, "_PRELOAD");
 782   lua_setfield(L, -2, "preload");
 783   lua_pushglobaltable(L);
 784   lua_pushvalue(L, -2);  /* set 'package' as upvalue for next lib */
 785   luaL_setfuncs(L, ll_funcs, 1);  /* open lib into global table */
 786   lua_pop(L, 1);  /* pop global table */
 787   return 1;  /* return 'package' table */
 788 }
 789