Actual source code: dl.c

  2: /*$Id: dl.c,v 1.71 2001/04/10 19:34:28 bsmith Exp $*/
  3: /*
  4:       Routines for opening dynamic link libraries (DLLs), keeping a searchable
  5:    path of DLLs, obtaining remote DLLs via a URL and opening them locally.
  6: */

 8:  #include petsc.h
 9:  #include petscsys.h
 10: #include "petscfix.h"
 11: #if defined(PETSC_HAVE_PWD_H)
 12: #include <pwd.h>
 13: #endif
 14: #include <ctype.h>
 15: #include <sys/types.h>
 16: #include <sys/stat.h>
 17: #if defined(PETSC_HAVE_UNISTD_H)
 18: #include <unistd.h>
 19: #endif
 20: #if defined(PETSC_HAVE_STDLIB_H)
 21: #include <stdlib.h>
 22: #endif
 23: #if !defined(PARCH_win32)
 24: #include <sys/utsname.h>
 25: #endif
 26: #if defined(PARCH_win32)
 27: #include <windows.h>
 28: #include <io.h>
 29: #include <direct.h>
 30: #endif
 31: #if defined (PARCH_win32_gnu)
 32: #include <windows.h>
 33: #endif
 34: #include <fcntl.h>
 35: #include <time.h>  
 36: #if defined(PETSC_HAVE_SYS_SYSTEMINFO_H)
 37: #include <sys/systeminfo.h>
 38: #endif
 39: #include "petscfix.h"

 41: #ifndef MAXPATHLEN
 42: #define MAXPATHLEN 1024
 43: #endif
 44: /*
 45:    Contains the list of registered CCA components
 46: */
 47: PetscFList CCAList = 0;


 50: /* ------------------------------------------------------------------------------*/
 51: /*
 52:       Code to maintain a list of opened dynamic libraries and load symbols
 53: */
 54: #if defined(PETSC_USE_DYNAMIC_LIBRARIES)
 55: #include <dlfcn.h>

 57: struct _PetscDLLibraryList {
 58:   PetscDLLibraryList next;
 59:   void          *handle;
 60:   char          libname[1024];
 61: };

 63: EXTERN_C_BEGIN
 64: extern int Petsc_DelTag(MPI_Comm,int,void*,void*);
 65: EXTERN_C_END

 67: int PetscDLLibraryPrintPath(void)
 68: {
 69:   PetscDLLibraryList libs;

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

 80: /*@C
 81:    PetscDLLibraryGetInfo - Gets the text information from a PETSc
 82:        dynamic library

 84:      Not Collective

 86:    Input Parameters:
 87: .   handle - library handle returned by PetscDLLibraryOpen()

 89:    Level: developer

 91: @*/
 92: int PetscDLLibraryGetInfo(void *handle,char *type,char **mess)
 93: {
 94:   int  ierr,(*sfunc)(const char *,const char*,char **);

 97:   sfunc   = (int (*)(const char *,const char*,char **)) dlsym(handle,"PetscDLLibraryInfo");
 98:   if (!sfunc) {
 99:     *mess = "No library information in the filen";
100:   } else {
101:     (*sfunc)(0,type,mess);
102:   }
103:   return(0);
104: }

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

110:      Collective on MPI_Comm

112:    Input Parameters:
113: +   comm - processors that are opening the library
114: -   libname - name of the library, can be relative or absolute

116:    Output Parameter:
117: .   handle - library handle 

119:    Level: developer

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

124:    ${PETSC_ARCH}, ${PETSC_DIR}, ${PETSC_LIB_DIR}, ${BOPT}, or ${any environmental variable}
125:    occuring in directoryname and filename will be replaced with appropriate values.
126: @*/
127: int PetscDLLibraryRetrieve(MPI_Comm comm,const char libname[],char *lname,int llen,PetscTruth *found)
128: {
129:   char       *par2,buff[10],*en,*gz;
130:   int        ierr,len1,len2,len;
131:   PetscTruth tflg,flg;


135:   /* 
136:      make copy of library name and replace $PETSC_ARCH and $BOPT and 
137:      so we can add to the end of it to look for something like .so.1.0 etc.
138:   */
139:   PetscStrlen(libname,&len);
140:   len  = PetscMax(4*len,1024);
141:   PetscMalloc(len*sizeof(char),&par2);
142:   PetscStrreplace(comm,libname,par2,len);

144:   /* 
145:      Remove any file: header
146:   */
147:   PetscStrncmp(par2,"file:",5,&tflg);
148:   if (tflg) {
149:     PetscStrcpy(par2,par2+5);
150:   }

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

156:   /* remove .gz if it ends library name */
157:   PetscStrstr(par2,".gz",&gz);
158:   if (gz) {
159:     PetscStrlen(gz,&len);
160:     if (len == 3) {
161:       *gz = 0;
162:     }
163:   }

165:   /* see if library name does already not have suffix attached */
166:   PetscStrcpy(buff,".");
167:   PetscStrcat(buff,PETSC_SLSUFFIX);
168:   PetscStrstr(par2,buff,&en);
169:   if (en) {
170:     PetscStrlen(en,&len1);
171:     PetscStrlen(PETSC_SLSUFFIX,&len2);
172:     flg = (PetscTruth) (len1 != 1 + len2);
173:   } else {
174:     flg = PETSC_TRUE;
175:   }
176:   if (flg) {
177:     PetscStrcat(par2,".");
178:     PetscStrcat(par2,PETSC_SLSUFFIX);
179:   }

181:   /* put the .gz back on if it was there */
182:   if (gz) {
183:     PetscStrcat(par2,".gz");
184:   }

186:   PetscFileRetrieve(comm,par2,lname,llen,found);
187:   PetscFree(par2);
188:   return(0);
189: }


192: /*@C
193:    PetscDLLibraryOpen - Opens a dynamic link library

195:      Collective on MPI_Comm

197:    Input Parameters:
198: +   comm - processors that are opening the library
199: -   libname - name of the library, can be relative or absolute

201:    Output Parameter:
202: .   handle - library handle 

204:    Level: developer

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

209:    ${PETSC_ARCH} and ${BOPT} occuring in directoryname and filename 
210:    will be replaced with appropriate values.
211: @*/
212: int PetscDLLibraryOpen(MPI_Comm comm,const char libname[],void **handle)
213: {
214:   char       *par2,ierr;
215:   PetscTruth foundlibrary;
216:   int        (*func)(const char*);


220:   PetscMalloc(1024*sizeof(char),&par2);
221:   PetscDLLibraryRetrieve(comm,libname,par2,1024,&foundlibrary);
222:   if (!foundlibrary) {
223:     SETERRQ1(1,"Unable to locate dynamic library:n  %sn",libname);
224:   }

226: #if !defined(PETSC_USE_NONEXECUTABLE_SO)
227:   ierr  = PetscTestFile(par2,'x',&foundlibrary);
228:   if (!foundlibrary) {
229:     SETERRQ2(1,"Dynamic library is not executable:n  %sn  %sn",libname,par2);
230:   }
231: #endif

233:   /*
234:       Mode indicates symbols required by symbol loaded with dlsym() 
235:      are only loaded when required (not all together) also indicates
236:      symbols required can be contained in other libraries also opened
237:      with dlopen()
238:   */
239:   PetscLogInfo(0,"PetscDLLibraryOpen:Opening %sn",libname);
240: #if defined(PETSC_HAVE_RTLD_GLOBAL)
241:   *handle = dlopen(par2,RTLD_LAZY  |  RTLD_GLOBAL);
242: #else
243:   *handle = dlopen(par2,RTLD_LAZY);
244: #endif

246:   if (!*handle) {
247:     SETERRQ3(1,"Unable to open dynamic library:n  %sn  %sn  Error message from dlopen() %sn",libname,par2,dlerror());
248:   }

250:   /* run the function PetscFListAddDynamic() if it is in the library */
251:   func  = (int (*)(const char *)) dlsym(*handle,"PetscDLLibraryRegister");
252:   if (func) {
253:     (*func)(libname);
254:     PetscLogInfo(0,"PetscDLLibraryOpen:Loading registered routines from %sn",libname);
255:   }
256:   if (PetscLogPrintInfo) {
257:     int  (*sfunc)(const char *,const char*,char **);
258:     char *mess;

260:     sfunc   = (int (*)(const char *,const char*,char **)) dlsym(*handle,"PetscDLLibraryInfo");
261:     if (sfunc) {
262:       (*sfunc)(libname,"Contents",&mess);
263:       if (mess) {
264:         PetscLogInfo(0,"Contents:n %s",mess);
265:       }
266:       (*sfunc)(libname,"Authors",&mess);
267:       if (mess) {
268:         PetscLogInfo(0,"Authors:n %s",mess);
269:       }
270:       (*sfunc)(libname,"Version",&mess);
271:       if (mess) {
272:         PetscLogInfo(0,"Version:n %sn",mess);
273:       }
274:     }
275:   }

277:   /* Look for CCA components in the library */
278: #if defined(__cplusplus) && !defined(PETSC_USE_COMPLEX)
279:   char **(*gcl)(void) = (char **(*)(void)) dlsym(*handle,"getESIFactoryList");
280:   if (gcl) {
281:     char       **list = (*gcl)(),*sname,*rname;
282:     int        i = 0;
283:     PetscToken *token;

285:     while (list[i]) {
286:       PetscLogInfo(0,"ESI factory function and name: %s from %sn",list[i],libname);
287:       PetscTokenCreate(list[i],' ',&token);
288:       PetscTokenFind(token,&rname);
289:       PetscTokenFind(token,&sname);
290:       PetscFListAdd(&CCAList,sname,rname,PETSC_NULL);
291:       PetscTokenDestroy(token);
292:       i++;
293:     }
294:   }
295: #endif

297:   PetscFree(par2);
298:   return(0);
299: }

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

304:    Collective on MPI_Comm

306:    Input Parameter:
307: +  path     - optional complete library name
308: -  insymbol - name of symbol

310:    Output Parameter:
311: .  value 

313:    Level: developer

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

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

320: @*/
321: int PetscDLLibrarySym(MPI_Comm comm,PetscDLLibraryList *inlist,const char path[],const char insymbol[],void **value)
322: {
323:   char               *par1,*symbol;
324:   int                ierr,len;
325:   PetscDLLibraryList nlist,prev,list;

328:   if (inlist) list = *inlist; else list = PETSC_NULL;
329:   *value = 0;

331:   /* make copy of symbol so we can edit it in place */
332:   PetscStrlen(insymbol,&len);
333:   PetscMalloc((len+1)*sizeof(char),&symbol);
334:   PetscStrcpy(symbol,insymbol);

336:   /* 
337:       If symbol contains () then replace with a NULL, to support functionname() 
338:   */
339:   PetscStrchr(symbol,'(',&par1);
340:   if (par1) *par1 = 0;


343:   /*
344:        Function name does include library 
345:        -------------------------------------
346:   */
347:   if (path && path[0] != '0') {
348:     void *handle;
349: 
350:     /*   
351:         Look if library is already opened and in path
352:     */
353:     nlist = list;
354:     prev  = 0;
355:     while (nlist) {
356:       PetscTruth match;

358:       PetscStrcmp(nlist->libname,path,&match);
359:       if (match) {
360:         handle = nlist->handle;
361:         goto done;
362:       }
363:       prev  = nlist;
364:       nlist = nlist->next;
365:     }
366:     PetscDLLibraryOpen(comm,path,&handle);

368:     ierr          = PetscNew(struct _PetscDLLibraryList,&nlist);
369:     nlist->next   = 0;
370:     nlist->handle = handle;
371:     PetscStrcpy(nlist->libname,path);

373:     if (prev) {
374:       prev->next = nlist;
375:     } else {
376:       if (inlist) *inlist = nlist;
377:       else {PetscDLLibraryClose(nlist);}
378:     }
379:     PetscLogInfo(0,"PetscDLLibraryAppend:Appending %s to dynamic library search pathn",path);

381:     done:;
382:     *value   = dlsym(handle,symbol);
383:     if (!*value) {
384:       SETERRQ2(1,"Unable to locate function %s in dynamic library %s",insymbol,path);
385:     }
386:     PetscLogInfo(0,"PetscDLLibrarySym:Loading function %s from dynamic library %sn",insymbol,path);

388:   /*
389:        Function name does not include library so search path
390:        -----------------------------------------------------
391:   */
392:   } else {
393:     while (list) {
394:       *value =  dlsym(list->handle,symbol);
395:       if (*value) {
396:         PetscLogInfo(0,"PetscDLLibrarySym:Loading function %s from dynamic library %sn",symbol,list->libname);
397:         break;
398:       }
399:       list = list->next;
400:     }
401:     if (!*value) {
402:       *value =  dlsym(0,symbol);
403:       if (*value) {
404:         PetscLogInfo(0,"PetscDLLibrarySym:Loading function %s from object coden",symbol);
405:       }
406:     }
407:   }

409:   PetscFree(symbol);
410:   return(0);
411: }

413: /*@C
414:      PetscDLLibraryAppend - Appends another dynamic link library to the seach list, to the end
415:                 of the search path.

417:      Collective on MPI_Comm

419:      Input Parameters:
420: +     comm - MPI communicator
421: -     libname - name of the library

423:      Output Parameter:
424: .     outlist - list of libraries

426:      Level: developer

428:      Notes: if library is already in path will not add it.
429: @*/
430: int PetscDLLibraryAppend(MPI_Comm comm,PetscDLLibraryList *outlist,const char libname[])
431: {
432:   PetscDLLibraryList list,prev;
433:   void*              handle;
434:   int                ierr,len;
435:   PetscTruth         match,dir;
436:   char               program[1024],buf[8*1024],*found,*libname1,suffix[16],*s;
437:   PetscToken         *token;


441:   /* is libname a directory? */
442:   PetscTestDirectory(libname,'r',&dir);
443:   if (dir) {
444:     PetscLogInfo(0,"Checking directory %s for dynamic librariesn",libname);
445:     ierr  = PetscStrcpy(program,libname);
446:     ierr  = PetscStrlen(program,&len);
447:     if (program[len-1] == '/') {
448:       ierr  = PetscStrcat(program,"*.");
449:     } else {
450:       ierr  = PetscStrcat(program,"/*.");
451:     }
452:     ierr  = PetscStrcat(program,PETSC_SLSUFFIX);

454:     PetscLs(comm,program,buf,8*1024,&dir);
455:     if (!dir) return(0);
456:     found = buf;
457:   } else {
458:     found = (char*)libname;
459:   }
460:   PetscStrcpy(suffix,".");
461:   PetscStrcat(suffix,PETSC_SLSUFFIX);

463:   PetscTokenCreate(found,'n',&token);
464:   PetscTokenFind(token,&libname1);
465:   PetscStrstr(libname1,suffix,&s);
466:   if (s) s[0] = 0;
467:   while (libname1) {

469:     /* see if library was already open then we are done */
470:     list  = prev = *outlist;
471:     match = PETSC_FALSE;
472:     while (list) {

474:       PetscStrcmp(list->libname,libname1,&match);
475:       if (match) break;
476:       prev = list;
477:       list = list->next;
478:     }
479:     if (!match) {

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

483:       ierr         = PetscNew(struct _PetscDLLibraryList,&list);
484:       list->next   = 0;
485:       list->handle = handle;
486:       PetscStrcpy(list->libname,libname1);

488:       if (!*outlist) {
489:         *outlist   = list;
490:       } else {
491:         prev->next = list;
492:       }
493:       PetscLogInfo(0,"PetscDLLibraryAppend:Appending %s to dynamic library search pathn",libname1);
494:     }
495:     PetscTokenFind(token,&libname1);
496:     if (libname1) {
497:       PetscStrstr(libname1,suffix,&s);
498:       if (s) s[0] = 0;
499:     }
500:   }
501:   PetscTokenDestroy(token);
502:   return(0);
503: }

505: /*@C
506:      PetscDLLibraryPrepend - Add another dynamic library to search for symbols to the beginning of
507:                  the search path.

509:      Collective on MPI_Comm

511:      Input Parameters:
512: +     comm - MPI communicator
513: -     libname - name of the library

515:      Output Parameter:
516: .     outlist - list of libraries

518:      Level: developer

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

522: @*/
523: int PetscDLLibraryPrepend(MPI_Comm comm,PetscDLLibraryList *outlist,const char libname[])
524: {
525:   PetscDLLibraryList list,prev;
526:   void*              handle;
527:   int                ierr,len;
528:   PetscTruth         match,dir;
529:   char               program[1024],buf[8*1024],*found,*libname1,suffix[16],*s;
530:   PetscToken         *token;

533: 
534:   /* is libname a directory? */
535:   PetscTestDirectory(libname,'r',&dir);
536:   if (dir) {
537:     PetscLogInfo(0,"Checking directory %s for dynamic librariesn",libname);
538:     ierr  = PetscStrcpy(program,libname);
539:     ierr  = PetscStrlen(program,&len);
540:     if (program[len-1] == '/') {
541:       ierr  = PetscStrcat(program,"*.");
542:     } else {
543:       ierr  = PetscStrcat(program,"/*.");
544:     }
545:     ierr  = PetscStrcat(program,PETSC_SLSUFFIX);

547:     PetscLs(comm,program,buf,8*1024,&dir);
548:     if (!dir) return(0);
549:     found = buf;
550:   } else {
551:     found = (char*)libname;
552:   }

554:   PetscStrcpy(suffix,".");
555:   PetscStrcat(suffix,PETSC_SLSUFFIX);

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

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

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

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: int PetscDLLibraryClose(PetscDLLibraryList next)
612: {
613:   PetscDLLibraryList prev;
614:   int           ierr;


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: }

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

631:      Collective on MPI_Comm

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

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

640:      Level: developer

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


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

659:   PetscLogInfo(0,"Checking directory %s for CCA componentsn",dirname);
660:   ierr  = PetscStrcpy(program,dirname);
661:   ierr  = PetscStrcat(program,"/*.cca");

663:   PetscLs(comm,program,buf,8*1024,&dir);
664:   if (!dir) return(0);

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


703: #endif