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"


 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: #include <dlfcn.h>

 55: struct _PetscDLLibraryList {
 56:   PetscDLLibraryList next;
 57:   void          *handle;
 58:   char          libname[PETSC_MAX_PATH_LEN];
 59: };

 61: EXTERN_C_BEGIN
 62: extern int Petsc_DelTag(MPI_Comm,int,void*,void*);
 63: EXTERN_C_END

 65: #undef __FUNCT__  
 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: #undef __FUNCT__  
 82: /*@C
 83:    PetscDLLibraryGetInfo - Gets the text information from a PETSc
 84:        dynamic library

 86:      Not Collective

 88:    Input Parameters:
 89: .   handle - library handle returned by PetscDLLibraryOpen()

 91:    Level: developer

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

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

108: #undef __FUNCT__  
110: /*@C
111:    PetscDLLibraryRetrieve - Copies a PETSc dynamic library from a remote location
112:      (if it is remote), indicates if it exits and its local name.

114:      Collective on MPI_Comm

116:    Input Parameters:
117: +   comm - processors that are opening the library
118: -   libname - name of the library, can be relative or absolute

120:    Output Parameter:
121: .   handle - library handle 

123:    Level: developer

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

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


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

148:   /* 
149:      Remove any file: header
150:   */
151:   PetscStrncmp(par2,"file:",5,&tflg);
152:   if (tflg) {
153:     PetscStrcpy(par2,par2+5);
154:   }

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

160:   /* remove .gz if it ends library name */
161:   PetscStrstr(par2,".gz",&gz);
162:   if (gz) {
163:     PetscStrlen(gz,&len);
164:     if (len == 3) {
165:       *gz = 0;
166:     }
167:   }

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

185:   /* put the .gz back on if it was there */
186:   if (gz) {
187:     PetscStrcat(par2,".gz");
188:   }

190:   PetscFileRetrieve(comm,par2,lname,llen,found);
191:   PetscFree(par2);
192:   return(0);
193: }


196: #undef __FUNCT__  
198: /*@C
199:    PetscDLLibraryOpen - Opens a dynamic link library

201:      Collective on MPI_Comm

203:    Input Parameters:
204: +   comm - processors that are opening the library
205: -   libname - name of the library, can be relative or absolute

207:    Output Parameter:
208: .   handle - library handle 

210:    Level: developer

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

215:    ${PETSC_ARCH} and ${BOPT} occuring in directoryname and filename 
216:    will be replaced with appropriate values.
217: @*/
218: int PetscDLLibraryOpen(MPI_Comm comm,const char libname[],void **handle)
219: {
220:   char       *par2,ierr;
221:   PetscTruth foundlibrary;
222:   int        (*func)(const char*);


226:   PetscMalloc(1024*sizeof(char),&par2);
227:   PetscDLLibraryRetrieve(comm,libname,par2,1024,&foundlibrary);
228:   if (!foundlibrary) {
229:     SETERRQ1(1,"Unable to locate dynamic library:n  %sn",libname);
230:   }

232: #if !defined(PETSC_USE_NONEXECUTABLE_SO)
233:   ierr  = PetscTestFile(par2,'x',&foundlibrary);
234:   if (!foundlibrary) {
235:     SETERRQ2(1,"Dynamic library is not executable:n  %sn  %sn",libname,par2);
236:   }
237: #endif

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

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

256:   /* run the function PetscFListAddDynamic() if it is in the library */
257:   func  = (int (*)(const char *)) dlsym(*handle,"PetscDLLibraryRegister");
258:   if (func) {
259:     (*func)(libname);
260:     PetscLogInfo(0,"PetscDLLibraryOpen:Loading registered routines from %sn",libname);
261:   }
262:   if (PetscLogPrintInfo) {
263:     int  (*sfunc)(const char *,const char*,char **);
264:     char *mess;

266:     sfunc   = (int (*)(const char *,const char*,char **)) dlsym(*handle,"PetscDLLibraryInfo");
267:     if (sfunc) {
268:       (*sfunc)(libname,"Contents",&mess);
269:       if (mess) {
270:         PetscLogInfo(0,"Contents:n %s",mess);
271:       }
272:       (*sfunc)(libname,"Authors",&mess);
273:       if (mess) {
274:         PetscLogInfo(0,"Authors:n %s",mess);
275:       }
276:       (*sfunc)(libname,"Version",&mess);
277:       if (mess) {
278:         PetscLogInfo(0,"Version:n %sn",mess);
279:       }
280:     }
281:   }

283:   /* Look for CCA components in the library */
284: #if defined(__cplusplus) && !defined(PETSC_USE_COMPLEX)
285:   char **(*gcl)(void) = (char **(*)(void)) dlsym(*handle,"getESIFactoryList");
286:   if (gcl) {
287:     char       **list = (*gcl)(),*sname,*rname;
288:     int        i = 0;
289:     PetscToken *token;

291:     while (list[i]) {
292:       PetscLogInfo(0,"ESI factory function and name: %s from %sn",list[i],libname);
293:       PetscTokenCreate(list[i],' ',&token);
294:       PetscTokenFind(token,&rname);
295:       PetscTokenFind(token,&sname);
296:       PetscFListAdd(&CCAList,sname,rname,PETSC_NULL);
297:       PetscTokenDestroy(token);
298:       i++;
299:     }
300:   }
301: #endif

303:   PetscFree(par2);
304:   return(0);
305: }

307: #undef __FUNCT__  
309: /*@C
310:    PetscDLLibrarySym - Load a symbol from the dynamic link libraries.

312:    Collective on MPI_Comm

314:    Input Parameter:
315: +  path     - optional complete library name
316: -  insymbol - name of symbol

318:    Output Parameter:
319: .  value 

321:    Level: developer

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

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

328: @*/
329: int PetscDLLibrarySym(MPI_Comm comm,PetscDLLibraryList *inlist,const char path[],const char insymbol[],void **value)
330: {
331:   char               *par1,*symbol;
332:   int                ierr,len;
333:   PetscDLLibraryList nlist,prev,list;

336:   if (inlist) list = *inlist; else list = PETSC_NULL;
337:   *value = 0;

339:   /* make copy of symbol so we can edit it in place */
340:   PetscStrlen(insymbol,&len);
341:   PetscMalloc((len+1)*sizeof(char),&symbol);
342:   PetscStrcpy(symbol,insymbol);

344:   /* 
345:       If symbol contains () then replace with a NULL, to support functionname() 
346:   */
347:   PetscStrchr(symbol,'(',&par1);
348:   if (par1) *par1 = 0;


351:   /*
352:        Function name does include library 
353:        -------------------------------------
354:   */
355:   if (path && path[0] != '0') {
356:     void *handle;
357: 
358:     /*   
359:         Look if library is already opened and in path
360:     */
361:     nlist = list;
362:     prev  = 0;
363:     while (nlist) {
364:       PetscTruth match;

366:       PetscStrcmp(nlist->libname,path,&match);
367:       if (match) {
368:         handle = nlist->handle;
369:         goto done;
370:       }
371:       prev  = nlist;
372:       nlist = nlist->next;
373:     }
374:     PetscDLLibraryOpen(comm,path,&handle);

376:     ierr          = PetscNew(struct _PetscDLLibraryList,&nlist);
377:     nlist->next   = 0;
378:     nlist->handle = handle;
379:     PetscStrcpy(nlist->libname,path);

381:     if (prev) {
382:       prev->next = nlist;
383:     } else {
384:       if (inlist) *inlist = nlist;
385:       else {PetscDLLibraryClose(nlist);}
386:     }
387:     PetscLogInfo(0,"PetscDLLibraryAppend:Appending %s to dynamic library search pathn",path);

389:     done:;
390:     *value   = dlsym(handle,symbol);
391:     if (!*value) {
392:       SETERRQ2(1,"Unable to locate function %s in dynamic library %s",insymbol,path);
393:     }
394:     PetscLogInfo(0,"PetscDLLibrarySym:Loading function %s from dynamic library %sn",insymbol,path);

396:   /*
397:        Function name does not include library so search path
398:        -----------------------------------------------------
399:   */
400:   } else {
401:     while (list) {
402:       *value =  dlsym(list->handle,symbol);
403:       if (*value) {
404:         PetscLogInfo(0,"PetscDLLibrarySym:Loading function %s from dynamic library %sn",symbol,list->libname);
405:         break;
406:       }
407:       list = list->next;
408:     }
409:     if (!*value) {
410:       *value =  dlsym(0,symbol);
411:       if (*value) {
412:         PetscLogInfo(0,"PetscDLLibrarySym:Loading function %s from object coden",symbol);
413:       }
414:     }
415:   }

417:   PetscFree(symbol);
418:   return(0);
419: }

421: #undef __FUNCT__  
423: /*@C
424:      PetscDLLibraryAppend - Appends another dynamic link library to the seach list, to the end
425:                 of the search path.

427:      Collective on MPI_Comm

429:      Input Parameters:
430: +     comm - MPI communicator
431: -     libname - name of the library

433:      Output Parameter:
434: .     outlist - list of libraries

436:      Level: developer

438:      Notes: if library is already in path will not add it.
439: @*/
440: int PetscDLLibraryAppend(MPI_Comm comm,PetscDLLibraryList *outlist,const char libname[])
441: {
442:   PetscDLLibraryList list,prev;
443:   void*              handle;
444:   int                ierr,len;
445:   PetscTruth         match,dir;
446:   char               program[PETSC_MAX_PATH_LEN],buf[8*PETSC_MAX_PATH_LEN],*found,*libname1,suffix[16],*s;
447:   PetscToken         *token;


451:   /* is libname a directory? */
452:   PetscTestDirectory(libname,'r',&dir);
453:   if (dir) {
454:     PetscLogInfo(0,"Checking directory %s for dynamic librariesn",libname);
455:     ierr  = PetscStrcpy(program,libname);
456:     ierr  = PetscStrlen(program,&len);
457:     if (program[len-1] == '/') {
458:       ierr  = PetscStrcat(program,"*.");
459:     } else {
460:       ierr  = PetscStrcat(program,"/*.");
461:     }
462:     ierr  = PetscStrcat(program,PETSC_SLSUFFIX);

464:     PetscLs(comm,program,buf,8*PETSC_MAX_PATH_LEN,&dir);
465:     if (!dir) return(0);
466:     found = buf;
467:   } else {
468:     found = (char*)libname;
469:   }
470:   PetscStrcpy(suffix,".");
471:   PetscStrcat(suffix,PETSC_SLSUFFIX);

473:   PetscTokenCreate(found,'n',&token);
474:   PetscTokenFind(token,&libname1);
475:   PetscStrstr(libname1,suffix,&s);
476:   if (s) s[0] = 0;
477:   while (libname1) {

479:     /* see if library was already open then we are done */
480:     list  = prev = *outlist;
481:     match = PETSC_FALSE;
482:     while (list) {

484:       PetscStrcmp(list->libname,libname1,&match);
485:       if (match) break;
486:       prev = list;
487:       list = list->next;
488:     }
489:     if (!match) {

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

493:       ierr         = PetscNew(struct _PetscDLLibraryList,&list);
494:       list->next   = 0;
495:       list->handle = handle;
496:       PetscStrcpy(list->libname,libname1);

498:       if (!*outlist) {
499:         *outlist   = list;
500:       } else {
501:         prev->next = list;
502:       }
503:       PetscLogInfo(0,"PetscDLLibraryAppend:Appending %s to dynamic library search pathn",libname1);
504:     }
505:     PetscTokenFind(token,&libname1);
506:     if (libname1) {
507:       PetscStrstr(libname1,suffix,&s);
508:       if (s) s[0] = 0;
509:     }
510:   }
511:   PetscTokenDestroy(token);
512:   return(0);
513: }

515: #undef __FUNCT__  
517: /*@C
518:      PetscDLLibraryPrepend - Add another dynamic library to search for symbols to the beginning of
519:                  the search path.

521:      Collective on MPI_Comm

523:      Input Parameters:
524: +     comm - MPI communicator
525: -     libname - name of the library

527:      Output Parameter:
528: .     outlist - list of libraries

530:      Level: developer

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

534: @*/
535: int PetscDLLibraryPrepend(MPI_Comm comm,PetscDLLibraryList *outlist,const char libname[])
536: {
537:   PetscDLLibraryList list,prev;
538:   void*              handle;
539:   int                ierr,len;
540:   PetscTruth         match,dir;
541:   char               program[PETSC_MAX_PATH_LEN],buf[8*PETSC_MAX_PATH_LEN],*found,*libname1,suffix[16],*s;
542:   PetscToken         *token;

545: 
546:   /* is libname a directory? */
547:   PetscTestDirectory(libname,'r',&dir);
548:   if (dir) {
549:     PetscLogInfo(0,"Checking directory %s for dynamic librariesn",libname);
550:     ierr  = PetscStrcpy(program,libname);
551:     ierr  = PetscStrlen(program,&len);
552:     if (program[len-1] == '/') {
553:       ierr  = PetscStrcat(program,"*.");
554:     } else {
555:       ierr  = PetscStrcat(program,"/*.");
556:     }
557:     ierr  = PetscStrcat(program,PETSC_SLSUFFIX);

559:     PetscLs(comm,program,buf,8*PETSC_MAX_PATH_LEN,&dir);
560:     if (!dir) return(0);
561:     found = buf;
562:   } else {
563:     found = (char*)libname;
564:   }

566:   PetscStrcpy(suffix,".");
567:   PetscStrcat(suffix,PETSC_SLSUFFIX);

569:   PetscTokenCreate(found,'n',&token);
570:   PetscTokenFind(token,&libname1);
571:   PetscStrstr(libname1,suffix,&s);
572:   if (s) s[0] = 0;
573:   while (libname1) {
574:     /* see if library was already open and move it to the front */
575:     list  = *outlist;
576:     prev  = 0;
577:     match = PETSC_FALSE;
578:     while (list) {

580:       PetscStrcmp(list->libname,libname1,&match);
581:       if (match) {
582:         if (prev) prev->next = list->next;
583:         list->next = *outlist;
584:         *outlist   = list;
585:         break;
586:       }
587:       prev = list;
588:       list = list->next;
589:     }
590:     if (!match) {
591:       /* open the library and add to front of list */
592:       PetscDLLibraryOpen(comm,libname1,&handle);
593: 
594:       PetscLogInfo(0,"PetscDLLibraryPrepend:Prepending %s to dynamic library search pathn",libname1);

596:       ierr         = PetscNew(struct _PetscDLLibraryList,&list);
597:       list->handle = handle;
598:       list->next   = *outlist;
599:       PetscStrcpy(list->libname,libname1);
600:       *outlist     = list;
601:     }
602:     PetscTokenFind(token,&libname1);
603:     if (libname1) {
604:       PetscStrstr(libname1,suffix,&s);
605:       if (s) s[0] = 0;
606:     }
607:   }
608:   PetscTokenDestroy(token);
609:   return(0);
610: }

612: #undef __FUNCT__  
614: /*@C
615:      PetscDLLibraryClose - Destroys the search path of dynamic libraries and closes the libraries.

617:     Collective on PetscDLLibrary

619:     Input Parameter:
620: .     next - library list

622:      Level: developer

624: @*/
625: int PetscDLLibraryClose(PetscDLLibraryList next)
626: {
627:   PetscDLLibraryList prev;
628:   int           ierr;


632:   while (next) {
633:     prev = next;
634:     next = next->next;
635:     /* free the space in the prev data-structure */
636:     PetscFree(prev);
637:   }
638:   return(0);
639: }

641: #undef __FUNCT__  
643: /*@C
644:      PetscDLLibraryCCAAppend - Appends another CCA dynamic link library to the seach list, to the end
645:                 of the search path.

647:      Collective on MPI_Comm

649:      Input Parameters:
650: +     comm - MPI communicator
651: -     libname - name of directory to check

653:      Output Parameter:
654: .     outlist - list of libraries

656:      Level: developer

658:      Notes: if library is already in path will not add it.
659: @*/
660: int PetscDLLibraryCCAAppend(MPI_Comm comm,PetscDLLibraryList *outlist,const char dirname[])
661: {
662:   int                ierr,l;
663:   PetscTruth         dir;
664:   char               program[PETSC_MAX_PATH_LEN],buf[8*PETSC_MAX_PATH_LEN],*libname1,fbuf[PETSC_MAX_PATH_LEN],*found,suffix[16],*f2;
665:   char               *func,*funcname,libname[PETSC_MAX_PATH_LEN],*lib;
666:   FILE               *fp;
667:   PetscToken         *token1,*token2;


671:   /* is dirname a directory? */
672:   PetscTestDirectory(dirname,'r',&dir);
673:   if (!dir) return(0);

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

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

682:   PetscStrcpy(suffix,".");
683:   PetscStrcat(suffix,PETSC_SLSUFFIX);
684:   PetscTokenCreate(buf,'n',&token1);
685:   PetscTokenFind(token1,&libname1);
686:   while (libname1) {
687:     fp    = fopen(libname1,"r"); if (!fp) continue;
688:     while ((found = fgets(fbuf,1024,fp))) {
689:       if (found[0] == '!') continue;
690:       PetscStrstr(found,suffix,&f2);
691:       if (f2) { /* found library name */
692:         if (found[0] == '/') {
693:           lib = found;
694:         } else {
695:           PetscStrcpy(libname,dirname);
696:           PetscStrlen(libname,&l);
697:           if (libname[l-1] != '/') {PetscStrcat(libname,"/");}
698:           PetscStrcat(libname,found);
699:           lib  = libname;
700:         }
701:         PetscDLLibraryAppend(comm,outlist,lib);
702:       } else {
703:         PetscLogInfo(0,"CCA Component function and name: %s from %sn",found,libname1);
704:         PetscTokenCreate(found,' ',&token2);
705:         PetscTokenFind(token2,&func);
706:         PetscTokenFind(token2,&funcname);
707:         PetscFListAdd(&CCAList,funcname,func,PETSC_NULL);
708:         PetscTokenDestroy(token2);
709:       }
710:     }
711:     fclose(fp);
712:     PetscTokenFind(token1,&libname1);
713:   }
714:   PetscTokenDestroy(token1);
715:   return(0);
716: }


719: #endif