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