xref: /petsc/src/sys/fileio/mpiuopen.c (revision f1580f4e3ce5d5b2393648fd039d0d41b440385d)
1 #define PETSC_DESIRE_FEATURE_TEST_MACROS /* for popen() */
2 /*
3       Some PETSc utility routines to add simple parallel IO capabilities
4 */
5 #include <petscsys.h>
6 #include <petsc/private/logimpl.h>
7 #include <errno.h>
8 
9 /*@C
10     PetscFOpen - Has the first process in the communicator open a file;
11     all others do nothing.
12 
13     Logically Collective
14 
15     Input Parameters:
16 +   comm - the communicator
17 .   name - the filename
18 -   mode - the mode for fopen(), usually "w"
19 
20     Output Parameter:
21 .   fp - the file pointer
22 
23     Level: developer
24 
25     Note:
26        NULL (0), "stderr" or "stdout" may be passed in as the filename
27 
28     Fortran Note:
29     This routine is not supported in Fortran.
30 
31 .seealso: `PetscFClose()`, `PetscSynchronizedFGets()`, `PetscSynchronizedPrintf()`, `PetscSynchronizedFlush()`,
32           `PetscFPrintf()`
33 @*/
34 PetscErrorCode PetscFOpen(MPI_Comm comm, const char name[], const char mode[], FILE **fp) {
35   PetscMPIInt rank;
36   FILE       *fd;
37   char        fname[PETSC_MAX_PATH_LEN], tname[PETSC_MAX_PATH_LEN];
38 
39   PetscFunctionBegin;
40   PetscCallMPI(MPI_Comm_rank(comm, &rank));
41   if (rank == 0) {
42     PetscBool isstdout, isstderr;
43     PetscCall(PetscStrcmp(name, "stdout", &isstdout));
44     PetscCall(PetscStrcmp(name, "stderr", &isstderr));
45     if (isstdout || !name) fd = PETSC_STDOUT;
46     else if (isstderr) fd = PETSC_STDERR;
47     else {
48       PetscBool devnull;
49       PetscCall(PetscStrreplace(PETSC_COMM_SELF, name, tname, PETSC_MAX_PATH_LEN));
50       PetscCall(PetscFixFilename(tname, fname));
51       PetscCall(PetscStrbeginswith(fname, "/dev/null", &devnull));
52       if (devnull) PetscCall(PetscStrcpy(fname, "/dev/null"));
53       PetscCall(PetscInfo(0, "Opening file %s\n", fname));
54       fd = fopen(fname, mode);
55       PetscCheck(fd, PETSC_COMM_SELF, PETSC_ERR_FILE_OPEN, "Unable to open file %s", fname);
56     }
57   } else fd = NULL;
58   *fp = fd;
59   PetscFunctionReturn(0);
60 }
61 
62 /*@C
63     PetscFClose - Has the first processor in the communicator close a
64     file; all others do nothing.
65 
66     Logically Collective
67 
68     Input Parameters:
69 +   comm - the communicator
70 -   fd - the file, opened with PetscFOpen()
71 
72    Level: developer
73 
74     Fortran Note:
75     This routine is not supported in Fortran.
76 
77 .seealso: `PetscFOpen()`
78 @*/
79 PetscErrorCode PetscFClose(MPI_Comm comm, FILE *fd) {
80   PetscMPIInt rank;
81   int         err;
82 
83   PetscFunctionBegin;
84   PetscCallMPI(MPI_Comm_rank(comm, &rank));
85   if (rank == 0 && fd != PETSC_STDOUT && fd != PETSC_STDERR) {
86     err = fclose(fd);
87     PetscCheck(!err, PETSC_COMM_SELF, PETSC_ERR_SYS, "fclose() failed on file");
88   }
89   PetscFunctionReturn(0);
90 }
91 
92 #if defined(PETSC_HAVE_POPEN)
93 static char PetscPOpenMachine[128] = "";
94 
95 /*@C
96       PetscPClose - Closes (ends) a program on processor zero run with `PetscPOpen()`
97 
98      Collective, but only process 0 runs the command
99 
100    Input Parameters:
101 +   comm - MPI communicator, only processor zero runs the program
102 -   fp - the file pointer where program input or output may be read or NULL if don't care
103 
104    Level: intermediate
105 
106    Note:
107        Does not work under Windows
108 
109 .seealso: `PetscFOpen()`, `PetscFClose()`, `PetscPOpen()`
110 @*/
111 PetscErrorCode PetscPClose(MPI_Comm comm, FILE *fd) {
112   PetscMPIInt rank;
113 
114   PetscFunctionBegin;
115   PetscCallMPI(MPI_Comm_rank(comm, &rank));
116   if (rank == 0) {
117     char buf[1024];
118     while (fgets(buf, 1024, fd))
119       ; /* wait till it prints everything */
120     (void)pclose(fd);
121   }
122   PetscFunctionReturn(0);
123 }
124 
125 /*@C
126       PetscPOpen - Runs a program on processor zero and sends either its input or output to
127           a file.
128 
129      Logically Collective, but only process 0 runs the command
130 
131    Input Parameters:
132 +   comm - MPI communicator, only processor zero runs the program
133 .   machine - machine to run command on or NULL, or string with 0 in first location
134 .   program - name of program to run
135 -   mode - either r or w
136 
137    Output Parameter:
138 .   fp - the file pointer where program input or output may be read or NULL if don't care
139 
140    Level: intermediate
141 
142    Notes:
143        Use `PetscPClose()` to close the file pointer when you are finished with it
144 
145        Does not work under Windows
146 
147        If machine is not provided will use the value set with `PetsPOpenSetMachine()` if that was provided, otherwise
148        will use the machine running node zero of the communicator
149 
150        The program string may contain ${DISPLAY}, ${HOMEDIRECTORY} or ${WORKINGDIRECTORY}; these
151     will be replaced with relevant values.
152 
153 .seealso: `PetscFOpen()`, `PetscFClose()`, `PetscPClose()`, `PetscPOpenSetMachine()`
154 @*/
155 PetscErrorCode PetscPOpen(MPI_Comm comm, const char machine[], const char program[], const char mode[], FILE **fp) {
156   PetscMPIInt rank;
157   size_t      i, len, cnt;
158   char        commandt[PETSC_MAX_PATH_LEN], command[PETSC_MAX_PATH_LEN];
159   FILE       *fd;
160 
161   PetscFunctionBegin;
162   /* all processors have to do the string manipulation because PetscStrreplace() is a collective operation */
163   if (PetscPOpenMachine[0] || (machine && machine[0])) {
164     PetscCall(PetscStrcpy(command, "ssh "));
165     if (PetscPOpenMachine[0]) {
166       PetscCall(PetscStrcat(command, PetscPOpenMachine));
167     } else {
168       PetscCall(PetscStrcat(command, machine));
169     }
170     PetscCall(PetscStrcat(command, " \" export DISPLAY=${DISPLAY}; "));
171     /*
172         Copy program into command but protect the " with a \ in front of it
173     */
174     PetscCall(PetscStrlen(command, &cnt));
175     PetscCall(PetscStrlen(program, &len));
176     for (i = 0; i < len; i++) {
177       if (program[i] == '\"') command[cnt++] = '\\';
178       command[cnt++] = program[i];
179     }
180     command[cnt] = 0;
181 
182     PetscCall(PetscStrcat(command, "\""));
183   } else {
184     PetscCall(PetscStrcpy(command, program));
185   }
186 
187   PetscCall(PetscStrreplace(comm, command, commandt, 1024));
188 
189   PetscCallMPI(MPI_Comm_rank(comm, &rank));
190   if (rank == 0) {
191     PetscCall(PetscInfo(NULL, "Running command :%s\n", commandt));
192     PetscCheck((fd = popen(commandt, mode)), PETSC_COMM_SELF, PETSC_ERR_LIB, "Cannot run command %s", commandt);
193     if (fp) *fp = fd;
194   }
195   PetscFunctionReturn(0);
196 }
197 
198 /*@C
199       PetscPOpenSetMachine - Sets the name of the default machine to run `PetscPOpen()` calls on
200 
201      Logically Collective, but only process 0 runs the command
202 
203    Input Parameter:
204 .   machine - machine to run command on or NULL for the current machine
205 
206    Options Database Key:
207 .   -popen_machine <machine> - run the process on this machine
208 
209    Level: intermediate
210 
211 .seealso: `PetscFOpen()`, `PetscFClose()`, `PetscPClose()`, `PetscPOpen()`
212 @*/
213 PetscErrorCode PetscPOpenSetMachine(const char machine[]) {
214   PetscFunctionBegin;
215   if (machine) {
216     PetscCall(PetscStrcpy(PetscPOpenMachine, machine));
217   } else {
218     PetscPOpenMachine[0] = 0;
219   }
220   PetscFunctionReturn(0);
221 }
222 
223 #endif
224