1 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 22 23 EXTERN_C_BEGIN 24 #undef __FUNCT__ 25 #define __FUNCT__ "Petsc_DelTmpShared" 26 /* 27 Private routine to delete tmp/shared storage 28 29 This is called by MPI, not by users. 30 31 Note: this is declared extern "C" because it is passed to MPI_Keyval_create() 32 33 */ 34 PetscMPIInt MPIAPI Petsc_DelTmpShared(MPI_Comm comm,PetscMPIInt keyval,void *count_val,void *extra_state) 35 { 36 PetscErrorCode ierr; 37 38 PetscFunctionBegin; 39 ierr = PetscInfo1(0,"Deleting tmp/shared data in an MPI_Comm %ld\n",(long)comm);if (ierr) PetscFunctionReturn((PetscMPIInt)ierr); 40 ierr = PetscFree(count_val);if (ierr) PetscFunctionReturn((PetscMPIInt)ierr); 41 PetscFunctionReturn(MPI_SUCCESS); 42 } 43 EXTERN_C_END 44 45 #undef __FUNCT__ 46 #define __FUNCT__ "PetscGetTmp" 47 /*@C 48 PetscGetTmp - Gets the name of the tmp directory 49 50 Collective on MPI_Comm 51 52 Input Parameters: 53 + comm - MPI_Communicator that may share /tmp 54 - len - length of string to hold name 55 56 Output Parameters: 57 . dir - directory name 58 59 Options Database Keys: 60 + -shared_tmp 61 . -not_shared_tmp 62 - -tmp tmpdir 63 64 Environmental Variables: 65 + PETSC_SHARED_TMP 66 . PETSC_NOT_SHARED_TMP 67 - PETSC_TMP 68 69 Level: developer 70 71 72 If the environmental variable PETSC_TMP is set it will use this directory 73 as the "/tmp" directory. 74 75 @*/ 76 PetscErrorCode PetscGetTmp(MPI_Comm comm,char dir[],size_t len) 77 { 78 PetscErrorCode ierr; 79 PetscBool flg; 80 81 PetscFunctionBegin; 82 ierr = PetscOptionsGetenv(comm,"PETSC_TMP",dir,len,&flg);CHKERRQ(ierr); 83 if (!flg) { 84 ierr = PetscStrncpy(dir,"/tmp",len);CHKERRQ(ierr); 85 } 86 PetscFunctionReturn(0); 87 } 88 89 #undef __FUNCT__ 90 #define __FUNCT__ "PetscSharedTmp" 91 /*@C 92 PetscSharedTmp - Determines if all processors in a communicator share a 93 /tmp or have different ones. 94 95 Collective on MPI_Comm 96 97 Input Parameters: 98 . comm - MPI_Communicator that may share /tmp 99 100 Output Parameters: 101 . shared - PETSC_TRUE or PETSC_FALSE 102 103 Options Database Keys: 104 + -shared_tmp 105 . -not_shared_tmp 106 - -tmp tmpdir 107 108 Environmental Variables: 109 + PETSC_SHARED_TMP 110 . PETSC_NOT_SHARED_TMP 111 - PETSC_TMP 112 113 Level: developer 114 115 Notes: 116 Stores the status as a MPI attribute so it does not have 117 to be redetermined each time. 118 119 Assumes that all processors in a communicator either 120 1) have a common /tmp or 121 2) each has a separate /tmp 122 eventually we can write a fancier one that determines which processors 123 share a common /tmp. 124 125 This will be very slow on runs with a large number of processors since 126 it requires O(p*p) file opens. 127 128 If the environmental variable PETSC_TMP is set it will use this directory 129 as the "/tmp" directory. 130 131 @*/ 132 PetscErrorCode PetscSharedTmp(MPI_Comm comm,PetscBool *shared) 133 { 134 PetscErrorCode ierr; 135 PetscMPIInt size,rank,*tagvalp,sum,cnt,i; 136 PetscBool flg,iflg; 137 FILE *fd; 138 static PetscMPIInt Petsc_Tmp_keyval = MPI_KEYVAL_INVALID; 139 int err; 140 141 PetscFunctionBegin; 142 ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr); 143 if (size == 1) { 144 *shared = PETSC_TRUE; 145 PetscFunctionReturn(0); 146 } 147 148 ierr = PetscOptionsGetenv(comm,"PETSC_SHARED_TMP",NULL,0,&flg);CHKERRQ(ierr); 149 if (flg) { 150 *shared = PETSC_TRUE; 151 PetscFunctionReturn(0); 152 } 153 154 ierr = PetscOptionsGetenv(comm,"PETSC_NOT_SHARED_TMP",NULL,0,&flg);CHKERRQ(ierr); 155 if (flg) { 156 *shared = PETSC_FALSE; 157 PetscFunctionReturn(0); 158 } 159 160 if (Petsc_Tmp_keyval == MPI_KEYVAL_INVALID) { 161 ierr = MPI_Keyval_create(MPI_NULL_COPY_FN,Petsc_DelTmpShared,&Petsc_Tmp_keyval,0);CHKERRQ(ierr); 162 } 163 164 ierr = MPI_Attr_get(comm,Petsc_Tmp_keyval,(void**)&tagvalp,(int*)&iflg);CHKERRQ(ierr); 165 if (!iflg) { 166 char filename[PETSC_MAX_PATH_LEN],tmpname[PETSC_MAX_PATH_LEN]; 167 168 /* This communicator does not yet have a shared tmp attribute */ 169 ierr = PetscMalloc(sizeof(PetscMPIInt),&tagvalp);CHKERRQ(ierr); 170 ierr = MPI_Attr_put(comm,Petsc_Tmp_keyval,tagvalp);CHKERRQ(ierr); 171 172 ierr = PetscOptionsGetenv(comm,"PETSC_TMP",tmpname,238,&iflg);CHKERRQ(ierr); 173 if (!iflg) { 174 ierr = PetscStrcpy(filename,"/tmp");CHKERRQ(ierr); 175 } else { 176 ierr = PetscStrcpy(filename,tmpname);CHKERRQ(ierr); 177 } 178 179 ierr = PetscStrcat(filename,"/petsctestshared");CHKERRQ(ierr); 180 ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr); 181 182 /* each processor creates a /tmp file and all the later ones check */ 183 /* this makes sure no subset of processors is shared */ 184 *shared = PETSC_FALSE; 185 for (i=0; i<size-1; i++) { 186 if (rank == i) { 187 fd = fopen(filename,"w"); 188 if (!fd) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Unable to open test file %s",filename); 189 err = fclose(fd); 190 if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fclose() failed on file"); 191 } 192 ierr = MPI_Barrier(comm);CHKERRQ(ierr); 193 if (rank >= i) { 194 fd = fopen(filename,"r"); 195 if (fd) cnt = 1; 196 else cnt = 0; 197 if (fd) { 198 err = fclose(fd); 199 if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fclose() failed on file"); 200 } 201 } else cnt = 0; 202 203 ierr = MPI_Allreduce(&cnt,&sum,1,MPI_INT,MPI_SUM,comm);CHKERRQ(ierr); 204 if (rank == i) unlink(filename); 205 206 if (sum == size) { 207 *shared = PETSC_TRUE; 208 break; 209 } else if (sum != 1) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP_SYS,"Subset of processes share /tmp "); 210 } 211 *tagvalp = (int)*shared; 212 ierr = PetscInfo2(0,"processors %s %s\n",(*shared) ? "share":"do NOT share",(iflg ? tmpname:"/tmp"));CHKERRQ(ierr); 213 } else *shared = (PetscBool) *tagvalp; 214 PetscFunctionReturn(0); 215 } 216 217 #undef __FUNCT__ 218 #define __FUNCT__ "PetscSharedWorkingDirectory" 219 /*@C 220 PetscSharedWorkingDirectory - Determines if all processors in a communicator share a 221 working directory or have different ones. 222 223 Collective on MPI_Comm 224 225 Input Parameters: 226 . comm - MPI_Communicator that may share working directory 227 228 Output Parameters: 229 . shared - PETSC_TRUE or PETSC_FALSE 230 231 Options Database Keys: 232 + -shared_working_directory 233 . -not_shared_working_directory 234 235 Environmental Variables: 236 + PETSC_SHARED_WORKING_DIRECTORY 237 . PETSC_NOT_SHARED_WORKING_DIRECTORY 238 239 Level: developer 240 241 Notes: 242 Stores the status as a MPI attribute so it does not have 243 to be redetermined each time. 244 245 Assumes that all processors in a communicator either 246 1) have a common working directory or 247 2) each has a separate working directory 248 eventually we can write a fancier one that determines which processors 249 share a common working directory. 250 251 This will be very slow on runs with a large number of processors since 252 it requires O(p*p) file opens. 253 254 @*/ 255 PetscErrorCode PetscSharedWorkingDirectory(MPI_Comm comm,PetscBool *shared) 256 { 257 PetscErrorCode ierr; 258 PetscMPIInt size,rank,*tagvalp,sum,cnt,i; 259 PetscBool flg,iflg; 260 FILE *fd; 261 static PetscMPIInt Petsc_WD_keyval = MPI_KEYVAL_INVALID; 262 int err; 263 264 PetscFunctionBegin; 265 ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr); 266 if (size == 1) { 267 *shared = PETSC_TRUE; 268 PetscFunctionReturn(0); 269 } 270 271 ierr = PetscOptionsGetenv(comm,"PETSC_SHARED_WORKING_DIRECTORY",NULL,0,&flg);CHKERRQ(ierr); 272 if (flg) { 273 *shared = PETSC_TRUE; 274 PetscFunctionReturn(0); 275 } 276 277 ierr = PetscOptionsGetenv(comm,"PETSC_NOT_SHARED_WORKING_DIRECTORY",NULL,0,&flg);CHKERRQ(ierr); 278 if (flg) { 279 *shared = PETSC_FALSE; 280 PetscFunctionReturn(0); 281 } 282 283 if (Petsc_WD_keyval == MPI_KEYVAL_INVALID) { 284 ierr = MPI_Keyval_create(MPI_NULL_COPY_FN,Petsc_DelTmpShared,&Petsc_WD_keyval,0);CHKERRQ(ierr); 285 } 286 287 ierr = MPI_Attr_get(comm,Petsc_WD_keyval,(void**)&tagvalp,(int*)&iflg);CHKERRQ(ierr); 288 if (!iflg) { 289 char filename[PETSC_MAX_PATH_LEN]; 290 291 /* This communicator does not yet have a shared attribute */ 292 ierr = PetscMalloc(sizeof(PetscMPIInt),&tagvalp);CHKERRQ(ierr); 293 ierr = MPI_Attr_put(comm,Petsc_WD_keyval,tagvalp);CHKERRQ(ierr); 294 295 ierr = PetscGetWorkingDirectory(filename,240);CHKERRQ(ierr); 296 ierr = PetscStrcat(filename,"/petsctestshared");CHKERRQ(ierr); 297 ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr); 298 299 /* each processor creates a file and all the later ones check */ 300 /* this makes sure no subset of processors is shared */ 301 *shared = PETSC_FALSE; 302 for (i=0; i<size-1; i++) { 303 if (rank == i) { 304 fd = fopen(filename,"w"); 305 if (!fd) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Unable to open test file %s",filename); 306 err = fclose(fd); 307 if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fclose() failed on file"); 308 } 309 ierr = MPI_Barrier(comm);CHKERRQ(ierr); 310 if (rank >= i) { 311 fd = fopen(filename,"r"); 312 if (fd) cnt = 1; 313 else cnt = 0; 314 if (fd) { 315 err = fclose(fd); 316 if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fclose() failed on file"); 317 } 318 } else cnt = 0; 319 320 ierr = MPI_Allreduce(&cnt,&sum,1,MPI_INT,MPI_SUM,comm);CHKERRQ(ierr); 321 if (rank == i) unlink(filename); 322 323 if (sum == size) { 324 *shared = PETSC_TRUE; 325 break; 326 } else if (sum != 1) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP_SYS,"Subset of processes share working directory"); 327 } 328 *tagvalp = (int)*shared; 329 } else *shared = (PetscBool) *tagvalp; 330 ierr = PetscInfo1(0,"processors %s working directory\n",(*shared) ? "shared" : "do NOT share");CHKERRQ(ierr); 331 PetscFunctionReturn(0); 332 } 333 334 335 #undef __FUNCT__ 336 #define __FUNCT__ "PetscFileRetrieve" 337 /*@C 338 PetscFileRetrieve - Obtains a library from a URL or compressed 339 and copies into local disk space as uncompressed. 340 341 Collective on MPI_Comm 342 343 Input Parameter: 344 + comm - processors accessing the library 345 . libname - name of library, including entire URL (with or without .gz) 346 - llen - length of llibname 347 348 Output Parameter: 349 + llibname - name of local copy of library 350 - found - if found and retrieved the file 351 352 Level: developer 353 354 @*/ 355 PetscErrorCode PetscFileRetrieve(MPI_Comm comm,const char libname[],char llibname[],size_t llen,PetscBool *found) 356 { 357 char buf[1024],tmpdir[PETSC_MAX_PATH_LEN],urlget[PETSC_MAX_PATH_LEN],*par; 358 const char *pdir; 359 FILE *fp; 360 PetscErrorCode ierr; 361 int i; 362 PetscMPIInt rank; 363 size_t len = 0; 364 PetscBool flg1,flg2,flg3,sharedtmp,exists; 365 #if defined(PETSC_HAVE_POPEN) 366 PetscInt rval; 367 #endif 368 369 PetscFunctionBegin; 370 *found = PETSC_FALSE; 371 372 /* if file does not have an ftp:// or http:// or .gz then need not process file */ 373 ierr = PetscStrstr(libname,".gz",&par);CHKERRQ(ierr); 374 if (par) {ierr = PetscStrlen(par,&len);CHKERRQ(ierr);} 375 376 ierr = PetscStrncmp(libname,"ftp://",6,&flg1);CHKERRQ(ierr); 377 ierr = PetscStrncmp(libname,"http://",7,&flg2);CHKERRQ(ierr); 378 ierr = PetscStrncmp(libname,"file://",7,&flg3);CHKERRQ(ierr); 379 if (!flg1 && !flg2 && !flg3 && (!par || len != 3)) { 380 ierr = PetscStrncpy(llibname,libname,llen);CHKERRQ(ierr); 381 ierr = PetscTestFile(libname,'r',found);CHKERRQ(ierr); 382 if (*found) { 383 ierr = PetscInfo1(NULL,"Found file %s\n",libname);CHKERRQ(ierr); 384 } else { 385 ierr = PetscInfo1(NULL,"Did not find file %s\n",libname);CHKERRQ(ierr); 386 } 387 PetscFunctionReturn(0); 388 } 389 390 /* Determine if all processors share a common /tmp */ 391 ierr = PetscSharedTmp(comm,&sharedtmp);CHKERRQ(ierr); 392 ierr = PetscOptionsGetenv(comm,"PETSC_TMP",tmpdir,PETSC_MAX_PATH_LEN,&flg1);CHKERRQ(ierr); 393 394 ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr); 395 if (!rank || !sharedtmp) { 396 397 /* Construct the script to get URL file */ 398 ierr = PetscGetPetscDir(&pdir);CHKERRQ(ierr); 399 ierr = PetscStrcpy(urlget,pdir);CHKERRQ(ierr); 400 ierr = PetscStrcat(urlget,"/bin/urlget");CHKERRQ(ierr); 401 ierr = PetscTestFile(urlget,'r',&exists);CHKERRQ(ierr); 402 if (!exists) { 403 ierr = PetscTestFile("urlget",'r',&exists);CHKERRQ(ierr); 404 if (!exists) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Cannot locate PETSc script urlget in %s or current directory",urlget); 405 ierr = PetscStrcpy(urlget,"urlget");CHKERRQ(ierr); 406 } 407 ierr = PetscStrcat(urlget," ");CHKERRQ(ierr); 408 409 /* are we using an alternative /tmp? */ 410 if (flg1) { 411 ierr = PetscStrcat(urlget,"-tmp ");CHKERRQ(ierr); 412 ierr = PetscStrcat(urlget,tmpdir);CHKERRQ(ierr); 413 ierr = PetscStrcat(urlget," ");CHKERRQ(ierr); 414 } 415 416 ierr = PetscStrcat(urlget,libname);CHKERRQ(ierr); 417 ierr = PetscStrcat(urlget," 2>&1 ");CHKERRQ(ierr); 418 419 #if defined(PETSC_HAVE_POPEN) 420 ierr = PetscPOpen(PETSC_COMM_SELF,NULL,urlget,"r",&fp);CHKERRQ(ierr); 421 #else 422 SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP_SYS,"Cannot run external programs on this machine"); 423 #endif 424 if (!fgets(buf,1024,fp)) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"No output from ${PETSC_DIR}/bin/urlget in getting file %s",libname); 425 ierr = PetscInfo1(0,"Message back from urlget: %s\n",buf);CHKERRQ(ierr); 426 427 ierr = PetscStrncmp(buf,"Error",5,&flg1);CHKERRQ(ierr); 428 ierr = PetscStrncmp(buf,"Traceback",9,&flg2);CHKERRQ(ierr); 429 #if defined(PETSC_HAVE_POPEN) 430 ierr = PetscPClose(PETSC_COMM_SELF,fp,&rval);CHKERRQ(ierr); 431 #endif 432 if (flg1 || flg2) *found = PETSC_FALSE; 433 else { 434 *found = PETSC_TRUE; 435 436 /* Check for \n and make it 0 */ 437 for (i=0; i<1024; i++) { 438 if (buf[i] == '\n') { 439 buf[i] = 0; 440 break; 441 } 442 } 443 ierr = PetscStrncpy(llibname,buf,llen);CHKERRQ(ierr); 444 } 445 } 446 if (sharedtmp) { /* send library name to all processors */ 447 ierr = MPI_Bcast(found,1,MPIU_BOOL,0,comm);CHKERRQ(ierr); 448 if (*found) { 449 ierr = MPI_Bcast(llibname,llen,MPI_CHAR,0,comm);CHKERRQ(ierr); 450 ierr = MPI_Bcast(found,1,MPIU_BOOL,0,comm);CHKERRQ(ierr); 451 } 452 } 453 PetscFunctionReturn(0); 454 } 455