libguile/simpos.c

   1 /* Copyright (C) 1995,1996,1997,1998,2000,2001, 2003, 2004, 2009, 2010 Free Software
   2  * 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
  30 #include "libguile/_scm.h"
  31
  32 #include "libguile/scmsigs.h"
  33 #include "libguile/strings.h"
  34
  35 #include "libguile/validate.h"
  36 #include "libguile/simpos.h"
  37 #include "libguile/dynwind.h"
  38
  39 #ifdef HAVE_STRING_H
  40 #include <string.h>
  41 #endif
  42 #ifdef HAVE_UNISTD_H
  43 #include <unistd.h>
  44 #endif
  45 #if HAVE_SYS_WAIT_H
  46 # include <sys/wait.h>
  47 #endif
  48
  49 #include "posix.h"
  50
  51 \f
  52 extern int system();
  53 \f
  54
  55 #ifdef HAVE_SYSTEM
  56 SCM_DEFINE (scm_system, "system", 0, 1, 0,
  57            (SCM cmd),
  58             "Execute @var{cmd} using the operating system's \"command\n"
  59             "processor\".  Under Unix this is usually the default shell\n"
  60             "@code{sh}.  The value returned is @var{cmd}'s exit status as\n"
  61             "returned by @code{waitpid}, which can be interpreted using\n"
  62             "@code{status:exit-val} and friends.\n"
  63             "\n"
  64             "If @code{system} is called without arguments, return a boolean\n"
  65             "indicating whether the command processor is available.")
  66 #define FUNC_NAME s_scm_system
  67 {
  68   int rv, eno;
  69   char *c_cmd;
  70
  71   if (SCM_UNBNDP (cmd))
  72     {
  73       rv = system (NULL);
  74       return scm_from_bool(rv);
  75     }
  76   SCM_VALIDATE_STRING (1, cmd);
  77   errno = 0;
  78   c_cmd = scm_to_locale_string (cmd);
  79   rv = system (c_cmd);
  80   eno = errno; free (c_cmd); errno = eno;
  81   if (rv == -1 || (rv == 127 && errno != 0))
  82     SCM_SYSERROR;
  83   return scm_from_int (rv);
  84 }
  85 #undef FUNC_NAME
  86 #endif /* HAVE_SYSTEM */
  87
  88
  89 #ifdef HAVE_SYSTEM
  90 #ifdef HAVE_WAITPID
  91
  92
  93 SCM_DEFINE (scm_system_star, "system*", 0, 0, 1,
  94            (SCM args),
  95 "Execute the command indicated by @var{args}.  The first element must\n"
  96 "be a string indicating the command to be executed, and the remaining\n"
  97 "items must be strings representing each of the arguments to that\n"
  98 "command.\n"
  99 "\n"
 100 "This function returns the exit status of the command as provided by\n"
 101 "@code{waitpid}.  This value can be handled with @code{status:exit-val}\n"
 102 "and the related functions.\n"
 103 "\n"
 104 "@code{system*} is similar to @code{system}, but accepts only one\n"
 105 "string per-argument, and performs no shell interpretation.  The\n"
 106 "command is executed using fork and execlp.  Accordingly this function\n"
 107 "may be safer than @code{system} in situations where shell\n"
 108 "interpretation is not required.\n"
 109 "\n"
 110 "Example: (system* \"echo\" \"foo\" \"bar\")")
 111 #define FUNC_NAME s_scm_system_star
 112 {
 113   if (scm_is_null (args))
 114     SCM_WRONG_NUM_ARGS ();
 115
 116   if (scm_is_pair (args))
 117     {
 118       SCM oldint;
 119       SCM oldquit;
 120       SCM sig_ign;
 121       SCM sigint;
 122       SCM sigquit;
 123       int pid;
 124       char **execargv;
 125
 126       /* allocate before fork */
 127       execargv = scm_i_allocate_string_pointers (args);
 128
 129       /* make sure the child can't kill us (as per normal system call) */
 130       sig_ign = scm_from_ulong ((unsigned long) SIG_IGN);
 131       sigint = scm_from_int (SIGINT);
 132       sigquit = scm_from_int (SIGQUIT);
 133       oldint = scm_sigaction (sigint, sig_ign, SCM_UNDEFINED);
 134       oldquit = scm_sigaction (sigquit, sig_ign, SCM_UNDEFINED);
 135
 136       pid = fork ();
 137       if (pid == 0)
 138         {
 139           /* child */
 140           execvp (execargv[0], execargv);
 141           SCM_SYSERROR;
 142           /* not reached.  */
 143           return SCM_BOOL_F;
 144         }
 145       else
 146         {
 147           /* parent */
 148           int wait_result, status;
 149
 150           if (pid == -1)
 151             SCM_SYSERROR;
 152
 153           SCM_SYSCALL (wait_result = waitpid (pid, &status, 0));
 154           if (wait_result == -1)
 155             SCM_SYSERROR;
 156           scm_sigaction (sigint, SCM_CAR (oldint), SCM_CDR (oldint));
 157           scm_sigaction (sigquit, SCM_CAR (oldquit), SCM_CDR (oldquit));
 158
 159           return scm_from_int (status);
 160         }
 161     }
 162   else
 163     SCM_WRONG_TYPE_ARG (1, args);
 164 }
 165 #undef FUNC_NAME
 166 #endif /* HAVE_WAITPID */
 167 #endif /* HAVE_SYSTEM */
 168
 169
 170 SCM_DEFINE (scm_getenv, "getenv", 1, 0, 0,
 171             (SCM nam),
 172             "Looks up the string @var{nam} in the current environment.  The return\n"
 173             "value is @code{#f} unless a string of the form @code{NAME=VALUE} is\n"
 174             "found, in which case the string @code{VALUE} is returned.")
 175 #define FUNC_NAME s_scm_getenv
 176 {
 177   char *val;
 178   char *var = scm_to_locale_string (nam);
 179   val = getenv (var);
 180   free (var);
 181   return val ? scm_from_locale_string (val) : SCM_BOOL_F;
 182 }
 183 #undef FUNC_NAME
 184
 185 /* simple exit, without unwinding the scheme stack or flushing ports.  */
 186 SCM_DEFINE (scm_primitive_exit, "primitive-exit", 0, 1, 0,
 187             (SCM status),
 188             "Terminate the current process without unwinding the Scheme\n"
 189             "stack.  The exit status is @var{status} if supplied, otherwise\n"
 190             "zero.")
 191 #define FUNC_NAME s_scm_primitive_exit
 192 {
 193   int cstatus = 0;
 194   if (!SCM_UNBNDP (status))
 195     cstatus = scm_to_int (status);
 196   exit (cstatus);
 197 }
 198 #undef FUNC_NAME
 199
 200 SCM_DEFINE (scm_primitive__exit, "primitive-_exit", 0, 1, 0,
 201             (SCM status),
 202             "Terminate the current process using the _exit() system call and\n"
 203             "without unwinding the Scheme stack.  The exit status is\n"
 204             "@var{status} if supplied, otherwise zero.\n"
 205             "\n"
 206             "This function is typically useful after a fork, to ensure no\n"
 207             "Scheme cleanups or @code{atexit} handlers are run (those\n"
 208             "usually belonging in the parent rather than the child).")
 209 #define FUNC_NAME s_scm_primitive__exit
 210 {
 211   int cstatus = 0;
 212   if (!SCM_UNBNDP (status))
 213     cstatus = scm_to_int (status);
 214   _exit (cstatus);
 215 }
 216 #undef FUNC_NAME
 217
 218
 219
 220 void
 221 scm_init_simpos ()
 222 {
 223 #include "libguile/simpos.x"
 224 }
 225
 226
 227 /*
 228   Local Variables:
 229   c-file-style: "gnu"
 230   End:
 231 */