libguile/simpos.c

   1 /* Copyright (C) 1995, 1996, 1997, 1998, 2000, 2001, 2003, 2004, 2009,
   2  *   2010, 2012, 2014 Free Software Foundation, Inc.
   3  *
   4  * This library is free software; you can redistribute it and/or
   5  * modify it under the terms of the GNU Lesser General Public License
   6  * as published by the Free Software Foundation; either version 3 of
   7  * the License, or (at your option) any later version.
   8  *
   9  * This library is distributed in the hope that it will be useful, but
  10  * WITHOUT ANY WARRANTY; without even the implied warranty of
  11  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  12  * Lesser General Public License for more details.
  13  *
  14  * You should have received a copy of the GNU Lesser General Public
  15  * License along with this library; if not, write to the Free Software
  16  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  17  * 02110-1301 USA
  18  */
  19
  20
  21 \f
  22 #ifdef HAVE_CONFIG_H
  23 #  include <config.h>
  24 #endif
  25
  26 #include <errno.h>
  27 #include <signal.h>  /* for SIG constants */
  28 #include <stdlib.h>  /* for getenv */
  29 #include <stdio.h>
  30
  31 #include "libguile/_scm.h"
  32
  33 #include "libguile/scmsigs.h"
  34 #include "libguile/strings.h"
  35
  36 #include "libguile/validate.h"
  37 #include "libguile/simpos.h"
  38 #include "libguile/dynwind.h"
  39
  40 #ifdef HAVE_STRING_H
  41 #include <string.h>
  42 #endif
  43 #include <unistd.h>
  44 #if HAVE_SYS_WAIT_H
  45 # include <sys/wait.h>
  46 #endif
  47
  48 #include "posix.h"
  49
  50 \f
  51 extern int system();
  52 \f
  53
  54 #ifdef HAVE_SYSTEM
  55 SCM_DEFINE (scm_system, "system", 0, 1, 0,
  56            (SCM cmd),
  57             "Execute @var{cmd} using the operating system's \"command\n"
  58             "processor\".  Under Unix this is usually the default shell\n"
  59             "@code{sh}.  The value returned is @var{cmd}'s exit status as\n"
  60             "returned by @code{waitpid}, which can be interpreted using\n"
  61             "@code{status:exit-val} and friends.\n"
  62             "\n"
  63             "If @code{system} is called without arguments, return a boolean\n"
  64             "indicating whether the command processor is available.")
  65 #define FUNC_NAME s_scm_system
  66 {
  67   int rv, eno;
  68   char *c_cmd;
  69
  70   if (SCM_UNBNDP (cmd))
  71     {
  72       rv = system (NULL);
  73       return scm_from_bool(rv);
  74     }
  75   SCM_VALIDATE_STRING (1, cmd);
  76   errno = 0;
  77   c_cmd = scm_to_locale_string (cmd);
  78   rv = system (c_cmd);
  79   eno = errno; free (c_cmd); errno = eno;
  80   if (rv == -1 || (rv == 127 && errno != 0))
  81     SCM_SYSERROR;
  82   return scm_from_int (rv);
  83 }
  84 #undef FUNC_NAME
  85 #endif /* HAVE_SYSTEM */
  86
  87
  88 #ifdef HAVE_SYSTEM
  89 #ifdef HAVE_WAITPID
  90
  91
  92 SCM_DEFINE (scm_system_star, "system*", 0, 0, 1,
  93            (SCM args),
  94 "Execute the command indicated by @var{args}.  The first element must\n"
  95 "be a string indicating the command to be executed, and the remaining\n"
  96 "items must be strings representing each of the arguments to that\n"
  97 "command.\n"
  98 "\n"
  99 "This function returns the exit status of the command as provided by\n"
 100 "@code{waitpid}.  This value can be handled with @code{status:exit-val}\n"
 101 "and the related functions.\n"
 102 "\n"
 103 "@code{system*} is similar to @code{system}, but accepts only one\n"
 104 "string per-argument, and performs no shell interpretation.  The\n"
 105 "command is executed using fork and execlp.  Accordingly this function\n"
 106 "may be safer than @code{system} in situations where shell\n"
 107 "interpretation is not required.\n"
 108 "\n"
 109 "Example: (system* \"echo\" \"foo\" \"bar\")")
 110 #define FUNC_NAME s_scm_system_star
 111 {
 112   if (scm_is_null (args))
 113     SCM_WRONG_NUM_ARGS ();
 114
 115   if (scm_is_pair (args))
 116     {
 117       SCM oldint;
 118       SCM oldquit;
 119       SCM sig_ign;
 120       SCM sigint;
 121       SCM sigquit;
 122       int pid;
 123       char **execargv;
 124
 125       /* allocate before fork */
 126       execargv = scm_i_allocate_string_pointers (args);
 127
 128       /* make sure the child can't kill us (as per normal system call) */
 129       sig_ign = scm_from_ulong ((unsigned long) SIG_IGN);
 130       sigint = scm_from_int (SIGINT);
 131       sigquit = scm_from_int (SIGQUIT);
 132       oldint = scm_sigaction (sigint, sig_ign, SCM_UNDEFINED);
 133       oldquit = scm_sigaction (sigquit, sig_ign, SCM_UNDEFINED);
 134
 135       pid = fork ();
 136       if (pid == 0)
 137         {
 138           /* child */
 139           execvp (execargv[0], execargv);
 140
 141           /* Something went wrong.  */
 142           fprintf (stderr, "In execvp of %s: %s\n",
 143                    execargv[0], strerror (errno));
 144
 145           /* Exit directly instead of throwing, because otherwise this
 146              process may keep on running.  Use exit status 127, like
 147              shells in this case, as per POSIX
 148              <http://pubs.opengroup.org/onlinepubs/007904875/utilities/xcu_chap02.html#tag_02_09_01_01>.  */
 149           _exit (127);
 150         }
 151       else
 152         {
 153           /* parent */
 154           int wait_result, status;
 155
 156           if (pid == -1)
 157             SCM_SYSERROR;
 158
 159           SCM_SYSCALL (wait_result = waitpid (pid, &status, 0));
 160           if (wait_result == -1)
 161             SCM_SYSERROR;
 162           scm_sigaction (sigint, SCM_CAR (oldint), SCM_CDR (oldint));
 163           scm_sigaction (sigquit, SCM_CAR (oldquit), SCM_CDR (oldquit));
 164
 165           return scm_from_int (status);
 166         }
 167     }
 168   else
 169     SCM_WRONG_TYPE_ARG (1, args);
 170 }
 171 #undef FUNC_NAME
 172 #endif /* HAVE_WAITPID */
 173 #endif /* HAVE_SYSTEM */
 174
 175
 176 SCM_DEFINE (scm_getenv, "getenv", 1, 0, 0,
 177             (SCM nam),
 178             "Looks up the string @var{nam} in the current environment.  The return\n"
 179             "value is @code{#f} unless a string of the form @code{NAME=VALUE} is\n"
 180             "found, in which case the string @code{VALUE} is returned.")
 181 #define FUNC_NAME s_scm_getenv
 182 {
 183   char *val;
 184   char *var = scm_to_locale_string (nam);
 185   val = getenv (var);
 186   free (var);
 187   return val ? scm_from_locale_string (val) : SCM_BOOL_F;
 188 }
 189 #undef FUNC_NAME
 190
 191 /* simple exit, without unwinding the scheme stack or flushing ports.  */
 192 SCM_DEFINE (scm_primitive_exit, "primitive-exit", 0, 1, 0,
 193             (SCM status),
 194             "Terminate the current process without unwinding the Scheme\n"
 195             "stack.  The exit status is @var{status} if supplied, otherwise\n"
 196             "zero.")
 197 #define FUNC_NAME s_scm_primitive_exit
 198 {
 199   int cstatus = 0;
 200   if (!SCM_UNBNDP (status))
 201     cstatus = scm_to_int (status);
 202   exit (cstatus);
 203 }
 204 #undef FUNC_NAME
 205
 206 SCM_DEFINE (scm_primitive__exit, "primitive-_exit", 0, 1, 0,
 207             (SCM status),
 208             "Terminate the current process using the _exit() system call and\n"
 209             "without unwinding the Scheme stack.  The exit status is\n"
 210             "@var{status} if supplied, otherwise zero.\n"
 211             "\n"
 212             "This function is typically useful after a fork, to ensure no\n"
 213             "Scheme cleanups or @code{atexit} handlers are run (those\n"
 214             "usually belonging in the parent rather than the child).")
 215 #define FUNC_NAME s_scm_primitive__exit
 216 {
 217   int cstatus = 0;
 218   if (!SCM_UNBNDP (status))
 219     cstatus = scm_to_int (status);
 220   _exit (cstatus);
 221 }
 222 #undef FUNC_NAME
 223
 224
 225
 226 void
 227 scm_init_simpos ()
 228 {
 229 #include "libguile/simpos.x"
 230 }
 231
 232
 233 /*
 234   Local Variables:
 235   c-file-style: "gnu"
 236   End:
 237 */