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