libguile/simpos.c

   1 /* Copyright (C) 1995,1996,1997,1998,2000,2001, 2003, 2004 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
   6  * License as published by the Free Software Foundation; either
   7  * version 2.1 of the License, or (at your option) any later version.
   8  *
   9  * This library is distributed in the hope that it will be useful,
  10  * but 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
  17  */
  18
  19
  20 \f
  21 #if HAVE_CONFIG_H
  22 #  include <config.h>
  23 #endif
  24
  25 #include <errno.h>
  26 #include <signal.h>  /* for SIG constants */
  27 #include <stdlib.h>  /* for getenv */
  28
  29 #include "libguile/_scm.h"
  30
  31 #include "libguile/scmsigs.h"
  32 #include "libguile/strings.h"
  33
  34 #include "libguile/validate.h"
  35 #include "libguile/simpos.h"
  36 #include "libguile/dynwind.h"
  37
  38 #ifdef HAVE_STRING_H
  39 #include <string.h>
  40 #endif
  41 #ifdef HAVE_UNISTD_H
  42 #include <unistd.h>
  43 #endif
  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;
  68
  69   if (SCM_UNBNDP (cmd))
  70     {
  71       rv = system (NULL);
  72       return scm_from_bool(rv);
  73     }
  74   SCM_VALIDATE_STRING (1, cmd);
  75   errno = 0;
  76   rv = system (SCM_STRING_CHARS (cmd));
  77   if (rv == -1 || (rv == 127 && errno != 0))
  78     SCM_SYSERROR;
  79   return scm_from_int (rv);
  80 }
  81 #undef FUNC_NAME
  82 #endif /* HAVE_SYSTEM */
  83
  84
  85 #ifdef HAVE_SYSTEM
  86 #ifdef HAVE_WAITPID
  87
  88 static void
  89 free_string_pointers (void *data)
  90 {
  91   scm_i_free_string_pointers ((char **)data);
  92 }
  93
  94 SCM_DEFINE (scm_system_star, "system*", 0, 0, 1,
  95            (SCM args),
  96 "Execute the command indicated by @var{args}.  The first element must\n"
  97 "be a string indicating the command to be executed, and the remaining\n"
  98 "items must be strings representing each of the arguments to that\n"
  99 "command.\n"
 100 "\n"
 101 "This function returns the exit status of the command as provided by\n"
 102 "@code{waitpid}.  This value can be handled with @code{status:exit-val}\n"
 103 "and the related functions.\n"
 104 "\n"
 105 "@code{system*} is similar to @code{system}, but accepts only one\n"
 106 "string per-argument, and performs no shell interpretation.  The\n"
 107 "command is executed using fork and execlp.  Accordingly this function\n"
 108 "may be safer than @code{system} in situations where shell\n"
 109 "interpretation is not required.\n"
 110 "\n"
 111 "Example: (system* \"echo\" \"foo\" \"bar\")")
 112 #define FUNC_NAME s_scm_system_star
 113 {
 114   if (SCM_NULLP (args))
 115     SCM_WRONG_NUM_ARGS ();
 116
 117   if (SCM_CONSP (args))
 118     {
 119       SCM oldint;
 120       SCM oldquit;
 121       SCM sig_ign;
 122       SCM sigint;
 123       SCM sigquit;
 124       int pid;
 125       char **execargv;
 126
 127       scm_frame_begin (0);
 128
 129       /* allocate before fork */
 130       execargv = scm_i_allocate_string_pointers (args);
 131       scm_frame_unwind_handler (free_string_pointers, execargv,
 132                                 SCM_F_WIND_EXPLICITLY);
 133
 134       /* make sure the child can't kill us (as per normal system call) */
 135       sig_ign = scm_from_long ((unsigned long) SIG_IGN);
 136       sigint = scm_from_int (SIGINT);
 137       sigquit = scm_from_int (SIGQUIT);
 138       oldint = scm_sigaction (sigint, sig_ign, SCM_UNDEFINED);
 139       oldquit = scm_sigaction (sigquit, sig_ign, SCM_UNDEFINED);
 140
 141       pid = fork ();
 142       if (pid == 0)
 143         {
 144           /* child */
 145           execvp (execargv[0], execargv);
 146           SCM_SYSERROR;
 147           /* not reached.  */
 148           scm_frame_end ();
 149           return SCM_BOOL_F;
 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           scm_frame_end ();
 166           return scm_from_int (status);
 167         }
 168     }
 169   else
 170     SCM_WRONG_TYPE_ARG (1, args);
 171 }
 172 #undef FUNC_NAME
 173 #endif /* HAVE_WAITPID */
 174 #endif /* HAVE_SYSTEM */
 175
 176
 177 SCM_DEFINE (scm_getenv, "getenv", 1, 0, 0,
 178             (SCM nam),
 179             "Looks up the string @var{name} in the current environment.  The return\n"
 180             "value is @code{#f} unless a string of the form @code{NAME=VALUE} is\n"
 181             "found, in which case the string @code{VALUE} is returned.")
 182 #define FUNC_NAME s_scm_getenv
 183 {
 184   char *val;
 185   char *var = scm_to_locale_string (nam);
 186   val = getenv (var);
 187   free (var);
 188   return val ? scm_from_locale_string (val) : SCM_BOOL_F;
 189 }
 190 #undef FUNC_NAME
 191
 192 /* simple exit, without unwinding the scheme stack or flushing ports.  */
 193 SCM_DEFINE (scm_primitive_exit, "primitive-exit", 0, 1, 0,
 194             (SCM status),
 195             "Terminate the current process without unwinding the Scheme stack.\n"
 196             "This is would typically be useful after a fork.  The exit status\n"
 197             "is @var{status} if supplied, otherwise zero.")
 198 #define FUNC_NAME s_scm_primitive_exit
 199 {
 200   int cstatus = 0;
 201   if (!SCM_UNBNDP (status))
 202     cstatus = scm_to_int (status);
 203   exit (cstatus);
 204 }
 205 #undef FUNC_NAME
 206
 207
 208 void
 209 scm_init_simpos ()
 210 {
 211 #include "libguile/simpos.x"
 212 }
 213
 214
 215 /*
 216   Local Variables:
 217   c-file-style: "gnu"
 218   End:
 219 */