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