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