Actual source code: fretrieve.c
petsc-3.7.1 2016-05-15
Report Typos and Errors

      2: /*
      3:       Code for opening and closing files.
      4: */
      5: #include <petscsys.h>
      6: #if defined(PETSC_HAVE_PWD_H)
      7: #include <pwd.h>
      8: #endif
      9: #include <ctype.h>
     10: #include <sys/stat.h>
     11: #if defined(PETSC_HAVE_UNISTD_H)
     12: #include <unistd.h>
     13: #endif
     14: #if defined(PETSC_HAVE_SYS_UTSNAME_H)
     15: #include <sys/utsname.h>
     16: #endif
     17: #include <fcntl.h>
     18: #include <time.h>
     19: #if defined(PETSC_HAVE_SYS_SYSTEMINFO_H)
     20: #include <sys/systeminfo.h>
     21: #endif

     25: /*
     26:    Private routine to delete tmp/shared storage

     28:    This is called by MPI, not by users.

     30:    Note: this is declared extern "C" because it is passed to MPI_Keyval_create()

     32: */
     33: PETSC_EXTERN PetscMPIInt MPIAPI Petsc_DelTmpShared(MPI_Comm comm,PetscMPIInt keyval,void *count_val,void *extra_state)
     34: {

     38:   PetscInfo1(0,"Deleting tmp/shared data in an MPI_Comm %ld\n",(long)comm);if (ierr) PetscFunctionReturn((PetscMPIInt)ierr);
     39:   PetscFree(count_val);if (ierr) PetscFunctionReturn((PetscMPIInt)ierr);
     40:   PetscFunctionReturn(MPI_SUCCESS);
     41: }

     45: /*@C
     46:    PetscGetTmp - Gets the name of the tmp directory

     48:    Collective on MPI_Comm

     50:    Input Parameters:
     51: +  comm - MPI_Communicator that may share /tmp
     52: -  len - length of string to hold name

     54:    Output Parameters:
     55: .  dir - directory name

     57:    Options Database Keys:
     58: +    -shared_tmp
     59: .    -not_shared_tmp
     60: -    -tmp tmpdir

     62:    Environmental Variables:
     63: +     PETSC_SHARED_TMP
     64: .     PETSC_NOT_SHARED_TMP
     65: -     PETSC_TMP

     67:    Level: developer

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

     73: @*/
     74: PetscErrorCode  PetscGetTmp(MPI_Comm comm,char dir[],size_t len)
     75: {
     77:   PetscBool      flg;

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

     89: /*@C
     90:    PetscSharedTmp - Determines if all processors in a communicator share a
     91:          /tmp or have different ones.

     93:    Collective on MPI_Comm

     95:    Input Parameters:
     96: .  comm - MPI_Communicator that may share /tmp

     98:    Output Parameters:
     99: .  shared - PETSC_TRUE or PETSC_FALSE

    101:    Options Database Keys:
    102: +    -shared_tmp
    103: .    -not_shared_tmp
    104: -    -tmp tmpdir

    106:    Environmental Variables:
    107: +     PETSC_SHARED_TMP
    108: .     PETSC_NOT_SHARED_TMP
    109: -     PETSC_TMP

    111:    Level: developer

    113:    Notes:
    114:    Stores the status as a MPI attribute so it does not have
    115:     to be redetermined each time.

    117:       Assumes that all processors in a communicator either
    118:        1) have a common /tmp or
    119:        2) each has a separate /tmp
    120:       eventually we can write a fancier one that determines which processors
    121:       share a common /tmp.

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

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

    129: @*/
    130: PetscErrorCode  PetscSharedTmp(MPI_Comm comm,PetscBool  *shared)
    131: {
    132:   PetscErrorCode     ierr;
    133:   PetscMPIInt        size,rank,*tagvalp,sum,cnt,i;
    134:   PetscBool          flg,iflg;
    135:   FILE               *fd;
    136:   static PetscMPIInt Petsc_Tmp_keyval = MPI_KEYVAL_INVALID;
    137:   int                err;

    140:   MPI_Comm_size(comm,&size);
    141:   if (size == 1) {
    142:     *shared = PETSC_TRUE;
    143:     return(0);
    144:   }

    146:   PetscOptionsGetenv(comm,"PETSC_SHARED_TMP",NULL,0,&flg);
    147:   if (flg) {
    148:     *shared = PETSC_TRUE;
    149:     return(0);
    150:   }

    152:   PetscOptionsGetenv(comm,"PETSC_NOT_SHARED_TMP",NULL,0,&flg);
    153:   if (flg) {
    154:     *shared = PETSC_FALSE;
    155:     return(0);
    156:   }

    158:   if (Petsc_Tmp_keyval == MPI_KEYVAL_INVALID) {
    159:     MPI_Keyval_create(MPI_NULL_COPY_FN,Petsc_DelTmpShared,&Petsc_Tmp_keyval,0);
    160:   }

    162:   MPI_Attr_get(comm,Petsc_Tmp_keyval,(void**)&tagvalp,(int*)&iflg);
    163:   if (!iflg) {
    164:     char filename[PETSC_MAX_PATH_LEN],tmpname[PETSC_MAX_PATH_LEN];

    166:     /* This communicator does not yet have a shared tmp attribute */
    167:     PetscMalloc1(1,&tagvalp);
    168:     MPI_Attr_put(comm,Petsc_Tmp_keyval,tagvalp);

    170:     PetscOptionsGetenv(comm,"PETSC_TMP",tmpname,238,&iflg);
    171:     if (!iflg) {
    172:       PetscStrcpy(filename,"/tmp");
    173:     } else {
    174:       PetscStrcpy(filename,tmpname);
    175:     }

    177:     PetscStrcat(filename,"/petsctestshared");
    178:     MPI_Comm_rank(comm,&rank);

    180:     /* each processor creates a /tmp file and all the later ones check */
    181:     /* this makes sure no subset of processors is shared */
    182:     *shared = PETSC_FALSE;
    183:     for (i=0; i<size-1; i++) {
    184:       if (rank == i) {
    185:         fd = fopen(filename,"w");
    186:         if (!fd) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Unable to open test file %s",filename);
    187:         err = fclose(fd);
    188:         if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fclose() failed on file");
    189:       }
    190:       MPI_Barrier(comm);
    191:       if (rank >= i) {
    192:         fd = fopen(filename,"r");
    193:         if (fd) cnt = 1;
    194:         else cnt = 0;
    195:         if (fd) {
    196:           err = fclose(fd);
    197:           if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fclose() failed on file");
    198:         }
    199:       } else cnt = 0;

    201:       MPIU_Allreduce(&cnt,&sum,1,MPI_INT,MPI_SUM,comm);
    202:       if (rank == i) unlink(filename);

    204:       if (sum == size) {
    205:         *shared = PETSC_TRUE;
    206:         break;
    207:       } else if (sum != 1) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP_SYS,"Subset of processes share /tmp ");
    208:     }
    209:     *tagvalp = (int)*shared;
    210:     PetscInfo2(0,"processors %s %s\n",(*shared) ? "share":"do NOT share",(iflg ? tmpname:"/tmp"));
    211:   } else *shared = (PetscBool) *tagvalp;
    212:   return(0);
    213: }

    217: /*@C
    218:    PetscSharedWorkingDirectory - Determines if all processors in a communicator share a
    219:          working directory or have different ones.

    221:    Collective on MPI_Comm

    223:    Input Parameters:
    224: .  comm - MPI_Communicator that may share working directory

    226:    Output Parameters:
    227: .  shared - PETSC_TRUE or PETSC_FALSE

    229:    Options Database Keys:
    230: +    -shared_working_directory
    231: .    -not_shared_working_directory

    233:    Environmental Variables:
    234: +     PETSC_SHARED_WORKING_DIRECTORY
    235: .     PETSC_NOT_SHARED_WORKING_DIRECTORY

    237:    Level: developer

    239:    Notes:
    240:    Stores the status as a MPI attribute so it does not have
    241:     to be redetermined each time.

    243:       Assumes that all processors in a communicator either
    244:        1) have a common working directory or
    245:        2) each has a separate working directory
    246:       eventually we can write a fancier one that determines which processors
    247:       share a common working directory.

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

    252: @*/
    253: PetscErrorCode  PetscSharedWorkingDirectory(MPI_Comm comm,PetscBool  *shared)
    254: {
    255:   PetscErrorCode     ierr;
    256:   PetscMPIInt        size,rank,*tagvalp,sum,cnt,i;
    257:   PetscBool          flg,iflg;
    258:   FILE               *fd;
    259:   static PetscMPIInt Petsc_WD_keyval = MPI_KEYVAL_INVALID;
    260:   int                err;

    263:   MPI_Comm_size(comm,&size);
    264:   if (size == 1) {
    265:     *shared = PETSC_TRUE;
    266:     return(0);
    267:   }

    269:   PetscOptionsGetenv(comm,"PETSC_SHARED_WORKING_DIRECTORY",NULL,0,&flg);
    270:   if (flg) {
    271:     *shared = PETSC_TRUE;
    272:     return(0);
    273:   }

    275:   PetscOptionsGetenv(comm,"PETSC_NOT_SHARED_WORKING_DIRECTORY",NULL,0,&flg);
    276:   if (flg) {
    277:     *shared = PETSC_FALSE;
    278:     return(0);
    279:   }

    281:   if (Petsc_WD_keyval == MPI_KEYVAL_INVALID) {
    282:     MPI_Keyval_create(MPI_NULL_COPY_FN,Petsc_DelTmpShared,&Petsc_WD_keyval,0);
    283:   }

    285:   MPI_Attr_get(comm,Petsc_WD_keyval,(void**)&tagvalp,(int*)&iflg);
    286:   if (!iflg) {
    287:     char filename[PETSC_MAX_PATH_LEN];

    289:     /* This communicator does not yet have a shared  attribute */
    290:     PetscMalloc1(1,&tagvalp);
    291:     MPI_Attr_put(comm,Petsc_WD_keyval,tagvalp);

    293:     PetscGetWorkingDirectory(filename,240);
    294:     PetscStrcat(filename,"/petsctestshared");
    295:     MPI_Comm_rank(comm,&rank);

    297:     /* each processor creates a  file and all the later ones check */
    298:     /* this makes sure no subset of processors is shared */
    299:     *shared = PETSC_FALSE;
    300:     for (i=0; i<size-1; i++) {
    301:       if (rank == i) {
    302:         fd = fopen(filename,"w");
    303:         if (!fd) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Unable to open test file %s",filename);
    304:         err = fclose(fd);
    305:         if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fclose() failed on file");
    306:       }
    307:       MPI_Barrier(comm);
    308:       if (rank >= i) {
    309:         fd = fopen(filename,"r");
    310:         if (fd) cnt = 1;
    311:         else cnt = 0;
    312:         if (fd) {
    313:           err = fclose(fd);
    314:           if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fclose() failed on file");
    315:         }
    316:       } else cnt = 0;

    318:       MPIU_Allreduce(&cnt,&sum,1,MPI_INT,MPI_SUM,comm);
    319:       if (rank == i) unlink(filename);

    321:       if (sum == size) {
    322:         *shared = PETSC_TRUE;
    323:         break;
    324:       } else if (sum != 1) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP_SYS,"Subset of processes share working directory");
    325:     }
    326:     *tagvalp = (int)*shared;
    327:   } else *shared = (PetscBool) *tagvalp;
    328:   PetscInfo1(0,"processors %s working directory\n",(*shared) ? "shared" : "do NOT share");
    329:   return(0);
    330: }

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

    339:     Collective on MPI_Comm

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

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

    350:     Level: developer

    352: @*/
    353: PetscErrorCode  PetscFileRetrieve(MPI_Comm comm,const char libname[],char llibname[],size_t llen,PetscBool  *found)
    354: {
    355:   char           buf[1024],tmpdir[PETSC_MAX_PATH_LEN],urlget[PETSC_MAX_PATH_LEN],*par;
    356:   const char     *pdir;
    357:   FILE           *fp;
    359:   int            i;
    360:   PetscMPIInt    rank;
    361:   size_t         len = 0;
    362:   PetscBool      flg1,flg2,flg3,sharedtmp,exists;
    363: #if defined(PETSC_HAVE_POPEN)
    364:   int            rval;
    365: #endif

    368:   *found = PETSC_FALSE;

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

    374:   PetscStrncmp(libname,"ftp://",6,&flg1);
    375:   PetscStrncmp(libname,"http://",7,&flg2);
    376:   PetscStrncmp(libname,"file://",7,&flg3);
    377:   if (!flg1 && !flg2 && !flg3 && (!par || len != 3)) {
    378:     PetscStrncpy(llibname,libname,llen);
    379:     PetscTestFile(libname,'r',found);
    380:     if (*found) {
    381:       PetscInfo1(NULL,"Found file %s\n",libname);
    382:     } else {
    383:       PetscInfo1(NULL,"Did not find file %s\n",libname);
    384:     }
    385:     return(0);
    386:   }

    388:   if (par && len == 3){
    389:     size_t llen;
    390:     PetscStrlen(libname,&llen);
    391:     PetscStrncpy(llibname,libname,llen);
    392:     llibname[llen-len] = 0;
    393:     PetscTestFile(llibname,'r',found);
    394:     if (*found) {
    395:       PetscInfo1(NULL,"Found uncompressed version of file %s\n",llibname);
    396:       return(0);
    397:     } else {
    398:       PetscInfo1(NULL,"Did not find uncompressed version of file %s\n",libname);
    399:     }
    400:   }

    402:   /* Determine if all processors share a common /tmp */
    403:   PetscSharedTmp(comm,&sharedtmp);
    404:   PetscOptionsGetenv(comm,"PETSC_TMP",tmpdir,PETSC_MAX_PATH_LEN,&flg1);

    406:   MPI_Comm_rank(comm,&rank);
    407:   if (!rank || !sharedtmp) {

    409:     /* Construct the script to get URL file */
    410:     PetscGetPetscDir(&pdir);
    411:     PetscStrcpy(urlget,pdir);
    412:     PetscStrcat(urlget,"/bin/urlget");
    413:     PetscTestFile(urlget,'r',&exists);
    414:     if (!exists) {
    415:       PetscTestFile("urlget",'r',&exists);
    416:       if (!exists) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Cannot locate PETSc script urlget in %s or current directory",urlget);
    417:       PetscStrcpy(urlget,"urlget");
    418:     }
    419:     PetscStrcat(urlget," ");

    421:     /* are we using an alternative /tmp? */
    422:     if (flg1) {
    423:       PetscStrcat(urlget,"-tmp ");
    424:       PetscStrcat(urlget,tmpdir);
    425:       PetscStrcat(urlget," ");
    426:     }

    428:     PetscStrcat(urlget,libname);
    429:     PetscStrcat(urlget," 2>&1 ");

    431: #if defined(PETSC_HAVE_POPEN)
    432:     PetscPOpen(PETSC_COMM_SELF,NULL,urlget,"r",&fp);
    433: #else
    434:     SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP_SYS,"Cannot run external programs on this machine");
    435: #endif
    436:     if (!fgets(buf,1024,fp)) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"No output from ${PETSC_DIR}/bin/urlget in getting file %s",libname);
    437:     PetscInfo1(0,"Message back from urlget: %s\n",buf);

    439:     PetscStrncmp(buf,"Error",5,&flg1);
    440:     PetscStrncmp(buf,"Traceback",9,&flg2);
    441: #if defined(PETSC_HAVE_POPEN)
    442:     PetscPClose(PETSC_COMM_SELF,fp,&rval);
    443: #endif
    444:     if (flg1 || flg2) *found = PETSC_FALSE;
    445:     else {
    446:       *found = PETSC_TRUE;

    448:       /* Check for \n and make it 0 */
    449:       for (i=0; i<1024; i++) {
    450:         if (buf[i] == '\n') {
    451:           buf[i] = 0;
    452:           break;
    453:         }
    454:       }
    455:       PetscStrncpy(llibname,buf,llen);
    456:     }
    457:   }
    458:   if (sharedtmp) { /* send library name to all processors */
    459:     MPI_Bcast(found,1,MPIU_BOOL,0,comm);
    460:     if (*found) {
    461:       MPI_Bcast(llibname,llen,MPI_CHAR,0,comm);
    462:       MPI_Bcast(found,1,MPIU_BOOL,0,comm);
    463:     }
    464:   }
    465:   return(0);
    466: }