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