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