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