/[guile]/guile/guile-core/libguile/simpos.c
ViewVC logotype

Diff of /guile/guile-core/libguile/simpos.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.53 by kryde, Fri Aug 22 23:25:02 2003 UTC revision 1.54 by rlb, Wed Nov 19 21:40:32 2003 UTC
# Line 39  Line 39 
39  #ifdef HAVE_UNISTD_H  #ifdef HAVE_UNISTD_H
40  #include <unistd.h>  #include <unistd.h>
41  #endif  #endif
42    #if HAVE_SYS_WAIT_H
43    # include <sys/wait.h>
44    #endif
45    
46    #include "posix.h"
47    
48    
49  extern int system();  extern int system();
50    
51    
52  #ifdef HAVE_SYSTEM  #ifdef HAVE_SYSTEM
53  SCM_DEFINE (scm_system, "system", 0, 1, 0,  SCM_DEFINE (scm_system, "system", 0, 1, 0,
54             (SCM cmd),             (SCM cmd),
55              "Execute @var{cmd} using the operating system's \"command\n"              "Execute @var{cmd} using the operating system's \"command\n"
56              "processor\".  Under Unix this is usually the default shell\n"              "processor\".  Under Unix this is usually the default shell\n"
# Line 63  SCM_DEFINE (scm_system, "system", 0, 1, Line 68  SCM_DEFINE (scm_system, "system", 0, 1,
68      {      {
69        rv = system (NULL);        rv = system (NULL);
70        return SCM_BOOL(rv);        return SCM_BOOL(rv);
71      }      }  
72    SCM_VALIDATE_STRING (1, cmd);    SCM_VALIDATE_STRING (1, cmd);
73    errno = 0;    errno = 0;
74    rv = system (SCM_STRING_CHARS (cmd));    rv = system (SCM_STRING_CHARS (cmd));
# Line 74  SCM_DEFINE (scm_system, "system", 0, 1, Line 79  SCM_DEFINE (scm_system, "system", 0, 1,
79  #undef FUNC_NAME  #undef FUNC_NAME
80  #endif /* HAVE_SYSTEM */  #endif /* HAVE_SYSTEM */
81    
82    
83    #ifdef HAVE_SYSTEM
84    #ifdef HAVE_WAITPID
85    
86    /* return a newly allocated array of char pointers to each of the strings
87       in args, with a terminating NULL pointer.  */
88    /* Note: a similar function is defined in dynl.c, but we don't necessarily
89       want to export it.  */
90    static char **
91    allocate_string_pointers (SCM args)
92    {
93      char **result;
94      int n_args = scm_ilength (args);
95      int i;
96    
97      SCM_ASSERT (n_args >= 0, args, SCM_ARGn, "allocate_string_pointers");
98      result = (char **) scm_malloc ((n_args + 1) * sizeof (char *));
99      result[n_args] = NULL;
100      for (i = 0; i < n_args; i++)
101        {
102          SCM car = SCM_CAR (args);
103    
104          if (!SCM_STRINGP (car))
105            {
106              free (result);
107              scm_wrong_type_arg ("allocate_string_pointers", SCM_ARGn, car);
108            }
109          result[i] = SCM_STRING_CHARS (SCM_CAR (args));
110          args = SCM_CDR (args);
111        }
112      return result;
113    }
114    
115    SCM_DEFINE (scm_system_star, "system*", 0, 0, 1,
116               (SCM args),
117    "Execute the command indicated by @var{args}.  The first element must\n"
118    "be a string indicating the command to be executed, and the remaining\n"
119    "items must be strings representing each of the arguments to that\n"
120    "command.\n"
121    "\n"
122    "This function returns the exit status of the command as provided by\n"
123    "@code{waitpid}.  This value can be handled with @code{status:exit-val}\n"
124    "and the related functions.\n"
125    "\n"
126    "@code{system*} is similar to @code{system}, but accepts only one\n"
127    "string per-argument, and performs no shell interpretation.  The\n"
128    "command is executed using fork and execlp.  Accordingly this function\n"
129    "may be safer than @code{system} in situations where shell\n"
130    "interpretation is not required.\n"
131    "\n"
132    "Example: (system* \"echo\" \"foo\" \"bar\")")
133    #define FUNC_NAME s_scm_system_star
134    {
135      if (SCM_NULLP (args))
136        SCM_WRONG_NUM_ARGS ();
137    
138      if (SCM_CONSP (args))
139        {
140          SCM oldint;
141          SCM oldquit;
142          SCM sig_ign;
143          SCM sigint;
144          SCM sigquit;
145          int pid;
146          char **execargv;
147    
148          SCM_VALIDATE_STRING (1, SCM_CAR (args));
149          /* allocate before fork */
150          execargv = allocate_string_pointers (args);
151    
152          /* make sure the child can't kill us (as per normal system call) */
153          sig_ign = scm_long2num ((long) SIG_IGN);
154          sigint = scm_long2num (SIGINT);
155          sigquit = scm_long2num (SIGQUIT);
156          oldint = scm_sigaction (sigint, sig_ign, SCM_UNDEFINED);
157          oldquit = scm_sigaction (sigquit, sig_ign, SCM_UNDEFINED);
158          
159          pid = fork ();
160          if (pid == -1)
161            SCM_SYSERROR;
162          else if (pid)
163            {
164              int wait_result;
165              int status;
166              SCM_SYSCALL (wait_result = waitpid (pid, &status, 0));
167              if (wait_result == -1) SCM_SYSERROR;
168              scm_sigaction (sigint, SCM_CAR (oldint), SCM_CDR (oldint));
169              scm_sigaction (sigquit, SCM_CAR (oldquit), SCM_CDR (oldquit));
170              scm_remember_upto_here_2 (oldint, oldquit);
171              return SCM_MAKINUM (0L + status);
172            }
173          else
174            {
175              execvp (SCM_STRING_CHARS (SCM_CAR (args)), execargv);
176              scm_remember_upto_here_1 (args);
177              SCM_SYSERROR;
178              /* not reached.  */
179              return SCM_BOOL_F;
180            }
181        }
182      else
183        SCM_WRONG_TYPE_ARG (1, SCM_CAR (args));
184    }
185    #undef FUNC_NAME
186    #endif /* HAVE_WAITPID */
187    #endif /* HAVE_SYSTEM */
188    
189    
190  SCM_DEFINE (scm_getenv, "getenv", 1, 0, 0,  SCM_DEFINE (scm_getenv, "getenv", 1, 0, 0,
191              (SCM nam),              (SCM nam),
192              "Looks up the string @var{name} in the current environment.  The return\n"              "Looks up the string @var{name} in the current environment.  The return\n"

Legend:
Removed from v.1.53  
changed lines
  Added in v.1.54

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26