ext/DynaLoader/dl_aix.xs

   1 /* dl_aix.xs
   2  *
   3  * Written: 8/31/94 by Wayne Scott (wscott@ichips.intel.com)
   4  *
   5  *  All I did was take Jens-Uwe Mager's libdl emulation library for
   6  *  AIX and merged it with the dl_dlopen.xs file to create a dynamic library
   7  *  package that works for AIX.
   8  *
   9  *  I did change all malloc's, free's, strdup's, calloc's to use the perl
  10  *  equilvant.  I also removed some stuff we will not need.  Call fini()
  11  *  on statup...   It can probably be trimmed more.
  12  */
  13
  14 /*
  15  * @(#)dlfcn.c  1.5 revision of 93/02/14  20:14:17
  16  * This is an unpublished work copyright (c) 1992 Helios Software GmbH
  17  * 3000 Hannover 1, Germany
  18  */
  19 #include "EXTERN.h"
  20 #include "perl.h"
  21 #include "XSUB.h"
  22
  23 #include <stdio.h>
  24 #include <errno.h>
  25 #include <string.h>
  26 #include <stdlib.h>
  27 #include <sys/types.h>
  28 #include <sys/ldr.h>
  29 #include <a.out.h>
  30 #include <ldfcn.h>
  31
  32 /* If using PerlIO, redefine these macros from <ldfcn.h> */
  33 #ifdef USE_PERLIO
  34 #define FSEEK(ldptr,o,p)        PerlIO_seek(IOPTR(ldptr),(p==BEGINNING)?(OFFSET(ldptr)+o):o,p)
  35 #define FREAD(p,s,n,ldptr)      PerlIO_read(IOPTR(ldptr),p,s*n)
  36 #endif
  37
  38 /*
  39  * We simulate dlopen() et al. through a call to load. Because AIX has
  40  * no call to find an exported symbol we read the loader section of the
  41  * loaded module and build a list of exported symbols and their virtual
  42  * address.
  43  */
  44
  45 typedef struct {
  46         char            *name;          /* the symbols's name */
  47         void            *addr;          /* its relocated virtual address */
  48 } Export, *ExportPtr;
  49
  50 /*
  51  * The void * handle returned from dlopen is actually a ModulePtr.
  52  */
  53 typedef struct Module {
  54         struct Module   *next;
  55         char            *name;          /* module name for refcounting */
  56         int             refCnt;         /* the number of references */
  57         void            *entry;         /* entry point from load */
  58         int             nExports;       /* the number of exports found */
  59         ExportPtr       exports;        /* the array of exports */
  60 } Module, *ModulePtr;
  61
  62 /*
  63  * We keep a list of all loaded modules to be able to call the fini
  64  * handlers at atexit() time.
  65  */
  66 static ModulePtr modList;
  67
  68 /*
  69  * The last error from one of the dl* routines is kept in static
  70  * variables here. Each error is returned only once to the caller.
  71  */
  72 static char errbuf[BUFSIZ];
  73 static int errvalid;
  74
  75 static void caterr(char *);
  76 static int readExports(ModulePtr);
  77 static void terminate(void);
  78 static void *findMain(void);
  79
  80 char *strerrorcat(char *str, int err) {
  81     char buf[8192];
  82     strerror_r(err, buf, sizeof(buf));
  83     strcat(str,buf);
  84     return str;
  85 }
  86 char *strerrorcpy(char *str, int err) {
  87     char buf[8192];
  88     strerror_r(err, buf, sizeof(buf));
  89     strcpy(str,buf);
  90     return str;
  91 }
  92
  93 /* ARGSUSED */
  94 void *dlopen(char *path, int mode)
  95 {
  96         register ModulePtr mp;
  97         static void *mainModule;
  98
  99         /*
 100          * Upon the first call register a terminate handler that will
 101          * close all libraries. Also get a reference to the main module
 102          * for use with loadbind.
 103          */
 104         if (!mainModule) {
 105                 if ((mainModule = findMain()) == NULL)
 106                         return NULL;
 107                 atexit(terminate);
 108         }
 109         /*
 110          * Scan the list of modules if have the module already loaded.
 111          */
 112         for (mp = modList; mp; mp = mp->next)
 113                 if (strcmp(mp->name, path) == 0) {
 114                         mp->refCnt++;
 115                         return mp;
 116                 }
 117         Newz(1000,mp,1,Module);
 118         if (mp == NULL) {
 119                 errvalid++;
 120                 strcpy(errbuf, "Newz: ");
 121                 strerrorcat(errbuf, errno);
 122                 return NULL;
 123         }
 124
 125         if ((mp->name = savepv(path)) == NULL) {
 126                 errvalid++;
 127                 strcpy(errbuf, "savepv: ");
 128                 strerrorcat(errbuf, errno);
 129                 safefree(mp);
 130                 return NULL;
 131         }
 132         /*
 133          * load should be declared load(const char *...). Thus we
 134          * cast the path to a normal char *. Ugly.
 135          */
 136         if ((mp->entry = (void *)load((char *)path, L_NOAUTODEFER, NULL)) == NULL) {
 137                 safefree(mp->name);
 138                 safefree(mp);
 139                 errvalid++;
 140                 strcpy(errbuf, "dlopen: ");
 141                 strcat(errbuf, path);
 142                 strcat(errbuf, ": ");
 143                 /*
 144                  * If AIX says the file is not executable, the error
 145                  * can be further described by querying the loader about
 146                  * the last error.
 147                  */
 148                 if (errno == ENOEXEC) {
 149                         char *tmp[BUFSIZ/sizeof(char *)];
 150                         if (loadquery(L_GETMESSAGES, tmp, sizeof(tmp)) == -1)
 151                                 strerrorcpy(errbuf, errno);
 152                         else {
 153                                 char **p;
 154                                 for (p = tmp; *p; p++)
 155                                         caterr(*p);
 156                         }
 157                 } else
 158                         strerrorcat(errbuf, errno);
 159                 return NULL;
 160         }
 161         mp->refCnt = 1;
 162         mp->next = modList;
 163         modList = mp;
 164         if (loadbind(0, mainModule, mp->entry) == -1) {
 165                 dlclose(mp);
 166                 errvalid++;
 167                 strcpy(errbuf, "loadbind: ");
 168                 strerrorcat(errbuf, errno);
 169                 return NULL;
 170         }
 171         if (readExports(mp) == -1) {
 172                 dlclose(mp);
 173                 return NULL;
 174         }
 175         return mp;
 176 }
 177
 178 /*
 179  * Attempt to decipher an AIX loader error message and append it
 180  * to our static error message buffer.
 181  */
 182 static void caterr(char *s)
 183 {
 184         register char *p = s;
 185
 186         while (*p >= '0' && *p <= '9')
 187                 p++;
 188         switch(atoi(s)) {
 189         case L_ERROR_TOOMANY:
 190                 strcat(errbuf, "to many errors");
 191                 break;
 192         case L_ERROR_NOLIB:
 193                 strcat(errbuf, "can't load library");
 194                 strcat(errbuf, p);
 195                 break;
 196         case L_ERROR_UNDEF:
 197                 strcat(errbuf, "can't find symbol");
 198                 strcat(errbuf, p);
 199                 break;
 200         case L_ERROR_RLDBAD:
 201                 strcat(errbuf, "bad RLD");
 202                 strcat(errbuf, p);
 203                 break;
 204         case L_ERROR_FORMAT:
 205                 strcat(errbuf, "bad exec format in");
 206                 strcat(errbuf, p);
 207                 break;
 208         case L_ERROR_ERRNO:
 209                 strerrorcat(errbuf, atoi(++p));
 210                 break;
 211         default:
 212                 strcat(errbuf, s);
 213                 break;
 214         }
 215 }
 216
 217 void *dlsym(void *handle, const char *symbol)
 218 {
 219         register ModulePtr mp = (ModulePtr)handle;
 220         register ExportPtr ep;
 221         register int i;
 222
 223         /*
 224          * Could speed up search, but I assume that one assigns
 225          * the result to function pointers anyways.
 226          */
 227         for (ep = mp->exports, i = mp->nExports; i; i--, ep++)
 228                 if (strcmp(ep->name, symbol) == 0)
 229                         return ep->addr;
 230         errvalid++;
 231         strcpy(errbuf, "dlsym: undefined symbol ");
 232         strcat(errbuf, symbol);
 233         return NULL;
 234 }
 235
 236 char *dlerror(void)
 237 {
 238         if (errvalid) {
 239                 errvalid = 0;
 240                 return errbuf;
 241         }
 242         return NULL;
 243 }
 244
 245 int dlclose(void *handle)
 246 {
 247         register ModulePtr mp = (ModulePtr)handle;
 248         int result;
 249         register ModulePtr mp1;
 250
 251         if (--mp->refCnt > 0)
 252                 return 0;
 253         result = unload(mp->entry);
 254         if (result == -1) {
 255                 errvalid++;
 256                 strerrorcpy(errbuf, errno);
 257         }
 258         if (mp->exports) {
 259                 register ExportPtr ep;
 260                 register int i;
 261                 for (ep = mp->exports, i = mp->nExports; i; i--, ep++)
 262                         if (ep->name)
 263                                 safefree(ep->name);
 264                 safefree(mp->exports);
 265         }
 266         if (mp == modList)
 267                 modList = mp->next;
 268         else {
 269                 for (mp1 = modList; mp1; mp1 = mp1->next)
 270                         if (mp1->next == mp) {
 271                                 mp1->next = mp->next;
 272                                 break;
 273                         }
 274         }
 275         safefree(mp->name);
 276         safefree(mp);
 277         return result;
 278 }
 279
 280 static void terminate(void)
 281 {
 282         while (modList)
 283                 dlclose(modList);
 284 }
 285
 286 /* Added by Wayne Scott
 287  * This is needed because the ldopen system call calls
 288  * calloc to allocated a block of date.  The ldclose call calls free.
 289  * Without this we get this system calloc and perl's free, resulting
 290  * in a "Bad free" message.  This way we always use perl's malloc.
 291  */
 292 void *calloc(size_t ne, size_t sz)
 293 {
 294   void *out;
 295
 296   out = (void *) safemalloc(ne*sz);
 297   memzero(out, ne*sz);
 298   return(out);
 299 }
 300
 301 /*
 302  * Build the export table from the XCOFF .loader section.
 303  */
 304 static int readExports(ModulePtr mp)
 305 {
 306         LDFILE *ldp = NULL;
 307         SCNHDR sh;
 308         LDHDR *lhp;
 309         char *ldbuf;
 310         LDSYM *ls;
 311         int i;
 312         ExportPtr ep;
 313
 314         if ((ldp = ldopen(mp->name, ldp)) == NULL) {
 315                 struct ld_info *lp;
 316                 char *buf;
 317                 int size = 4*1024;
 318                 if (errno != ENOENT) {
 319                         errvalid++;
 320                         strcpy(errbuf, "readExports: ");
 321                         strerrorcat(errbuf, errno);
 322                         return -1;
 323                 }
 324                 /*
 325                  * The module might be loaded due to the LIBPATH
 326                  * environment variable. Search for the loaded
 327                  * module using L_GETINFO.
 328                  */
 329                 if ((buf = safemalloc(size)) == NULL) {
 330                         errvalid++;
 331                         strcpy(errbuf, "readExports: ");
 332                         strerrorcat(errbuf, errno);
 333                         return -1;
 334                 }
 335                 while ((i = loadquery(L_GETINFO, buf, size)) == -1 && errno == ENOMEM) {
 336                         safefree(buf);
 337                         size += 4*1024;
 338                         if ((buf = safemalloc(size)) == NULL) {
 339                                 errvalid++;
 340                                 strcpy(errbuf, "readExports: ");
 341                                 strerrorcat(errbuf, errno);
 342                                 return -1;
 343                         }
 344                 }
 345                 if (i == -1) {
 346                         errvalid++;
 347                         strcpy(errbuf, "readExports: ");
 348                         strerrorcat(errbuf, errno);
 349                         safefree(buf);
 350                         return -1;
 351                 }
 352                 /*
 353                  * Traverse the list of loaded modules. The entry point
 354                  * returned by load() does actually point to the data
 355                  * segment origin.
 356                  */
 357                 lp = (struct ld_info *)buf;
 358                 while (lp) {
 359                         if (lp->ldinfo_dataorg == mp->entry) {
 360                                 ldp = ldopen(lp->ldinfo_filename, ldp);
 361                                 break;
 362                         }
 363                         if (lp->ldinfo_next == 0)
 364                                 lp = NULL;
 365                         else
 366                                 lp = (struct ld_info *)((char *)lp + lp->ldinfo_next);
 367                 }
 368                 safefree(buf);
 369                 if (!ldp) {
 370                         errvalid++;
 371                         strcpy(errbuf, "readExports: ");
 372                         strerrorcat(errbuf, errno);
 373                         return -1;
 374                 }
 375         }
 376         if (TYPE(ldp) != U802TOCMAGIC) {
 377                 errvalid++;
 378                 strcpy(errbuf, "readExports: bad magic");
 379                 while(ldclose(ldp) == FAILURE)
 380                         ;
 381                 return -1;
 382         }
 383         if (ldnshread(ldp, _LOADER, &sh) != SUCCESS) {
 384                 errvalid++;
 385                 strcpy(errbuf, "readExports: cannot read loader section header");
 386                 while(ldclose(ldp) == FAILURE)
 387                         ;
 388                 return -1;
 389         }
 390         /*
 391          * We read the complete loader section in one chunk, this makes
 392          * finding long symbol names residing in the string table easier.
 393          */
 394         if ((ldbuf = (char *)safemalloc(sh.s_size)) == NULL) {
 395                 errvalid++;
 396                 strcpy(errbuf, "readExports: ");
 397                 strerrorcat(errbuf, errno);
 398                 while(ldclose(ldp) == FAILURE)
 399                         ;
 400                 return -1;
 401         }
 402         if (FSEEK(ldp, sh.s_scnptr, BEGINNING) != OKFSEEK) {
 403                 errvalid++;
 404                 strcpy(errbuf, "readExports: cannot seek to loader section");
 405                 safefree(ldbuf);
 406                 while(ldclose(ldp) == FAILURE)
 407                         ;
 408                 return -1;
 409         }
 410 /* This first case is a hack, since it assumes that the 3rd parameter to
 411    FREAD is 1. See the redefinition of FREAD above to see how this works. */
 412 #ifdef USE_PERLIO
 413         if (FREAD(ldbuf, sh.s_size, 1, ldp) != sh.s_size) {
 414 #else
 415         if (FREAD(ldbuf, sh.s_size, 1, ldp) != 1) {
 416 #endif
 417                 errvalid++;
 418                 strcpy(errbuf, "readExports: cannot read loader section");
 419                 safefree(ldbuf);
 420                 while(ldclose(ldp) == FAILURE)
 421                         ;
 422                 return -1;
 423         }
 424         lhp = (LDHDR *)ldbuf;
 425         ls = (LDSYM *)(ldbuf+LDHDRSZ);
 426         /*
 427          * Count the number of exports to include in our export table.
 428          */
 429         for (i = lhp->l_nsyms; i; i--, ls++) {
 430                 if (!LDR_EXPORT(*ls))
 431                         continue;
 432                 mp->nExports++;
 433         }
 434         Newz(1001, mp->exports, mp->nExports, Export);
 435         if (mp->exports == NULL) {
 436                 errvalid++;
 437                 strcpy(errbuf, "readExports: ");
 438                 strerrorcat(errbuf, errno);
 439                 safefree(ldbuf);
 440                 while(ldclose(ldp) == FAILURE)
 441                         ;
 442                 return -1;
 443         }
 444         /*
 445          * Fill in the export table. All entries are relative to
 446          * the entry point we got from load.
 447          */
 448         ep = mp->exports;
 449         ls = (LDSYM *)(ldbuf+LDHDRSZ);
 450         for (i = lhp->l_nsyms; i; i--, ls++) {
 451                 char *symname;
 452                 if (!LDR_EXPORT(*ls))
 453                         continue;
 454                 if (ls->l_zeroes == 0)
 455                         symname = ls->l_offset+lhp->l_stoff+ldbuf;
 456                 else
 457                         symname = ls->l_name;
 458                 ep->name = savepv(symname);
 459                 ep->addr = (void *)((unsigned long)mp->entry + ls->l_value);
 460                 ep++;
 461         }
 462         safefree(ldbuf);
 463         while(ldclose(ldp) == FAILURE)
 464                 ;
 465         return 0;
 466 }
 467
 468 /*
 469  * Find the main modules entry point. This is used as export pointer
 470  * for loadbind() to be able to resolve references to the main part.
 471  */
 472 static void * findMain(void)
 473 {
 474         struct ld_info *lp;
 475         char *buf;
 476         int size = 4*1024;
 477         int i;
 478         void *ret;
 479
 480         if ((buf = safemalloc(size)) == NULL) {
 481                 errvalid++;
 482                 strcpy(errbuf, "findMain: ");
 483                 strerrorcat(errbuf, errno);
 484                 return NULL;
 485         }
 486         while ((i = loadquery(L_GETINFO, buf, size)) == -1 && errno == ENOMEM) {
 487                 safefree(buf);
 488                 size += 4*1024;
 489                 if ((buf = safemalloc(size)) == NULL) {
 490                         errvalid++;
 491                         strcpy(errbuf, "findMain: ");
 492                         strerrorcat(errbuf, errno);
 493                         return NULL;
 494                 }
 495         }
 496         if (i == -1) {
 497                 errvalid++;
 498                 strcpy(errbuf, "findMain: ");
 499                 strerrorcat(errbuf, errno);
 500                 safefree(buf);
 501                 return NULL;
 502         }
 503         /*
 504          * The first entry is the main module. The entry point
 505          * returned by load() does actually point to the data
 506          * segment origin.
 507          */
 508         lp = (struct ld_info *)buf;
 509         ret = lp->ldinfo_dataorg;
 510         safefree(buf);
 511         return ret;
 512 }
 513
 514 /* dl_dlopen.xs
 515  *
 516  * Platform:    SunOS/Solaris, possibly others which use dlopen.
 517  * Author:      Paul Marquess (pmarquess@bfsec.bt.co.uk)
 518  * Created:     10th July 1994
 519  *
 520  * Modified:
 521  * 15th July 1994   - Added code to explicitly save any error messages.
 522  * 3rd August 1994  - Upgraded to v3 spec.
 523  * 9th August 1994  - Changed to use IV
 524  * 10th August 1994 - Tim Bunce: Added RTLD_LAZY, switchable debugging,
 525  *                    basic FreeBSD support, removed ClearError
 526  *
 527  */
 528
 529 /* Porting notes:
 530
 531         see dl_dlopen.xs
 532
 533 */
 534
 535 #include "dlutils.c"    /* SaveError() etc      */
 536
 537
 538 static void
 539 dl_private_init()
 540 {
 541     (void)dl_generic_private_init();
 542 }
 543
 544 MODULE = DynaLoader     PACKAGE = DynaLoader
 545
 546 BOOT:
 547     (void)dl_private_init();
 548
 549
 550 void *
 551 dl_load_file(filename, flags=0)
 552         char *  filename
 553         int     flags
 554         CODE:
 555         DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s,%x):\n", filename,flags));
 556         if (flags & 0x01)
 557             warn("Can't make loaded symbols global on this platform while loading %s",filename);
 558         RETVAL = dlopen(filename, 1) ;
 559         DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), " libref=%x\n", RETVAL));
 560         ST(0) = sv_newmortal() ;
 561         if (RETVAL == NULL)
 562             SaveError("%s",dlerror()) ;
 563         else
 564             sv_setiv( ST(0), (IV)RETVAL);
 565
 566
 567 void *
 568 dl_find_symbol(libhandle, symbolname)
 569         void *          libhandle
 570         char *          symbolname
 571         CODE:
 572         DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "dl_find_symbol(handle=%x, symbol=%s)\n",
 573                 libhandle, symbolname));
 574         RETVAL = dlsym(libhandle, symbolname);
 575         DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "  symbolref = %x\n", RETVAL));
 576         ST(0) = sv_newmortal() ;
 577         if (RETVAL == NULL)
 578             SaveError("%s",dlerror()) ;
 579         else
 580             sv_setiv( ST(0), (IV)RETVAL);
 581
 582
 583 void
 584 dl_undef_symbols()
 585         PPCODE:
 586
 587
 588
 589 # These functions should not need changing on any platform:
 590
 591 void
 592 dl_install_xsub(perl_name, symref, filename="$Package")
 593     char *      perl_name
 594     void *      symref
 595     char *      filename
 596     CODE:
 597     DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "dl_install_xsub(name=%s, symref=%x)\n",
 598         perl_name, symref));
 599     ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)())symref, filename)));
 600
 601
 602 char *
 603 dl_error()
 604     CODE:
 605     RETVAL = LastError ;
 606     OUTPUT:
 607     RETVAL
 608
 609 # end.