Actual source code: dl.c

      1: /*
      2:       Routines for opening dynamic link libraries (DLLs), keeping a searchable
      3:    path of DLLs, obtaining remote DLLs via a URL and opening them locally.
      4: */

      6: #include <petsc/private/petscimpl.h>

      8: /* ------------------------------------------------------------------------------*/
      9: /*
     10:       Code to maintain a list of opened dynamic libraries and load symbols
     11: */
     12: struct _n_PetscDLLibrary {
     13:   PetscDLLibrary next;
     14:   PetscDLHandle  handle;
     15:   char           libname[PETSC_MAX_PATH_LEN];
     16: };

     18: PetscErrorCode  PetscDLLibraryPrintPath(PetscDLLibrary libs)
     19: {
     21:   while (libs) {
     22:     PetscErrorPrintf("  %s\n",libs->libname);
     23:     libs = libs->next;
     24:   }
     25:   return(0);
     26: }

     28: /*@C
     29:    PetscDLLibraryRetrieve - Copies a PETSc dynamic library from a remote location
     30:      (if it is remote), indicates if it exits and its local name.

     32:      Collective

     34:    Input Parameters:
     35: +   comm - processors that are opening the library
     36: -   libname - name of the library, can be relative or absolute

     38:    Output Parameter:
     39: +   name - actual name of file on local filesystem if found
     40: .   llen - length of the name buffer
     41: -   found - true if the file exists

     43:    Level: developer

     45:    Notes:
     46:    [[<http,ftp>://hostname]/directoryname/]filename[.so.1.0]

     48:    ${PETSC_ARCH}, ${PETSC_DIR}, ${PETSC_LIB_DIR}, or ${any environmental variable}
     49:    occuring in directoryname and filename will be replaced with appropriate values.
     50: @*/
     51: PetscErrorCode  PetscDLLibraryRetrieve(MPI_Comm comm,const char libname[],char *lname,size_t llen,PetscBool  *found)
     52: {
     53:   char           *buf,*par2,suffix[16],*gz,*so;
     54:   size_t         len;

     58:   /*
     59:      make copy of library name and replace $PETSC_ARCH etc
     60:      so we can add to the end of it to look for something like .so.1.0 etc.
     61:   */
     62:   PetscStrlen(libname,&len);
     63:   len  = PetscMax(4*len,PETSC_MAX_PATH_LEN);
     64:   PetscMalloc1(len,&buf);
     65:   par2 = buf;
     66:   PetscStrreplace(comm,libname,par2,len);

     68:   /* temporarily remove .gz if it ends library name */
     69:   PetscStrrstr(par2,".gz",&gz);
     70:   if (gz) {
     71:     PetscStrlen(gz,&len);
     72:     if (len != 3) gz  = NULL; /* do not end (exactly) with .gz */
     73:     else          *gz = 0;    /* ends with .gz, so remove it   */
     74:   }
     75:   /* strip out .a from it if user put it in by mistake */
     76:   PetscStrlen(par2,&len);
     77:   if (par2[len-1] == 'a' && par2[len-2] == '.') par2[len-2] = 0;

     79:   PetscFileRetrieve(comm,par2,lname,llen,found);
     80:   if (!(*found)) {
     81:     /* see if library name does already not have suffix attached */
     82:     PetscStrncpy(suffix,".",sizeof(suffix));
     83:     PetscStrlcat(suffix,PETSC_SLSUFFIX,sizeof(suffix));
     84:     PetscStrrstr(par2,suffix,&so);
     85:     /* and attach the suffix if it is not there */
     86:     if (!so) { PetscStrcat(par2,suffix); }

     88:     /* restore the .gz suffix if it was there */
     89:     if (gz) { PetscStrcat(par2,".gz"); }

     91:     /* and finally retrieve the file */
     92:     PetscFileRetrieve(comm,par2,lname,llen,found);
     93:   }

     95:   PetscFree(buf);
     96:   return(0);
     97: }

     99:   /*
    100:      Some compilers when used with -std=c89 don't produce a usable PETSC_FUNCTION_NAME. Since this name is needed in PetscMallocDump()
    101:      to avoid reporting the memory allocations in the function as not freed we hardwire the value here.
    102:   */
    103: #undef    PETSC_FUNCTION_NAME
    104: #define   PETSC_FUNCTION_NAME "PetscDLLibraryOpen"

    106: /*@C
    107:    PetscDLLibraryOpen - Opens a PETSc dynamic link library

    109:      Collective

    111:    Input Parameters:
    112: +   comm - processors that are opening the library
    113: -   path - name of the library, can be relative or absolute

    115:    Output Parameter:
    116: .   entry - a PETSc dynamic link library entry

    118:    Level: developer

    120:    Notes:
    121:    [[<http,ftp>://hostname]/directoryname/]libbasename[.so.1.0]

    123:    If the library has the symbol PetscDLLibraryRegister_basename() in it then that function is automatically run
    124:    when the library is opened.

    126:    ${PETSC_ARCH} occuring in directoryname and filename
    127:    will be replaced with the appropriate value.

    129: .seealso: PetscLoadDynamicLibrary(), PetscDLLibraryAppend()
    130: @*/
    131: PetscErrorCode  PetscDLLibraryOpen(MPI_Comm comm,const char path[],PetscDLLibrary *entry)
    132: {
    134:   PetscBool      foundlibrary,match;
    135:   char           libname[PETSC_MAX_PATH_LEN],par2[PETSC_MAX_PATH_LEN],suffix[16],*s;
    136:   char           *basename,registername[128];
    137:   PetscDLHandle  handle;
    138:   PetscErrorCode (*func)(void) = NULL;

    144:   *entry = NULL;

    146:   /* retrieve the library */
    147:   PetscInfo1(NULL,"Retrieving %s\n",path);
    148:   PetscDLLibraryRetrieve(comm,path,par2,PETSC_MAX_PATH_LEN,&foundlibrary);
    149:   if (!foundlibrary) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Unable to locate dynamic library:\n  %s\n",path);
    150:   /* Eventually ./configure should determine if the system needs an executable dynamic library */
    151: #define PETSC_USE_NONEXECUTABLE_SO
    152: #if !defined(PETSC_USE_NONEXECUTABLE_SO)
    153:   PetscTestFile(par2,'x',&foundlibrary);
    154:   if (!foundlibrary) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Dynamic library is not executable:\n  %s\n  %s\n",path,par2);
    155: #endif

    157:   /* copy path and setup shared library suffix  */
    158:   PetscStrncpy(libname,path,PETSC_MAX_PATH_LEN);
    159:   PetscStrncpy(suffix,".",sizeof(suffix));
    160:   PetscStrlcat(suffix,PETSC_SLSUFFIX,sizeof(suffix));
    161:   /* remove wrong suffixes from libname */
    162:   PetscStrrstr(libname,".gz",&s);
    163:   if (s && s[3] == 0) s[0] = 0;
    164:   PetscStrrstr(libname,".a",&s);
    165:   if (s && s[2] == 0) s[0] = 0;
    166:   /* remove shared suffix from libname */
    167:   PetscStrrstr(libname,suffix,&s);
    168:   if (s) s[0] = 0;

    170:   /* open the dynamic library */
    171:   PetscInfo1(NULL,"Opening dynamic library %s\n",libname);
    172:   PetscDLOpen(par2,PETSC_DL_DECIDE,&handle);

    174:   /* look for [path/]libXXXXX.YYY and extract out the XXXXXX */
    175:   PetscStrrchr(libname,'/',&basename); /* XXX Windows ??? */
    176:   if (!basename) basename = libname;
    177:   PetscStrncmp(basename,"lib",3,&match);
    178:   if (match) basename = basename + 3;
    179:   else {
    180:     PetscInfo1(NULL,"Dynamic library %s does not have lib prefix\n",libname);
    181:   }
    182:   for (s=basename; *s; s++) if (*s == '-') *s = '_';
    183:   PetscStrncpy(registername,"PetscDLLibraryRegister_",sizeof(registername));
    184:   PetscStrlcat(registername,basename,sizeof(registername));
    185:   PetscDLSym(handle,registername,(void**)&func);
    186:   if (func) {
    187:     PetscInfo1(NULL,"Loading registered routines from %s\n",libname);
    188:     (*func)();
    189:   } else {
    190:     PetscInfo2(NULL,"Dynamic library %s does not have symbol %s\n",libname,registername);
    191:   }

    193:   PetscNew(entry);
    194:   (*entry)->next   = NULL;
    195:   (*entry)->handle = handle;
    196:   PetscStrcpy((*entry)->libname,libname);
    197:   return(0);
    198: }

    200: #undef    PETSC_FUNCTION_NAME
    201: #if defined(__cplusplus)
    202: #  define PETSC_FUNCTION_NAME PETSC_FUNCTION_NAME_CXX
    203: #else
    204: #  define PETSC_FUNCTION_NAME PETSC_FUNCTION_NAME_C
    205: #endif

    207: /*@C
    208:    PetscDLLibrarySym - Load a symbol from the dynamic link libraries.

    210:    Collective

    212:    Input Parameter:
    213: +  comm - communicator that will open the library
    214: .  outlist - list of already open libraries that may contain symbol (can be NULL and only the executable is searched for the function)
    215: .  path     - optional complete library name (if provided checks here before checking outlist)
    216: -  insymbol - name of symbol

    218:    Output Parameter:
    219: .  value - if symbol not found then this value is set to NULL

    221:    Level: developer

    223:    Notes:
    224:     Symbol can be of the form
    225:         [/path/libname[.so.1.0]:]functionname[()] where items in [] denote optional

    227:         Will attempt to (retrieve and) open the library if it is not yet been opened.

    229: @*/
    230: PetscErrorCode  PetscDLLibrarySym(MPI_Comm comm,PetscDLLibrary *outlist,const char path[],const char insymbol[],void **value)
    231: {
    232:   char           libname[PETSC_MAX_PATH_LEN],suffix[16],*symbol,*s;
    233:   PetscDLLibrary nlist,prev,list = NULL;

    242:   if (outlist) list = *outlist;
    243:   *value = NULL;

    246:   PetscStrchr(insymbol,'(',&s);
    247:   if (s) {
    248:     /* make copy of symbol so we can edit it in place */
    249:     PetscStrallocpy(insymbol,&symbol);
    250:     /* If symbol contains () then replace with a NULL, to support functionname() */
    251:     PetscStrchr(symbol,'(',&s);
    252:     s[0] = 0;
    253:   } else symbol = (char*)insymbol;

    255:   /*
    256:        Function name does include library
    257:        -------------------------------------
    258:   */
    259:   if (path && path[0] != '\0') {
    260:     /* copy path and remove suffix from libname */
    261:     PetscStrncpy(libname,path,PETSC_MAX_PATH_LEN);
    262:     PetscStrncpy(suffix,".",sizeof(suffix));
    263:     PetscStrlcat(suffix,PETSC_SLSUFFIX,sizeof(suffix));
    264:     PetscStrrstr(libname,suffix,&s);
    265:     if (s) s[0] = 0;
    266:     /* Look if library is already opened and in path */
    267:     prev  = NULL;
    268:     nlist = list;
    269:     while (nlist) {
    270:       PetscBool match;
    271:       PetscStrcmp(nlist->libname,libname,&match);
    272:       if (match) goto done;
    273:       prev  = nlist;
    274:       nlist = nlist->next;
    275:     }
    276:     /* open the library and append it to path */
    277:     PetscDLLibraryOpen(comm,path,&nlist);
    278:     PetscInfo1(NULL,"Appending %s to dynamic library search path\n",path);
    279:     if (prev) prev->next = nlist;
    280:     else {if (outlist) *outlist   = nlist;}

    282: done:;
    283:     PetscDLSym(nlist->handle,symbol,value);
    284:     if (*value) {
    285:       PetscInfo2(NULL,"Loading function %s from dynamic library %s\n",insymbol,path);
    286:     }

    288:     /*
    289:          Function name does not include library so search path
    290:          -----------------------------------------------------
    291:     */
    292:   } else {
    293:     while (list) {
    294:       PetscDLSym(list->handle,symbol,value);
    295:       if (*value) {
    296:         PetscInfo2(NULL,"Loading symbol %s from dynamic library %s\n",symbol,list->libname);
    297:         break;
    298:       }
    299:       list = list->next;
    300:     }
    301:     if (!*value) {
    302:       PetscDLSym(NULL,symbol,value);
    303:       if (*value) {
    304:         PetscInfo1(NULL,"Loading symbol %s from object code\n",symbol);
    305:       }
    306:     }
    307:   }

    309:   if (symbol != insymbol) {
    310:     PetscFree(symbol);
    311:   }
    312:   return(0);
    313: }

    315: /*@C
    316:      PetscDLLibraryAppend - Appends another dynamic link library to the seach list, to the end
    317:                 of the search path.

    319:      Collective

    321:      Input Parameters:
    322: +     comm - MPI communicator
    323: -     path - name of the library

    325:      Output Parameter:
    326: .     outlist - list of libraries

    328:      Level: developer

    330:      Notes:
    331:     if library is already in path will not add it.

    333:   If the library has the symbol PetscDLLibraryRegister_basename() in it then that function is automatically run
    334:       when the library is opened.

    336: .seealso: PetscDLLibraryOpen()
    337: @*/
    338: PetscErrorCode  PetscDLLibraryAppend(MPI_Comm comm,PetscDLLibrary *outlist,const char path[])
    339: {
    340:   PetscDLLibrary list,prev;
    342:   size_t         len;
    343:   PetscBool      match,dir;
    344:   char           program[PETSC_MAX_PATH_LEN],found[8*PETSC_MAX_PATH_LEN];
    345:   char           *libname,suffix[16],*s;
    346:   PetscToken     token;

    351:   /* is path a directory? */
    352:   PetscTestDirectory(path,'r',&dir);
    353:   if (dir) {
    354:     PetscInfo1(NULL,"Checking directory %s for dynamic libraries\n",path);
    355:     PetscStrncpy(program,path,sizeof(program));
    356:     PetscStrlen(program,&len);
    357:     if (program[len-1] == '/') {
    358:       PetscStrlcat(program,"*.",sizeof(program));
    359:     } else {
    360:       PetscStrlcat(program,"/*.",sizeof(program));
    361:     }
    362:     PetscStrlcat(program,PETSC_SLSUFFIX,sizeof(program));

    364:     PetscLs(comm,program,found,8*PETSC_MAX_PATH_LEN,&dir);
    365:     if (!dir) return(0);
    366:   } else {
    367:     PetscStrncpy(found,path,PETSC_MAX_PATH_LEN);
    368:   }
    369:   PetscStrncpy(suffix,".",sizeof(suffix));
    370:   PetscStrlcat(suffix,PETSC_SLSUFFIX,sizeof(suffix));

    372:   PetscTokenCreate(found,'\n',&token);
    373:   PetscTokenFind(token,&libname);
    374:   while (libname) {
    375:     /* remove suffix from libname */
    376:     PetscStrrstr(libname,suffix,&s);
    377:     if (s) s[0] = 0;
    378:     /* see if library was already open then we are done */
    379:     list  = prev = *outlist;
    380:     match = PETSC_FALSE;
    381:     while (list) {
    382:       PetscStrcmp(list->libname,libname,&match);
    383:       if (match) break;
    384:       prev = list;
    385:       list = list->next;
    386:     }
    387:     /* restore suffix from libname */
    388:     if (s) s[0] = '.';
    389:     if (!match) {
    390:       /* open the library and add to end of list */
    391:       PetscDLLibraryOpen(comm,libname,&list);
    392:       PetscInfo1(NULL,"Appending %s to dynamic library search path\n",libname);
    393:       if (!*outlist) *outlist   = list;
    394:       else           prev->next = list;
    395:     }
    396:     PetscTokenFind(token,&libname);
    397:   }
    398:   PetscTokenDestroy(&token);
    399:   return(0);
    400: }

    402: /*@C
    403:      PetscDLLibraryPrepend - Add another dynamic library to search for symbols to the beginning of
    404:                  the search path.

    406:      Collective

    408:      Input Parameters:
    409: +     comm - MPI communicator
    410: -     path - name of the library

    412:      Output Parameter:
    413: .     outlist - list of libraries

    415:      Level: developer

    417:      Notes:
    418:     If library is already in path will remove old reference.

    420: @*/
    421: PetscErrorCode  PetscDLLibraryPrepend(MPI_Comm comm,PetscDLLibrary *outlist,const char path[])
    422: {
    423:   PetscDLLibrary list,prev;
    425:   size_t         len;
    426:   PetscBool      match,dir;
    427:   char           program[PETSC_MAX_PATH_LEN],found[8*PETSC_MAX_PATH_LEN];
    428:   char           *libname,suffix[16],*s;
    429:   PetscToken     token;

    434:   /* is path a directory? */
    435:   PetscTestDirectory(path,'r',&dir);
    436:   if (dir) {
    437:     PetscInfo1(NULL,"Checking directory %s for dynamic libraries\n",path);
    438:     PetscStrncpy(program,path,sizeof(program));
    439:     PetscStrlen(program,&len);
    440:     if (program[len-1] == '/') {
    441:       PetscStrlcat(program,"*.",sizeof(program));
    442:     } else {
    443:       PetscStrlcat(program,"/*.",sizeof(program));
    444:     }
    445:     PetscStrlcat(program,PETSC_SLSUFFIX,sizeof(program));

    447:     PetscLs(comm,program,found,8*PETSC_MAX_PATH_LEN,&dir);
    448:     if (!dir) return(0);
    449:   } else {
    450:     PetscStrncpy(found,path,PETSC_MAX_PATH_LEN);
    451:   }

    453:   PetscStrncpy(suffix,".",sizeof(suffix));
    454:   PetscStrlcat(suffix,PETSC_SLSUFFIX,sizeof(suffix));

    456:   PetscTokenCreate(found,'\n',&token);
    457:   PetscTokenFind(token,&libname);
    458:   while (libname) {
    459:     /* remove suffix from libname */
    460:     PetscStrstr(libname,suffix,&s);
    461:     if (s) s[0] = 0;
    462:     /* see if library was already open and move it to the front */
    463:     prev  = NULL;
    464:     list  = *outlist;
    465:     match = PETSC_FALSE;
    466:     while (list) {
    467:       PetscStrcmp(list->libname,libname,&match);
    468:       if (match) {
    469:         PetscInfo1(NULL,"Moving %s to begin of dynamic library search path\n",libname);
    470:         if (prev) prev->next = list->next;
    471:         if (prev) list->next = *outlist;
    472:         *outlist = list;
    473:         break;
    474:       }
    475:       prev = list;
    476:       list = list->next;
    477:     }
    478:     /* restore suffix from libname */
    479:     if (s) s[0] = '.';
    480:     if (!match) {
    481:       /* open the library and add to front of list */
    482:       PetscDLLibraryOpen(comm,libname,&list);
    483:       PetscInfo1(NULL,"Prepending %s to dynamic library search path\n",libname);
    484:       list->next = *outlist;
    485:       *outlist   = list;
    486:     }
    487:     PetscTokenFind(token,&libname);
    488:   }
    489:   PetscTokenDestroy(&token);
    490:   return(0);
    491: }

    493: /*@C
    494:      PetscDLLibraryClose - Destroys the search path of dynamic libraries and closes the libraries.

    496:     Collective on PetscDLLibrary

    498:     Input Parameter:
    499: .     head - library list

    501:      Level: developer

    503: @*/
    504: PetscErrorCode  PetscDLLibraryClose(PetscDLLibrary list)
    505: {
    506:   PetscBool      done = PETSC_FALSE;
    507:   PetscDLLibrary prev,tail;

    511:   if (!list) return(0);
    512:   /* traverse the list in reverse order */
    513:   while (!done) {
    514:     if (!list->next) done = PETSC_TRUE;
    515:     prev = tail = list;
    516:     while (tail->next) {
    517:       prev = tail;
    518:       tail = tail->next;
    519:     }
    520:     prev->next = NULL;
    521:     /* close the dynamic library and free the space in entry data-structure*/
    522:     PetscInfo1(NULL,"Closing dynamic library %s\n",tail->libname);
    523:     PetscDLClose(&tail->handle);
    524:     PetscFree(tail);
    525:   }
    526:   return(0);
    527: }