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_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 129 PetscFunctionBegin; 130 ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr); 131 if (size == 1) { 132 *shared = PETSC_TRUE; 133 PetscFunctionReturn(0); 134 } 135 136 ierr = PetscOptionsGetenv(comm,"PETSC_SHARED_TMP",PETSC_NULL,0,&flg);CHKERRQ(ierr); 137 if (flg) { 138 *shared = PETSC_TRUE; 139 PetscFunctionReturn(0); 140 } 141 142 ierr = PetscOptionsGetenv(comm,"PETSC_NOT_SHARED_TMP",PETSC_NULL,0,&flg);CHKERRQ(ierr); 143 if (flg) { 144 *shared = PETSC_FALSE; 145 PetscFunctionReturn(0); 146 } 147 148 if (Petsc_Tmp_keyval == MPI_KEYVAL_INVALID) { 149 ierr = MPI_Keyval_create(MPI_NULL_COPY_FN,Petsc_DelTag,&Petsc_Tmp_keyval,0);CHKERRQ(ierr); 150 } 151 152 ierr = MPI_Attr_get(comm,Petsc_Tmp_keyval,(void**)&tagvalp,(int*)&iflg);CHKERRQ(ierr); 153 if (!iflg) { 154 char filename[PETSC_MAX_PATH_LEN],tmpname[PETSC_MAX_PATH_LEN]; 155 156 /* This communicator does not yet have a shared tmp attribute */ 157 ierr = PetscMalloc(sizeof(PetscMPIInt),&tagvalp);CHKERRQ(ierr); 158 ierr = MPI_Attr_put(comm,Petsc_Tmp_keyval,tagvalp);CHKERRQ(ierr); 159 160 ierr = PetscOptionsGetenv(comm,"PETSC_TMP",tmpname,238,&iflg);CHKERRQ(ierr); 161 if (!iflg) { 162 ierr = PetscStrcpy(filename,"/tmp");CHKERRQ(ierr); 163 } else { 164 ierr = PetscStrcpy(filename,tmpname);CHKERRQ(ierr); 165 } 166 167 ierr = PetscStrcat(filename,"/petsctestshared");CHKERRQ(ierr); 168 ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr); 169 170 /* each processor creates a /tmp file and all the later ones check */ 171 /* this makes sure no subset of processors is shared */ 172 *shared = PETSC_FALSE; 173 for (i=0; i<size-1; i++) { 174 if (rank == i) { 175 fd = fopen(filename,"w"); 176 if (!fd) { 177 SETERRQ1(PETSC_ERR_FILE_OPEN,"Unable to open test file %s",filename); 178 } 179 fclose(fd); 180 } 181 ierr = MPI_Barrier(comm);CHKERRQ(ierr); 182 if (rank >= i) { 183 fd = fopen(filename,"r"); 184 if (fd) cnt = 1; else cnt = 0; 185 if (fd) { 186 fclose(fd); 187 } 188 } else { 189 cnt = 0; 190 } 191 ierr = MPI_Allreduce(&cnt,&sum,1,MPI_INT,MPI_SUM,comm);CHKERRQ(ierr); 192 if (rank == i) { 193 unlink(filename); 194 } 195 196 if (sum == size) { 197 *shared = PETSC_TRUE; 198 break; 199 } else if (sum != 1) { 200 SETERRQ(PETSC_ERR_SUP_SYS,"Subset of processes share /tmp "); 201 } 202 } 203 *tagvalp = (int)*shared; 204 ierr = PetscVerboseInfo((0,"PetscSharedTmp: processors %s %s\n",(*shared) ? "share":"do NOT share",(iflg ? tmpname:"/tmp")));CHKERRQ(ierr); 205 } else { 206 *shared = (PetscTruth) *tagvalp; 207 } 208 PetscFunctionReturn(0); 209 } 210 211 #undef __FUNCT__ 212 #define __FUNCT__ "PetscSharedWorkingDirectory" 213 /*@C 214 PetscSharedWorkingDirectory - Determines if all processors in a communicator share a 215 working directory or have different ones. 216 217 Collective on MPI_Comm 218 219 Input Parameters: 220 . comm - MPI_Communicator that may share working directory 221 222 Output Parameters: 223 . shared - PETSC_TRUE or PETSC_FALSE 224 225 Options Database Keys: 226 + -shared_working_directory 227 . -not_shared_working_directory 228 229 Environmental Variables: 230 + PETSC_SHARED_WORKING_DIRECTORY 231 . PETSC_NOT_SHARED_WORKING_DIRECTORY 232 233 Level: developer 234 235 Notes: 236 Stores the status as a MPI attribute so it does not have 237 to be redetermined each time. 238 239 Assumes that all processors in a communicator either 240 1) have a common working directory or 241 2) each has a separate working directory 242 eventually we can write a fancier one that determines which processors 243 share a common working directory. 244 245 This will be very slow on runs with a large number of processors since 246 it requires O(p*p) file opens. 247 248 @*/ 249 PetscErrorCode PETSC_DLLEXPORT PetscSharedWorkingDirectory(MPI_Comm comm,PetscTruth *shared) 250 { 251 PetscErrorCode ierr; 252 PetscMPIInt size,rank,*tagvalp,sum,cnt,i; 253 PetscTruth flg,iflg; 254 FILE *fd; 255 static PetscMPIInt Petsc_WD_keyval = MPI_KEYVAL_INVALID; 256 257 PetscFunctionBegin; 258 ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr); 259 if (size == 1) { 260 *shared = PETSC_TRUE; 261 PetscFunctionReturn(0); 262 } 263 264 ierr = PetscOptionsGetenv(comm,"PETSC_SHARED_WORKING_DIRECTORY",PETSC_NULL,0,&flg);CHKERRQ(ierr); 265 if (flg) { 266 *shared = PETSC_TRUE; 267 PetscFunctionReturn(0); 268 } 269 270 ierr = PetscOptionsGetenv(comm,"PETSC_NOT_SHARED_WORKING_DIRECTORY",PETSC_NULL,0,&flg);CHKERRQ(ierr); 271 if (flg) { 272 *shared = PETSC_FALSE; 273 PetscFunctionReturn(0); 274 } 275 276 if (Petsc_WD_keyval == MPI_KEYVAL_INVALID) { 277 ierr = MPI_Keyval_create(MPI_NULL_COPY_FN,Petsc_DelTag,&Petsc_WD_keyval,0);CHKERRQ(ierr); 278 } 279 280 ierr = MPI_Attr_get(comm,Petsc_WD_keyval,(void**)&tagvalp,(int*)&iflg);CHKERRQ(ierr); 281 if (!iflg) { 282 char filename[PETSC_MAX_PATH_LEN]; 283 284 /* This communicator does not yet have a shared attribute */ 285 ierr = PetscMalloc(sizeof(PetscMPIInt),&tagvalp);CHKERRQ(ierr); 286 ierr = MPI_Attr_put(comm,Petsc_WD_keyval,tagvalp);CHKERRQ(ierr); 287 288 ierr = PetscGetWorkingDirectory(filename,240);CHKERRQ(ierr); 289 ierr = PetscStrcat(filename,"/petsctestshared");CHKERRQ(ierr); 290 ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr); 291 292 /* each processor creates a file and all the later ones check */ 293 /* this makes sure no subset of processors is shared */ 294 *shared = PETSC_FALSE; 295 for (i=0; i<size-1; i++) { 296 if (rank == i) { 297 fd = fopen(filename,"w"); 298 if (!fd) { 299 SETERRQ1(PETSC_ERR_FILE_OPEN,"Unable to open test file %s",filename); 300 } 301 fclose(fd); 302 } 303 ierr = MPI_Barrier(comm);CHKERRQ(ierr); 304 if (rank >= i) { 305 fd = fopen(filename,"r"); 306 if (fd) cnt = 1; else cnt = 0; 307 if (fd) { 308 fclose(fd); 309 } 310 } else { 311 cnt = 0; 312 } 313 ierr = MPI_Allreduce(&cnt,&sum,1,MPI_INT,MPI_SUM,comm);CHKERRQ(ierr); 314 if (rank == i) { 315 unlink(filename); 316 } 317 318 if (sum == size) { 319 *shared = PETSC_TRUE; 320 break; 321 } else if (sum != 1) { 322 SETERRQ(PETSC_ERR_SUP_SYS,"Subset of processes share working directory"); 323 } 324 } 325 *tagvalp = (int)*shared; 326 } else { 327 *shared = (PetscTruth) *tagvalp; 328 } 329 ierr = PetscVerboseInfo((0,"PetscSharedWorkingDirectory: processors %s working directory\n",(*shared) ? "shared" : "do NOT share"));CHKERRQ(ierr); 330 PetscFunctionReturn(0); 331 } 332 333 334 #undef __FUNCT__ 335 #define __FUNCT__ "PetscFileRetrieve" 336 /*@C 337 PetscFileRetrieve - Obtains a library from a URL or compressed 338 and copies into local disk space as uncompressed. 339 340 Collective on MPI_Comm 341 342 Input Parameter: 343 + comm - processors accessing the library 344 . libname - name of library, including entire URL (with or without .gz) 345 - llen - length of llibname 346 347 Output Parameter: 348 + llibname - name of local copy of library 349 - found - if found and retrieved the file 350 351 Level: developer 352 353 @*/ 354 PetscErrorCode PETSC_DLLEXPORT PetscFileRetrieve(MPI_Comm comm,const char *libname,char *llibname,size_t llen,PetscTruth *found) 355 { 356 char buf[1024],tmpdir[PETSC_MAX_PATH_LEN],urlget[PETSC_MAX_PATH_LEN],*par; 357 const char *pdir; 358 FILE *fp; 359 PetscErrorCode ierr; 360 int i; 361 PetscMPIInt rank; 362 size_t len = 0; 363 PetscTruth flg1,flg2,sharedtmp,exists; 364 365 PetscFunctionBegin; 366 *found = PETSC_FALSE; 367 368 /* if file does not have an ftp:// or http:// or .gz then need not process file */ 369 ierr = PetscStrstr(libname,".gz",&par);CHKERRQ(ierr); 370 if (par) {ierr = PetscStrlen(par,&len);CHKERRQ(ierr);} 371 372 ierr = PetscStrncmp(libname,"ftp://",6,&flg1);CHKERRQ(ierr); 373 ierr = PetscStrncmp(libname,"http://",7,&flg2);CHKERRQ(ierr); 374 if (!flg1 && !flg2 && (!par || len != 3)) { 375 ierr = PetscStrncpy(llibname,libname,llen);CHKERRQ(ierr); 376 ierr = PetscTestFile(libname,'r',found);CHKERRQ(ierr); 377 PetscFunctionReturn(0); 378 } 379 380 /* Determine if all processors share a common /tmp */ 381 ierr = PetscSharedTmp(comm,&sharedtmp);CHKERRQ(ierr); 382 ierr = PetscOptionsGetenv(comm,"PETSC_TMP",tmpdir,PETSC_MAX_PATH_LEN,&flg1);CHKERRQ(ierr); 383 384 ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr); 385 if (!rank || !sharedtmp) { 386 387 /* Construct the script to get URL file */ 388 ierr = PetscGetPetscDir(&pdir);CHKERRQ(ierr); 389 ierr = PetscStrcpy(urlget,pdir);CHKERRQ(ierr); 390 ierr = PetscStrcat(urlget,"/bin/urlget");CHKERRQ(ierr); 391 ierr = PetscTestFile(urlget,'r',&exists);CHKERRQ(ierr); 392 if (!exists) { 393 ierr = PetscTestFile("urlget",'r',&exists);CHKERRQ(ierr); 394 if (!exists) { 395 SETERRQ1(PETSC_ERR_PLIB,"Cannot locate PETSc script urlget in %s or current directory",urlget); 396 } 397 ierr = PetscStrcpy(urlget,"urlget");CHKERRQ(ierr); 398 } 399 ierr = PetscStrcat(urlget," ");CHKERRQ(ierr); 400 401 /* are we using an alternative /tmp? */ 402 if (flg1) { 403 ierr = PetscStrcat(urlget,"-tmp ");CHKERRQ(ierr); 404 ierr = PetscStrcat(urlget,tmpdir);CHKERRQ(ierr); 405 ierr = PetscStrcat(urlget," ");CHKERRQ(ierr); 406 } 407 408 ierr = PetscStrcat(urlget,libname);CHKERRQ(ierr); 409 ierr = PetscStrcat(urlget," 2>&1 ");CHKERRQ(ierr); 410 411 #if defined(PETSC_HAVE_POPEN) 412 ierr = PetscPOpen(PETSC_COMM_SELF,PETSC_NULL,urlget,"r",&fp);CHKERRQ(ierr); 413 #else 414 SETERRQ(PETSC_ERR_SUP_SYS,"Cannot run external programs on this machine"); 415 #endif 416 if (!fgets(buf,1024,fp)) { 417 SETERRQ1(PETSC_ERR_PLIB,"No output from ${PETSC_DIR}/bin/urlget in getting file %s",libname); 418 } 419 ierr = PetscVerboseInfo((0,"PetscFileRetrieve:Message back from urlget: %s\n",buf));CHKERRQ(ierr); 420 421 ierr = PetscStrncmp(buf,"Error",5,&flg1);CHKERRQ(ierr); 422 ierr = PetscStrncmp(buf,"Traceback",9,&flg2);CHKERRQ(ierr); 423 #if defined(PETSC_HAVE_POPEN) 424 ierr = PetscPClose(PETSC_COMM_SELF,fp);CHKERRQ(ierr); 425 #endif 426 if (flg1 || flg2) { 427 *found = PETSC_FALSE; 428 } else { 429 *found = PETSC_TRUE; 430 431 /* Check for \n and make it 0 */ 432 for (i=0; i<1024; i++) { 433 if (buf[i] == '\n') { 434 buf[i] = 0; 435 break; 436 } 437 } 438 ierr = PetscStrncpy(llibname,buf,llen);CHKERRQ(ierr); 439 } 440 } 441 if (sharedtmp) { /* send library name to all processors */ 442 ierr = MPI_Bcast(found,1,MPI_INT,0,comm);CHKERRQ(ierr); 443 if (*found) { 444 ierr = MPI_Bcast(llibname,llen,MPI_CHAR,0,comm);CHKERRQ(ierr); 445 ierr = MPI_Bcast(found,1,MPI_INT,0,comm);CHKERRQ(ierr); 446 } 447 } 448 449 PetscFunctionReturn(0); 450 } 451