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