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
 36: #if defined(PETSC_HAVE_DLFCN_H)
 37: #include <dlfcn.h>
 38: #endif

 40: #endif


 43: /*
 44:    Contains the list of registered CCA components
 45: */
 46: PetscFList CCAList = 0;


 49: /* ------------------------------------------------------------------------------*/
 50: /*
 51:       Code to maintain a list of opened dynamic libraries and load symbols
 52: */
 53: #if defined(PETSC_USE_DYNAMIC_LIBRARIES)
 54: struct _n_PetscDLLibrary {
 55:   PetscDLLibrary next;
 56:   void           *handle;
 57:   char           libname[PETSC_MAX_PATH_LEN];
 58: };

 61: EXTERN PetscErrorCode Petsc_DelTag(MPI_Comm,int,void*,void*);

 66: PetscErrorCode  PetscDLLibraryPrintPath(void)
 67: {
 68:   PetscDLLibrary libs;

 71:   libs = DLLibrariesLoaded;
 72:   while (libs) {
 73:     PetscErrorPrintf("  %s\n",libs->libname);
 74:     libs = libs->next;
 75:   }
 76:   return(0);
 77: }

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

 85:      Collective on MPI_Comm

 87:    Input Parameters:
 88: +   comm - processors that are opening the library
 89: -   libname - name of the library, can be relative or absolute

 91:    Output Parameter:
 92: .   handle - library handle 

 94:    Level: developer

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

 99:    ${PETSC_ARCH}, ${PETSC_DIR}, ${PETSC_LIB_DIR}, or ${any environmental variable}
100:    occuring in directoryname and filename will be replaced with appropriate values.
101: @*/
102: PetscErrorCode  PetscDLLibraryRetrieve(MPI_Comm comm,const char libname[],char *lname,int llen,PetscTruth *found)
103: {
104:   char           *par2,buff[10],*en,*gz;
106:   size_t         len1,len2,len;
107:   PetscTruth     tflg,flg;

110:   /* 
111:      make copy of library name and replace $PETSC_ARCH and 
112:      so we can add to the end of it to look for something like .so.1.0 etc.
113:   */
114:   PetscStrlen(libname,&len);
115:   len  = PetscMax(4*len,PETSC_MAX_PATH_LEN);
116:   PetscMalloc(len*sizeof(char),&par2);
117:   PetscStrreplace(comm,libname,par2,len);

119:   /* 
120:      Remove any file: header
121:   */
122:   PetscStrncmp(par2,"file:",5,&tflg);
123:   if (tflg) {
124:     PetscStrcpy(par2,par2+5);
125:   }

127:   /* strip out .a from it if user put it in by mistake */
128:   PetscStrlen(par2,&len);
129:   if (par2[len-1] == 'a' && par2[len-2] == '.') par2[len-2] = 0;

131:   /* remove .gz if it ends library name */
132:   PetscStrstr(par2,".gz",&gz);
133:   if (gz) {
134:     PetscStrlen(gz,&len);
135:     if (len == 3) {
136:       *gz = 0;
137:     }
138:   }

140:   /* see if library name does already not have suffix attached */
141:   PetscStrcpy(buff,".");
142:   PetscStrcat(buff,PETSC_SLSUFFIX);
143:   PetscStrstr(par2,buff,&en);
144:   if (en) {
145:     PetscStrlen(en,&len1);
146:     PetscStrlen(PETSC_SLSUFFIX,&len2);
147:     flg = (PetscTruth) (len1 != 1 + len2);
148:   } else {
149:     flg = PETSC_TRUE;
150:   }
151:   if (flg) {
152:     PetscStrcat(par2,".");
153:     PetscStrcat(par2,PETSC_SLSUFFIX);
154:   }

156:   /* put the .gz back on if it was there */
157:   if (gz) {
158:     PetscStrcat(par2,".gz");
159:   }

161:   PetscFileRetrieve(comm,par2,lname,llen,found);
162:   PetscFree(par2);
163:   return(0);
164: }


169: /*@C
170:    PetscDLLibraryOpen - Opens a dynamic link library

172:      Collective on MPI_Comm

174:    Input Parameters:
175: +   comm - processors that are opening the library
176: -   libname - name of the library, can be relative or absolute

178:    Output Parameter:
179: .   handle - library handle 

181:    Level: developer

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

186:    ${PETSC_ARCH} occuring in directoryname and filename 
187:    will be replaced with the appropriate value.
188: @*/
189: PetscErrorCode  PetscDLLibraryOpen(MPI_Comm comm,const char libname[],void **handle)
190: {
192:   char           *par2,registername[128],*ptr,*ptrp;
193:   PetscTruth     foundlibrary;
194:   PetscErrorCode (*func)(const char*) = NULL;
195:   size_t         len;

198:   *handle = NULL;
199:   PetscMalloc(PETSC_MAX_PATH_LEN*sizeof(char),&par2);
200:   PetscDLLibraryRetrieve(comm,libname,par2,PETSC_MAX_PATH_LEN,&foundlibrary);
201:   if (!foundlibrary) {
202:     SETERRQ1(PETSC_ERR_FILE_OPEN,"Unable to locate dynamic library:\n  %s\n",libname);
203:   }

205:   /* Eventually config/configure.py should determine if the system needs an executable dynamic library */
206: #define PETSC_USE_NONEXECUTABLE_SO
207: #if !defined(PETSC_USE_NONEXECUTABLE_SO)
208:   PetscTestFile(par2,'x',&foundlibrary);
209:   if (!foundlibrary) {
210:     SETERRQ2(PETSC_ERR_FILE_OPEN,"Dynamic library is not executable:\n  %s\n  %s\n",libname,par2);
211:   }
212: #endif

214:   /*
215:       Mode indicates symbols required by symbol loaded with dlsym() 
216:      are only loaded when required (not all together) also indicates
217:      symbols required can be contained in other libraries also opened
218:      with dlopen()
219:   */
220:   PetscInfo1(0,"Opening %s\n",libname);
221: #if defined(PETSC_HAVE_LOADLIBRARY)
222:   *handle = LoadLibrary(par2);
223: #elif defined(PETSC_HAVE_RTLD_GLOBAL)
224:   *handle = dlopen(par2,RTLD_LAZY | RTLD_GLOBAL);
225: #else
226:   *handle = dlopen(par2,RTLD_LAZY);
227: #endif

229:   if (!*handle) {
230: #if defined(PETSC_HAVE_DLERROR)
231:     SETERRQ3(PETSC_ERR_FILE_OPEN,"Unable to open dynamic library:\n  %s\n  %s\n  Error message from dlopen() %s\n",libname,par2,dlerror());
232: #elif defined(PETSC_HAVE_GETLASTERROR)
233:     {
234:       DWORD erc;
235:       char  *buff;
236:       erc   = GetLastError();
237:       FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_ALLOCATE_BUFFER | FORMAT_MESSAGE_IGNORE_INSERTS,
238:                     NULL,erc,MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT),(LPSTR)&buff,0,NULL);
239:       PetscError(__LINE__,__FUNCT__,__FILE__,__SDIR__,PETSC_ERR_FILE_OPEN,1,
240:                         "Unable to open dynamic library:\n  %s\n  %s\n  Error message from LoadLibrary() %s\n",libname,par2,buff);
241:       LocalFree(buff);
242:       return(ierr);
243:     }
244: #endif
245:   }

247:   /* build name of symbol to look for based on libname */
248:   PetscStrcpy(registername,"PetscDLLibraryRegister_");
249:   /* look for libXXXXX.YYY and extract out the XXXXXX */
250:   PetscStrrstr(libname,"lib",&ptr);
251:   if (!ptr) SETERRQ1(PETSC_ERR_ARG_WRONG,"Dynamic library name must have lib prefix:%s",libname);
252:   PetscStrchr(ptr+3,'.',&ptrp);
253:   if (ptrp) {
254:     len = ptrp - ptr - 3;
255:   } else {
256:     PetscStrlen(ptr+3,&len);
257:   }
258:   PetscStrncat(registername,ptr+3,len);

260: #if defined(PETSC_HAVE_GETPROCADDRESS)
261:   func = (PetscErrorCode (*)(const char *)) GetProcAddress((HMODULE)*handle,registername);
262: #else
263:   func = (PetscErrorCode (*)(const char *)) dlsym(*handle,registername);
264: #endif
265:   if (func) {
266:     (*func)(libname);
267:     PetscInfo1(0,"Loading registered routines from %s\n",libname);
268:   } else {
269:     SETERRQ2(PETSC_ERR_FILE_UNEXPECTED,"Able to locate dynamic library %s, but cannot load symbol  %s\n",libname,registername);
270:   }
271:   PetscFree(par2);
272:   return(0);
273: }

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

280:    Collective on MPI_Comm

282:    Input Parameter:
283: +  comm - communicator that will open the library
284: .  inlist - list of already open libraries that may contain symbol (checks here before path)
285: .  path     - optional complete library name
286: -  insymbol - name of symbol

288:    Output Parameter:
289: .  value 

291:    Level: developer

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

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

298: @*/
299: PetscErrorCode  PetscDLLibrarySym(MPI_Comm comm,PetscDLLibrary *inlist,const char path[],const char insymbol[],void **value)
300: {
301:   char           *par1,*symbol;
303:   size_t         len;
304:   PetscDLLibrary nlist,prev,list;

307:   if (inlist) list = *inlist; else list = PETSC_NULL;
308:   *value = 0;

310:   /* make copy of symbol so we can edit it in place */
311:   PetscStrlen(insymbol,&len);
312:   PetscMalloc((len+1)*sizeof(char),&symbol);
313:   PetscStrcpy(symbol,insymbol);

315:   /* 
316:       If symbol contains () then replace with a NULL, to support functionname() 
317:   */
318:   PetscStrchr(symbol,'(',&par1);
319:   if (par1) *par1 = 0;


322:   /*
323:        Function name does include library 
324:        -------------------------------------
325:   */
326:   if (path && path[0] != '\0') {
327:     void *handle;
328: 
329:     /*   
330:         Look if library is already opened and in path
331:     */
332:     nlist = list;
333:     prev  = 0;
334:     while (nlist) {
335:       PetscTruth match;

337:       PetscStrcmp(nlist->libname,path,&match);
338:       if (match) {
339:         handle = nlist->handle;
340:         goto done;
341:       }
342:       prev  = nlist;
343:       nlist = nlist->next;
344:     }
345:     PetscDLLibraryOpen(comm,path,&handle);

347:     PetscNew(struct _n_PetscDLLibrary,&nlist);
348:     nlist->next   = 0;
349:     nlist->handle = handle;
350:     PetscStrcpy(nlist->libname,path);

352:     if (prev) {
353:       prev->next = nlist;
354:     } else {
355:       if (inlist) *inlist = nlist;
356:       else {PetscDLLibraryClose(nlist);}
357:     }
358:     PetscInfo1(0,"Appending %s to dynamic library search path\n",path);

360:     done:;
361: #if defined(PETSC_HAVE_GETPROCADDRESS)
362:     *value   = GetProcAddress((HMODULE)handle,symbol);
363: #else
364:     *value   = dlsym(handle,symbol);
365: #endif
366:     if (!*value) {
367:       SETERRQ2(PETSC_ERR_PLIB,"Unable to locate function %s in dynamic library %s",insymbol,path);
368:     }
369:     PetscInfo2(0,"Loading function %s from dynamic library %s\n",insymbol,path);

371:   /*
372:        Function name does not include library so search path
373:        -----------------------------------------------------
374:   */
375:   } else {
376:     while (list) {
377: #if defined(PETSC_HAVE_GETPROCADDRESS)
378:       *value = GetProcAddress((HMODULE)list->handle,symbol);
379: #else
380:       *value =  dlsym(list->handle,symbol);
381: #endif
382:       if (*value) {
383:         PetscInfo2(0,"Loading function %s from dynamic library %s\n",symbol,list->libname);
384:         break;
385:       }
386:       list = list->next;
387:     }
388:     if (!*value) {
389: #if defined(PETSC_HAVE_GETPROCADDRESS)
390:       *value = GetProcAddress(GetCurrentProcess(),symbol);
391: #else
392:       *value = dlsym(0,symbol);
393: #endif
394:       if (*value) {
395:         PetscInfo1(0,"Loading function %s from object code\n",symbol);
396:       }
397:     }
398:   }

400:   PetscFree(symbol);
401:   return(0);
402: }

406: /*@C
407:      PetscDLLibraryAppend - Appends another dynamic link library to the seach list, to the end
408:                 of the search path.

410:      Collective on MPI_Comm

412:      Input Parameters:
413: +     comm - MPI communicator
414: -     libname - name of the library

416:      Output Parameter:
417: .     outlist - list of libraries

419:      Level: developer

421:      Notes: if library is already in path will not add it.
422: @*/
423: PetscErrorCode  PetscDLLibraryAppend(MPI_Comm comm,PetscDLLibrary *outlist,const char libname[])
424: {
425:   PetscDLLibrary list,prev;
426:   void*          handle;
428:   size_t         len;
429:   PetscTruth     match,dir;
430:   char           program[PETSC_MAX_PATH_LEN],buf[8*PETSC_MAX_PATH_LEN],*found,*libname1,suffix[16],*s;
431:   PetscToken     *token;


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

448:     PetscLs(comm,program,buf,8*PETSC_MAX_PATH_LEN,&dir);
449:     if (!dir) return(0);
450:     found = buf;
451:   } else {
452:     found = (char*)libname;
453:   }
454:   PetscStrcpy(suffix,".");
455:   PetscStrcat(suffix,PETSC_SLSUFFIX);

457:   PetscTokenCreate(found,'\n',&token);
458:   PetscTokenFind(token,&libname1);
459:   PetscStrstr(libname1,suffix,&s);
460:   if (s) s[0] = 0;
461:   while (libname1) {

463:     /* see if library was already open then we are done */
464:     list  = prev = *outlist;
465:     match = PETSC_FALSE;
466:     while (list) {

468:       PetscStrcmp(list->libname,libname1,&match);
469:       if (match) break;
470:       prev = list;
471:       list = list->next;
472:     }
473:     if (!match) {

475:       PetscDLLibraryOpen(comm,libname1,&handle);

477:       PetscNew(struct _n_PetscDLLibrary,&list);
478:       list->next   = 0;
479:       list->handle = handle;
480:       PetscStrcpy(list->libname,libname1);

482:       if (!*outlist) {
483:         *outlist   = list;
484:       } else {
485:         prev->next = list;
486:       }
487:       PetscInfo1(0,"Appending %s to dynamic library search path\n",libname1);
488:     }
489:     PetscTokenFind(token,&libname1);
490:     if (libname1) {
491:       PetscStrstr(libname1,suffix,&s);
492:       if (s) s[0] = 0;
493:     }
494:   }
495:   PetscTokenDestroy(token);
496:   return(0);
497: }

501: /*@C
502:      PetscDLLibraryPrepend - Add another dynamic library to search for symbols to the beginning of
503:                  the search path.

505:      Collective on MPI_Comm

507:      Input Parameters:
508: +     comm - MPI communicator
509: -     libname - name of the library

511:      Output Parameter:
512: .     outlist - list of libraries

514:      Level: developer

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

518: @*/
519: PetscErrorCode  PetscDLLibraryPrepend(MPI_Comm comm,PetscDLLibrary *outlist,const char libname[])
520: {
521:   PetscDLLibrary list,prev;
522:   void*          handle;
524:   size_t         len;
525:   PetscTruth     match,dir;
526:   char           program[PETSC_MAX_PATH_LEN],buf[8*PETSC_MAX_PATH_LEN],*found,*libname1,suffix[16],*s;
527:   PetscToken     *token;

530: 
531:   /* is libname a directory? */
532:   PetscTestDirectory(libname,'r',&dir);
533:   if (dir) {
534:     PetscInfo1(0,"Checking directory %s for dynamic libraries\n",libname);
535:     PetscStrcpy(program,libname);
536:     PetscStrlen(program,&len);
537:     if (program[len-1] == '/') {
538:       PetscStrcat(program,"*.");
539:     } else {
540:       PetscStrcat(program,"/*.");
541:     }
542:     PetscStrcat(program,PETSC_SLSUFFIX);

544:     PetscLs(comm,program,buf,8*PETSC_MAX_PATH_LEN,&dir);
545:     if (!dir) return(0);
546:     found = buf;
547:   } else {
548:     found = (char*)libname;
549:   }

551:   PetscStrcpy(suffix,".");
552:   PetscStrcat(suffix,PETSC_SLSUFFIX);

554:   PetscTokenCreate(found,'\n',&token);
555:   PetscTokenFind(token,&libname1);
556:   PetscStrstr(libname1,suffix,&s);
557:   if (s) s[0] = 0;
558:   while (libname1) {
559:     /* see if library was already open and move it to the front */
560:     list  = *outlist;
561:     prev  = 0;
562:     match = PETSC_FALSE;
563:     while (list) {

565:       PetscStrcmp(list->libname,libname1,&match);
566:       if (match) {
567:         if (prev) prev->next = list->next;
568:         list->next = *outlist;
569:         *outlist   = list;
570:         break;
571:       }
572:       prev = list;
573:       list = list->next;
574:     }
575:     if (!match) {
576:       /* open the library and add to front of list */
577:       PetscDLLibraryOpen(comm,libname1,&handle);
578: 
579:       PetscInfo1(0,"Prepending %s to dynamic library search path\n",libname1);

581:       PetscNew(struct _n_PetscDLLibrary,&list);
582:       list->handle = handle;
583:       list->next   = *outlist;
584:       PetscStrcpy(list->libname,libname1);
585:       *outlist     = list;
586:     }
587:     PetscTokenFind(token,&libname1);
588:     if (libname1) {
589:       PetscStrstr(libname1,suffix,&s);
590:       if (s) s[0] = 0;
591:     }
592:   }
593:   PetscTokenDestroy(token);
594:   return(0);
595: }

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

602:     Collective on PetscDLLibrary

604:     Input Parameter:
605: .     next - library list

607:      Level: developer

609: @*/
610: PetscErrorCode  PetscDLLibraryClose(PetscDLLibrary next)
611: {
612:   PetscDLLibrary prev;


617:   while (next) {
618:     prev = next;
619:     next = next->next;
620:     /* free the space in the prev data-structure */
621:     PetscFree(prev);
622:   }
623:   return(0);
624: }

628: /*@C
629:      PetscDLLibraryCCAAppend - Appends another CCA dynamic link library to the seach list, to the end
630:                 of the search path.

632:      Collective on MPI_Comm

634:      Input Parameters:
635: +     comm - MPI communicator
636: -     libname - name of directory to check

638:      Output Parameter:
639: .     outlist - list of libraries

641:      Level: developer

643:      Notes: if library is already in path will not add it.
644: @*/
645: PetscErrorCode  PetscDLLibraryCCAAppend(MPI_Comm comm,PetscDLLibrary *outlist,const char dirname[])
646: {
648:   size_t         l;
649:   PetscTruth     dir;
650:   char           program[PETSC_MAX_PATH_LEN],buf[8*PETSC_MAX_PATH_LEN],*libname1,fbuf[PETSC_MAX_PATH_LEN],*found,suffix[16],*f2;
651:   char           *func,*funcname,libname[PETSC_MAX_PATH_LEN],*lib;
652:   FILE           *fp;
653:   PetscToken     *token1,*token2;
654:   int            err;

657:   /* is dirname a directory? */
658:   PetscTestDirectory(dirname,'r',&dir);
659:   if (!dir) return(0);

661:   PetscInfo1(0,"Checking directory %s for CCA components\n",dirname);
662:   PetscStrcpy(program,dirname);
663:   PetscStrcat(program,"/*.cca");

665:   PetscLs(comm,program,buf,8*PETSC_MAX_PATH_LEN,&dir);
666:   if (!dir) return(0);

668:   PetscStrcpy(suffix,".");
669:   PetscStrcat(suffix,PETSC_SLSUFFIX);
670:   PetscTokenCreate(buf,'\n',&token1);
671:   PetscTokenFind(token1,&libname1);
672:   while (libname1) {
673:     fp    = fopen(libname1,"r"); if (!fp) continue;
674:     while ((found = fgets(fbuf,PETSC_MAX_PATH_LEN,fp))) {
675:       if (found[0] == '!') continue;
676:       PetscStrstr(found,suffix,&f2);
677:       if (f2) { /* found library name */
678:         if (found[0] == '/') {
679:           lib = found;
680:         } else {
681:           PetscStrcpy(libname,dirname);
682:           PetscStrlen(libname,&l);
683:           if (libname[l-1] != '/') {PetscStrcat(libname,"/");}
684:           PetscStrcat(libname,found);
685:           lib  = libname;
686:         }
687:         PetscDLLibraryAppend(comm,outlist,lib);
688:       } else {
689:         PetscInfo2(0,"CCA Component function and name: %s from %s\n",found,libname1);
690:         PetscTokenCreate(found,' ',&token2);
691:         PetscTokenFind(token2,&func);
692:         PetscTokenFind(token2,&funcname);
693:         PetscFListAdd(&CCAList,funcname,func,PETSC_NULL);
694:         PetscTokenDestroy(token2);
695:       }
696:     }
697:     err = fclose(fp);
698:     if (err) SETERRQ(PETSC_ERR_SYS,"fclose() failed on file");
699:     PetscTokenFind(token1,&libname1);
700:   }
701:   PetscTokenDestroy(token1);
702:   return(0);
703: }


706: #endif