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