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__)
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
81extern "C" {
82#endif
83
84#ifdef VMS
85#include <vms/descrip.h>
86#endif
87
88#include "env.h"
89
90void
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
106typedef struct _ile3
107{
108  unsigned short len, code;
109  __char_ptr32 adr;
110  __char_ptr32 retlen_adr;
111} ile_s;
112
113#endif
114
115void
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 (__FreeBSD__) && (__FreeBSD__ < 7)) \
196   || defined (__MINGW32__) \
197   ||(defined (__vxworks) && ! defined (__RTP__))
198  /* On some systems like FreeBSD 6.x and earlier, MacOS X and Windows,
199     putenv is making a copy of the expression string so we can free
200     it after the call to putenv */
201  free (expression);
202#endif
203#endif
204}
205
206char **
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__) && !defined (__arm__)
218  return *_NSGetEnviron ();
219#elif ! (defined (__vxworks))
220  extern char **environ;
221  return environ;
222#else
223  return environ;
224#endif
225}
226
227void __gnat_unsetenv (char *name)
228{
229#if defined (VMS)
230  /* Not implemented */
231  return;
232#elif defined (__hpux__) || defined (sun) \
233     || (defined (__vxworks) && ! defined (__RTP__)) \
234     || defined (_AIX) || defined (__Lynx__)
235
236  /* On Solaris and HP-UX there is no function to clear an environment
237     variable. So we look for the variable in the environ table and delete it
238     by setting the entry to NULL. This can clearly cause some memory leaks
239     but free cannot be used on this context as not all strings in the environ
240     have been allocated using malloc. To avoid this memory leak another
241     method can be used. It consists in forcing the reallocation of all the
242     strings in the environ table using malloc on the first call on the
243     functions related to environment variable management. The disadvantage
244     is that if a program makes a direct call to getenv the return string
245     may be deallocated at some point. */
246  /* Note that on AIX, unsetenv is not supported on 5.1 but it is on 5.3.
247     As we are still supporting AIX 5.1 we cannot use unsetenv */
248  char **env = __gnat_environ ();
249  int index = 0;
250  size_t size = strlen (name);
251
252  while (env[index] != NULL) {
253     if (strlen (env[index]) > size) {
254       if (strstr (env[index], name) == env[index] &&
255	   env[index][size] == '=') {
256#if defined (__vxworks) && ! defined (__RTP__)
257         /* on Vxworks we are sure that the string has been allocated using
258            malloc */
259         free (env[index]);
260#endif
261         while (env[index] != NULL) {
262          env[index]=env[index + 1];
263          index++;
264         }
265       } else
266           index++;
267     } else
268         index++;
269  }
270#elif defined (__MINGW32__)
271  /* On Windows platform putenv ("key=") is equivalent to unsetenv (a
272     subsequent call to getenv ("key") will return NULL and not the "\0"
273     string */
274  size_t size = strlen (name) + 2;
275  char *expression;
276  expression = (char *) xmalloc (size * sizeof (char));
277
278  sprintf (expression, "%s=", name);
279  putenv (expression);
280  free (expression);
281#else
282  unsetenv (name);
283#endif
284}
285
286void __gnat_clearenv (void)
287{
288#if defined (VMS)
289  /* not implemented */
290  return;
291#elif defined (sun) \
292  || (defined (__vxworks) && ! defined (__RTP__)) || defined (__Lynx__) \
293  || defined (__PikeOS__)
294  /* On Solaris, VxWorks (not RTPs), and Lynx there is no system
295     call to unset a variable or to clear the environment so set all
296     the entries in the environ table to NULL (see comment in
297     __gnat_unsetenv for more explanation). */
298  char **env = __gnat_environ ();
299  int index = 0;
300
301  while (env[index] != NULL) {
302    env[index]=NULL;
303    index++;
304  }
305#elif defined (__MINGW32__) || defined (__FreeBSD__) || defined (__APPLE__) \
306   || (defined (__vxworks) && defined (__RTP__)) || defined (__CYGWIN__) \
307   || defined (__NetBSD__) || defined (__OpenBSD__) || defined (__rtems__)
308  /* On Windows, FreeBSD and MacOS there is no function to clean all the
309     environment but there is a "clean" way to unset a variable. So go
310     through the environ table and call __gnat_unsetenv on all entries */
311  char **env = __gnat_environ ();
312  size_t size;
313
314  while (env[0] != NULL) {
315    size = 0;
316    while (env[0][size] != '=')
317      size++;
318    /* create a string that contains "name" */
319    size++;
320    {
321      char *expression;
322      expression = (char *) xmalloc (size * sizeof (char));
323      strncpy (expression, env[0], size);
324      expression[size - 1] = 0;
325      __gnat_unsetenv (expression);
326      free (expression);
327    }
328  }
329#else
330  clearenv ();
331#endif
332}
333
334#ifdef __cplusplus
335}
336#endif
337