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