|
111
|
1 /****************************************************************************
|
|
|
2 * *
|
|
|
3 * GNAT COMPILER COMPONENTS *
|
|
|
4 * *
|
|
|
5 * E N V *
|
|
|
6 * *
|
|
|
7 * C Implementation File *
|
|
|
8 * *
|
|
131
|
9 * Copyright (C) 2005-2018, Free Software Foundation, Inc. *
|
|
111
|
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 3, 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. *
|
|
|
17 * *
|
|
|
18 * As a special exception under Section 7 of GPL version 3, you are granted *
|
|
|
19 * additional permissions described in the GCC Runtime Library Exception, *
|
|
|
20 * version 3.1, as published by the Free Software Foundation. *
|
|
|
21 * *
|
|
|
22 * You should have received a copy of the GNU General Public License and *
|
|
|
23 * a copy of the GCC Runtime Library Exception along with this program; *
|
|
|
24 * see the files COPYING3 and COPYING.RUNTIME respectively. If not, see *
|
|
|
25 * <http://www.gnu.org/licenses/>. *
|
|
|
26 * *
|
|
|
27 * GNAT was originally developed by the GNAT team at New York University. *
|
|
|
28 * Extensive contributions were provided by Ada Core Technologies Inc. *
|
|
|
29 * *
|
|
|
30 ****************************************************************************/
|
|
|
31
|
|
|
32 #ifdef IN_RTS
|
|
|
33 # include "tconfig.h"
|
|
|
34 # include "tsystem.h"
|
|
|
35
|
|
|
36 # include <sys/stat.h>
|
|
|
37 # include <fcntl.h>
|
|
|
38 # include <time.h>
|
|
|
39 # ifdef VMS
|
|
|
40 # include <unixio.h>
|
|
|
41 # endif
|
|
|
42 /* We don't have libiberty, so use malloc. */
|
|
|
43 # define xmalloc(S) malloc (S)
|
|
|
44 #else /* IN_RTS */
|
|
|
45 # include "config.h"
|
|
|
46 # include "system.h"
|
|
|
47 #endif /* IN_RTS */
|
|
|
48
|
|
|
49 #if defined (__MINGW32__)
|
|
|
50 #include <stdlib.h>
|
|
|
51 #endif
|
|
|
52
|
|
|
53 #if defined (__APPLE__) && !(defined (__arm__) || defined (__arm64__))
|
|
|
54 /* On Darwin, _NSGetEnviron must be used for shared libraries; but it is not
|
|
|
55 available on iOS. */
|
|
|
56 #include <crt_externs.h>
|
|
|
57 #endif
|
|
|
58
|
|
|
59 #if defined (__vxworks)
|
|
|
60 #if defined (__RTP__)
|
|
|
61 /* On VxWorks 6 Real-Time process mode, environ is defined in unistd.h. */
|
|
|
62 #include <unistd.h>
|
|
|
63 #elif defined (VTHREADS)
|
|
|
64 /* VTHREADS mode applies to both VxWorks 653 and VxWorks MILS. The
|
|
|
65 inclusion of vThreadsData.h is necessary to workaround a bug with
|
|
|
66 envLib.h on VxWorks MILS and VxWorks 653. */
|
|
|
67 #include <vThreadsData.h>
|
|
|
68 #include <envLib.h>
|
|
|
69 #else
|
|
|
70 /* This should work for kernel mode on both VxWorks 5 and VxWorks 6. */
|
|
|
71 #include <envLib.h>
|
|
|
72
|
|
|
73 /* In that mode environ is a macro which reference the following symbol.
|
|
|
74 As the symbol is not defined in any VxWorks include files we declare
|
|
|
75 it as extern. */
|
|
|
76 extern char** ppGlobalEnviron;
|
|
|
77 #endif
|
|
|
78 #endif
|
|
|
79
|
|
|
80 #ifdef __cplusplus
|
|
|
81 extern "C" {
|
|
|
82 #endif
|
|
|
83
|
|
|
84 #ifdef VMS
|
|
|
85 #include <vms/descrip.h>
|
|
|
86 #endif
|
|
|
87
|
|
|
88 #include "env.h"
|
|
|
89
|
|
|
90 void
|
|
|
91 __gnat_getenv (char *name, int *len, char **value)
|
|
|
92 {
|
|
|
93 *value = getenv (name);
|
|
|
94 if (!*value)
|
|
|
95 *len = 0;
|
|
|
96 else
|
|
|
97 *len = strlen (*value);
|
|
|
98
|
|
|
99 return;
|
|
|
100 }
|
|
|
101
|
|
|
102 /* VMS specific declarations for set_env_value. */
|
|
|
103
|
|
|
104 #ifdef VMS
|
|
|
105
|
|
|
106 typedef struct _ile3
|
|
|
107 {
|
|
|
108 unsigned short len, code;
|
|
|
109 __char_ptr32 adr;
|
|
|
110 __char_ptr32 retlen_adr;
|
|
|
111 } ile_s;
|
|
|
112
|
|
|
113 #endif
|
|
|
114
|
|
|
115 void
|
|
|
116 __gnat_setenv (char *name, char *value)
|
|
|
117 {
|
|
|
118 #if defined (VMS)
|
|
|
119 struct dsc$descriptor_s name_desc;
|
|
|
120 $DESCRIPTOR (table_desc, "LNM$PROCESS");
|
|
|
121 char *host_pathspec = value;
|
|
|
122 char *copy_pathspec;
|
|
|
123 int num_dirs_in_pathspec = 1;
|
|
|
124 char *ptr;
|
|
|
125 long status;
|
|
|
126
|
|
|
127 name_desc.dsc$w_length = strlen (name);
|
|
|
128 name_desc.dsc$b_dtype = DSC$K_DTYPE_T;
|
|
|
129 name_desc.dsc$b_class = DSC$K_CLASS_S;
|
|
|
130 name_desc.dsc$a_pointer = name; /* ??? Danger, not 64bit safe. */
|
|
|
131
|
|
|
132 if (*host_pathspec == 0)
|
|
|
133 /* deassign */
|
|
|
134 {
|
|
|
135 status = LIB$DELETE_LOGICAL (&name_desc, &table_desc);
|
|
|
136 /* no need to check status; if the logical name is not
|
|
|
137 defined, that's fine. */
|
|
|
138 return;
|
|
|
139 }
|
|
|
140
|
|
|
141 ptr = host_pathspec;
|
|
|
142 while (*ptr++)
|
|
|
143 if (*ptr == ',')
|
|
|
144 num_dirs_in_pathspec++;
|
|
|
145
|
|
|
146 {
|
|
|
147 int i, status;
|
|
|
148 /* Alloca is guaranteed to be 32bit. */
|
|
|
149 ile_s *ile_array = alloca (sizeof (ile_s) * (num_dirs_in_pathspec + 1));
|
|
|
150 char *copy_pathspec = alloca (strlen (host_pathspec) + 1);
|
|
|
151 char *curr, *next;
|
|
|
152
|
|
|
153 strcpy (copy_pathspec, host_pathspec);
|
|
|
154 curr = copy_pathspec;
|
|
|
155 for (i = 0; i < num_dirs_in_pathspec; i++)
|
|
|
156 {
|
|
|
157 next = strchr (curr, ',');
|
|
|
158 if (next == 0)
|
|
|
159 next = strchr (curr, 0);
|
|
|
160
|
|
|
161 *next = 0;
|
|
|
162 ile_array[i].len = strlen (curr);
|
|
|
163
|
|
|
164 /* Code 2 from lnmdef.h means it's a string. */
|
|
|
165 ile_array[i].code = 2;
|
|
|
166 ile_array[i].adr = curr;
|
|
|
167
|
|
|
168 /* retlen_adr is ignored. */
|
|
|
169 ile_array[i].retlen_adr = 0;
|
|
|
170 curr = next + 1;
|
|
|
171 }
|
|
|
172
|
|
|
173 /* Terminating item must be zero. */
|
|
|
174 ile_array[i].len = 0;
|
|
|
175 ile_array[i].code = 0;
|
|
|
176 ile_array[i].adr = 0;
|
|
|
177 ile_array[i].retlen_adr = 0;
|
|
|
178
|
|
|
179 status = LIB$SET_LOGICAL (&name_desc, 0, &table_desc, 0, ile_array);
|
|
|
180 if ((status & 1) != 1)
|
|
|
181 LIB$SIGNAL (status);
|
|
|
182 }
|
|
|
183
|
|
|
184 #elif (defined (__vxworks) && defined (__RTP__)) || defined (__APPLE__)
|
|
|
185 setenv (name, value, 1);
|
|
|
186
|
|
|
187 #else
|
|
|
188 size_t size = strlen (name) + strlen (value) + 2;
|
|
|
189 char *expression;
|
|
|
190
|
|
|
191 expression = (char *) xmalloc (size * sizeof (char));
|
|
|
192
|
|
|
193 sprintf (expression, "%s=%s", name, value);
|
|
|
194 putenv (expression);
|
|
|
195 #if defined (__MINGW32__) || (defined (__vxworks) && ! defined (__RTP__))
|
|
|
196 /* On some systems like MacOS X and Windows, putenv is making a copy of the
|
|
|
197 expression string so we can free it after the call to putenv */
|
|
|
198 free (expression);
|
|
|
199 #endif
|
|
|
200 #endif
|
|
|
201 }
|
|
|
202
|
|
|
203 char **
|
|
|
204 __gnat_environ (void)
|
|
|
205 {
|
|
|
206 #if defined (VMS) || defined (RTX)
|
|
|
207 /* Not implemented */
|
|
|
208 return NULL;
|
|
|
209 #elif defined (__MINGW32__)
|
|
|
210 return _environ;
|
|
|
211 #elif defined (__sun__)
|
|
|
212 extern char **_environ;
|
|
|
213 return _environ;
|
|
|
214 #elif defined (__APPLE__) && !(defined (__arm__) || defined (__arm64__))
|
|
|
215 return *_NSGetEnviron ();
|
|
|
216 #elif ! (defined (__vxworks))
|
|
|
217 extern char **environ;
|
|
|
218 return environ;
|
|
|
219 #else
|
|
|
220 return environ;
|
|
|
221 #endif
|
|
|
222 }
|
|
|
223
|
|
|
224 void __gnat_unsetenv (char *name)
|
|
|
225 {
|
|
|
226 #if defined (VMS)
|
|
|
227 /* Not implemented */
|
|
|
228 return;
|
|
|
229 #elif defined (__hpux__) || defined (__sun__) \
|
|
|
230 || (defined (__vxworks) && ! defined (__RTP__)) \
|
|
|
231 || defined (_AIX) || defined (__Lynx__)
|
|
|
232
|
|
|
233 /* On Solaris and HP-UX there is no function to clear an environment
|
|
|
234 variable. So we look for the variable in the environ table and delete it
|
|
|
235 by setting the entry to NULL. This can clearly cause some memory leaks
|
|
|
236 but free cannot be used on this context as not all strings in the environ
|
|
|
237 have been allocated using malloc. To avoid this memory leak another
|
|
|
238 method can be used. It consists in forcing the reallocation of all the
|
|
|
239 strings in the environ table using malloc on the first call on the
|
|
|
240 functions related to environment variable management. The disadvantage
|
|
|
241 is that if a program makes a direct call to getenv the return string
|
|
|
242 may be deallocated at some point. */
|
|
|
243 /* Note that on AIX, unsetenv is not supported on 5.1 but it is on 5.3.
|
|
|
244 As we are still supporting AIX 5.1 we cannot use unsetenv */
|
|
|
245 char **env = __gnat_environ ();
|
|
|
246 int index = 0;
|
|
|
247 size_t size = strlen (name);
|
|
|
248
|
|
|
249 while (env[index] != NULL) {
|
|
|
250 if (strlen (env[index]) > size) {
|
|
|
251 if (strstr (env[index], name) == env[index] &&
|
|
|
252 env[index][size] == '=') {
|
|
|
253 #if defined (__vxworks) && ! defined (__RTP__)
|
|
|
254 /* on Vxworks we are sure that the string has been allocated using
|
|
|
255 malloc */
|
|
|
256 free (env[index]);
|
|
|
257 #endif
|
|
|
258 while (env[index] != NULL) {
|
|
|
259 env[index]=env[index + 1];
|
|
|
260 index++;
|
|
|
261 }
|
|
|
262 } else
|
|
|
263 index++;
|
|
|
264 } else
|
|
|
265 index++;
|
|
|
266 }
|
|
|
267 #elif defined (__MINGW32__)
|
|
|
268 /* On Windows platform putenv ("key=") is equivalent to unsetenv (a
|
|
|
269 subsequent call to getenv ("key") will return NULL and not the "\0"
|
|
|
270 string */
|
|
|
271 size_t size = strlen (name) + 2;
|
|
|
272 char *expression;
|
|
|
273 expression = (char *) xmalloc (size * sizeof (char));
|
|
|
274
|
|
|
275 sprintf (expression, "%s=", name);
|
|
|
276 putenv (expression);
|
|
|
277 free (expression);
|
|
|
278 #else
|
|
|
279 unsetenv (name);
|
|
|
280 #endif
|
|
|
281 }
|
|
|
282
|
|
|
283 void __gnat_clearenv (void)
|
|
|
284 {
|
|
|
285 #if defined (VMS)
|
|
|
286 /* not implemented */
|
|
|
287 return;
|
|
|
288 #elif defined (__sun__) \
|
|
|
289 || (defined (__vxworks) && ! defined (__RTP__)) || defined (__Lynx__) \
|
|
|
290 || defined (__PikeOS__)
|
|
|
291 /* On Solaris, VxWorks (not RTPs), and Lynx there is no system
|
|
|
292 call to unset a variable or to clear the environment so set all
|
|
|
293 the entries in the environ table to NULL (see comment in
|
|
|
294 __gnat_unsetenv for more explanation). */
|
|
|
295 char **env = __gnat_environ ();
|
|
|
296 int index = 0;
|
|
|
297
|
|
|
298 while (env[index] != NULL) {
|
|
|
299 env[index]=NULL;
|
|
|
300 index++;
|
|
|
301 }
|
|
|
302 #elif defined (__MINGW32__) || defined (__FreeBSD__) || defined (__APPLE__) \
|
|
|
303 || (defined (__vxworks) && defined (__RTP__)) || defined (__CYGWIN__) \
|
|
|
304 || defined (__NetBSD__) || defined (__OpenBSD__) || defined (__rtems__) \
|
|
|
305 || defined (__DragonFly__) || defined (__DJGPP__)
|
|
|
306 /* On Windows, FreeBSD and MacOS there is no function to clean all the
|
|
|
307 environment but there is a "clean" way to unset a variable. So go
|
|
|
308 through the environ table and call __gnat_unsetenv on all entries */
|
|
|
309 char **env = __gnat_environ ();
|
|
|
310 size_t size;
|
|
|
311
|
|
|
312 while (env[0] != NULL) {
|
|
|
313 size = 0;
|
|
|
314 while (env[0][size] != '=')
|
|
|
315 size++;
|
|
|
316 /* create a string that contains "name" */
|
|
|
317 size++;
|
|
|
318 {
|
|
|
319 char *expression;
|
|
|
320 expression = (char *) xmalloc (size * sizeof (char));
|
|
|
321 strncpy (expression, env[0], size);
|
|
|
322 expression[size - 1] = 0;
|
|
|
323 __gnat_unsetenv (expression);
|
|
|
324 free (expression);
|
|
|
325 }
|
|
|
326 }
|
|
|
327 #else
|
|
|
328 clearenv ();
|
|
|
329 #endif
|
|
|
330 }
|
|
|
331
|
|
|
332 #ifdef __cplusplus
|
|
|
333 }
|
|
|
334 #endif
|
