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