1 /* Implementation of the EXECUTE_COMMAND_LINE intrinsic.
2 Copyright (C) 2009-2023 Free Software Foundation, Inc.
3 Contributed by François-Xavier Coudert.
4
5 This file is part of the GNU Fortran runtime library (libgfortran).
6
7 Libgfortran is free software; you can redistribute it and/or modify it under
8 the terms of the GNU General Public License as published by the Free
9 Software Foundation; either version 3, or (at your option) any later
10 version.
11
12 Libgfortran is distributed in the hope that it will be useful, but WITHOUT
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
15 for more details.
16
17 Under Section 7 of GPL version 3, you are granted additional
18 permissions described in the GCC Runtime Library Exception, version
19 3.1, as published by the Free Software Foundation.
20
21 You should have received a copy of the GNU General Public License and
22 a copy of the GCC Runtime Library Exception along with this program;
23 see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
24 <http://www.gnu.org/licenses/>. */
25
26 #include "libgfortran.h"
27 #include <string.h>
28
29 #ifdef HAVE_UNISTD_H
30 #include <unistd.h>
31 #endif
32 #ifdef HAVE_SYS_WAIT_H
33 #include <sys/wait.h>
34 #endif
35 #ifdef HAVE_POSIX_SPAWN
36 #include <spawn.h>
37 # ifdef __APPLE__
38 # include <crt_externs.h>
39 # define environ (*_NSGetEnviron ())
40 # else
41 extern char **environ;
42 # endif
43 #endif
44 #if defined(HAVE_POSIX_SPAWN) || defined(HAVE_FORK)
45 #include <signal.h>
46 #endif
47
48 enum { EXEC_SYNCHRONOUS = -2, EXEC_NOERROR = 0, EXEC_SYSTEMFAILED,
49 EXEC_CHILDFAILED, EXEC_INVALIDCOMMAND };
50 static const char *cmdmsg_values[] =
51 { "",
52 "Termination status of the command-language interpreter cannot be obtained",
53 "Execution of child process impossible",
54 "Invalid command line" };
55
56
57
58 static void
59 set_cmdstat (int *cmdstat, int value)
60 {
61 if (cmdstat)
62 *cmdstat = value;
63 else if (value > EXEC_NOERROR)
64 {
65 #define MSGLEN 200
66 char msg[MSGLEN] = "EXECUTE_COMMAND_LINE: ";
67 strncat (msg, cmdmsg_values[value], MSGLEN - strlen(msg) - 1);
68 runtime_error ("%s", msg);
69 }
70 }
71
72
73 #if defined(HAVE_WAITPID) && defined(HAVE_SIGACTION)
74 static void
75 sigchld_handler (int signum __attribute__((unused)))
76 {
77 while (waitpid ((pid_t)(-1), NULL, WNOHANG) > 0) {}
78 }
79 #endif
80
81 static void
82 execute_command_line (const char *command, bool wait, int *exitstat,
83 int *cmdstat, char *cmdmsg,
84 gfc_charlen_type command_len,
85 gfc_charlen_type cmdmsg_len)
86 {
87 /* Transform the Fortran string to a C string. */
88 char *cmd = fc_strdup (command, command_len);
89
90 /* Flush all I/O units before executing the command. */
91 flush_all_units();
92
93 #if defined(HAVE_POSIX_SPAWN) || defined(HAVE_FORK)
94 if (!wait)
95 {
96 /* Asynchronous execution. */
97 pid_t pid;
98
99 set_cmdstat (cmdstat, EXEC_NOERROR);
100
101 #if defined(HAVE_SIGACTION) && defined(HAVE_WAITPID)
102 static bool sig_init_saved;
103 bool sig_init = __atomic_load_n (&sig_init_saved, __ATOMIC_RELAXED);
104 if (!sig_init)
105 {
106 struct sigaction sa;
107 sa.sa_handler = &sigchld_handler;
108 sigemptyset(&sa.sa_mask);
109 sa.sa_flags = SA_RESTART | SA_NOCLDSTOP;
110 sigaction(SIGCHLD, &sa, 0);
111 __atomic_store_n (&sig_init_saved, true, __ATOMIC_RELAXED);
112 }
113 #endif
114
115 #ifdef HAVE_POSIX_SPAWN
116 const char * const argv[] = {"sh", "-c", cmd, NULL};
117 if (posix_spawn (&pid, "/bin/sh", NULL, NULL,
118 (char * const* restrict) argv, environ))
119 set_cmdstat (cmdstat, EXEC_CHILDFAILED);
120 #elif defined(HAVE_FORK)
121 if ((pid = fork()) < 0)
122 set_cmdstat (cmdstat, EXEC_CHILDFAILED);
123 else if (pid == 0)
124 {
125 /* Child process. */
126 int res = system (cmd);
127 _exit (WIFEXITED(res) ? WEXITSTATUS(res) : res);
128 }
129 #endif
130 }
131 else
132 #endif
133 {
134 /* Synchronous execution. */
135 int res = system (cmd);
136
137 if (res == -1)
138 set_cmdstat (cmdstat, EXEC_SYSTEMFAILED);
139 #if !defined(HAVE_POSIX_SPAWN) && !defined(HAVE_FORK)
140 else if (!wait)
141 set_cmdstat (cmdstat, EXEC_SYNCHRONOUS);
142 #endif
143 else if (res == 127 || res == 126
144 #if defined(WEXITSTATUS) && defined(WIFEXITED)
145 || (WIFEXITED(res) && WEXITSTATUS(res) == 127)
146 || (WIFEXITED(res) && WEXITSTATUS(res) == 126)
147 #endif
148 #ifdef __MINGW32__
149 /* cmd.exe sets the errorlevel to 9009,
150 if the command could not be executed. */
151 || res == 9009
152 #endif
153 )
154 /* Shell return codes 126 and 127 mean that the command line could
155 not be executed for various reasons. */
156 set_cmdstat (cmdstat, EXEC_INVALIDCOMMAND);
157 else
158 set_cmdstat (cmdstat, EXEC_NOERROR);
159
160 if (res != -1)
161 {
162 #if defined(WEXITSTATUS) && defined(WIFEXITED)
163 *exitstat = WIFEXITED(res) ? WEXITSTATUS(res) : res;
164 #else
165 *exitstat = res;
166 #endif
167 }
168 }
169
170 free (cmd);
171
172 /* Now copy back to the Fortran string if needed. */
173 if (cmdstat && *cmdstat > EXEC_NOERROR && cmdmsg)
174 fstrcpy (cmdmsg, cmdmsg_len, cmdmsg_values[*cmdstat],
175 strlen (cmdmsg_values[*cmdstat]));
176 }
177
178
179 extern void
180 execute_command_line_i4 (const char *command, GFC_LOGICAL_4 *wait,
181 GFC_INTEGER_4 *exitstat, GFC_INTEGER_4 *cmdstat,
182 char *cmdmsg, gfc_charlen_type command_len,
183 gfc_charlen_type cmdmsg_len);
184 export_proto(execute_command_line_i4);
185
186 void
187 execute_command_line_i4 (const char *command, GFC_LOGICAL_4 *wait,
188 GFC_INTEGER_4 *exitstat, GFC_INTEGER_4 *cmdstat,
189 char *cmdmsg, gfc_charlen_type command_len,
190 gfc_charlen_type cmdmsg_len)
191 {
192 bool w = wait ? *wait : true;
193 int estat, estat_initial, cstat;
194
195 estat_initial = 0; /* Avoid nuisance warning if not initialized. */
196
197 if (exitstat)
198 estat_initial = estat = *exitstat;
199
200 execute_command_line (command, w, &estat, cmdstat ? &cstat : NULL,
201 cmdmsg, command_len, cmdmsg_len);
202
203 if (exitstat && estat != estat_initial)
204 *exitstat = estat;
205 if (cmdstat)
206 *cmdstat = cstat;
207 }
208
209
210 extern void
211 execute_command_line_i8 (const char *command, GFC_LOGICAL_8 *wait,
212 GFC_INTEGER_8 *exitstat, GFC_INTEGER_8 *cmdstat,
213 char *cmdmsg, gfc_charlen_type command_len,
214 gfc_charlen_type cmdmsg_len);
215 export_proto(execute_command_line_i8);
216
217 void
218 execute_command_line_i8 (const char *command, GFC_LOGICAL_8 *wait,
219 GFC_INTEGER_8 *exitstat, GFC_INTEGER_8 *cmdstat,
220 char *cmdmsg, gfc_charlen_type command_len,
221 gfc_charlen_type cmdmsg_len)
222 {
223 bool w = wait ? *wait : true;
224 int estat, estat_initial, cstat;
225
226 estat_initial = 0; /* Avoid nuisance warning if not initialized. */
227
228 if (exitstat)
229 estat_initial = estat = *exitstat;
230
231 execute_command_line (command, w, &estat, cmdstat ? &cstat : NULL,
232 cmdmsg, command_len, cmdmsg_len);
233
234 if (exitstat && estat != estat_initial)
235 *exitstat = estat;
236 if (cmdstat)
237 *cmdstat = cstat;
238 }