]>
Commit | Line | Data |
---|---|---|
0022d9e3 PO |
1 | /**************************************************************************** |
2 | * * | |
3 | * GNAT COMPILER COMPONENTS * | |
4 | * * | |
5 | * E N V * | |
6 | * * | |
7 | * C Implementation File * | |
8 | * * | |
9 | * Copyright (C) 2005-2006, Free Software Foundation, Inc. * | |
10 | * * | |
11 | * GNAT is free software; you can redistribute it and/or modify it under * | |
12 | * terms of the GNU General Public License as published by the Free Soft- * | |
13 | * ware Foundation; either version 2, or (at your option) any later ver- * | |
14 | * sion. GNAT is distributed in the hope that it will be useful, but WITH- * | |
15 | * OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY * | |
16 | * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License * | |
17 | * for more details. You should have received a copy of the GNU General * | |
18 | * Public License distributed with GNAT; see file COPYING. If not, write * | |
19 | * to the Free Software Foundation, 51 Franklin Street, Fifth Floor, * | |
20 | * Boston, MA 02110-1301, USA. * | |
21 | * * | |
22 | * As a special exception, if you link this file with other files to * | |
23 | * produce an executable, this file does not by itself cause the resulting * | |
24 | * executable to be covered by the GNU General Public License. This except- * | |
25 | * ion does not however invalidate any other reasons why the executable * | |
26 | * file might be covered by the GNU Public License. * | |
27 | * * | |
28 | * GNAT was originally developed by the GNAT team at New York University. * | |
29 | * Extensive contributions were provided by Ada Core Technologies Inc. * | |
30 | * * | |
31 | ****************************************************************************/ | |
32 | ||
33 | #ifdef IN_RTS | |
34 | #include "tconfig.h" | |
35 | #include "tsystem.h" | |
36 | ||
37 | #include <sys/stat.h> | |
38 | #include <fcntl.h> | |
39 | #include <time.h> | |
40 | #ifdef VMS | |
41 | #include <unixio.h> | |
42 | #endif | |
43 | ||
44 | #if defined (__APPLE__) | |
45 | #include <crt_externs.h> | |
46 | #endif | |
47 | ||
48 | #if defined (__MINGW32__) | |
49 | #include <stdlib.h> | |
50 | #endif | |
51 | ||
52 | #if defined (__vxworks) && ! (defined (__RTP__) || defined (__COREOS__)) | |
53 | #include "envLib.h" | |
54 | extern char** ppGlobalEnviron; | |
55 | #endif | |
56 | ||
57 | /* We don't have libiberty, so use malloc. */ | |
58 | #define xmalloc(S) malloc (S) | |
59 | #else /* IN_RTS */ | |
60 | #include "config.h" | |
61 | #include "system.h" | |
62 | #endif /* IN_RTS */ | |
63 | ||
64 | #include "env.h" | |
65 | ||
66 | void | |
67 | __gnat_getenv (char *name, int *len, char **value) | |
68 | { | |
69 | *value = getenv (name); | |
70 | if (!*value) | |
71 | *len = 0; | |
72 | else | |
73 | *len = strlen (*value); | |
74 | ||
75 | return; | |
76 | } | |
77 | ||
78 | /* VMS specific declarations for set_env_value. */ | |
79 | ||
80 | #ifdef VMS | |
81 | ||
82 | static char *to_host_path_spec (char *); | |
83 | ||
84 | struct descriptor_s | |
85 | { | |
86 | unsigned short len, mbz; | |
87 | __char_ptr32 adr; | |
88 | }; | |
89 | ||
90 | typedef struct _ile3 | |
91 | { | |
92 | unsigned short len, code; | |
93 | __char_ptr32 adr; | |
94 | unsigned short *retlen_adr; | |
95 | } ile_s; | |
96 | ||
97 | #endif | |
98 | ||
99 | void | |
100 | __gnat_setenv (char *name, char *value) | |
101 | { | |
102 | #ifdef MSDOS | |
103 | ||
104 | #elif defined (VMS) | |
105 | struct descriptor_s name_desc; | |
106 | /* Put in JOB table for now, so that the project stuff at least works. */ | |
107 | struct descriptor_s table_desc = {7, 0, "LNM$JOB"}; | |
108 | char *host_pathspec = value; | |
109 | char *copy_pathspec; | |
110 | int num_dirs_in_pathspec = 1; | |
111 | char *ptr; | |
112 | long status; | |
113 | ||
114 | name_desc.len = strlen (name); | |
115 | name_desc.mbz = 0; | |
116 | name_desc.adr = name; | |
117 | ||
118 | if (*host_pathspec == 0) | |
119 | /* deassign */ | |
120 | { | |
121 | status = LIB$DELETE_LOGICAL (&name_desc, &table_desc); | |
122 | /* no need to check status; if the logical name is not | |
123 | defined, that's fine. */ | |
124 | return; | |
125 | } | |
126 | ||
127 | ptr = host_pathspec; | |
128 | while (*ptr++) | |
129 | if (*ptr == ',') | |
130 | num_dirs_in_pathspec++; | |
131 | ||
132 | { | |
133 | int i, status; | |
134 | ile_s *ile_array = alloca (sizeof (ile_s) * (num_dirs_in_pathspec + 1)); | |
135 | char *copy_pathspec = alloca (strlen (host_pathspec) + 1); | |
136 | char *curr, *next; | |
137 | ||
138 | strcpy (copy_pathspec, host_pathspec); | |
139 | curr = copy_pathspec; | |
140 | for (i = 0; i < num_dirs_in_pathspec; i++) | |
141 | { | |
142 | next = strchr (curr, ','); | |
143 | if (next == 0) | |
144 | next = strchr (curr, 0); | |
145 | ||
146 | *next = 0; | |
147 | ile_array[i].len = strlen (curr); | |
148 | ||
149 | /* Code 2 from lnmdef.h means it's a string. */ | |
150 | ile_array[i].code = 2; | |
151 | ile_array[i].adr = curr; | |
152 | ||
153 | /* retlen_adr is ignored. */ | |
154 | ile_array[i].retlen_adr = 0; | |
155 | curr = next + 1; | |
156 | } | |
157 | ||
158 | /* Terminating item must be zero. */ | |
159 | ile_array[i].len = 0; | |
160 | ile_array[i].code = 0; | |
161 | ile_array[i].adr = 0; | |
162 | ile_array[i].retlen_adr = 0; | |
163 | ||
164 | status = LIB$SET_LOGICAL (&name_desc, 0, &table_desc, 0, ile_array); | |
165 | if ((status & 1) != 1) | |
166 | LIB$SIGNAL (status); | |
167 | } | |
168 | ||
169 | #elif defined (__vxworks) && defined (__RTP__) | |
170 | setenv (name, value, 1); | |
171 | ||
172 | #else | |
fd7927cd | 173 | size_t size = strlen (name) + strlen (value) + 2; |
0022d9e3 PO |
174 | char *expression; |
175 | ||
176 | expression = (char *) xmalloc (size * sizeof (char)); | |
177 | ||
178 | sprintf (expression, "%s=%s", name, value); | |
179 | putenv (expression); | |
180 | #if defined (__FreeBSD__) || defined (__APPLE__) || defined (__MINGW32__) \ | |
181 | ||(defined (__vxworks) && ! defined (__RTP__)) | |
182 | /* On some systems like FreeBSD, MacOS X and Windows, putenv is making | |
183 | a copy of the expression string so we can free it after the call to | |
184 | putenv */ | |
185 | free (expression); | |
186 | #endif | |
187 | #endif | |
188 | } | |
189 | ||
190 | char ** | |
191 | __gnat_environ (void) | |
192 | { | |
193 | #if defined (VMS) | |
194 | /* Not implemented */ | |
195 | return NULL; | |
196 | #elif defined (__APPLE__) | |
197 | char ***result = _NSGetEnviron (); | |
198 | return *result; | |
199 | #elif defined (__MINGW32__) | |
200 | return _environ; | |
201 | #elif defined (sun) | |
202 | extern char **_environ; | |
203 | return _environ; | |
204 | #else | |
205 | #if ! (defined (__vxworks) && ! (defined (__RTP__) || defined (__COREOS__))) | |
206 | /* in VxWorks kernel mode environ is macro and not a variable */ | |
207 | /* same thing on 653 in the CoreOS */ | |
208 | extern char **environ; | |
209 | #endif | |
210 | return environ; | |
211 | #endif | |
212 | } | |
213 | ||
214 | void __gnat_unsetenv (char *name) { | |
215 | #if defined (VMS) | |
216 | /* Not implemented */ | |
217 | return; | |
218 | #elif defined (__hpux__) || defined (sun) \ | |
219 | || (defined (__mips) && defined (__sgi)) \ | |
220 | || (defined (__vxworks) && ! defined (__RTP__)) \ | |
221 | || defined (_AIX) | |
222 | ||
223 | /* On Solaris, HP-UX and IRIX there is no function to clear an environment | |
224 | variable. So we look for the variable in the environ table and delete it | |
225 | by setting the entry to NULL. This can clearly cause some memory leaks | |
226 | but free cannot be used on this context as not all strings in the environ | |
227 | have been allocated using malloc. To avoid this memory leak another | |
228 | method can be used. It consists in forcing the reallocation of all the | |
229 | strings in the environ table using malloc on the first call on the | |
230 | functions related to environment variable management. The disavantage | |
231 | is that if a program makes a direct call to getenv the return string | |
232 | may be deallocated at some point. */ | |
233 | /* Note that on AIX, unsetenv is not supported on 5.1 but it is on 5.3. | |
234 | As we are still supporting AIX 5.1 we cannot use unsetenv */ | |
235 | char **env = __gnat_environ (); | |
236 | int index = 0; | |
fd7927cd | 237 | size_t size = strlen (name); |
0022d9e3 PO |
238 | |
239 | while (env[index] != NULL) { | |
240 | if (strlen (env[index]) > size) { | |
241 | if (strstr (env[index], name) == env[index] && | |
242 | env[index][size] == '=') { | |
243 | #if defined (__vxworks) && ! defined (__RTP__) | |
244 | /* on Vxworks we are sure that the string has been allocated using | |
245 | malloc */ | |
246 | free (env[index]); | |
247 | #endif | |
248 | while (env[index] != NULL) { | |
249 | env[index]=env[index + 1]; | |
250 | index++; | |
251 | } | |
252 | } else | |
253 | index++; | |
254 | } else | |
255 | index++; | |
256 | } | |
257 | #elif defined (__MINGW32__) | |
258 | /* On Windows platform putenv ("key=") is equivalent to unsetenv (a | |
259 | subsequent call to getenv ("key") will return NULL and not the "\0" | |
260 | string */ | |
fd7927cd | 261 | size_t size = strlen (name) + 2; |
0022d9e3 PO |
262 | char *expression; |
263 | expression = (char *) xmalloc (size * sizeof (char)); | |
264 | ||
265 | sprintf (expression, "%s=", name); | |
266 | putenv (expression); | |
267 | free (expression); | |
268 | #else | |
269 | unsetenv (name); | |
270 | #endif | |
271 | } | |
272 | ||
273 | void __gnat_clearenv (void) { | |
274 | #if defined (VMS) | |
275 | /* not implemented */ | |
276 | return; | |
277 | #elif defined (sun) || (defined (__mips) && defined (__sgi)) \ | |
278 | || (defined (__vxworks) && ! defined (__RTP__)) || defined (__Lynx__) | |
279 | /* On Solaris, IRIX, VxWorks (not RTPs), and Lynx there is no system | |
280 | call to unset a variable or to clear the environment so set all | |
281 | the entries in the environ table to NULL (see comment in | |
282 | __gnat_unsetenv for more explanation). */ | |
283 | char **env = __gnat_environ (); | |
284 | int index = 0; | |
285 | ||
286 | while (env[index] != NULL) { | |
287 | env[index]=NULL; | |
288 | index++; | |
289 | } | |
290 | #elif defined (__MINGW32__) || defined (__FreeBSD__) || defined (__APPLE__) \ | |
291 | || (defined (__vxworks) && defined (__RTP__)) | |
292 | /* On Windows, FreeBSD and MacOS there is no function to clean all the | |
293 | environment but there is a "clean" way to unset a variable. So go | |
294 | through the environ table and call __gnat_unsetenv on all entries */ | |
295 | char **env = __gnat_environ (); | |
fd7927cd | 296 | size_t size; |
0022d9e3 PO |
297 | |
298 | while (env[0] != NULL) { | |
299 | size = 0; | |
300 | while (env[0][size] != '=') | |
301 | size++; | |
302 | /* create a string that contains "name" */ | |
303 | size++; | |
304 | { | |
305 | char expression[size]; | |
306 | strncpy (expression, env[0], size); | |
307 | expression[size - 1] = 0; | |
308 | __gnat_unsetenv (expression); | |
309 | } | |
310 | } | |
311 | #else | |
312 | clearenv (); | |
313 | #endif | |
314 | } |