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 */
5
6 #include <petsc/private/petscimpl.h>
7
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 };
17
PetscDLLibraryPrintPath(PetscDLLibrary libs)18 PetscErrorCode PetscDLLibraryPrintPath(PetscDLLibrary libs)
19 {
20 PetscFunctionBegin;
21 while (libs) {
22 PetscErrorPrintf(" %s\n",libs->libname);
23 libs = libs->next;
24 }
25 PetscFunctionReturn(0);
26 }
27
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.
31
32 Collective
33
34 Input Parameters:
35 + comm - processors that are opening the library
36 - libname - name of the library, can be relative or absolute
37
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
42
43 Level: developer
44
45 Notes:
46 [[<http,ftp>://hostname]/directoryname/]filename[.so.1.0]
47
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 @*/
PetscDLLibraryRetrieve(MPI_Comm comm,const char libname[],char * lname,size_t llen,PetscBool * found)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;
55 PetscErrorCode ierr;
56
57 PetscFunctionBegin;
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 ierr = PetscStrlen(libname,&len);CHKERRQ(ierr);
63 len = PetscMax(4*len,PETSC_MAX_PATH_LEN);CHKERRQ(ierr);
64 ierr = PetscMalloc1(len,&buf);CHKERRQ(ierr);
65 par2 = buf;
66 ierr = PetscStrreplace(comm,libname,par2,len);CHKERRQ(ierr);
67
68 /* temporarily remove .gz if it ends library name */
69 ierr = PetscStrrstr(par2,".gz",&gz);CHKERRQ(ierr);
70 if (gz) {
71 ierr = PetscStrlen(gz,&len);CHKERRQ(ierr);
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 ierr = PetscStrlen(par2,&len);CHKERRQ(ierr);
77 if (par2[len-1] == 'a' && par2[len-2] == '.') par2[len-2] = 0;
78
79 ierr = PetscFileRetrieve(comm,par2,lname,llen,found);CHKERRQ(ierr);
80 if (!(*found)) {
81 /* see if library name does already not have suffix attached */
82 ierr = PetscStrncpy(suffix,".",sizeof(suffix));CHKERRQ(ierr);
83 ierr = PetscStrlcat(suffix,PETSC_SLSUFFIX,sizeof(suffix));CHKERRQ(ierr);
84 ierr = PetscStrrstr(par2,suffix,&so);CHKERRQ(ierr);
85 /* and attach the suffix if it is not there */
86 if (!so) { ierr = PetscStrcat(par2,suffix);CHKERRQ(ierr); }
87
88 /* restore the .gz suffix if it was there */
89 if (gz) { ierr = PetscStrcat(par2,".gz");CHKERRQ(ierr); }
90
91 /* and finally retrieve the file */
92 ierr = PetscFileRetrieve(comm,par2,lname,llen,found);CHKERRQ(ierr);
93 }
94
95 ierr = PetscFree(buf);CHKERRQ(ierr);
96 PetscFunctionReturn(0);
97 }
98
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"
105
106 /*@C
107 PetscDLLibraryOpen - Opens a PETSc dynamic link library
108
109 Collective
110
111 Input Parameters:
112 + comm - processors that are opening the library
113 - path - name of the library, can be relative or absolute
114
115 Output Parameter:
116 . entry - a PETSc dynamic link library entry
117
118 Level: developer
119
120 Notes:
121 [[<http,ftp>://hostname]/directoryname/]libbasename[.so.1.0]
122
123 If the library has the symbol PetscDLLibraryRegister_basename() in it then that function is automatically run
124 when the library is opened.
125
126 ${PETSC_ARCH} occuring in directoryname and filename
127 will be replaced with the appropriate value.
128
129 .seealso: PetscLoadDynamicLibrary(), PetscDLLibraryAppend()
130 @*/
PetscDLLibraryOpen(MPI_Comm comm,const char path[],PetscDLLibrary * entry)131 PetscErrorCode PetscDLLibraryOpen(MPI_Comm comm,const char path[],PetscDLLibrary *entry)
132 {
133 PetscErrorCode ierr;
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;
139
140 PetscFunctionBegin;
141 PetscValidCharPointer(path,2);
142 PetscValidPointer(entry,3);
143
144 *entry = NULL;
145
146 /* retrieve the library */
147 ierr = PetscInfo1(NULL,"Retrieving %s\n",path);CHKERRQ(ierr);
148 ierr = PetscDLLibraryRetrieve(comm,path,par2,PETSC_MAX_PATH_LEN,&foundlibrary);CHKERRQ(ierr);
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 ierr = PetscTestFile(par2,'x',&foundlibrary);CHKERRQ(ierr);
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
156
157 /* copy path and setup shared library suffix */
158 ierr = PetscStrncpy(libname,path,PETSC_MAX_PATH_LEN);CHKERRQ(ierr);
159 ierr = PetscStrncpy(suffix,".",sizeof(suffix));CHKERRQ(ierr);
160 ierr = PetscStrlcat(suffix,PETSC_SLSUFFIX,sizeof(suffix));CHKERRQ(ierr);
161 /* remove wrong suffixes from libname */
162 ierr = PetscStrrstr(libname,".gz",&s);CHKERRQ(ierr);
163 if (s && s[3] == 0) s[0] = 0;
164 ierr = PetscStrrstr(libname,".a",&s);CHKERRQ(ierr);
165 if (s && s[2] == 0) s[0] = 0;
166 /* remove shared suffix from libname */
167 ierr = PetscStrrstr(libname,suffix,&s);CHKERRQ(ierr);
168 if (s) s[0] = 0;
169
170 /* open the dynamic library */
171 ierr = PetscInfo1(NULL,"Opening dynamic library %s\n",libname);CHKERRQ(ierr);
172 ierr = PetscDLOpen(par2,PETSC_DL_DECIDE,&handle);CHKERRQ(ierr);
173
174 /* look for [path/]libXXXXX.YYY and extract out the XXXXXX */
175 ierr = PetscStrrchr(libname,'/',&basename);CHKERRQ(ierr); /* XXX Windows ??? */
176 if (!basename) basename = libname;
177 ierr = PetscStrncmp(basename,"lib",3,&match);CHKERRQ(ierr);
178 if (match) basename = basename + 3;
179 else {
180 ierr = PetscInfo1(NULL,"Dynamic library %s does not have lib prefix\n",libname);CHKERRQ(ierr);
181 }
182 for (s=basename; *s; s++) if (*s == '-') *s = '_';
183 ierr = PetscStrncpy(registername,"PetscDLLibraryRegister_",sizeof(registername));CHKERRQ(ierr);
184 ierr = PetscStrlcat(registername,basename,sizeof(registername));CHKERRQ(ierr);
185 ierr = PetscDLSym(handle,registername,(void**)&func);CHKERRQ(ierr);
186 if (func) {
187 ierr = PetscInfo1(NULL,"Loading registered routines from %s\n",libname);CHKERRQ(ierr);
188 ierr = (*func)();CHKERRQ(ierr);
189 } else {
190 ierr = PetscInfo2(NULL,"Dynamic library %s does not have symbol %s\n",libname,registername);CHKERRQ(ierr);
191 }
192
193 ierr = PetscNew(entry);CHKERRQ(ierr);
194 (*entry)->next = NULL;
195 (*entry)->handle = handle;
196 ierr = PetscStrcpy((*entry)->libname,libname);CHKERRQ(ierr);
197 PetscFunctionReturn(0);
198 }
199
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
206
207 /*@C
208 PetscDLLibrarySym - Load a symbol from the dynamic link libraries.
209
210 Collective
211
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
217
218 Output Parameter:
219 . value - if symbol not found then this value is set to NULL
220
221 Level: developer
222
223 Notes:
224 Symbol can be of the form
225 [/path/libname[.so.1.0]:]functionname[()] where items in [] denote optional
226
227 Will attempt to (retrieve and) open the library if it is not yet been opened.
228
229 @*/
PetscDLLibrarySym(MPI_Comm comm,PetscDLLibrary * outlist,const char path[],const char insymbol[],void ** value)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;
234 PetscErrorCode ierr;
235
236 PetscFunctionBegin;
237 if (outlist) PetscValidPointer(outlist,2);
238 if (path) PetscValidCharPointer(path,3);
239 PetscValidCharPointer(insymbol,4);
240 PetscValidPointer(value,5);
241
242 if (outlist) list = *outlist;
243 *value = NULL;
244
245
246 ierr = PetscStrchr(insymbol,'(',&s);CHKERRQ(ierr);
247 if (s) {
248 /* make copy of symbol so we can edit it in place */
249 ierr = PetscStrallocpy(insymbol,&symbol);CHKERRQ(ierr);
250 /* If symbol contains () then replace with a NULL, to support functionname() */
251 ierr = PetscStrchr(symbol,'(',&s);CHKERRQ(ierr);
252 s[0] = 0;
253 } else symbol = (char*)insymbol;
254
255 /*
256 Function name does include library
257 -------------------------------------
258 */
259 if (path && path[0] != '\0') {
260 /* copy path and remove suffix from libname */
261 ierr = PetscStrncpy(libname,path,PETSC_MAX_PATH_LEN);CHKERRQ(ierr);
262 ierr = PetscStrncpy(suffix,".",sizeof(suffix));CHKERRQ(ierr);
263 ierr = PetscStrlcat(suffix,PETSC_SLSUFFIX,sizeof(suffix));CHKERRQ(ierr);
264 ierr = PetscStrrstr(libname,suffix,&s);CHKERRQ(ierr);
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 ierr = PetscStrcmp(nlist->libname,libname,&match);CHKERRQ(ierr);
272 if (match) goto done;
273 prev = nlist;
274 nlist = nlist->next;
275 }
276 /* open the library and append it to path */
277 ierr = PetscDLLibraryOpen(comm,path,&nlist);CHKERRQ(ierr);
278 ierr = PetscInfo1(NULL,"Appending %s to dynamic library search path\n",path);CHKERRQ(ierr);
279 if (prev) prev->next = nlist;
280 else {if (outlist) *outlist = nlist;}
281
282 done:;
283 ierr = PetscDLSym(nlist->handle,symbol,value);CHKERRQ(ierr);
284 if (*value) {
285 ierr = PetscInfo2(NULL,"Loading function %s from dynamic library %s\n",insymbol,path);CHKERRQ(ierr);
286 }
287
288 /*
289 Function name does not include library so search path
290 -----------------------------------------------------
291 */
292 } else {
293 while (list) {
294 ierr = PetscDLSym(list->handle,symbol,value);CHKERRQ(ierr);
295 if (*value) {
296 ierr = PetscInfo2(NULL,"Loading symbol %s from dynamic library %s\n",symbol,list->libname);CHKERRQ(ierr);
297 break;
298 }
299 list = list->next;
300 }
301 if (!*value) {
302 ierr = PetscDLSym(NULL,symbol,value);CHKERRQ(ierr);
303 if (*value) {
304 ierr = PetscInfo1(NULL,"Loading symbol %s from object code\n",symbol);CHKERRQ(ierr);
305 }
306 }
307 }
308
309 if (symbol != insymbol) {
310 ierr = PetscFree(symbol);CHKERRQ(ierr);
311 }
312 PetscFunctionReturn(0);
313 }
314
315 /*@C
316 PetscDLLibraryAppend - Appends another dynamic link library to the seach list, to the end
317 of the search path.
318
319 Collective
320
321 Input Parameters:
322 + comm - MPI communicator
323 - path - name of the library
324
325 Output Parameter:
326 . outlist - list of libraries
327
328 Level: developer
329
330 Notes:
331 if library is already in path will not add it.
332
333 If the library has the symbol PetscDLLibraryRegister_basename() in it then that function is automatically run
334 when the library is opened.
335
336 .seealso: PetscDLLibraryOpen()
337 @*/
PetscDLLibraryAppend(MPI_Comm comm,PetscDLLibrary * outlist,const char path[])338 PetscErrorCode PetscDLLibraryAppend(MPI_Comm comm,PetscDLLibrary *outlist,const char path[])
339 {
340 PetscDLLibrary list,prev;
341 PetscErrorCode ierr;
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;
347
348 PetscFunctionBegin;
349 PetscValidPointer(outlist,2);
350
351 /* is path a directory? */
352 ierr = PetscTestDirectory(path,'r',&dir);CHKERRQ(ierr);
353 if (dir) {
354 ierr = PetscInfo1(NULL,"Checking directory %s for dynamic libraries\n",path);CHKERRQ(ierr);
355 ierr = PetscStrncpy(program,path,sizeof(program));CHKERRQ(ierr);
356 ierr = PetscStrlen(program,&len);CHKERRQ(ierr);
357 if (program[len-1] == '/') {
358 ierr = PetscStrlcat(program,"*.",sizeof(program));CHKERRQ(ierr);
359 } else {
360 ierr = PetscStrlcat(program,"/*.",sizeof(program));CHKERRQ(ierr);
361 }
362 ierr = PetscStrlcat(program,PETSC_SLSUFFIX,sizeof(program));CHKERRQ(ierr);
363
364 ierr = PetscLs(comm,program,found,8*PETSC_MAX_PATH_LEN,&dir);CHKERRQ(ierr);
365 if (!dir) PetscFunctionReturn(0);
366 } else {
367 ierr = PetscStrncpy(found,path,PETSC_MAX_PATH_LEN);CHKERRQ(ierr);
368 }
369 ierr = PetscStrncpy(suffix,".",sizeof(suffix));CHKERRQ(ierr);
370 ierr = PetscStrlcat(suffix,PETSC_SLSUFFIX,sizeof(suffix));CHKERRQ(ierr);
371
372 ierr = PetscTokenCreate(found,'\n',&token);CHKERRQ(ierr);
373 ierr = PetscTokenFind(token,&libname);CHKERRQ(ierr);
374 while (libname) {
375 /* remove suffix from libname */
376 ierr = PetscStrrstr(libname,suffix,&s);CHKERRQ(ierr);
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 ierr = PetscStrcmp(list->libname,libname,&match);CHKERRQ(ierr);
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 ierr = PetscDLLibraryOpen(comm,libname,&list);CHKERRQ(ierr);
392 ierr = PetscInfo1(NULL,"Appending %s to dynamic library search path\n",libname);CHKERRQ(ierr);
393 if (!*outlist) *outlist = list;
394 else prev->next = list;
395 }
396 ierr = PetscTokenFind(token,&libname);CHKERRQ(ierr);
397 }
398 ierr = PetscTokenDestroy(&token);CHKERRQ(ierr);
399 PetscFunctionReturn(0);
400 }
401
402 /*@C
403 PetscDLLibraryPrepend - Add another dynamic library to search for symbols to the beginning of
404 the search path.
405
406 Collective
407
408 Input Parameters:
409 + comm - MPI communicator
410 - path - name of the library
411
412 Output Parameter:
413 . outlist - list of libraries
414
415 Level: developer
416
417 Notes:
418 If library is already in path will remove old reference.
419
420 @*/
PetscDLLibraryPrepend(MPI_Comm comm,PetscDLLibrary * outlist,const char path[])421 PetscErrorCode PetscDLLibraryPrepend(MPI_Comm comm,PetscDLLibrary *outlist,const char path[])
422 {
423 PetscDLLibrary list,prev;
424 PetscErrorCode ierr;
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;
430
431 PetscFunctionBegin;
432 PetscValidPointer(outlist,2);
433
434 /* is path a directory? */
435 ierr = PetscTestDirectory(path,'r',&dir);CHKERRQ(ierr);
436 if (dir) {
437 ierr = PetscInfo1(NULL,"Checking directory %s for dynamic libraries\n",path);CHKERRQ(ierr);
438 ierr = PetscStrncpy(program,path,sizeof(program));CHKERRQ(ierr);
439 ierr = PetscStrlen(program,&len);CHKERRQ(ierr);
440 if (program[len-1] == '/') {
441 ierr = PetscStrlcat(program,"*.",sizeof(program));CHKERRQ(ierr);
442 } else {
443 ierr = PetscStrlcat(program,"/*.",sizeof(program));CHKERRQ(ierr);
444 }
445 ierr = PetscStrlcat(program,PETSC_SLSUFFIX,sizeof(program));CHKERRQ(ierr);
446
447 ierr = PetscLs(comm,program,found,8*PETSC_MAX_PATH_LEN,&dir);CHKERRQ(ierr);
448 if (!dir) PetscFunctionReturn(0);
449 } else {
450 ierr = PetscStrncpy(found,path,PETSC_MAX_PATH_LEN);CHKERRQ(ierr);
451 }
452
453 ierr = PetscStrncpy(suffix,".",sizeof(suffix));CHKERRQ(ierr);
454 ierr = PetscStrlcat(suffix,PETSC_SLSUFFIX,sizeof(suffix));CHKERRQ(ierr);
455
456 ierr = PetscTokenCreate(found,'\n',&token);CHKERRQ(ierr);
457 ierr = PetscTokenFind(token,&libname);CHKERRQ(ierr);
458 while (libname) {
459 /* remove suffix from libname */
460 ierr = PetscStrstr(libname,suffix,&s);CHKERRQ(ierr);
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 ierr = PetscStrcmp(list->libname,libname,&match);CHKERRQ(ierr);
468 if (match) {
469 ierr = PetscInfo1(NULL,"Moving %s to begin of dynamic library search path\n",libname);CHKERRQ(ierr);
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 ierr = PetscDLLibraryOpen(comm,libname,&list);CHKERRQ(ierr);
483 ierr = PetscInfo1(NULL,"Prepending %s to dynamic library search path\n",libname);CHKERRQ(ierr);
484 list->next = *outlist;
485 *outlist = list;
486 }
487 ierr = PetscTokenFind(token,&libname);CHKERRQ(ierr);
488 }
489 ierr = PetscTokenDestroy(&token);CHKERRQ(ierr);
490 PetscFunctionReturn(0);
491 }
492
493 /*@C
494 PetscDLLibraryClose - Destroys the search path of dynamic libraries and closes the libraries.
495
496 Collective on PetscDLLibrary
497
498 Input Parameter:
499 . head - library list
500
501 Level: developer
502
503 @*/
PetscDLLibraryClose(PetscDLLibrary list)504 PetscErrorCode PetscDLLibraryClose(PetscDLLibrary list)
505 {
506 PetscBool done = PETSC_FALSE;
507 PetscDLLibrary prev,tail;
508 PetscErrorCode ierr;
509
510 PetscFunctionBegin;
511 if (!list) PetscFunctionReturn(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 ierr = PetscInfo1(NULL,"Closing dynamic library %s\n",tail->libname);CHKERRQ(ierr);
523 ierr = PetscDLClose(&tail->handle);CHKERRQ(ierr);
524 ierr = PetscFree(tail);CHKERRQ(ierr);
525 }
526 PetscFunctionReturn(0);
527 }
528
529