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