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