[thirdparty/gcc.git] / libgfortran / intrinsics / execute_command_line.c

/* Implementation of the EXECUTE_COMMAND_LINE intrinsic.
   Copyright (C) 2009-2020 Free Software Foundation, Inc.
   Contributed by François-Xavier Coudert.

This file is part of the GNU Fortran runtime library (libgfortran).

Libgfortran is free software; you can redistribute it and/or modify it under
the terms of the GNU General Public License as published by the Free
Software Foundation; either version 3, or (at your option) any later
version.

Libgfortran is distributed in the hope that it will be useful, but WITHOUT
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
for more details.

Under Section 7 of GPL version 3, you are granted additional
permissions described in the GCC Runtime Library Exception, version
3.1, as published by the Free Software Foundation.

You should have received a copy of the GNU General Public License and
a copy of the GCC Runtime Library Exception along with this program;
see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
<http://www.gnu.org/licenses/>.  */

#include "libgfortran.h"
#include <string.h>

#ifdef HAVE_UNISTD_H
#include <unistd.h>
#endif
#ifdef  HAVE_SYS_WAIT_H
#include <sys/wait.h>
#endif
#ifdef HAVE_POSIX_SPAWN
#include <spawn.h>
extern char **environ;
#endif
#if defined(HAVE_POSIX_SPAWN) || defined(HAVE_FORK)
#include <signal.h>
#endif

enum { EXEC_SYNCHRONOUS = -2, EXEC_NOERROR = 0, EXEC_SYSTEMFAILED,
       EXEC_CHILDFAILED, EXEC_INVALIDCOMMAND };
static const char *cmdmsg_values[] =
  { "",
    "Termination status of the command-language interpreter cannot be obtained",
    "Execution of child process impossible",
    "Invalid command line" };


static void
set_cmdstat (int *cmdstat, int value)
{
  if (cmdstat)
    *cmdstat = value;
  else if (value > EXEC_NOERROR)
    {
#define MSGLEN 200
      char msg[MSGLEN] = "EXECUTE_COMMAND_LINE: ";
      strncat (msg, cmdmsg_values[value], MSGLEN - strlen(msg) - 1);
      runtime_error ("%s", msg);
    }
}


#if defined(HAVE_WAITPID) && defined(HAVE_SIGACTION)
static void
sigchld_handler (int signum __attribute__((unused)))
{
  while (waitpid ((pid_t)(-1), NULL, WNOHANG) > 0) {}
}
#endif

static void
execute_command_line (const char *command, bool wait, int *exitstat,
		      int *cmdstat, char *cmdmsg,
		      gfc_charlen_type command_len,
		      gfc_charlen_type cmdmsg_len)
{
  /* Transform the Fortran string to a C string.  */
  char *cmd = fc_strdup (command, command_len);

  /* Flush all I/O units before executing the command.  */
  flush_all_units();

#if defined(HAVE_POSIX_SPAWN) || defined(HAVE_FORK)
  if (!wait)
    {
      /* Asynchronous execution.  */
      pid_t pid;

      set_cmdstat (cmdstat, EXEC_NOERROR);

#if defined(HAVE_SIGACTION) && defined(HAVE_WAITPID)
      static bool sig_init_saved;
      bool sig_init = __atomic_load_n (&sig_init_saved, __ATOMIC_RELAXED);
      if (!sig_init)
	{
	  struct sigaction sa;
	  sa.sa_handler = &sigchld_handler;
	  sigemptyset(&sa.sa_mask);
	  sa.sa_flags = SA_RESTART | SA_NOCLDSTOP;
	  sigaction(SIGCHLD, &sa, 0);
	  __atomic_store_n (&sig_init_saved, true, __ATOMIC_RELAXED);
	}
#endif

#ifdef HAVE_POSIX_SPAWN
      const char * const argv[] = {"sh", "-c", cmd, NULL};
      if (posix_spawn (&pid, "/bin/sh", NULL, NULL,
		       (char * const* restrict) argv, environ))
	set_cmdstat (cmdstat, EXEC_CHILDFAILED);
#elif defined(HAVE_FORK)
      if ((pid = fork()) < 0)
        set_cmdstat (cmdstat, EXEC_CHILDFAILED);
      else if (pid == 0)
	{
	  /* Child process.  */
	  int res = system (cmd);
	  _exit (WIFEXITED(res) ? WEXITSTATUS(res) : res);
	}
#endif
    }
  else
#endif
    {
      /* Synchronous execution.  */
      int res = system (cmd);

      if (res == -1)
	set_cmdstat (cmdstat, EXEC_SYSTEMFAILED);
#if !defined(HAVE_POSIX_SPAWN) && !defined(HAVE_FORK)
      else if (!wait)
	set_cmdstat (cmdstat, EXEC_SYNCHRONOUS);
#endif
      else if (res == 127 || res == 126
#if defined(WEXITSTATUS) && defined(WIFEXITED)
	       || (WIFEXITED(res) && WEXITSTATUS(res) == 127)
	       || (WIFEXITED(res) && WEXITSTATUS(res) == 126)
#endif
	       )
	/* Shell return codes 126 and 127 mean that the command line could
	   not be executed for various reasons.  */
	set_cmdstat (cmdstat, EXEC_INVALIDCOMMAND);
      else
	set_cmdstat (cmdstat, EXEC_NOERROR);

      if (res != -1)
	{
#if defined(WEXITSTATUS) && defined(WIFEXITED)
	  *exitstat = WIFEXITED(res) ? WEXITSTATUS(res) : res;
#else
	  *exitstat = res;
#endif
	}
    }

  free (cmd);

  /* Now copy back to the Fortran string if needed.  */
  if (cmdstat && *cmdstat > EXEC_NOERROR && cmdmsg)
    fstrcpy (cmdmsg, cmdmsg_len, cmdmsg_values[*cmdstat],
		strlen (cmdmsg_values[*cmdstat]));
}


extern void
execute_command_line_i4 (const char *command, GFC_LOGICAL_4 *wait,
			 GFC_INTEGER_4 *exitstat, GFC_INTEGER_4 *cmdstat,
			 char *cmdmsg, gfc_charlen_type command_len,
			 gfc_charlen_type cmdmsg_len);
export_proto(execute_command_line_i4);

void
execute_command_line_i4 (const char *command, GFC_LOGICAL_4 *wait,
			 GFC_INTEGER_4 *exitstat, GFC_INTEGER_4 *cmdstat,
			 char *cmdmsg, gfc_charlen_type command_len,
			 gfc_charlen_type cmdmsg_len)
{
  bool w = wait ? *wait : true;
  int estat, estat_initial, cstat;

  if (exitstat)
    estat_initial = estat = *exitstat;

  execute_command_line (command, w, &estat, cmdstat ? &cstat : NULL,
			cmdmsg, command_len, cmdmsg_len);

  if (exitstat && estat != estat_initial)
    *exitstat = estat;
  if (cmdstat)
    *cmdstat = cstat;
}


extern void
execute_command_line_i8 (const char *command, GFC_LOGICAL_8 *wait,
			 GFC_INTEGER_8 *exitstat, GFC_INTEGER_8 *cmdstat,
			 char *cmdmsg, gfc_charlen_type command_len,
			 gfc_charlen_type cmdmsg_len);
export_proto(execute_command_line_i8);

void
execute_command_line_i8 (const char *command, GFC_LOGICAL_8 *wait,
			 GFC_INTEGER_8 *exitstat, GFC_INTEGER_8 *cmdstat,
			 char *cmdmsg, gfc_charlen_type command_len,
			 gfc_charlen_type cmdmsg_len)
{
  bool w = wait ? *wait : true;
  int estat, estat_initial, cstat;

  if (exitstat)
    estat_initial = estat = *exitstat;

  execute_command_line (command, w, &estat, cmdstat ? &cstat : NULL,
			cmdmsg, command_len, cmdmsg_len);

  if (exitstat && estat != estat_initial)
    *exitstat = estat;
  if (cmdstat)
    *cmdstat = cstat;
}
Commit	Line	Data
c14c8155	1	/* Implementation of the EXECUTE_COMMAND_LINE intrinsic.
8d9254fc	2	Copyright (C) 2009-2020 Free Software Foundation, Inc.
f4742991	3	Contributed by François-Xavier Coudert.
c14c8155 FXC	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>
74544378	28
c14c8155 FXC	29	#ifdef HAVE_UNISTD_H
	30	#include <unistd.h>
	31	#endif
	32	#ifdef HAVE_SYS_WAIT_H
	33	#include <sys/wait.h>
	34	#endif
f8886038 JB	35	#ifdef HAVE_POSIX_SPAWN
	36	#include <spawn.h>
	37	extern char **environ;
	38	#endif
ef536b41 JB	39	#if defined(HAVE_POSIX_SPAWN) \|\| defined(HAVE_FORK)
	40	#include <signal.h>
	41	#endif
c14c8155	42
b4224aec	43	enum { EXEC_SYNCHRONOUS = -2, EXEC_NOERROR = 0, EXEC_SYSTEMFAILED,
1487cca0	44	EXEC_CHILDFAILED, EXEC_INVALIDCOMMAND };
c14c8155	45	static const char *cmdmsg_values[] =
b4224aec TB	46	{ "",
b4224aec TB	47	"Termination status of the command-language interpreter cannot be obtained",
1487cca0 FXC	48	"Execution of child process impossible",
1487cca0 FXC	49	"Invalid command line" };
c14c8155 FXC	50
	51
	52
	53	static void
	54	set_cmdstat (int *cmdstat, int value)
	55	{
	56	if (cmdstat)
	57	*cmdstat = value;
b4224aec	58	else if (value > EXEC_NOERROR)
1487cca0 FXC	59	{
	60	#define MSGLEN 200
	61	char msg[MSGLEN] = "EXECUTE_COMMAND_LINE: ";
	62	strncat (msg, cmdmsg_values[value], MSGLEN - strlen(msg) - 1);
f4742991	63	runtime_error ("%s", msg);
1487cca0	64	}
c14c8155 FXC	65	}
	66
	67
ef536b41 JB	68	#if defined(HAVE_WAITPID) && defined(HAVE_SIGACTION)
	69	static void
	70	sigchld_handler (int signum __attribute__((unused)))
	71	{
	72	while (waitpid ((pid_t)(-1), NULL, WNOHANG) > 0) {}
	73	}
	74	#endif
	75
c14c8155 FXC	76	static void
	77	execute_command_line (const char command, bool wait, int exitstat,
	78	int cmdstat, char cmdmsg,
	79	gfc_charlen_type command_len,
	80	gfc_charlen_type cmdmsg_len)
	81	{
	82	/* Transform the Fortran string to a C string. */
581d2326	83	char *cmd = fc_strdup (command, command_len);
c14c8155 FXC	84
	85	/* Flush all I/O units before executing the command. */
	86	flush_all_units();
	87
f8886038	88	#if defined(HAVE_POSIX_SPAWN) \|\| defined(HAVE_FORK)
c14c8155 FXC	89	if (!wait)
	90	{
	91	/* Asynchronous execution. */
	92	pid_t pid;
	93
b4224aec	94	set_cmdstat (cmdstat, EXEC_NOERROR);
c14c8155	95
ef536b41 JB	96	#if defined(HAVE_SIGACTION) && defined(HAVE_WAITPID)
	97	static bool sig_init_saved;
	98	bool sig_init = __atomic_load_n (&sig_init_saved, __ATOMIC_RELAXED);
	99	if (!sig_init)
	100	{
	101	struct sigaction sa;
	102	sa.sa_handler = &sigchld_handler;
	103	sigemptyset(&sa.sa_mask);
	104	sa.sa_flags = SA_RESTART \| SA_NOCLDSTOP;
	105	sigaction(SIGCHLD, &sa, 0);
	106	__atomic_store_n (&sig_init_saved, true, __ATOMIC_RELAXED);
	107	}
	108	#endif
	109
f8886038 JB	110	#ifdef HAVE_POSIX_SPAWN
	111	const char * const argv[] = {"sh", "-c", cmd, NULL};
	112	if (posix_spawn (&pid, "/bin/sh", NULL, NULL,
	113	(char * const* restrict) argv, environ))
b4224aec	114	set_cmdstat (cmdstat, EXEC_CHILDFAILED);
f8886038 JB	115	#elif defined(HAVE_FORK)
	116	if ((pid = fork()) < 0)
	117	set_cmdstat (cmdstat, EXEC_CHILDFAILED);
c14c8155 FXC	118	else if (pid == 0)
	119	{
	120	/* Child process. */
	121	int res = system (cmd);
	122	_exit (WIFEXITED(res) ? WEXITSTATUS(res) : res);
	123	}
f8886038	124	#endif
c14c8155 FXC	125	}
	126	else
	127	#endif
	128	{
	129	/* Synchronous execution. */
	130	int res = system (cmd);
	131
b4224aec	132	if (res == -1)
c14c8155	133	set_cmdstat (cmdstat, EXEC_SYSTEMFAILED);
f8886038	134	#if !defined(HAVE_POSIX_SPAWN) && !defined(HAVE_FORK)
b4224aec TB	135	else if (!wait)
b4224aec TB	136	set_cmdstat (cmdstat, EXEC_SYNCHRONOUS);
43b594b4	137	#endif
1487cca0 FXC	138	else if (res == 127 \|\| res == 126
	139	#if defined(WEXITSTATUS) && defined(WIFEXITED)
	140	\|\| (WIFEXITED(res) && WEXITSTATUS(res) == 127)
	141	\|\| (WIFEXITED(res) && WEXITSTATUS(res) == 126)
	142	#endif
	143	)
	144	/* Shell return codes 126 and 127 mean that the command line could
	145	not be executed for various reasons. */
	146	set_cmdstat (cmdstat, EXEC_INVALIDCOMMAND);
c14c8155	147	else
b4224aec TB	148	set_cmdstat (cmdstat, EXEC_NOERROR);
	149
	150	if (res != -1)
c14c8155	151	{
c14c8155 FXC	152	#if defined(WEXITSTATUS) && defined(WIFEXITED)
	153	*exitstat = WIFEXITED(res) ? WEXITSTATUS(res) : res;
	154	#else
	155	*exitstat = res;
	156	#endif
	157	}
	158	}
	159
581d2326 JB	160	free (cmd);
581d2326 JB	161
c14c8155	162	/* Now copy back to the Fortran string if needed. */
3934b625 TK	163	if (cmdstat && *cmdstat > EXEC_NOERROR && cmdmsg)
3934b625 TK	164	fstrcpy (cmdmsg, cmdmsg_len, cmdmsg_values[*cmdstat],
c14c8155	165	strlen (cmdmsg_values[*cmdstat]));
c14c8155 FXC	166	}
	167
	168
	169	extern void
	170	execute_command_line_i4 (const char command, GFC_LOGICAL_4 wait,
	171	GFC_INTEGER_4 exitstat, GFC_INTEGER_4 cmdstat,
	172	char *cmdmsg, gfc_charlen_type command_len,
	173	gfc_charlen_type cmdmsg_len);
	174	export_proto(execute_command_line_i4);
	175
	176	void
	177	execute_command_line_i4 (const char command, GFC_LOGICAL_4 wait,
	178	GFC_INTEGER_4 exitstat, GFC_INTEGER_4 cmdstat,
	179	char *cmdmsg, gfc_charlen_type command_len,
	180	gfc_charlen_type cmdmsg_len)
	181	{
	182	bool w = wait ? *wait : true;
	183	int estat, estat_initial, cstat;
	184
	185	if (exitstat)
	186	estat_initial = estat = *exitstat;
	187
	188	execute_command_line (command, w, &estat, cmdstat ? &cstat : NULL,
	189	cmdmsg, command_len, cmdmsg_len);
	190
	191	if (exitstat && estat != estat_initial)
	192	*exitstat = estat;
	193	if (cmdstat)
	194	*cmdstat = cstat;
	195	}
	196
	197
	198	extern void
	199	execute_command_line_i8 (const char command, GFC_LOGICAL_8 wait,
	200	GFC_INTEGER_8 exitstat, GFC_INTEGER_8 cmdstat,
	201	char *cmdmsg, gfc_charlen_type command_len,
	202	gfc_charlen_type cmdmsg_len);
	203	export_proto(execute_command_line_i8);
	204
	205	void
	206	execute_command_line_i8 (const char command, GFC_LOGICAL_8 wait,
	207	GFC_INTEGER_8 exitstat, GFC_INTEGER_8 cmdstat,
	208	char *cmdmsg, gfc_charlen_type command_len,
	209	gfc_charlen_type cmdmsg_len)
	210	{
	211	bool w = wait ? *wait : true;
	212	int estat, estat_initial, cstat;
	213
	214	if (exitstat)
	215	estat_initial = estat = *exitstat;
	216
	217	execute_command_line (command, w, &estat, cmdstat ? &cstat : NULL,
	218	cmdmsg, command_len, cmdmsg_len);
	219
	220	if (exitstat && estat != estat_initial)
	221	*exitstat = estat;
	222	if (cmdstat)
	223	*cmdstat = cstat;
	224	}