gcc/ada/env.c

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