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