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