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