Actual source code: fretrieve.c

  1: /*$Id: fretrieve.c,v 1.42 2001/08/10 03:28:49 bsmith Exp $*/
  2: /*
  3:       Code for opening and closing files.
  4: */
 5:  #include petsc.h
 6:  #include petscsys.h
  7: #include "petscfix.h"
  8: #if defined(PETSC_HAVE_PWD_H)
  9: #include <pwd.h>
 10: #endif
 11: #include <ctype.h>
 12: #include <sys/types.h>
 13: #include <sys/stat.h>
 14: #if defined(PETSC_HAVE_UNISTD_H)
 15: #include <unistd.h>
 16: #endif
 17: #if defined(PETSC_HAVE_STDLIB_H)
 18: #include <stdlib.h>
 19: #endif
 20: #if !defined(PARCH_win32)
 21: #include <sys/utsname.h>
 22: #endif
 23: #if defined(PARCH_win32)
 24: #include <windows.h>
 25: #include <io.h>
 26: #include <direct.h>
 27: #endif
 28: #if defined (PARCH_win32_gnu)
 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: #include "petscfix.h"

 38: EXTERN_C_BEGIN
 39: EXTERN int Petsc_DelTag(MPI_Comm,int,void*,void*);
 40: EXTERN_C_END

 42: /*@C
 43:    PetscGetTmp - Gets the name of the tmp directory

 45:    Collective on MPI_Comm

 47:    Input Parameters:
 48: +  comm - MPI_Communicator that may share /tmp
 49: -  len - length of string to hold name

 51:    Output Parameters:
 52: .  dir - directory name

 54:    Options Database Keys:
 55: +    -shared_tmp 
 56: .    -not_shared_tmp
 57: -    -tmp tmpdir

 59:    Environmental Variables:
 60: +     PETSC_SHARED_TMP
 61: .     PETSC_NOT_SHARED_TMP
 62: -     PETSC_TMP

 64:    Level: developer

 66:    
 67:    If the environmental variable PETSC_TMP is set it will use this directory
 68:   as the "/tmp" directory.

 70: @*/
 71: int PetscGetTmp(MPI_Comm comm,char *dir,int len)
 72: {
 73:   int        ierr;
 74:   PetscTruth flg;

 77:   PetscOptionsGetenv(comm,"PETSC_TMP",dir,len,&flg);
 78:   if (!flg) {
 79:     PetscStrncpy(dir,"/tmp",len);
 80:   }
 81:   return(0);
 82: }

 84: /*@C
 85:    PetscSharedTmp - Determines if all processors in a communicator share a
 86:          /tmp or have different ones.

 88:    Collective on MPI_Comm

 90:    Input Parameters:
 91: .  comm - MPI_Communicator that may share /tmp

 93:    Output Parameters:
 94: .  shared - PETSC_TRUE or PETSC_FALSE

 96:    Options Database Keys:
 97: +    -shared_tmp 
 98: .    -not_shared_tmp
 99: -    -tmp tmpdir

101:    Environmental Variables:
102: +     PETSC_SHARED_TMP
103: .     PETSC_NOT_SHARED_TMP
104: -     PETSC_TMP

106:    Level: developer

108:    Notes:
109:    Stores the status as a MPI attribute so it does not have
110:     to be redetermined each time.

112:       Assumes that all processors in a communicator either
113:        1) have a common /tmp or
114:        2) each has a seperate /tmp
115:       eventually we can write a fancier one that determines which processors
116:       share a common /tmp.

118:    This will be very slow on runs with a large number of processors since
119:    it requires O(p*p) file opens.

121:    If the environmental variable PETSC_TMP is set it will use this directory
122:   as the "/tmp" directory.

124: @*/
125: int PetscSharedTmp(MPI_Comm comm,PetscTruth *shared)
126: {
127:   int        ierr,size,rank,*tagvalp,sum,cnt,i;
128:   PetscTruth flg,iflg;
129:   FILE       *fd;
130:   static int Petsc_Tmp_keyval = MPI_KEYVAL_INVALID;

133:   MPI_Comm_size(comm,&size);
134:   if (size == 1) {
135:     *shared = PETSC_TRUE;
136:     return(0);
137:   }

139:   PetscOptionsGetenv(comm,"PETSC_SHARED_TMP",PETSC_NULL,0,&flg);
140:   if (flg) {
141:     *shared = PETSC_TRUE;
142:     return(0);
143:   }

145:   PetscOptionsGetenv(comm,"PETSC_NOT_SHARED_TMP",PETSC_NULL,0,&flg);
146:   if (flg) {
147:     *shared = PETSC_FALSE;
148:     return(0);
149:   }

151:   if (Petsc_Tmp_keyval == MPI_KEYVAL_INVALID) {
152:     MPI_Keyval_create(MPI_NULL_COPY_FN,Petsc_DelTag,&Petsc_Tmp_keyval,0);
153:   }

155:   MPI_Attr_get(comm,Petsc_Tmp_keyval,(void**)&tagvalp,(int*)&iflg);
156:   if (!iflg) {
157:     char       filename[256],tmpname[256];

159:     /* This communicator does not yet have a shared tmp attribute */
160:     PetscMalloc(sizeof(int),&tagvalp);
161:     MPI_Attr_put(comm,Petsc_Tmp_keyval,tagvalp);

163:     PetscOptionsGetenv(comm,"PETSC_TMP",tmpname,238,&iflg);
164:     if (!iflg) {
165:       PetscStrcpy(filename,"/tmp");
166:     } else {
167:       PetscStrcpy(filename,tmpname);
168:     }

170:     PetscStrcat(filename,"/petsctestshared");
171:     MPI_Comm_rank(comm,&rank);
172: 
173:     /* each processor creates a /tmp file and all the later ones check */
174:     /* this makes sure no subset of processors is shared */
175:     *shared = PETSC_FALSE;
176:     for (i=0; i<size-1; i++) {
177:       if (rank == i) {
178:         fd = fopen(filename,"w");
179:         if (!fd) {
180:           SETERRQ1(1,"Unable to open test file %s",filename);
181:         }
182:         fclose(fd);
183:       }
184:       MPI_Barrier(comm);
185:       if (rank >= i) {
186:         fd = fopen(filename,"r");
187:         if (fd) cnt = 1; else cnt = 0;
188:         if (fd) {
189:           fclose(fd);
190:         }
191:       } else {
192:         cnt = 0;
193:       }
194:       MPI_Allreduce(&cnt,&sum,1,MPI_INT,MPI_SUM,comm);
195:       if (rank == i) {
196:         unlink(filename);
197:       }

199:       if (sum == size) {
200:         *shared = PETSC_TRUE;
201:         break;
202:       } else if (sum != 1) {
203:         SETERRQ(1,"Subset of processes share /tmp ");
204:       }
205:     }
206:     *tagvalp = (int)*shared;
207:     PetscLogInfo(0,"PetscSharedTmp: processors %s %sn",(*shared == PETSC_TRUE) ? "share":"do NOT share",(iflg ? tmpname:"/tmp"));
208:   } else {
209:     *shared = (PetscTruth) *tagvalp;
210:   }
211:   return(0);
212: }

214: /*@C
215:    PetscSharedWorkingDirectory - Determines if all processors in a communicator share a
216:          working directory or have different ones.

218:    Collective on MPI_Comm

220:    Input Parameters:
221: .  comm - MPI_Communicator that may share working directory

223:    Output Parameters:
224: .  shared - PETSC_TRUE or PETSC_FALSE

226:    Options Database Keys:
227: +    -shared_working_directory 
228: .    -not_shared_working_directory

230:    Environmental Variables:
231: +     PETSC_SHARED_WORKING_DIRECTORY
232: .     PETSC_NOT_SHARED_WORKING_DIRECTORY

234:    Level: developer

236:    Notes:
237:    Stores the status as a MPI attribute so it does not have
238:     to be redetermined each time.

240:       Assumes that all processors in a communicator either
241:        1) have a common working directory or
242:        2) each has a seperate working directory
243:       eventually we can write a fancier one that determines which processors
244:       share a common working directory.

246:    This will be very slow on runs with a large number of processors since
247:    it requires O(p*p) file opens.

249: @*/
250: int PetscSharedWorkingDirectory(MPI_Comm comm,PetscTruth *shared)
251: {
252:   int        ierr,size,rank,*tagvalp,sum,cnt,i;
253:   PetscTruth flg,iflg;
254:   FILE       *fd;
255:   static int Petsc_WD_keyval = MPI_KEYVAL_INVALID;

258:   MPI_Comm_size(comm,&size);
259:   if (size == 1) {
260:     *shared = PETSC_TRUE;
261:     return(0);
262:   }

264:   PetscOptionsGetenv(comm,"PETSC_SHARED_WORKING_DIRECTORY",PETSC_NULL,0,&flg);
265:   if (flg) {
266:     *shared = PETSC_TRUE;
267:     return(0);
268:   }

270:   PetscOptionsGetenv(comm,"PETSC_NOT_SHARED_WORKING_DIRECTORY",PETSC_NULL,0,&flg);
271:   if (flg) {
272:     *shared = PETSC_FALSE;
273:     return(0);
274:   }

276:   if (Petsc_WD_keyval == MPI_KEYVAL_INVALID) {
277:     MPI_Keyval_create(MPI_NULL_COPY_FN,Petsc_DelTag,&Petsc_WD_keyval,0);
278:   }

280:   MPI_Attr_get(comm,Petsc_WD_keyval,(void**)&tagvalp,(int*)&iflg);
281:   if (!iflg) {
282:     char       filename[256];

284:     /* This communicator does not yet have a shared  attribute */
285:     PetscMalloc(sizeof(int),&tagvalp);
286:     MPI_Attr_put(comm,Petsc_WD_keyval,tagvalp);

288:     PetscGetWorkingDirectory(filename,240);
289:     PetscStrcat(filename,"/petsctestshared");
290:     MPI_Comm_rank(comm,&rank);
291: 
292:     /* each processor creates a  file and all the later ones check */
293:     /* this makes sure no subset of processors is shared */
294:     *shared = PETSC_FALSE;
295:     for (i=0; i<size-1; i++) {
296:       if (rank == i) {
297:         fd = fopen(filename,"w");
298:         if (!fd) {
299:           SETERRQ1(1,"Unable to open test file %s",filename);
300:         }
301:         fclose(fd);
302:       }
303:       MPI_Barrier(comm);
304:       if (rank >= i) {
305:         fd = fopen(filename,"r");
306:         if (fd) cnt = 1; else cnt = 0;
307:         if (fd) {
308:           fclose(fd);
309:         }
310:       } else {
311:         cnt = 0;
312:       }
313:       MPI_Allreduce(&cnt,&sum,1,MPI_INT,MPI_SUM,comm);
314:       if (rank == i) {
315:         unlink(filename);
316:       }

318:       if (sum == size) {
319:         *shared = PETSC_TRUE;
320:         break;
321:       } else if (sum != 1) {
322:         SETERRQ(1,"Subset of processes share working directory");
323:       }
324:     }
325:     *tagvalp = (int)*shared;
326:   } else {
327:     *shared = (PetscTruth) *tagvalp;
328:   }
329:   PetscLogInfo(0,"PetscSharedWorkingDirectory: processors %s working directoryn",(*shared == PETSC_TRUE) ? "shared" : "do NOT share");
330:   return(0);
331: }


334: /*@C
335:     PetscFileRetrieve - Obtains a library from a URL or compressed 
336:         and copies into local disk space as uncompressed.

338:     Collective on MPI_Comm

340:     Input Parameter:
341: +   comm     - processors accessing the library
342: .   libname  - name of library, including entire URL (with or without .gz)
343: -   llen     - length of llibname

345:     Output Parameter:
346: +   llibname - name of local copy of library
347: -   found - if found and retrieved the file

349:     Level: developer

351: @*/
352: int PetscFileRetrieve(MPI_Comm comm,const char *libname,char *llibname,int llen,PetscTruth *found)
353: {
354:   char              buf[1024],tmpdir[256],urlget[256],*par,*pdir;
355:   FILE              *fp;
356:   int               i,rank,ierr,len = 0;
357:   PetscTruth        flg1,flg2,sharedtmp,exists;

360:   *found = PETSC_FALSE;

362:   /* if file does not have an ftp:// or http:// or .gz then need not process file */
363:   PetscStrstr(libname,".gz",&par);
364:   if (par) {PetscStrlen(par,&len);}

366:   PetscStrncmp(libname,"ftp://",6,&flg1);
367:   PetscStrncmp(libname,"http://",7,&flg2);
368:   if (!flg1 && !flg2 && (!par || len != 3)) {
369:     PetscStrncpy(llibname,libname,llen);
370:     PetscTestFile(libname,'r',found);
371:     return(0);
372:   }

374:   /* Determine if all processors share a common /tmp */
375:   PetscSharedTmp(comm,&sharedtmp);
376:   PetscOptionsGetenv(comm,"PETSC_TMP",tmpdir,256,&flg1);

378:   MPI_Comm_rank(comm,&rank);
379:   if (!rank || !sharedtmp) {
380: 
381:     /* Construct the script to get URL file */
382:     PetscGetPetscDir(&pdir);
383:     PetscStrcpy(urlget,pdir);
384:     PetscStrcat(urlget,"/bin/urlget");
385:     PetscTestFile(urlget,'r',&exists);
386:     if (!exists) {
387:       PetscTestFile("urlget",'r',&exists);
388:       if (!exists) {
389:         SETERRQ1(1,"Cannot locate PETSc script urlget in %s or current directory",urlget);
390:       }
391:       PetscStrcpy(urlget,"urlget");
392:     }
393:     PetscStrcat(urlget," ");

395:     /* are we using an alternative /tmp? */
396:     if (flg1) {
397:       PetscStrcat(urlget,"-tmp ");
398:       PetscStrcat(urlget,tmpdir);
399:       PetscStrcat(urlget," ");
400:     }

402:     PetscStrcat(urlget,libname);
403:     PetscStrcat(urlget," 2>&1 ");

405:     PetscPOpen(PETSC_COMM_SELF,PETSC_NULL,urlget,"r",&fp);
406:     if (!fgets(buf,1024,fp)) {
407:       SETERRQ1(1,"No output from ${PETSC_DIR}/bin/urlget in getting file %s",libname);
408:     }
409:     PetscLogInfo(0,"PetscFileRetrieve:Message back from urlget: %sn",buf);

411:     PetscStrncmp(buf,"Error",5,&flg1);
412:     PetscStrncmp(buf,"Traceback",9,&flg2);
413:     PetscPClose(PETSC_COMM_SELF,fp);
414:     if (flg1 || flg2) {
415:       *found = PETSC_FALSE;
416:     } else {
417:       *found = PETSC_TRUE;
418: 
419:       /* Check for n and make it 0 */
420:       for (i=0; i<1024; i++) {
421:         if (buf[i] == 'n') {
422:           buf[i] = 0;
423:           break;
424:         }
425:       }
426:       PetscStrncpy(llibname,buf,llen);
427:     }
428:   }
429:   if (sharedtmp) { /* send library name to all processors */
430:     MPI_Bcast(found,1,MPI_INT,0,comm);
431:     if (*found) {
432:       MPI_Bcast(llibname,llen,MPI_CHAR,0,comm);
433:       MPI_Bcast(found,1,MPI_INT,0,comm);
434:     }
435:   }

437:   return(0);
438: }