xref: /petsc/src/sys/fileio/mpiuopen.c (revision 9371c9d470a9602b6d10a8bf50c9b2280a79e45a)
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     Notes:
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    Notes:
107        Does not work under Windows
108 
109 .seealso: `PetscFOpen()`, `PetscFClose()`, `PetscPOpen()`
110 
111 @*/
112 PetscErrorCode PetscPClose(MPI_Comm comm, FILE *fd) {
113   PetscMPIInt rank;
114 
115   PetscFunctionBegin;
116   PetscCallMPI(MPI_Comm_rank(comm, &rank));
117   if (rank == 0) {
118     char buf[1024];
119     while (fgets(buf, 1024, fd))
120       ; /* wait till it prints everything */
121     (void)pclose(fd);
122   }
123   PetscFunctionReturn(0);
124 }
125 
126 /*@C
127       PetscPOpen - Runs a program on processor zero and sends either its input or output to
128           a file.
129 
130      Logically Collective, but only process 0 runs the command
131 
132    Input Parameters:
133 +   comm - MPI communicator, only processor zero runs the program
134 .   machine - machine to run command on or NULL, or string with 0 in first location
135 .   program - name of program to run
136 -   mode - either r or w
137 
138    Output Parameter:
139 .   fp - the file pointer where program input or output may be read or NULL if don't care
140 
141    Level: intermediate
142 
143    Notes:
144        Use PetscPClose() to close the file pointer when you are finished with it
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 @*/
156 PetscErrorCode PetscPOpen(MPI_Comm comm, const char machine[], const char program[], const char mode[], FILE **fp) {
157   PetscMPIInt rank;
158   size_t      i, len, cnt;
159   char        commandt[PETSC_MAX_PATH_LEN], command[PETSC_MAX_PATH_LEN];
160   FILE       *fd;
161 
162   PetscFunctionBegin;
163   /* all processors have to do the string manipulation because PetscStrreplace() is a collective operation */
164   if (PetscPOpenMachine[0] || (machine && machine[0])) {
165     PetscCall(PetscStrcpy(command, "ssh "));
166     if (PetscPOpenMachine[0]) {
167       PetscCall(PetscStrcat(command, PetscPOpenMachine));
168     } else {
169       PetscCall(PetscStrcat(command, machine));
170     }
171     PetscCall(PetscStrcat(command, " \" export DISPLAY=${DISPLAY}; "));
172     /*
173         Copy program into command but protect the " with a \ in front of it
174     */
175     PetscCall(PetscStrlen(command, &cnt));
176     PetscCall(PetscStrlen(program, &len));
177     for (i = 0; i < len; i++) {
178       if (program[i] == '\"') command[cnt++] = '\\';
179       command[cnt++] = program[i];
180     }
181     command[cnt] = 0;
182 
183     PetscCall(PetscStrcat(command, "\""));
184   } else {
185     PetscCall(PetscStrcpy(command, program));
186   }
187 
188   PetscCall(PetscStrreplace(comm, command, commandt, 1024));
189 
190   PetscCallMPI(MPI_Comm_rank(comm, &rank));
191   if (rank == 0) {
192     PetscCall(PetscInfo(NULL, "Running command :%s\n", commandt));
193     PetscCheck((fd = popen(commandt, mode)), PETSC_COMM_SELF, PETSC_ERR_LIB, "Cannot run command %s", commandt);
194     if (fp) *fp = fd;
195   }
196   PetscFunctionReturn(0);
197 }
198 
199 /*@C
200       PetscPOpenSetMachine - Sets the name of the default machine to run PetscPOpen() calls on
201 
202      Logically Collective, but only process 0 runs the command
203 
204    Input Parameter:
205 .   machine - machine to run command on or NULL for the current machine
206 
207    Options Database:
208 .   -popen_machine <machine> - run the process on this machine
209 
210    Level: intermediate
211 
212 .seealso: `PetscFOpen()`, `PetscFClose()`, `PetscPClose()`, `PetscPOpen()`
213 @*/
214 PetscErrorCode PetscPOpenSetMachine(const char machine[]) {
215   PetscFunctionBegin;
216   if (machine) {
217     PetscCall(PetscStrcpy(PetscPOpenMachine, machine));
218   } else {
219     PetscPOpenMachine[0] = 0;
220   }
221   PetscFunctionReturn(0);
222 }
223 
224 #endif
225