1190214Srpaulo/* Implementation of the EXECUTE_COMMAND_LINE intrinsic. 2190214Srpaulo Copyright (C) 2009-2020 Free Software Foundation, Inc. 3190214Srpaulo Contributed by Fran��ois-Xavier Coudert. 4190214Srpaulo 5190214SrpauloThis file is part of the GNU Fortran runtime library (libgfortran). 6190214Srpaulo 7190214SrpauloLibgfortran is free software; you can redistribute it and/or modify it under 8190214Srpaulothe terms of the GNU General Public License as published by the Free 9190214SrpauloSoftware Foundation; either version 3, or (at your option) any later 10190214Srpauloversion. 11190214Srpaulo 12190214SrpauloLibgfortran is distributed in the hope that it will be useful, but WITHOUT 13190214SrpauloANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 14190214SrpauloFITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License 15190214Srpaulofor more details. 16190214Srpaulo 17190214SrpauloUnder Section 7 of GPL version 3, you are granted additional 18190214Srpaulopermissions described in the GCC Runtime Library Exception, version 19190214Srpaulo3.1, as published by the Free Software Foundation. 20190214Srpaulo 21190214SrpauloYou should have received a copy of the GNU General Public License and 22190214Srpauloa copy of the GCC Runtime Library Exception along with this program; 23190214Srpaulosee the files COPYING3 and COPYING.RUNTIME respectively. If not, see 24190214Srpaulo<http://www.gnu.org/licenses/>. */ 25190214Srpaulo 26190214Srpaulo#include "libgfortran.h" 27190214Srpaulo#include <string.h> 28190214Srpaulo 29190214Srpaulo#ifdef HAVE_UNISTD_H 30190214Srpaulo#include <unistd.h> 31190214Srpaulo#endif 32190214Srpaulo#ifdef HAVE_SYS_WAIT_H 33190214Srpaulo#include <sys/wait.h> 34190214Srpaulo#endif 35190214Srpaulo#ifdef HAVE_POSIX_SPAWN 36190214Srpaulo#include <spawn.h> 37190214Srpaulo# ifdef __APPLE__ 38190214Srpaulo# include <crt_externs.h> 39190214Srpaulo# define environ (*_NSGetEnviron ()) 40190214Srpaulo# else 41190214Srpauloextern char **environ; 42190214Srpaulo# endif 43190214Srpaulo#endif 44190214Srpaulo#if defined(HAVE_POSIX_SPAWN) || defined(HAVE_FORK) 45190214Srpaulo#include <signal.h> 46190214Srpaulo#endif 47190214Srpaulo 48190214Srpauloenum { EXEC_SYNCHRONOUS = -2, EXEC_NOERROR = 0, EXEC_SYSTEMFAILED, 49190214Srpaulo EXEC_CHILDFAILED, EXEC_INVALIDCOMMAND }; 50190214Srpaulostatic const char *cmdmsg_values[] = 51190214Srpaulo { "", 52190214Srpaulo "Termination status of the command-language interpreter cannot be obtained", 53190214Srpaulo "Execution of child process impossible", 54190214Srpaulo "Invalid command line" }; 55190214Srpaulo 56190214Srpaulo 57190214Srpaulo 58190214Srpaulostatic void 59190214Srpauloset_cmdstat (int *cmdstat, int value) 60190214Srpaulo{ 61190214Srpaulo if (cmdstat) 62190214Srpaulo *cmdstat = value; 63190214Srpaulo else if (value > EXEC_NOERROR) 64190214Srpaulo { 65190214Srpaulo#define MSGLEN 200 66190214Srpaulo char msg[MSGLEN] = "EXECUTE_COMMAND_LINE: "; 67190214Srpaulo strncat (msg, cmdmsg_values[value], MSGLEN - strlen(msg) - 1); 68190214Srpaulo runtime_error ("%s", msg); 69276768Sdelphij } 70276768Sdelphij} 71276768Sdelphij 72276768Sdelphij 73276768Sdelphij#if defined(HAVE_WAITPID) && defined(HAVE_SIGACTION) 74276768Sdelphijstatic void 75276768Sdelphijsigchld_handler (int signum __attribute__((unused))) 76190214Srpaulo{ 77251129Sdelphij while (waitpid ((pid_t)(-1), NULL, WNOHANG) > 0) {} 78190214Srpaulo} 79190214Srpaulo#endif 80190214Srpaulo 81190214Srpaulostatic void 82190214Srpauloexecute_command_line (const char *command, bool wait, int *exitstat, 83251129Sdelphij int *cmdstat, char *cmdmsg, 84190214Srpaulo gfc_charlen_type command_len, 85190214Srpaulo gfc_charlen_type cmdmsg_len) 86190214Srpaulo{ 87190214Srpaulo /* Transform the Fortran string to a C string. */ 88190214Srpaulo char *cmd = fc_strdup (command, command_len); 89190214Srpaulo 90235426Sdelphij /* Flush all I/O units before executing the command. */ 91235426Sdelphij flush_all_units(); 92190214Srpaulo 93190214Srpaulo#if defined(HAVE_POSIX_SPAWN) || defined(HAVE_FORK) 94190214Srpaulo if (!wait) 95190214Srpaulo { 96190214Srpaulo /* Asynchronous execution. */ 97190214Srpaulo pid_t pid; 98190214Srpaulo 99190214Srpaulo set_cmdstat (cmdstat, EXEC_NOERROR); 100190214Srpaulo 101190214Srpaulo#if defined(HAVE_SIGACTION) && defined(HAVE_WAITPID) 102190214Srpaulo static bool sig_init_saved; 103190214Srpaulo bool sig_init = __atomic_load_n (&sig_init_saved, __ATOMIC_RELAXED); 104190214Srpaulo if (!sig_init) 105190214Srpaulo { 106190214Srpaulo struct sigaction sa; 107190214Srpaulo sa.sa_handler = &sigchld_handler; 108235426Sdelphij sigemptyset(&sa.sa_mask); 109235426Sdelphij sa.sa_flags = SA_RESTART | SA_NOCLDSTOP; 110235426Sdelphij sigaction(SIGCHLD, &sa, 0); 111190214Srpaulo __atomic_store_n (&sig_init_saved, true, __ATOMIC_RELAXED); 112190214Srpaulo } 113190214Srpaulo#endif 114190214Srpaulo 115190214Srpaulo#ifdef HAVE_POSIX_SPAWN 116190214Srpaulo const char * const argv[] = {"sh", "-c", cmd, NULL}; 117190214Srpaulo if (posix_spawn (&pid, "/bin/sh", NULL, NULL, 118190214Srpaulo (char * const* restrict) argv, environ)) 119190214Srpaulo set_cmdstat (cmdstat, EXEC_CHILDFAILED); 120190214Srpaulo#elif defined(HAVE_FORK) 121190214Srpaulo if ((pid = fork()) < 0) 122276768Sdelphij set_cmdstat (cmdstat, EXEC_CHILDFAILED); 123190214Srpaulo else if (pid == 0) 124190214Srpaulo { 125190214Srpaulo /* Child process. */ 126190214Srpaulo int res = system (cmd); 127190214Srpaulo _exit (WIFEXITED(res) ? WEXITSTATUS(res) : res); 128190214Srpaulo } 129190214Srpaulo#endif 130190214Srpaulo } 131190214Srpaulo else 132190214Srpaulo#endif 133190214Srpaulo { 134190214Srpaulo /* Synchronous execution. */ 135190214Srpaulo int res = system (cmd); 136190214Srpaulo 137190214Srpaulo if (res == -1) 138190214Srpaulo set_cmdstat (cmdstat, EXEC_SYSTEMFAILED); 139190214Srpaulo#if !defined(HAVE_POSIX_SPAWN) && !defined(HAVE_FORK) 140251129Sdelphij else if (!wait) 141190214Srpaulo set_cmdstat (cmdstat, EXEC_SYNCHRONOUS); 142251129Sdelphij#endif 143251129Sdelphij else if (res == 127 || res == 126 144251129Sdelphij#if defined(WEXITSTATUS) && defined(WIFEXITED) 145190214Srpaulo || (WIFEXITED(res) && WEXITSTATUS(res) == 127) 146190214Srpaulo || (WIFEXITED(res) && WEXITSTATUS(res) == 126) 147251129Sdelphij#endif 148251129Sdelphij ) 149251129Sdelphij /* Shell return codes 126 and 127 mean that the command line could 150251129Sdelphij not be executed for various reasons. */ 151251129Sdelphij set_cmdstat (cmdstat, EXEC_INVALIDCOMMAND); 152251129Sdelphij else 153251129Sdelphij set_cmdstat (cmdstat, EXEC_NOERROR); 154251129Sdelphij 155251129Sdelphij if (res != -1) 156251129Sdelphij { 157251129Sdelphij#if defined(WEXITSTATUS) && defined(WIFEXITED) 158251129Sdelphij *exitstat = WIFEXITED(res) ? WEXITSTATUS(res) : res; 159251129Sdelphij#else 160251129Sdelphij *exitstat = res; 161251129Sdelphij#endif 162251129Sdelphij } 163251129Sdelphij } 164251129Sdelphij 165251129Sdelphij free (cmd); 166251129Sdelphij 167251129Sdelphij /* Now copy back to the Fortran string if needed. */ 168251129Sdelphij if (cmdstat && *cmdstat > EXEC_NOERROR && cmdmsg) 169251129Sdelphij fstrcpy (cmdmsg, cmdmsg_len, cmdmsg_values[*cmdstat], 170251129Sdelphij strlen (cmdmsg_values[*cmdstat])); 171251129Sdelphij} 172251129Sdelphij 173251129Sdelphij 174276768Sdelphijextern void 175190214Srpauloexecute_command_line_i4 (const char *command, GFC_LOGICAL_4 *wait, 176190214Srpaulo GFC_INTEGER_4 *exitstat, GFC_INTEGER_4 *cmdstat, 177190214Srpaulo char *cmdmsg, gfc_charlen_type command_len, 178190214Srpaulo gfc_charlen_type cmdmsg_len); 179190214Srpauloexport_proto(execute_command_line_i4); 180190214Srpaulo 181190214Srpaulovoid 182190214Srpauloexecute_command_line_i4 (const char *command, GFC_LOGICAL_4 *wait, 183190214Srpaulo GFC_INTEGER_4 *exitstat, GFC_INTEGER_4 *cmdstat, 184190214Srpaulo char *cmdmsg, gfc_charlen_type command_len, 185276768Sdelphij gfc_charlen_type cmdmsg_len) 186190214Srpaulo{ 187190214Srpaulo bool w = wait ? *wait : true; 188190214Srpaulo int estat, estat_initial, cstat; 189190214Srpaulo 190190214Srpaulo if (exitstat) 191190214Srpaulo estat_initial = estat = *exitstat; 192190214Srpaulo 193190214Srpaulo execute_command_line (command, w, &estat, cmdstat ? &cstat : NULL, 194190214Srpaulo cmdmsg, command_len, cmdmsg_len); 195190214Srpaulo 196190214Srpaulo if (exitstat && estat != estat_initial) 197190214Srpaulo *exitstat = estat; 198190214Srpaulo if (cmdstat) 199190214Srpaulo *cmdstat = cstat; 200190214Srpaulo} 201190214Srpaulo 202190214Srpaulo 203190214Srpauloextern void 204190214Srpauloexecute_command_line_i8 (const char *command, GFC_LOGICAL_8 *wait, 205190214Srpaulo GFC_INTEGER_8 *exitstat, GFC_INTEGER_8 *cmdstat, 206190214Srpaulo char *cmdmsg, gfc_charlen_type command_len, 207190214Srpaulo gfc_charlen_type cmdmsg_len); 208235426Sdelphijexport_proto(execute_command_line_i8); 209190214Srpaulo 210190214Srpaulovoid 211190214Srpauloexecute_command_line_i8 (const char *command, GFC_LOGICAL_8 *wait, 212190214Srpaulo GFC_INTEGER_8 *exitstat, GFC_INTEGER_8 *cmdstat, 213190214Srpaulo char *cmdmsg, gfc_charlen_type command_len, 214276768Sdelphij gfc_charlen_type cmdmsg_len) 215190214Srpaulo{ 216190214Srpaulo bool w = wait ? *wait : true; 217190214Srpaulo int estat, estat_initial, cstat; 218190214Srpaulo 219235426Sdelphij if (exitstat) 220235426Sdelphij estat_initial = estat = *exitstat; 221190214Srpaulo 222190214Srpaulo execute_command_line (command, w, &estat, cmdstat ? &cstat : NULL, 223190214Srpaulo cmdmsg, command_len, cmdmsg_len); 224190214Srpaulo 225190214Srpaulo if (exitstat && estat != estat_initial) 226190214Srpaulo *exitstat = estat; 227190214Srpaulo if (cmdstat) 228190214Srpaulo *cmdstat = cstat; 229190214Srpaulo} 230190214Srpaulo