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>

  9: /*@C
 10:   PetscFOpen - Has the first process in the MPI communicator open a file;
 11:   all others do nothing.

 13:   Logically Collective; No Fortran Support

 15:   Input Parameters:
 16: + comm - the MPI communicator
 17: . name - the filename
 18: - mode - the mode for `fopen()`, usually "w"

 20:   Output Parameter:
 21: . fp - the file pointer

 23:   Level: developer

 25:   Note:
 26:   `NULL`, "stderr" or "stdout" may be passed in as the filename

 28: .seealso: `PetscFClose()`, `PetscSynchronizedFGets()`, `PetscSynchronizedPrintf()`, `PetscSynchronizedFlush()`,
 29:           `PetscFPrintf()`
 30: @*/
 31: PetscErrorCode PetscFOpen(MPI_Comm comm, const char name[], const char mode[], FILE **fp)
 32: {
 33:   PetscMPIInt rank;
 34:   FILE       *fd;
 35:   char        fname[PETSC_MAX_PATH_LEN], tname[PETSC_MAX_PATH_LEN];

 37:   PetscFunctionBegin;
 38:   PetscCallMPI(MPI_Comm_rank(comm, &rank));
 39:   if (rank == 0) {
 40:     PetscBool isstdout, isstderr;
 41:     PetscCall(PetscStrcmp(name, "stdout", &isstdout));
 42:     PetscCall(PetscStrcmp(name, "stderr", &isstderr));
 43:     if (isstdout || !name) fd = PETSC_STDOUT;
 44:     else if (isstderr) fd = PETSC_STDERR;
 45:     else {
 46:       PetscBool devnull = PETSC_FALSE;
 47:       PetscCall(PetscStrreplace(PETSC_COMM_SELF, name, tname, PETSC_MAX_PATH_LEN));
 48:       PetscCall(PetscFixFilename(tname, fname));
 49:       PetscCall(PetscStrbeginswith(fname, "/dev/null", &devnull));
 50:       if (devnull) PetscCall(PetscStrncpy(fname, "/dev/null", sizeof(fname)));
 51:       PetscCall(PetscInfo(0, "Opening file %s\n", fname));
 52:       fd = fopen(fname, mode);
 53:       PetscCheck(fd, PETSC_COMM_SELF, PETSC_ERR_FILE_OPEN, "Unable to open file %s", fname);
 54:     }
 55:   } else fd = NULL;
 56:   *fp = fd;
 57:   PetscFunctionReturn(PETSC_SUCCESS);
 58: }

 60: /*@C
 61:   PetscFClose - Has MPI rank 0 in the communicator close a
 62:   file (usually obtained with `PetscFOpen()`; all others do nothing.

 64:   Logically Collective; No Fortran Support

 66:   Input Parameters:
 67: + comm - the MPI communicator
 68: - fd   - the file, opened with `PetscFOpen()`

 70:   Level: developer

 72: .seealso: `PetscFOpen()`
 73: @*/
 74: PetscErrorCode PetscFClose(MPI_Comm comm, FILE *fd)
 75: {
 76:   PetscMPIInt rank;
 77:   int         err;

 79:   PetscFunctionBegin;
 80:   PetscCallMPI(MPI_Comm_rank(comm, &rank));
 81:   if (rank == 0 && fd != PETSC_STDOUT && fd != PETSC_STDERR) {
 82:     err = fclose(fd);
 83:     PetscCheck(!err, PETSC_COMM_SELF, PETSC_ERR_SYS, "fclose() failed on file");
 84:   }
 85:   PetscFunctionReturn(PETSC_SUCCESS);
 86: }

 88: #if defined(PETSC_HAVE_POPEN)
 89: static char PetscPOpenMachine[128] = "";

 91: /*@C
 92:   PetscPClose - Closes (ends) a program on MPI rank 0 run with `PetscPOpen()`

 94:   Collective, but only MPI rank 0 does anything

 96:   Input Parameters:
 97: + comm - MPI communicator, only rank 0 performs the close
 98: - fd   - the file pointer where program input or output may be read or `NULL` if don't care

100:   Level: intermediate

102:   Note:
103:   Does not work under Microsoft Windows

105: .seealso: `PetscFOpen()`, `PetscFClose()`, `PetscPOpen()`
106: @*/
107: PetscErrorCode PetscPClose(MPI_Comm comm, FILE *fd)
108: {
109:   PetscMPIInt rank;

111:   PetscFunctionBegin;
112:   PetscCallMPI(MPI_Comm_rank(comm, &rank));
113:   if (rank == 0) {
114:     char buf[1024];
115:     while (fgets(buf, 1024, fd))
116:       ; /* wait till it prints everything */
117:     (void)pclose(fd);
118:   }
119:   PetscFunctionReturn(PETSC_SUCCESS);
120: }

122: /*@C
123:   PetscPOpen - Runs a program on MPI rank 0 and sends either its input or output to
124:   a file.

126:   Logically Collective, but only MPI rank 0 runs the command

128:   Input Parameters:
129: + comm    - MPI communicator, only processor zero runs the program
130: . machine - machine to run command on or `NULL`, or a string with 0 in first location
131: . program - name of program to run
132: - mode    - either "r" or "w"

134:   Output Parameter:
135: . fp - the file pointer where program input or output may be read or `NULL` if results are not needed

137:   Level: intermediate

139:   Notes:
140:   Use `PetscPClose()` to close the file pointer when you are finished with it

142:   Does not work under Microsoft Windows

144:   If machine is not provided will use the value set with `PetsPOpenSetMachine()` if that was provided, otherwise
145:   will use the machine running MPI rank 0 of the communicator

147:   The program string may contain ${DISPLAY}, ${HOMEDIRECTORY} or ${WORKINGDIRECTORY}; these
148:   will be replaced with relevant values.

150: .seealso: `PetscFOpen()`, `PetscFClose()`, `PetscPClose()`, `PetscPOpenSetMachine()`
151: @*/
152: PetscErrorCode PetscPOpen(MPI_Comm comm, const char machine[], const char program[], const char mode[], FILE **fp)
153: {
154:   PetscMPIInt rank;
155:   size_t      i, len, cnt;
156:   char        commandt[PETSC_MAX_PATH_LEN], command[PETSC_MAX_PATH_LEN];
157:   FILE       *fd;

159:   PetscFunctionBegin;
160:   /* all processors have to do the string manipulation because PetscStrreplace() is a collective operation */
161:   if (PetscPOpenMachine[0] || (machine && machine[0])) {
162:     PetscCall(PetscStrncpy(command, "ssh ", sizeof(command)));
163:     if (PetscPOpenMachine[0]) {
164:       PetscCall(PetscStrlcat(command, PetscPOpenMachine, sizeof(command)));
165:     } else {
166:       PetscCall(PetscStrlcat(command, machine, sizeof(command)));
167:     }
168:     PetscCall(PetscStrlcat(command, " \" export DISPLAY=${DISPLAY}; ", sizeof(command)));
169:     /*
170:         Copy program into command but protect the " with a \ in front of it
171:     */
172:     PetscCall(PetscStrlen(command, &cnt));
173:     PetscCall(PetscStrlen(program, &len));
174:     for (i = 0; i < len; i++) {
175:       if (program[i] == '\"') command[cnt++] = '\\';
176:       command[cnt++] = program[i];
177:     }
178:     command[cnt] = 0;

180:     PetscCall(PetscStrlcat(command, "\"", sizeof(command)));
181:   } else {
182:     PetscCall(PetscStrncpy(command, program, sizeof(command)));
183:   }

185:   PetscCall(PetscStrreplace(comm, command, commandt, 1024));

187:   PetscCallMPI(MPI_Comm_rank(comm, &rank));
188:   if (rank == 0) {
189:     PetscCall(PetscInfo(NULL, "Running command :%s\n", commandt));
190:     PetscCheck((fd = popen(commandt, mode)), PETSC_COMM_SELF, PETSC_ERR_LIB, "Cannot run command %s", commandt);
191:     if (fp) *fp = fd;
192:   }
193:   PetscFunctionReturn(PETSC_SUCCESS);
194: }

196: /*@C
197:   PetscPOpenSetMachine - Sets the name of the default machine to run `PetscPOpen()` calls on

199:   Logically Collective, but only MPI rank 0 runs the command

201:   Input Parameter:
202: . machine - machine to run command on or `NULL` for the current machine

204:   Options Database Key:
205: . -popen_machine <machine> - run the process on this machine

207:   Level: intermediate

209: .seealso: `PetscFOpen()`, `PetscFClose()`, `PetscPClose()`, `PetscPOpen()`
210: @*/
211: PetscErrorCode PetscPOpenSetMachine(const char machine[])
212: {
213:   PetscFunctionBegin;
214:   if (machine) {
215:     PetscCall(PetscStrncpy(PetscPOpenMachine, machine, sizeof(PetscPOpenMachine)));
216:   } else {
217:     PetscPOpenMachine[0] = 0;
218:   }
219:   PetscFunctionReturn(PETSC_SUCCESS);
220: }

222: #endif