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