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: {
 20:   PetscFunctionBegin;
 21:   while (libs) {
 22:     PetscCall(PetscErrorPrintf("  %s\n", libs->libname));
 23:     libs = libs->next;
 24:   }
 25:   PetscFunctionReturn(PETSC_SUCCESS);
 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 Parameters:
 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:    occurring 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 = NULL, *so = NULL;
 54:   size_t len;

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

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

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

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

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

 94:   PetscCall(PetscFree(buf));
 95:   PetscFunctionReturn(PETSC_SUCCESS);
 96: }

 98: /*@C
 99:    PetscDLLibraryOpen - Opens a PETSc dynamic link library

101:      Collective

103:    Input Parameters:
104: +   comm - processors that are opening the library
105: -   path - name of the library, can be relative or absolute

107:    Output Parameter:
108: .   entry - a PETSc dynamic link library entry

110:    Level: developer

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

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

118:    ${PETSC_ARCH} occurring in directoryname and filename
119:    will be replaced with the appropriate value.

121: .seealso: `PetscLoadDynamicLibrary()`, `PetscDLLibraryAppend()`
122: @*/
123: PetscErrorCode PetscDLLibraryOpen(MPI_Comm comm, const char path[], PetscDLLibrary *entry)
124: {
125:   PetscBool     foundlibrary, match;
126:   char          libname[PETSC_MAX_PATH_LEN], par2[PETSC_MAX_PATH_LEN], suffix[16], *s;
127:   char         *basename, registername[128];
128:   PetscDLHandle handle;
129:   PetscErrorCode (*func)(void) = NULL;

131:   PetscFunctionBegin;

135:   *entry = NULL;

137:   /* retrieve the library */
138:   PetscCall(PetscInfo(NULL, "Retrieving %s\n", path));
139:   PetscCall(PetscDLLibraryRetrieve(comm, path, par2, PETSC_MAX_PATH_LEN, &foundlibrary));
140:   PetscCheck(foundlibrary, PETSC_COMM_SELF, PETSC_ERR_FILE_OPEN, "Unable to locate dynamic library:\n  %s", path);
141:   /* Eventually ./configure should determine if the system needs an executable dynamic library */
142: #define PETSC_USE_NONEXECUTABLE_SO
143: #if !defined(PETSC_USE_NONEXECUTABLE_SO)
144:   PetscCall(PetscTestFile(par2, 'x', &foundlibrary));
145:   PetscCheck(foundlibrary, PETSC_COMM_SELF, PETSC_ERR_FILE_OPEN, "Dynamic library is not executable:\n  %s\n  %s", path, par2);
146: #endif

148:   /* copy path and setup shared library suffix  */
149:   PetscCall(PetscStrncpy(libname, path, PETSC_MAX_PATH_LEN));
150:   PetscCall(PetscStrncpy(suffix, ".", sizeof(suffix)));
151:   PetscCall(PetscStrlcat(suffix, PETSC_SLSUFFIX, sizeof(suffix)));
152:   /* remove wrong suffixes from libname */
153:   PetscCall(PetscStrrstr(libname, ".gz", &s));
154:   if (s && s[3] == 0) s[0] = 0;
155:   PetscCall(PetscStrrstr(libname, ".a", &s));
156:   if (s && s[2] == 0) s[0] = 0;
157:   /* remove shared suffix from libname */
158:   PetscCall(PetscStrrstr(libname, suffix, &s));
159:   if (s) s[0] = 0;

161:   /* open the dynamic library */
162:   PetscCall(PetscInfo(NULL, "Opening dynamic library %s\n", libname));
163:   PetscCall(PetscDLOpen(par2, PETSC_DL_DECIDE, &handle));

165:   /* look for [path/]libXXXXX.YYY and extract out the XXXXXX */
166:   PetscCall(PetscStrrchr(libname, '/', &basename)); /* XXX Windows ??? */
167:   if (!basename) basename = libname;
168:   PetscCall(PetscStrncmp(basename, "lib", 3, &match));
169:   if (match) basename = basename + 3;
170:   else PetscCall(PetscInfo(NULL, "Dynamic library %s does not have lib prefix\n", libname));
171:   for (s = basename; *s; s++)
172:     if (*s == '-') *s = '_';
173:   PetscCall(PetscStrncpy(registername, "PetscDLLibraryRegister_", sizeof(registername)));
174:   PetscCall(PetscStrlcat(registername, basename, sizeof(registername)));
175:   PetscCall(PetscDLSym(handle, registername, (void **)&func));
176:   if (func) {
177:     PetscCall(PetscInfo(NULL, "Loading registered routines from %s\n", libname));
178:     PetscCall((*func)());
179:   } else {
180:     PetscCall(PetscInfo(NULL, "Dynamic library %s does not have symbol %s\n", libname, registername));
181:   }

183:   PetscCall(PetscNew(entry));
184:   (*entry)->next   = NULL;
185:   (*entry)->handle = handle;
186:   PetscCall(PetscStrcpy((*entry)->libname, libname));
187:   PetscFunctionReturn(PETSC_SUCCESS);
188: }

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

193:    Collective

195:    Input Parameters:
196: +  comm - communicator that will open the library
197: .  outlist - list of already open libraries that may contain symbol (can be NULL and only the executable is searched for the function)
198: .  path     - optional complete library name (if provided checks here before checking outlist)
199: -  insymbol - name of symbol

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

204:    Level: developer

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

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

212: @*/
213: PetscErrorCode PetscDLLibrarySym(MPI_Comm comm, PetscDLLibrary *outlist, const char path[], const char insymbol[], void **value)
214: {
215:   char           libname[PETSC_MAX_PATH_LEN], suffix[16];
216:   char          *symbol = NULL, *s = NULL;
217:   PetscDLLibrary list = NULL, nlist, prev;

219:   PetscFunctionBegin;

225:   if (outlist) list = *outlist;
226:   *value = NULL;

228:   PetscCall(PetscStrchr(insymbol, '(', &s));
229:   if (s) {
230:     /* make copy of symbol so we can edit it in place */
231:     PetscCall(PetscStrallocpy(insymbol, &symbol));
232:     /* If symbol contains () then replace with a NULL, to support functionname() */
233:     PetscCall(PetscStrchr(symbol, '(', &s));
234:     s[0] = 0;
235:   } else symbol = (char *)insymbol;

237:   /*
238:        Function name does include library
239:        -------------------------------------
240:   */
241:   if (path && path[0] != '\0') {
242:     /* copy path and remove suffix from libname */
243:     PetscCall(PetscStrncpy(libname, path, PETSC_MAX_PATH_LEN));
244:     PetscCall(PetscStrncpy(suffix, ".", sizeof(suffix)));
245:     PetscCall(PetscStrlcat(suffix, PETSC_SLSUFFIX, sizeof(suffix)));
246:     PetscCall(PetscStrrstr(libname, suffix, &s));
247:     if (s) s[0] = 0;
248:     /* Look if library is already opened and in path */
249:     prev  = NULL;
250:     nlist = list;
251:     while (nlist) {
252:       PetscBool match;
253:       PetscCall(PetscStrcmp(nlist->libname, libname, &match));
254:       if (match) goto done;
255:       prev  = nlist;
256:       nlist = nlist->next;
257:     }
258:     /* open the library and append it to path */
259:     PetscCall(PetscDLLibraryOpen(comm, path, &nlist));
260:     PetscCall(PetscInfo(NULL, "Appending %s to dynamic library search path\n", path));
261:     if (prev) prev->next = nlist;
262:     else {
263:       if (outlist) *outlist = nlist;
264:     }

266:   done:;
267:     PetscCall(PetscDLSym(nlist->handle, symbol, value));
268:     if (*value) PetscCall(PetscInfo(NULL, "Loading function %s from dynamic library %s\n", insymbol, path));

270:     /*
271:          Function name does not include library so search path
272:          -----------------------------------------------------
273:     */
274:   } else {
275:     while (list) {
276:       PetscCall(PetscDLSym(list->handle, symbol, value));
277:       if (*value) {
278:         PetscCall(PetscInfo(NULL, "Loading symbol %s from dynamic library %s\n", symbol, list->libname));
279:         break;
280:       }
281:       list = list->next;
282:     }
283:     if (!*value) {
284:       PetscCall(PetscDLSym(NULL, symbol, value));
285:       if (*value) PetscCall(PetscInfo(NULL, "Loading symbol %s from object code\n", symbol));
286:     }
287:   }

289:   if (symbol != insymbol) PetscCall(PetscFree(symbol));
290:   PetscFunctionReturn(PETSC_SUCCESS);
291: }

293: /*@C
294:      PetscDLLibraryAppend - Appends another dynamic link library to the search list, to the end
295:                 of the search path.

297:      Collective

299:      Input Parameters:
300: +     comm - MPI communicator
301: -     path - name of the library

303:      Output Parameter:
304: .     outlist - list of libraries

306:      Level: developer

308:      Note:
309:     if library is already in path will not add it.

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

314: .seealso: `PetscDLLibraryOpen()`
315: @*/
316: PetscErrorCode PetscDLLibraryAppend(MPI_Comm comm, PetscDLLibrary *outlist, const char path[])
317: {
318:   PetscDLLibrary list, prev;
319:   size_t         len;
320:   PetscBool      match, dir;
321:   char           program[PETSC_MAX_PATH_LEN], found[8 * PETSC_MAX_PATH_LEN];
322:   char          *libname, suffix[16], *s = NULL;
323:   PetscToken     token;

325:   PetscFunctionBegin;

328:   /* is path a directory? */
329:   PetscCall(PetscTestDirectory(path, 'r', &dir));
330:   if (dir) {
331:     PetscCall(PetscInfo(NULL, "Checking directory %s for dynamic libraries\n", path));
332:     PetscCall(PetscStrncpy(program, path, sizeof(program)));
333:     PetscCall(PetscStrlen(program, &len));
334:     if (program[len - 1] == '/') {
335:       PetscCall(PetscStrlcat(program, "*.", sizeof(program)));
336:     } else {
337:       PetscCall(PetscStrlcat(program, "/*.", sizeof(program)));
338:     }
339:     PetscCall(PetscStrlcat(program, PETSC_SLSUFFIX, sizeof(program)));

341:     PetscCall(PetscLs(comm, program, found, 8 * PETSC_MAX_PATH_LEN, &dir));
342:     if (!dir) PetscFunctionReturn(PETSC_SUCCESS);
343:   } else {
344:     PetscCall(PetscStrncpy(found, path, PETSC_MAX_PATH_LEN));
345:   }
346:   PetscCall(PetscStrncpy(suffix, ".", sizeof(suffix)));
347:   PetscCall(PetscStrlcat(suffix, PETSC_SLSUFFIX, sizeof(suffix)));

349:   PetscCall(PetscTokenCreate(found, '\n', &token));
350:   PetscCall(PetscTokenFind(token, &libname));
351:   while (libname) {
352:     /* remove suffix from libname */
353:     PetscCall(PetscStrrstr(libname, suffix, &s));
354:     if (s) s[0] = 0;
355:     /* see if library was already open then we are done */
356:     list = prev = *outlist;
357:     match       = PETSC_FALSE;
358:     while (list) {
359:       PetscCall(PetscStrcmp(list->libname, libname, &match));
360:       if (match) break;
361:       prev = list;
362:       list = list->next;
363:     }
364:     /* restore suffix from libname */
365:     if (s) s[0] = '.';
366:     if (!match) {
367:       /* open the library and add to end of list */
368:       PetscCall(PetscDLLibraryOpen(comm, libname, &list));
369:       PetscCall(PetscInfo(NULL, "Appending %s to dynamic library search path\n", libname));
370:       if (!*outlist) *outlist = list;
371:       else prev->next = list;
372:     }
373:     PetscCall(PetscTokenFind(token, &libname));
374:   }
375:   PetscCall(PetscTokenDestroy(&token));
376:   PetscFunctionReturn(PETSC_SUCCESS);
377: }

379: /*@C
380:      PetscDLLibraryPrepend - Add another dynamic library to search for symbols to the beginning of
381:                  the search path.

383:      Collective

385:      Input Parameters:
386: +     comm - MPI communicator
387: -     path - name of the library

389:      Output Parameter:
390: .     outlist - list of libraries

392:      Level: developer

394:      Note:
395:     If library is already in path will remove old reference.

397: @*/
398: PetscErrorCode PetscDLLibraryPrepend(MPI_Comm comm, PetscDLLibrary *outlist, const char path[])
399: {
400:   PetscDLLibrary list, prev;
401:   size_t         len;
402:   PetscBool      match, dir;
403:   char           program[PETSC_MAX_PATH_LEN], found[8 * PETSC_MAX_PATH_LEN];
404:   char          *libname, suffix[16], *s = NULL;
405:   PetscToken     token;

407:   PetscFunctionBegin;

410:   /* is path a directory? */
411:   PetscCall(PetscTestDirectory(path, 'r', &dir));
412:   if (dir) {
413:     PetscCall(PetscInfo(NULL, "Checking directory %s for dynamic libraries\n", path));
414:     PetscCall(PetscStrncpy(program, path, sizeof(program)));
415:     PetscCall(PetscStrlen(program, &len));
416:     if (program[len - 1] == '/') {
417:       PetscCall(PetscStrlcat(program, "*.", sizeof(program)));
418:     } else {
419:       PetscCall(PetscStrlcat(program, "/*.", sizeof(program)));
420:     }
421:     PetscCall(PetscStrlcat(program, PETSC_SLSUFFIX, sizeof(program)));

423:     PetscCall(PetscLs(comm, program, found, 8 * PETSC_MAX_PATH_LEN, &dir));
424:     if (!dir) PetscFunctionReturn(PETSC_SUCCESS);
425:   } else {
426:     PetscCall(PetscStrncpy(found, path, PETSC_MAX_PATH_LEN));
427:   }

429:   PetscCall(PetscStrncpy(suffix, ".", sizeof(suffix)));
430:   PetscCall(PetscStrlcat(suffix, PETSC_SLSUFFIX, sizeof(suffix)));

432:   PetscCall(PetscTokenCreate(found, '\n', &token));
433:   PetscCall(PetscTokenFind(token, &libname));
434:   while (libname) {
435:     /* remove suffix from libname */
436:     PetscCall(PetscStrstr(libname, suffix, &s));
437:     if (s) s[0] = 0;
438:     /* see if library was already open and move it to the front */
439:     prev  = NULL;
440:     list  = *outlist;
441:     match = PETSC_FALSE;
442:     while (list) {
443:       PetscCall(PetscStrcmp(list->libname, libname, &match));
444:       if (match) {
445:         PetscCall(PetscInfo(NULL, "Moving %s to begin of dynamic library search path\n", libname));
446:         if (prev) prev->next = list->next;
447:         if (prev) list->next = *outlist;
448:         *outlist = list;
449:         break;
450:       }
451:       prev = list;
452:       list = list->next;
453:     }
454:     /* restore suffix from libname */
455:     if (s) s[0] = '.';
456:     if (!match) {
457:       /* open the library and add to front of list */
458:       PetscCall(PetscDLLibraryOpen(comm, libname, &list));
459:       PetscCall(PetscInfo(NULL, "Prepending %s to dynamic library search path\n", libname));
460:       list->next = *outlist;
461:       *outlist   = list;
462:     }
463:     PetscCall(PetscTokenFind(token, &libname));
464:   }
465:   PetscCall(PetscTokenDestroy(&token));
466:   PetscFunctionReturn(PETSC_SUCCESS);
467: }

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

472:     Collective

474:     Input Parameter:
475: .     head - library list

477:      Level: developer

479: @*/
480: PetscErrorCode PetscDLLibraryClose(PetscDLLibrary list)
481: {
482:   PetscBool      done = PETSC_FALSE;
483:   PetscDLLibrary prev, tail;

485:   PetscFunctionBegin;
486:   if (!list) PetscFunctionReturn(PETSC_SUCCESS);
487:   /* traverse the list in reverse order */
488:   while (!done) {
489:     if (!list->next) done = PETSC_TRUE;
490:     prev = tail = list;
491:     while (tail->next) {
492:       prev = tail;
493:       tail = tail->next;
494:     }
495:     prev->next = NULL;
496:     /* close the dynamic library and free the space in entry data-structure*/
497:     PetscCall(PetscInfo(NULL, "Closing dynamic library %s\n", tail->libname));
498:     PetscCall(PetscDLClose(&tail->handle));
499:     PetscCall(PetscFree(tail));
500:   }
501:   PetscFunctionReturn(PETSC_SUCCESS);
502: }