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> /*I "petscsys.h" I*/ 7 #include <errno.h> 8 9 /*@C 10 PetscFOpen - Has the first process in the MPI communicator open a file; 11 all others do nothing. 12 13 Logically Collective 14 15 Input Parameters: 16 + comm - the MPI 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`, "stderr" or "stdout" may be passed in as the filename 27 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]; 36 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 } 59 60 /*@C 61 PetscFClose - Has MPI rank 0 in the communicator close a 62 file (usually obtained with `PetscFOpen()`; all others do nothing. 63 64 Logically Collective 65 66 Input Parameters: 67 + comm - the MPI communicator 68 - fd - the file, opened with `PetscFOpen()` 69 70 Level: developer 71 72 .seealso: `PetscFOpen()` 73 @*/ 74 PetscErrorCode PetscFClose(MPI_Comm comm, FILE *fd) 75 { 76 PetscMPIInt rank; 77 int err; 78 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 } 87 88 static char PetscPOpenMachine[128] = ""; 89 90 /*@C 91 PetscPClose - Closes (ends) a program on MPI rank 0 run with `PetscPOpen()` 92 93 Collective, but only MPI rank 0 does anything 94 95 Input Parameters: 96 + comm - MPI communicator, only rank 0 performs the close 97 - fd - the file pointer where program input or output may be read or `NULL` if don't care 98 99 Level: intermediate 100 101 Note: 102 Does not work under Microsoft Windows 103 104 .seealso: `PetscFOpen()`, `PetscFClose()`, `PetscPOpen()` 105 @*/ 106 PetscErrorCode PetscPClose(MPI_Comm comm, FILE *fd) 107 { 108 #if defined(PETSC_HAVE_POPEN) 109 PetscMPIInt rank; 110 #endif 111 112 PetscFunctionBegin; 113 #if defined(PETSC_HAVE_POPEN) 114 PetscCallMPI(MPI_Comm_rank(comm, &rank)); 115 if (rank == 0) { 116 char buf[1024]; 117 while (fgets(buf, 1024, fd)); /* wait till it prints everything */ 118 (void)pclose(fd); 119 } 120 #else 121 SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "pclose() - routine is unavailable."); 122 #endif 123 PetscFunctionReturn(PETSC_SUCCESS); 124 } 125 126 /*@C 127 PetscPOpen - Runs a program on MPI rank 0 and sends either its input or output to 128 a file. 129 130 Logically Collective, but only MPI rank 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 a 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 results are not needed 140 141 Level: intermediate 142 143 Notes: 144 Use `PetscPClose()` to close the file pointer when you are finished with it 145 146 Does not work under Microsoft Windows 147 148 If machine is not provided will use the value set with `PetscPOpenSetMachine()` if that was provided, otherwise 149 will use the machine running MPI rank 0 of the communicator 150 151 The program string may contain ${DISPLAY}, ${HOMEDIRECTORY} or ${WORKINGDIRECTORY}; these 152 will be replaced with relevant values. 153 154 .seealso: `PetscFOpen()`, `PetscFClose()`, `PetscPClose()`, `PetscPOpenSetMachine()` 155 @*/ 156 PetscErrorCode PetscPOpen(MPI_Comm comm, const char machine[], const char program[], const char mode[], FILE **fp) 157 { 158 #if defined(PETSC_HAVE_POPEN) 159 PetscMPIInt rank; 160 size_t i, len, cnt; 161 char commandt[PETSC_MAX_PATH_LEN], command[PETSC_MAX_PATH_LEN]; 162 FILE *fd; 163 #endif 164 165 PetscFunctionBegin; 166 #if defined(PETSC_HAVE_POPEN) 167 /* all processors have to do the string manipulation because PetscStrreplace() is a collective operation */ 168 if (PetscPOpenMachine[0] || (machine && machine[0])) { 169 PetscCall(PetscStrncpy(command, "ssh ", sizeof(command))); 170 if (PetscPOpenMachine[0]) { 171 PetscCall(PetscStrlcat(command, PetscPOpenMachine, sizeof(command))); 172 } else { 173 PetscCall(PetscStrlcat(command, machine, sizeof(command))); 174 } 175 PetscCall(PetscStrlcat(command, " \" export DISPLAY=${DISPLAY}; ", sizeof(command))); 176 /* 177 Copy program into command but protect the " with a \ in front of it 178 */ 179 PetscCall(PetscStrlen(command, &cnt)); 180 PetscCall(PetscStrlen(program, &len)); 181 for (i = 0; i < len; i++) { 182 if (program[i] == '\"') command[cnt++] = '\\'; 183 command[cnt++] = program[i]; 184 } 185 command[cnt] = 0; 186 187 PetscCall(PetscStrlcat(command, "\"", sizeof(command))); 188 } else { 189 PetscCall(PetscStrncpy(command, program, sizeof(command))); 190 } 191 192 PetscCall(PetscStrreplace(comm, command, commandt, 1024)); 193 194 PetscCallMPI(MPI_Comm_rank(comm, &rank)); 195 if (rank == 0) { 196 PetscCall(PetscInfo(NULL, "Running command :%s\n", commandt)); 197 PetscCheck(fd = popen(commandt, mode), PETSC_COMM_SELF, PETSC_ERR_LIB, "Cannot run command %s", commandt); 198 if (fp) *fp = fd; 199 } 200 #else 201 SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "popen() - system routine is unavailable."); 202 #endif 203 PetscFunctionReturn(PETSC_SUCCESS); 204 } 205 206 /*@ 207 PetscPOpenSetMachine - Sets the name of the default machine to run `PetscPOpen()` calls on 208 209 Logically Collective, but only the MPI process with rank 0 runs the command 210 211 Input Parameter: 212 . machine - machine to run command on or `NULL` for the current machine 213 214 Options Database Key: 215 . -popen_machine <machine> - run the process on this machine 216 217 Level: intermediate 218 219 .seealso: `PetscFOpen()`, `PetscFClose()`, `PetscPClose()`, `PetscPOpen()` 220 @*/ 221 PetscErrorCode PetscPOpenSetMachine(const char machine[]) 222 { 223 PetscFunctionBegin; 224 if (machine) { 225 PetscCall(PetscStrncpy(PetscPOpenMachine, machine, sizeof(PetscPOpenMachine))); 226 } else { 227 PetscPOpenMachine[0] = 0; 228 } 229 PetscFunctionReturn(PETSC_SUCCESS); 230 } 231