1 /****************************************************************************
2 * *
3 * GNAT COMPILER COMPONENTS *
4 * *
5 * E N V *
6 * *
7 * C Implementation File *
8 * *
9 * Copyright (C) 2005-2015, 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 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
__gnat_getenv(char * name,int * len,char ** value)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
__gnat_setenv(char * name,char * value)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 **
__gnat_environ(void)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
__gnat_unsetenv(char * name)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
__gnat_clearenv(void)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__)
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
335