Actual source code: dl.c
1: #define PETSC_DLL
2: /*
3: Routines for opening dynamic link libraries (DLLs), keeping a searchable
4: path of DLLs, obtaining remote DLLs via a URL and opening them locally.
5: */
7: #include petsc.h
8: #include petscsys.h
9: #include "petscfix.h"
11: #if defined(PETSC_USE_DYNAMIC_LIBRARIES)
13: #if defined(PETSC_HAVE_PWD_H)
14: #include <pwd.h>
15: #endif
16: #include <ctype.h>
17: #include <sys/types.h>
18: #include <sys/stat.h>
19: #if defined(PETSC_HAVE_UNISTD_H)
20: #include <unistd.h>
21: #endif
22: #if defined(PETSC_HAVE_STDLIB_H)
23: #include <stdlib.h>
24: #endif
25: #if defined(PETSC_HAVE_SYS_UTSNAME_H)
26: #include <sys/utsname.h>
27: #endif
28: #if defined(PETSC_HAVE_WINDOWS_H)
29: #include <windows.h>
30: #endif
31: #include <fcntl.h>
32: #include <time.h>
33: #if defined(PETSC_HAVE_SYS_SYSTEMINFO_H)
34: #include <sys/systeminfo.h>
35: #endif
37: #endif
39: #include "petscfix.h"
42: /*
43: Contains the list of registered CCA components
44: */
45: PetscFList CCAList = 0;
48: /* ------------------------------------------------------------------------------*/
49: /*
50: Code to maintain a list of opened dynamic libraries and load symbols
51: */
52: #if defined(PETSC_USE_DYNAMIC_LIBRARIES)
53: #if defined(PETSC_HAVE_DLFCN_H)
54: #include <dlfcn.h>
55: #endif
56: struct _n_PetscDLLibraryList {
57: PetscDLLibraryList next;
58: void *handle;
59: char libname[PETSC_MAX_PATH_LEN];
60: };
63: EXTERN PetscErrorCode Petsc_DelTag(MPI_Comm,int,void*,void*);
68: PetscErrorCode PetscDLLibraryPrintPath(void)
69: {
70: PetscDLLibraryList libs;
73: libs = DLLibrariesLoaded;
74: while (libs) {
75: PetscErrorPrintf(" %s\n",libs->libname);
76: libs = libs->next;
77: }
78: return(0);
79: }
83: /*@C
84: PetscDLLibraryRetrieve - Copies a PETSc dynamic library from a remote location
85: (if it is remote), indicates if it exits and its local name.
87: Collective on MPI_Comm
89: Input Parameters:
90: + comm - processors that are opening the library
91: - libname - name of the library, can be relative or absolute
93: Output Parameter:
94: . handle - library handle
96: Level: developer
98: Notes:
99: [[<http,ftp>://hostname]/directoryname/]filename[.so.1.0]
101: ${PETSC_ARCH}, ${PETSC_DIR}, ${PETSC_LIB_DIR}, or ${any environmental variable}
102: occuring in directoryname and filename will be replaced with appropriate values.
103: @*/
104: PetscErrorCode PetscDLLibraryRetrieve(MPI_Comm comm,const char libname[],char *lname,int llen,PetscTruth *found)
105: {
106: char *par2,buff[10],*en,*gz;
108: size_t len1,len2,len;
109: PetscTruth tflg,flg;
112: /*
113: make copy of library name and replace $PETSC_ARCH and and
114: so we can add to the end of it to look for something like .so.1.0 etc.
115: */
116: PetscStrlen(libname,&len);
117: len = PetscMax(4*len,PETSC_MAX_PATH_LEN);
118: PetscMalloc(len*sizeof(char),&par2);
119: PetscStrreplace(comm,libname,par2,len);
121: /*
122: Remove any file: header
123: */
124: PetscStrncmp(par2,"file:",5,&tflg);
125: if (tflg) {
126: PetscStrcpy(par2,par2+5);
127: }
129: /* strip out .a from it if user put it in by mistake */
130: PetscStrlen(par2,&len);
131: if (par2[len-1] == 'a' && par2[len-2] == '.') par2[len-2] = 0;
133: /* remove .gz if it ends library name */
134: PetscStrstr(par2,".gz",&gz);
135: if (gz) {
136: PetscStrlen(gz,&len);
137: if (len == 3) {
138: *gz = 0;
139: }
140: }
142: /* see if library name does already not have suffix attached */
143: PetscStrcpy(buff,".");
144: PetscStrcat(buff,PETSC_SLSUFFIX);
145: PetscStrstr(par2,buff,&en);
146: if (en) {
147: PetscStrlen(en,&len1);
148: PetscStrlen(PETSC_SLSUFFIX,&len2);
149: flg = (PetscTruth) (len1 != 1 + len2);
150: } else {
151: flg = PETSC_TRUE;
152: }
153: if (flg) {
154: PetscStrcat(par2,".");
155: PetscStrcat(par2,PETSC_SLSUFFIX);
156: }
158: /* put the .gz back on if it was there */
159: if (gz) {
160: PetscStrcat(par2,".gz");
161: }
163: PetscFileRetrieve(comm,par2,lname,llen,found);
164: PetscFree(par2);
165: return(0);
166: }
171: /*@C
172: PetscDLLibraryOpen - Opens a dynamic link library
174: Collective on MPI_Comm
176: Input Parameters:
177: + comm - processors that are opening the library
178: - libname - name of the library, can be relative or absolute
180: Output Parameter:
181: . handle - library handle
183: Level: developer
185: Notes:
186: [[<http,ftp>://hostname]/directoryname/]filename[.so.1.0]
188: ${PETSC_ARCH} occuring in directoryname and filename
189: will be replaced with the appropriate value.
190: @*/
191: PetscErrorCode PetscDLLibraryOpen(MPI_Comm comm,const char libname[],void **handle)
192: {
194: char *par2,registername[128],*ptr,*ptrp;
195: PetscTruth foundlibrary;
196: PetscErrorCode (*func)(const char*) = NULL;
197: size_t len;
200: *handle = NULL;
201: PetscMalloc(PETSC_MAX_PATH_LEN*sizeof(char),&par2);
202: PetscDLLibraryRetrieve(comm,libname,par2,PETSC_MAX_PATH_LEN,&foundlibrary);
203: if (!foundlibrary) {
204: SETERRQ1(PETSC_ERR_FILE_OPEN,"Unable to locate dynamic library:\n %s\n",libname);
205: }
207: /* Eventually config/configure.py should determine if the system needs an executable dynamic library */
208: #define PETSC_USE_NONEXECUTABLE_SO
209: #if !defined(PETSC_USE_NONEXECUTABLE_SO)
210: PetscTestFile(par2,'x',&foundlibrary);
211: if (!foundlibrary) {
212: SETERRQ2(PETSC_ERR_FILE_OPEN,"Dynamic library is not executable:\n %s\n %s\n",libname,par2);
213: }
214: #endif
216: /*
217: Mode indicates symbols required by symbol loaded with dlsym()
218: are only loaded when required (not all together) also indicates
219: symbols required can be contained in other libraries also opened
220: with dlopen()
221: */
222: PetscInfo1(0,"Opening %s\n",libname);
223: #if defined(PETSC_HAVE_LOADLIBRARY)
224: *handle = LoadLibrary(par2);
225: #else
226: #if defined(PETSC_HAVE_RTLD_GLOBAL)
227: *handle = dlopen(par2,RTLD_LAZY | RTLD_GLOBAL);
228: #else
229: *handle = dlopen(par2,RTLD_LAZY);
230: #endif
231: #endif
232: if (!*handle) {
233: #if defined(PETSC_HAVE_DLERROR)
234: SETERRQ3(PETSC_ERR_FILE_OPEN,"Unable to open dynamic library:\n %s\n %s\n Error message from dlopen() %s\n",libname,par2,dlerror());
235: #elif defined(PETSC_HAVE_GETLASTERROR)
236: {
237: DWORD erc;
238: char *buff;
239: erc = GetLastError();
240: FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_ALLOCATE_BUFFER | FORMAT_MESSAGE_IGNORE_INSERTS,
241: NULL,erc,MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT),(LPSTR)&buff,0,NULL);
242: PetscError(__LINE__,__FUNCT__,__FILE__,__SDIR__,PETSC_ERR_FILE_OPEN,1,
243: "Unable to open dynamic library:\n %s\n %s\n Error message from LoadLibrary() %s\n",libname,par2,buff);
244: LocalFree(buff);
245: return(ierr);
246: }
247: #endif
248: }
250: /* build name of symbol to look for based on libname */
251: PetscStrcpy(registername,"PetscDLLibraryRegister_");
252: /* look for libXXXXX.YYY and extract out the XXXXXX */
253: PetscStrrstr(libname,"lib",&ptr);
254: if (!ptr) SETERRQ1(PETSC_ERR_ARG_WRONG,"Dynamic library name must have lib prefix:%s",libname);
255: PetscStrchr(ptr+3,'.',&ptrp);
256: if (ptrp) {
257: len = ptrp - ptr - 3;
258: } else {
259: PetscStrlen(ptr+3,&len);
260: }
261: PetscStrncat(registername,ptr+3,len);
263: #if defined(PETSC_HAVE_GETPROCADDRESS)
264: func = (PetscErrorCode (*)(const char *)) GetProcAddress((HMODULE)*handle,registername);
265: #else
266: func = (PetscErrorCode (*)(const char *)) dlsym(*handle,registername);
267: #endif
268: if (func) {
269: (*func)(libname);
270: PetscInfo1(0,"Loading registered routines from %s\n",libname);
271: } else {
272: SETERRQ2(PETSC_ERR_FILE_UNEXPECTED,"Able to locate dynamic library %s, but cannot load symbol %s\n",libname,registername);
273: }
274: PetscFree(par2);
275: return(0);
276: }
280: /*@C
281: PetscDLLibrarySym - Load a symbol from the dynamic link libraries.
283: Collective on MPI_Comm
285: Input Parameter:
286: + path - optional complete library name
287: - insymbol - name of symbol
289: Output Parameter:
290: . value
292: Level: developer
294: Notes: Symbol can be of the form
295: [/path/libname[.so.1.0]:]functionname[()] where items in [] denote optional
297: Will attempt to (retrieve and) open the library if it is not yet been opened.
299: @*/
300: PetscErrorCode PetscDLLibrarySym(MPI_Comm comm,PetscDLLibraryList *inlist,const char path[],const char insymbol[],void **value)
301: {
302: char *par1,*symbol;
304: size_t len;
305: PetscDLLibraryList nlist,prev,list;
308: if (inlist) list = *inlist; else list = PETSC_NULL;
309: *value = 0;
311: /* make copy of symbol so we can edit it in place */
312: PetscStrlen(insymbol,&len);
313: PetscMalloc((len+1)*sizeof(char),&symbol);
314: PetscStrcpy(symbol,insymbol);
316: /*
317: If symbol contains () then replace with a NULL, to support functionname()
318: */
319: PetscStrchr(symbol,'(',&par1);
320: if (par1) *par1 = 0;
323: /*
324: Function name does include library
325: -------------------------------------
326: */
327: if (path && path[0] != '\0') {
328: void *handle;
329:
330: /*
331: Look if library is already opened and in path
332: */
333: nlist = list;
334: prev = 0;
335: while (nlist) {
336: PetscTruth match;
338: PetscStrcmp(nlist->libname,path,&match);
339: if (match) {
340: handle = nlist->handle;
341: goto done;
342: }
343: prev = nlist;
344: nlist = nlist->next;
345: }
346: PetscDLLibraryOpen(comm,path,&handle);
348: PetscNew(struct _n_PetscDLLibraryList,&nlist);
349: nlist->next = 0;
350: nlist->handle = handle;
351: PetscStrcpy(nlist->libname,path);
353: if (prev) {
354: prev->next = nlist;
355: } else {
356: if (inlist) *inlist = nlist;
357: else {PetscDLLibraryClose(nlist);}
358: }
359: PetscInfo1(0,"Appending %s to dynamic library search path\n",path);
361: done:;
362: #if defined(PETSC_HAVE_GETPROCADDRESS)
363: *value = GetProcAddress((HMODULE)handle,symbol);
364: #else
365: *value = dlsym(handle,symbol);
366: #endif
367: if (!*value) {
368: SETERRQ2(PETSC_ERR_PLIB,"Unable to locate function %s in dynamic library %s",insymbol,path);
369: }
370: PetscInfo2(0,"Loading function %s from dynamic library %s\n",insymbol,path);
372: /*
373: Function name does not include library so search path
374: -----------------------------------------------------
375: */
376: } else {
377: while (list) {
378: #if defined(PETSC_HAVE_GETPROCADDRESS)
379: *value = GetProcAddress((HMODULE)list->handle,symbol);
380: #else
381: *value = dlsym(list->handle,symbol);
382: #endif
383: if (*value) {
384: PetscInfo2(0,"Loading function %s from dynamic library %s\n",symbol,list->libname);
385: break;
386: }
387: list = list->next;
388: }
389: if (!*value) {
390: #if defined(PETSC_HAVE_GETPROCADDRESS)
391: *value = GetProcAddress(GetCurrentProcess(),symbol);
392: #else
393: *value = dlsym(0,symbol);
394: #endif
395: if (*value) {
396: PetscInfo1(0,"Loading function %s from object code\n",symbol);
397: }
398: }
399: }
401: PetscFree(symbol);
402: return(0);
403: }
407: /*@C
408: PetscDLLibraryAppend - Appends another dynamic link library to the seach list, to the end
409: of the search path.
411: Collective on MPI_Comm
413: Input Parameters:
414: + comm - MPI communicator
415: - libname - name of the library
417: Output Parameter:
418: . outlist - list of libraries
420: Level: developer
422: Notes: if library is already in path will not add it.
423: @*/
424: PetscErrorCode PetscDLLibraryAppend(MPI_Comm comm,PetscDLLibraryList *outlist,const char libname[])
425: {
426: PetscDLLibraryList list,prev;
427: void* handle;
428: PetscErrorCode ierr;
429: size_t len;
430: PetscTruth match,dir;
431: char program[PETSC_MAX_PATH_LEN],buf[8*PETSC_MAX_PATH_LEN],*found,*libname1,suffix[16],*s;
432: PetscToken *token;
436: /* is libname a directory? */
437: PetscTestDirectory(libname,'r',&dir);
438: if (dir) {
439: PetscInfo1(0,"Checking directory %s for dynamic libraries\n",libname);
440: PetscStrcpy(program,libname);
441: PetscStrlen(program,&len);
442: if (program[len-1] == '/') {
443: PetscStrcat(program,"*.");
444: } else {
445: PetscStrcat(program,"/*.");
446: }
447: PetscStrcat(program,PETSC_SLSUFFIX);
449: PetscLs(comm,program,buf,8*PETSC_MAX_PATH_LEN,&dir);
450: if (!dir) return(0);
451: found = buf;
452: } else {
453: found = (char*)libname;
454: }
455: PetscStrcpy(suffix,".");
456: PetscStrcat(suffix,PETSC_SLSUFFIX);
458: PetscTokenCreate(found,'\n',&token);
459: PetscTokenFind(token,&libname1);
460: PetscStrstr(libname1,suffix,&s);
461: if (s) s[0] = 0;
462: while (libname1) {
464: /* see if library was already open then we are done */
465: list = prev = *outlist;
466: match = PETSC_FALSE;
467: while (list) {
469: PetscStrcmp(list->libname,libname1,&match);
470: if (match) break;
471: prev = list;
472: list = list->next;
473: }
474: if (!match) {
476: PetscDLLibraryOpen(comm,libname1,&handle);
478: PetscNew(struct _n_PetscDLLibraryList,&list);
479: list->next = 0;
480: list->handle = handle;
481: PetscStrcpy(list->libname,libname1);
483: if (!*outlist) {
484: *outlist = list;
485: } else {
486: prev->next = list;
487: }
488: PetscInfo1(0,"Appending %s to dynamic library search path\n",libname1);
489: }
490: PetscTokenFind(token,&libname1);
491: if (libname1) {
492: PetscStrstr(libname1,suffix,&s);
493: if (s) s[0] = 0;
494: }
495: }
496: PetscTokenDestroy(token);
497: return(0);
498: }
502: /*@C
503: PetscDLLibraryPrepend - Add another dynamic library to search for symbols to the beginning of
504: the search path.
506: Collective on MPI_Comm
508: Input Parameters:
509: + comm - MPI communicator
510: - libname - name of the library
512: Output Parameter:
513: . outlist - list of libraries
515: Level: developer
517: Notes: If library is already in path will remove old reference.
519: @*/
520: PetscErrorCode PetscDLLibraryPrepend(MPI_Comm comm,PetscDLLibraryList *outlist,const char libname[])
521: {
522: PetscDLLibraryList list,prev;
523: void* handle;
525: size_t len;
526: PetscTruth match,dir;
527: char program[PETSC_MAX_PATH_LEN],buf[8*PETSC_MAX_PATH_LEN],*found,*libname1,suffix[16],*s;
528: PetscToken *token;
531:
532: /* is libname a directory? */
533: PetscTestDirectory(libname,'r',&dir);
534: if (dir) {
535: PetscInfo1(0,"Checking directory %s for dynamic libraries\n",libname);
536: PetscStrcpy(program,libname);
537: PetscStrlen(program,&len);
538: if (program[len-1] == '/') {
539: PetscStrcat(program,"*.");
540: } else {
541: PetscStrcat(program,"/*.");
542: }
543: PetscStrcat(program,PETSC_SLSUFFIX);
545: PetscLs(comm,program,buf,8*PETSC_MAX_PATH_LEN,&dir);
546: if (!dir) return(0);
547: found = buf;
548: } else {
549: found = (char*)libname;
550: }
552: PetscStrcpy(suffix,".");
553: PetscStrcat(suffix,PETSC_SLSUFFIX);
555: PetscTokenCreate(found,'\n',&token);
556: PetscTokenFind(token,&libname1);
557: PetscStrstr(libname1,suffix,&s);
558: if (s) s[0] = 0;
559: while (libname1) {
560: /* see if library was already open and move it to the front */
561: list = *outlist;
562: prev = 0;
563: match = PETSC_FALSE;
564: while (list) {
566: PetscStrcmp(list->libname,libname1,&match);
567: if (match) {
568: if (prev) prev->next = list->next;
569: list->next = *outlist;
570: *outlist = list;
571: break;
572: }
573: prev = list;
574: list = list->next;
575: }
576: if (!match) {
577: /* open the library and add to front of list */
578: PetscDLLibraryOpen(comm,libname1,&handle);
579:
580: PetscInfo1(0,"Prepending %s to dynamic library search path\n",libname1);
582: PetscNew(struct _n_PetscDLLibraryList,&list);
583: list->handle = handle;
584: list->next = *outlist;
585: PetscStrcpy(list->libname,libname1);
586: *outlist = list;
587: }
588: PetscTokenFind(token,&libname1);
589: if (libname1) {
590: PetscStrstr(libname1,suffix,&s);
591: if (s) s[0] = 0;
592: }
593: }
594: PetscTokenDestroy(token);
595: return(0);
596: }
600: /*@C
601: PetscDLLibraryClose - Destroys the search path of dynamic libraries and closes the libraries.
603: Collective on PetscDLLibrary
605: Input Parameter:
606: . next - library list
608: Level: developer
610: @*/
611: PetscErrorCode PetscDLLibraryClose(PetscDLLibraryList next)
612: {
613: PetscDLLibraryList prev;
618: while (next) {
619: prev = next;
620: next = next->next;
621: /* free the space in the prev data-structure */
622: PetscFree(prev);
623: }
624: return(0);
625: }
629: /*@C
630: PetscDLLibraryCCAAppend - Appends another CCA dynamic link library to the seach list, to the end
631: of the search path.
633: Collective on MPI_Comm
635: Input Parameters:
636: + comm - MPI communicator
637: - libname - name of directory to check
639: Output Parameter:
640: . outlist - list of libraries
642: Level: developer
644: Notes: if library is already in path will not add it.
645: @*/
646: PetscErrorCode PetscDLLibraryCCAAppend(MPI_Comm comm,PetscDLLibraryList *outlist,const char dirname[])
647: {
649: size_t l;
650: PetscTruth dir;
651: char program[PETSC_MAX_PATH_LEN],buf[8*PETSC_MAX_PATH_LEN],*libname1,fbuf[PETSC_MAX_PATH_LEN],*found,suffix[16],*f2;
652: char *func,*funcname,libname[PETSC_MAX_PATH_LEN],*lib;
653: FILE *fp;
654: PetscToken *token1,*token2;
658: /* is dirname a directory? */
659: PetscTestDirectory(dirname,'r',&dir);
660: if (!dir) return(0);
662: PetscInfo1(0,"Checking directory %s for CCA components\n",dirname);
663: PetscStrcpy(program,dirname);
664: PetscStrcat(program,"/*.cca");
666: PetscLs(comm,program,buf,8*PETSC_MAX_PATH_LEN,&dir);
667: if (!dir) return(0);
669: PetscStrcpy(suffix,".");
670: PetscStrcat(suffix,PETSC_SLSUFFIX);
671: PetscTokenCreate(buf,'\n',&token1);
672: PetscTokenFind(token1,&libname1);
673: while (libname1) {
674: fp = fopen(libname1,"r"); if (!fp) continue;
675: while ((found = fgets(fbuf,PETSC_MAX_PATH_LEN,fp))) {
676: if (found[0] == '!') continue;
677: PetscStrstr(found,suffix,&f2);
678: if (f2) { /* found library name */
679: if (found[0] == '/') {
680: lib = found;
681: } else {
682: PetscStrcpy(libname,dirname);
683: PetscStrlen(libname,&l);
684: if (libname[l-1] != '/') {PetscStrcat(libname,"/");}
685: PetscStrcat(libname,found);
686: lib = libname;
687: }
688: PetscDLLibraryAppend(comm,outlist,lib);
689: } else {
690: PetscInfo2(0,"CCA Component function and name: %s from %s\n",found,libname1);
691: PetscTokenCreate(found,' ',&token2);
692: PetscTokenFind(token2,&func);
693: PetscTokenFind(token2,&funcname);
694: PetscFListAdd(&CCAList,funcname,func,PETSC_NULL);
695: PetscTokenDestroy(token2);
696: }
697: }
698: fclose(fp);
699: PetscTokenFind(token1,&libname1);
700: }
701: PetscTokenDestroy(token1);
702: return(0);
703: }
706: #endif