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