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