xref: /petsc/src/sys/dll/dl.c (revision 609bdbee21ea3be08735c64dbe00a9ab27759925)
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 
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 on MPI_Comm
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 @*/
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  = 0; /* 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 = PetscStrcpy(suffix,".");CHKERRQ(ierr);
83     ierr = PetscStrcat(suffix,PETSC_SLSUFFIX);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 /*@C
101    PetscDLLibraryOpen - Opens a PETSc dynamic link library
102 
103      Collective on MPI_Comm
104 
105    Input Parameters:
106 +   comm - processors that are opening the library
107 -   path - name of the library, can be relative or absolute
108 
109    Output Parameter:
110 .   entry - a PETSc dynamic link library entry
111 
112    Level: developer
113 
114    Notes:
115    [[<http,ftp>://hostname]/directoryname/]libbasename[.so.1.0]
116 
117    If the library has the symbol PetscDLLibraryRegister_basename() in it then that function is automatically run
118    when the library is opened.
119 
120    ${PETSC_ARCH} occuring in directoryname and filename
121    will be replaced with the appropriate value.
122 
123 .seealso: PetscLoadDynamicLibrary(), PetscDLLibraryAppend()
124 @*/
125 PetscErrorCode  PetscDLLibraryOpen(MPI_Comm comm,const char path[],PetscDLLibrary *entry)
126 {
127   PetscErrorCode ierr;
128   PetscBool      foundlibrary,match;
129   char           libname[PETSC_MAX_PATH_LEN],par2[PETSC_MAX_PATH_LEN],suffix[16],*s;
130   char           *basename,registername[128];
131   PetscDLHandle  handle;
132   PetscErrorCode (*func)(void) = NULL;
133   size_t         len;
134 
135   PetscFunctionBegin;
136   PetscValidCharPointer(path,2);
137   PetscValidPointer(entry,3);
138 
139   *entry = NULL;
140 
141   /* retrieve the library */
142   ierr = PetscInfo1(0,"Retrieving %s\n",path);CHKERRQ(ierr);
143   ierr = PetscDLLibraryRetrieve(comm,path,par2,PETSC_MAX_PATH_LEN,&foundlibrary);CHKERRQ(ierr);
144   if (!foundlibrary) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Unable to locate dynamic library:\n  %s\n",path);
145   /* Eventually ./configure should determine if the system needs an executable dynamic library */
146 #define PETSC_USE_NONEXECUTABLE_SO
147 #if !defined(PETSC_USE_NONEXECUTABLE_SO)
148   ierr = PetscTestFile(par2,'x',&foundlibrary);CHKERRQ(ierr);
149   if (!foundlibrary) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Dynamic library is not executable:\n  %s\n  %s\n",path,par2);
150 #endif
151 
152   /* copy path and setup shared library suffix  */
153   ierr = PetscStrncpy(libname,path,PETSC_MAX_PATH_LEN);CHKERRQ(ierr);
154   ierr = PetscStrcpy(suffix,".");CHKERRQ(ierr);
155   ierr = PetscStrcat(suffix,PETSC_SLSUFFIX);CHKERRQ(ierr);
156   /* remove wrong suffixes from libname */
157   ierr = PetscStrrstr(libname,".gz",&s);CHKERRQ(ierr);
158   if (s && s[3] == 0) s[0] = 0;
159   ierr = PetscStrrstr(libname,".a",&s);CHKERRQ(ierr);
160   if (s && s[2] == 0) s[0] = 0;
161   /* remove shared suffix from libname */
162   ierr = PetscStrrstr(libname,suffix,&s);CHKERRQ(ierr);
163   if (s) s[0] = 0;
164 
165   /* open the dynamic library */
166   ierr = PetscInfo1(0,"Opening dynamic library %s\n",libname);CHKERRQ(ierr);
167   ierr = PetscDLOpen(par2,PETSC_DL_DECIDE,&handle);CHKERRQ(ierr);
168 
169   /* look for [path/]libXXXXX.YYY and extract out the XXXXXX */
170   ierr = PetscStrrchr(libname,'/',&basename);CHKERRQ(ierr); /* XXX Windows ??? */
171   if (!basename) basename = libname;
172   ierr = PetscStrncmp(basename,"lib",3,&match);CHKERRQ(ierr);
173   if (match) basename = basename + 3;
174   else {
175     ierr = PetscInfo1(0,"Dynamic library %s does not have lib prefix\n",libname);CHKERRQ(ierr);
176   }
177   for (s=basename; *s; s++) if (*s == '-') *s = '_';
178   ierr = PetscStrlen(basename,&len);CHKERRQ(ierr);
179   ierr = PetscStrcpy(registername,"PetscDLLibraryRegister_");CHKERRQ(ierr);
180   ierr = PetscStrncat(registername,basename,len);CHKERRQ(ierr);
181   ierr = PetscDLSym(handle,registername,(void**)&func);CHKERRQ(ierr);
182   if (func) {
183     ierr = PetscInfo1(0,"Loading registered routines from %s\n",libname);CHKERRQ(ierr);
184     ierr = (*func)();CHKERRQ(ierr);
185   } else {
186     ierr = PetscInfo2(0,"Dynamic library %s does not have symbol %s\n",libname,registername);CHKERRQ(ierr);
187   }
188 
189   ierr = PetscNew(entry);CHKERRQ(ierr);
190   (*entry)->next   = 0;
191   (*entry)->handle = handle;
192   ierr = PetscStrcpy((*entry)->libname,libname);CHKERRQ(ierr);
193   PetscFunctionReturn(0);
194 }
195 
196 /*@C
197    PetscDLLibrarySym - Load a symbol from the dynamic link libraries.
198 
199    Collective on MPI_Comm
200 
201    Input Parameter:
202 +  comm - communicator that will open the library
203 .  outlist - list of already open libraries that may contain symbol (can be NULL and only the executable is searched for the function)
204 .  path     - optional complete library name (if provided checks here before checking outlist)
205 -  insymbol - name of symbol
206 
207    Output Parameter:
208 .  value - if symbol not found then this value is set to NULL
209 
210    Level: developer
211 
212    Notes: Symbol can be of the form
213         [/path/libname[.so.1.0]:]functionname[()] where items in [] denote optional
214 
215         Will attempt to (retrieve and) open the library if it is not yet been opened.
216 
217 @*/
218 PetscErrorCode  PetscDLLibrarySym(MPI_Comm comm,PetscDLLibrary *outlist,const char path[],const char insymbol[],void **value)
219 {
220   char           libname[PETSC_MAX_PATH_LEN],suffix[16],*symbol,*s;
221   PetscDLLibrary nlist,prev,list = NULL;
222   PetscErrorCode ierr;
223 
224   PetscFunctionBegin;
225   if (outlist) PetscValidPointer(outlist,2);
226   if (path) PetscValidCharPointer(path,3);
227   PetscValidCharPointer(insymbol,4);
228   PetscValidPointer(value,5);
229 
230   if (outlist) list = *outlist;
231   *value = 0;
232 
233 
234   ierr = PetscStrchr(insymbol,'(',&s);CHKERRQ(ierr);
235   if (s) {
236     /* make copy of symbol so we can edit it in place */
237     ierr = PetscStrallocpy(insymbol,&symbol);CHKERRQ(ierr);
238     /* If symbol contains () then replace with a NULL, to support functionname() */
239     ierr = PetscStrchr(symbol,'(',&s);CHKERRQ(ierr);
240     s[0] = 0;
241   } else symbol = (char*)insymbol;
242 
243   /*
244        Function name does include library
245        -------------------------------------
246   */
247   if (path && path[0] != '\0') {
248     /* copy path and remove suffix from libname */
249     ierr = PetscStrncpy(libname,path,PETSC_MAX_PATH_LEN);CHKERRQ(ierr);
250     ierr = PetscStrcpy(suffix,".");CHKERRQ(ierr);
251     ierr = PetscStrcat(suffix,PETSC_SLSUFFIX);CHKERRQ(ierr);
252     ierr = PetscStrrstr(libname,suffix,&s);CHKERRQ(ierr);
253     if (s) s[0] = 0;
254     /* Look if library is already opened and in path */
255     prev  = 0;
256     nlist = list;
257     while (nlist) {
258       PetscBool match;
259       ierr = PetscStrcmp(nlist->libname,libname,&match);CHKERRQ(ierr);
260       if (match) goto done;
261       prev  = nlist;
262       nlist = nlist->next;
263     }
264     /* open the library and append it to path */
265     ierr = PetscDLLibraryOpen(comm,path,&nlist);CHKERRQ(ierr);
266     ierr = PetscInfo1(0,"Appending %s to dynamic library search path\n",path);CHKERRQ(ierr);
267     if (prev) prev->next = nlist;
268     else {if (outlist) *outlist   = nlist;}
269 
270 done:;
271     ierr = PetscDLSym(nlist->handle,symbol,value);CHKERRQ(ierr);
272     if (*value) {
273       ierr = PetscInfo2(0,"Loading function %s from dynamic library %s\n",insymbol,path);CHKERRQ(ierr);
274     }
275 
276     /*
277          Function name does not include library so search path
278          -----------------------------------------------------
279     */
280   } else {
281     while (list) {
282       ierr = PetscDLSym(list->handle,symbol,value);CHKERRQ(ierr);
283       if (*value) {
284         ierr = PetscInfo2(0,"Loading symbol %s from dynamic library %s\n",symbol,list->libname);CHKERRQ(ierr);
285         break;
286       }
287       list = list->next;
288     }
289     if (!*value) {
290       ierr = PetscDLSym(NULL,symbol,value);CHKERRQ(ierr);
291       if (*value) {
292         ierr = PetscInfo1(0,"Loading symbol %s from object code\n",symbol);CHKERRQ(ierr);
293       }
294     }
295   }
296 
297   if (symbol != insymbol) {
298     ierr = PetscFree(symbol);CHKERRQ(ierr);
299   }
300   PetscFunctionReturn(0);
301 }
302 
303 /*@C
304      PetscDLLibraryAppend - Appends another dynamic link library to the seach list, to the end
305                 of the search path.
306 
307      Collective on MPI_Comm
308 
309      Input Parameters:
310 +     comm - MPI communicator
311 -     path - name of the library
312 
313      Output Parameter:
314 .     outlist - list of libraries
315 
316      Level: developer
317 
318      Notes: if library is already in path will not add it.
319 
320   If the library has the symbol PetscDLLibraryRegister_basename() in it then that function is automatically run
321       when the library is opened.
322 
323 .seealso: PetscDLLibraryOpen()
324 @*/
325 PetscErrorCode  PetscDLLibraryAppend(MPI_Comm comm,PetscDLLibrary *outlist,const char path[])
326 {
327   PetscDLLibrary list,prev;
328   PetscErrorCode ierr;
329   size_t         len;
330   PetscBool      match,dir;
331   char           program[PETSC_MAX_PATH_LEN],found[8*PETSC_MAX_PATH_LEN];
332   char           *libname,suffix[16],*s;
333   PetscToken     token;
334 
335   PetscFunctionBegin;
336   PetscValidPointer(outlist,2);
337 
338   /* is path a directory? */
339   ierr = PetscTestDirectory(path,'r',&dir);CHKERRQ(ierr);
340   if (dir) {
341     ierr = PetscInfo1(0,"Checking directory %s for dynamic libraries\n",path);CHKERRQ(ierr);
342     ierr = PetscStrcpy(program,path);CHKERRQ(ierr);
343     ierr = PetscStrlen(program,&len);CHKERRQ(ierr);
344     if (program[len-1] == '/') {
345       ierr = PetscStrcat(program,"*.");CHKERRQ(ierr);
346     } else {
347       ierr = PetscStrcat(program,"/*.");CHKERRQ(ierr);
348     }
349     ierr = PetscStrcat(program,PETSC_SLSUFFIX);CHKERRQ(ierr);
350 
351     ierr = PetscLs(comm,program,found,8*PETSC_MAX_PATH_LEN,&dir);CHKERRQ(ierr);
352     if (!dir) PetscFunctionReturn(0);
353   } else {
354     ierr = PetscStrncpy(found,path,PETSC_MAX_PATH_LEN);CHKERRQ(ierr);
355   }
356   ierr = PetscStrcpy(suffix,".");CHKERRQ(ierr);
357   ierr = PetscStrcat(suffix,PETSC_SLSUFFIX);CHKERRQ(ierr);
358 
359   ierr = PetscTokenCreate(found,'\n',&token);CHKERRQ(ierr);
360   ierr = PetscTokenFind(token,&libname);CHKERRQ(ierr);
361   while (libname) {
362     /* remove suffix from libname */
363     ierr = PetscStrrstr(libname,suffix,&s);CHKERRQ(ierr);
364     if (s) s[0] = 0;
365     /* see if library was already open then we are done */
366     list  = prev = *outlist;
367     match = PETSC_FALSE;
368     while (list) {
369       ierr = PetscStrcmp(list->libname,libname,&match);CHKERRQ(ierr);
370       if (match) break;
371       prev = list;
372       list = list->next;
373     }
374     /* restore suffix from libname */
375     if (s) s[0] = '.';
376     if (!match) {
377       /* open the library and add to end of list */
378       ierr = PetscDLLibraryOpen(comm,libname,&list);CHKERRQ(ierr);
379       ierr = PetscInfo1(0,"Appending %s to dynamic library search path\n",libname);CHKERRQ(ierr);
380       if (!*outlist) *outlist   = list;
381       else           prev->next = list;
382     }
383     ierr = PetscTokenFind(token,&libname);CHKERRQ(ierr);
384   }
385   ierr = PetscTokenDestroy(&token);CHKERRQ(ierr);
386   PetscFunctionReturn(0);
387 }
388 
389 /*@C
390      PetscDLLibraryPrepend - Add another dynamic library to search for symbols to the beginning of
391                  the search path.
392 
393      Collective on MPI_Comm
394 
395      Input Parameters:
396 +     comm - MPI communicator
397 -     path - name of the library
398 
399      Output Parameter:
400 .     outlist - list of libraries
401 
402      Level: developer
403 
404      Notes: If library is already in path will remove old reference.
405 
406 @*/
407 PetscErrorCode  PetscDLLibraryPrepend(MPI_Comm comm,PetscDLLibrary *outlist,const char path[])
408 {
409   PetscDLLibrary list,prev;
410   PetscErrorCode ierr;
411   size_t         len;
412   PetscBool      match,dir;
413   char           program[PETSC_MAX_PATH_LEN],found[8*PETSC_MAX_PATH_LEN];
414   char           *libname,suffix[16],*s;
415   PetscToken     token;
416 
417   PetscFunctionBegin;
418   PetscValidPointer(outlist,2);
419 
420   /* is path a directory? */
421   ierr = PetscTestDirectory(path,'r',&dir);CHKERRQ(ierr);
422   if (dir) {
423     ierr = PetscInfo1(0,"Checking directory %s for dynamic libraries\n",path);CHKERRQ(ierr);
424     ierr = PetscStrcpy(program,path);CHKERRQ(ierr);
425     ierr = PetscStrlen(program,&len);CHKERRQ(ierr);
426     if (program[len-1] == '/') {
427       ierr = PetscStrcat(program,"*.");CHKERRQ(ierr);
428     } else {
429       ierr = PetscStrcat(program,"/*.");CHKERRQ(ierr);
430     }
431     ierr = PetscStrcat(program,PETSC_SLSUFFIX);CHKERRQ(ierr);
432 
433     ierr = PetscLs(comm,program,found,8*PETSC_MAX_PATH_LEN,&dir);CHKERRQ(ierr);
434     if (!dir) PetscFunctionReturn(0);
435   } else {
436     ierr = PetscStrncpy(found,path,PETSC_MAX_PATH_LEN);CHKERRQ(ierr);
437   }
438 
439   ierr = PetscStrcpy(suffix,".");CHKERRQ(ierr);
440   ierr = PetscStrcat(suffix,PETSC_SLSUFFIX);CHKERRQ(ierr);
441 
442   ierr = PetscTokenCreate(found,'\n',&token);CHKERRQ(ierr);
443   ierr = PetscTokenFind(token,&libname);CHKERRQ(ierr);
444   while (libname) {
445     /* remove suffix from libname */
446     ierr = PetscStrstr(libname,suffix,&s);CHKERRQ(ierr);
447     if (s) s[0] = 0;
448     /* see if library was already open and move it to the front */
449     prev  = 0;
450     list  = *outlist;
451     match = PETSC_FALSE;
452     while (list) {
453       ierr = PetscStrcmp(list->libname,libname,&match);CHKERRQ(ierr);
454       if (match) {
455         ierr = PetscInfo1(0,"Moving %s to begin of dynamic library search path\n",libname);CHKERRQ(ierr);
456         if (prev) prev->next = list->next;
457         if (prev) list->next = *outlist;
458         *outlist = list;
459         break;
460       }
461       prev = list;
462       list = list->next;
463     }
464     /* restore suffix from libname */
465     if (s) s[0] = '.';
466     if (!match) {
467       /* open the library and add to front of list */
468       ierr       = PetscDLLibraryOpen(comm,libname,&list);CHKERRQ(ierr);
469       ierr       = PetscInfo1(0,"Prepending %s to dynamic library search path\n",libname);CHKERRQ(ierr);
470       list->next = *outlist;
471       *outlist   = list;
472     }
473     ierr = PetscTokenFind(token,&libname);CHKERRQ(ierr);
474   }
475   ierr = PetscTokenDestroy(&token);CHKERRQ(ierr);
476   PetscFunctionReturn(0);
477 }
478 
479 /*@C
480      PetscDLLibraryClose - Destroys the search path of dynamic libraries and closes the libraries.
481 
482     Collective on PetscDLLibrary
483 
484     Input Parameter:
485 .     head - library list
486 
487      Level: developer
488 
489 @*/
490 PetscErrorCode  PetscDLLibraryClose(PetscDLLibrary list)
491 {
492   PetscBool      done = PETSC_FALSE;
493   PetscDLLibrary prev,tail;
494   PetscErrorCode ierr;
495 
496   PetscFunctionBegin;
497   if (!list) PetscFunctionReturn(0);
498   /* traverse the list in reverse order */
499   while (!done) {
500     if (!list->next) done = PETSC_TRUE;
501     prev = tail = list;
502     while (tail->next) {
503       prev = tail;
504       tail = tail->next;
505     }
506     prev->next = 0;
507     /* close the dynamic library and free the space in entry data-structure*/
508     ierr = PetscInfo1(0,"Closing dynamic library %s\n",tail->libname);CHKERRQ(ierr);
509     ierr = PetscDLClose(&tail->handle);CHKERRQ(ierr);
510     ierr = PetscFree(tail);CHKERRQ(ierr);
511   }
512   PetscFunctionReturn(0);
513 }
514 
515