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 (__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
  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
 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 **
 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
 227 void __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
 286 void __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