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