1 /* Copyright 1995-1998,2000-2001,2003-2004,2009-2014,2018
2 Free Software Foundation, Inc.
3
4 This file is part of Guile.
5
6 Guile is free software: you can redistribute it and/or modify it
7 under the terms of the GNU Lesser General Public License as published
8 by the Free Software Foundation, either version 3 of the License, or
9 (at your option) any later version.
10
11 Guile is distributed in the hope that it will be useful, but WITHOUT
12 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
13 FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public
14 License for more details.
15
16 You should have received a copy of the GNU Lesser General Public
17 License along with Guile. If not, see
18 <https://www.gnu.org/licenses/>. */
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 "boolean.h"
31 #include "gsubr.h"
32 #include "numbers.h"
33 #include "strings.h"
34
35 #include "simpos.h"
36
37
38
39 #ifdef HAVE_SYSTEM
40 SCM_DEFINE (scm_system, "system", 0, 1, 0,
41 (SCM cmd),
42 "Execute @var{cmd} using the operating system's \"command\n"
43 "processor\". Under Unix this is usually the default shell\n"
44 "@code{sh}. The value returned is @var{cmd}'s exit status as\n"
45 "returned by @code{waitpid}, which can be interpreted using\n"
46 "@code{status:exit-val} and friends.\n"
47 "\n"
48 "If @code{system} is called without arguments, return a boolean\n"
49 "indicating whether the command processor is available.")
50 #define FUNC_NAME s_scm_system
51 {
52 int rv, eno;
53 char *c_cmd;
54
55 if (SCM_UNBNDP (cmd))
56 {
57 rv = system (NULL);
58 return scm_from_bool (rv);
59 }
60 SCM_VALIDATE_STRING (1, cmd);
61 errno = 0;
62 c_cmd = scm_to_locale_string (cmd);
63 rv = system (c_cmd);
64 eno = errno; free (c_cmd); errno = eno;
65 if (rv == -1 || (rv == 127 && errno != 0))
66 SCM_SYSERROR;
67 return scm_from_int (rv);
68 }
69 #undef FUNC_NAME
70 #endif /* HAVE_SYSTEM */
71
72
73 SCM_DEFINE (scm_getenv, "getenv", 1, 0, 0,
74 (SCM nam),
75 "Looks up the string @var{nam} in the current environment. The return\n"
76 "value is @code{#f} unless a string of the form @code{NAME=VALUE} is\n"
77 "found, in which case the string @code{VALUE} is returned.")
78 #define FUNC_NAME s_scm_getenv
79 {
80 char *val;
81 char *var = scm_to_locale_string (nam);
82 val = getenv (var);
83 free (var);
84 return val ? scm_from_locale_string (val) : SCM_BOOL_F;
85 }
86 #undef FUNC_NAME
87
88 /* Get an integer from an environment variable. */
89 int
scm_getenv_int(const char * var,int def)90 scm_getenv_int (const char *var, int def)
91 {
92 char *end = 0;
93 char *val = getenv (var);
94 long res = def;
95 if (!val)
96 return def;
97 res = strtol (val, &end, 10);
98 if (end == val)
99 return def;
100 return res;
101 }
102
103 /* simple exit, without unwinding the scheme stack or flushing ports. */
104 SCM_DEFINE (scm_primitive_exit, "primitive-exit", 0, 1, 0,
105 (SCM status),
106 "Terminate the current process without unwinding the Scheme\n"
107 "stack. The exit status is @var{status} if supplied, otherwise\n"
108 "zero.")
109 #define FUNC_NAME s_scm_primitive_exit
110 {
111 int cstatus = 0;
112 if (!SCM_UNBNDP (status))
113 cstatus = scm_to_int (status);
114 exit (cstatus);
115 }
116 #undef FUNC_NAME
117
118 SCM_DEFINE (scm_primitive__exit, "primitive-_exit", 0, 1, 0,
119 (SCM status),
120 "Terminate the current process using the _exit() system call and\n"
121 "without unwinding the Scheme stack. The exit status is\n"
122 "@var{status} if supplied, otherwise zero.\n"
123 "\n"
124 "This function is typically useful after a fork, to ensure no\n"
125 "Scheme cleanups or @code{atexit} handlers are run (those\n"
126 "usually belonging in the parent rather than the child).")
127 #define FUNC_NAME s_scm_primitive__exit
128 {
129 int cstatus = 0;
130 if (!SCM_UNBNDP (status))
131 cstatus = scm_to_int (status);
132 _exit (cstatus);
133 }
134 #undef FUNC_NAME
135
136
137
138 void
scm_init_simpos()139 scm_init_simpos ()
140 {
141 #include "simpos.x"
142 }
143
144