1 /* Copyright (C) 1995, 1996, 1997, 1998, 2000, 2001, 2003, 2004, 2009,
2 * 2010, 2012, 2013, 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
22 #ifdef HAVE_CONFIG_H
23 # include <config.h>
24 #endif
25
26 #include <errno.h>
27 #include <stdlib.h> /* for getenv, system, exit, free */
28 #include <unistd.h> /* for _exit */
29
30 #include "libguile/_scm.h"
31
32 #include "libguile/strings.h"
33 #include "libguile/validate.h"
34 #include "libguile/simpos.h"
35
36
37
38 #ifdef HAVE_SYSTEM
39 SCM_DEFINE (scm_system, "system", 0, 1, 0,
40 (SCM cmd),
41 "Execute @var{cmd} using the operating system's \"command\n"
42 "processor\". Under Unix this is usually the default shell\n"
43 "@code{sh}. The value returned is @var{cmd}'s exit status as\n"
44 "returned by @code{waitpid}, which can be interpreted using\n"
45 "@code{status:exit-val} and friends.\n"
46 "\n"
47 "If @code{system} is called without arguments, return a boolean\n"
48 "indicating whether the command processor is available.")
49 #define FUNC_NAME s_scm_system
50 {
51 int rv, eno;
52 char *c_cmd;
53
54 if (SCM_UNBNDP (cmd))
55 {
56 rv = system (NULL);
57 return scm_from_bool (rv);
58 }
59 SCM_VALIDATE_STRING (1, cmd);
60 errno = 0;
61 c_cmd = scm_to_locale_string (cmd);
62 rv = system (c_cmd);
63 eno = errno; free (c_cmd); errno = eno;
64 if (rv == -1 || (rv == 127 && errno != 0))
65 SCM_SYSERROR;
66 return scm_from_int (rv);
67 }
68 #undef FUNC_NAME
69 #endif /* HAVE_SYSTEM */
70
71
72 SCM_DEFINE (scm_getenv, "getenv", 1, 0, 0,
73 (SCM nam),
74 "Looks up the string @var{nam} in the current environment. The return\n"
75 "value is @code{#f} unless a string of the form @code{NAME=VALUE} is\n"
76 "found, in which case the string @code{VALUE} is returned.")
77 #define FUNC_NAME s_scm_getenv
78 {
79 char *val;
80 char *var = scm_to_locale_string (nam);
81 val = getenv (var);
82 free (var);
83 return val ? scm_from_locale_string (val) : SCM_BOOL_F;
84 }
85 #undef FUNC_NAME
86
87 /* Get an integer from an environment variable. */
88 int
scm_getenv_int(const char * var,int def)89 scm_getenv_int (const char *var, int def)
90 {
91 char *end = 0;
92 char *val = getenv (var);
93 long res = def;
94 if (!val)
95 return def;
96 res = strtol (val, &end, 10);
97 if (end == val)
98 return def;
99 return res;
100 }
101
102 /* simple exit, without unwinding the scheme stack or flushing ports. */
103 SCM_DEFINE (scm_primitive_exit, "primitive-exit", 0, 1, 0,
104 (SCM status),
105 "Terminate the current process without unwinding the Scheme\n"
106 "stack. The exit status is @var{status} if supplied, otherwise\n"
107 "zero.")
108 #define FUNC_NAME s_scm_primitive_exit
109 {
110 int cstatus = 0;
111 if (!SCM_UNBNDP (status))
112 cstatus = scm_to_int (status);
113 exit (cstatus);
114 }
115 #undef FUNC_NAME
116
117 SCM_DEFINE (scm_primitive__exit, "primitive-_exit", 0, 1, 0,
118 (SCM status),
119 "Terminate the current process using the _exit() system call and\n"
120 "without unwinding the Scheme stack. The exit status is\n"
121 "@var{status} if supplied, otherwise zero.\n"
122 "\n"
123 "This function is typically useful after a fork, to ensure no\n"
124 "Scheme cleanups or @code{atexit} handlers are run (those\n"
125 "usually belonging in the parent rather than the child).")
126 #define FUNC_NAME s_scm_primitive__exit
127 {
128 int cstatus = 0;
129 if (!SCM_UNBNDP (status))
130 cstatus = scm_to_int (status);
131 _exit (cstatus);
132 }
133 #undef FUNC_NAME
134
135
136
137 void
scm_init_simpos()138 scm_init_simpos ()
139 {
140 #include "libguile/simpos.x"
141 }
142
143
144 /*
145 Local Variables:
146 c-file-style: "gnu"
147 End:
148 */
149