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