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-2011, 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 __cplusplus
  41 extern "C" {
  42 #endif
  43
  44 #ifdef IN_RTS
  45 #include "tconfig.h"
  46 #include "tsystem.h"
  47
  48 #include <sys/stat.h>
  49 #include <fcntl.h>
  50 #include <time.h>
  51 #ifdef VMS
  52 #include <unixio.h>
  53 #endif
  54
  55 #if defined (__MINGW32__)
  56 #include <stdlib.h>
  57 #endif
  58
  59 #if defined (__vxworks) \
  60   && ! (defined (__RTP__) || defined (__COREOS__) || defined (__VXWORKSMILS__))
  61 #include "envLib.h"
  62 extern char** ppGlobalEnviron;
  63 #endif
  64
  65 /* We don't have libiberty, so use malloc.  */
  66 #define xmalloc(S) malloc (S)
  67 #else /* IN_RTS */
  68 #include "config.h"
  69 #include "system.h"
  70 #endif /* IN_RTS */
  71
  72 #if defined (__APPLE__)
  73 #include <crt_externs.h>
  74 #endif
  75
  76 #ifdef VMS
  77 #include <vms/descrip.h>
  78 #endif
  79
  80 #include "env.h"
  81
  82 void
  83 __gnat_getenv (char *name, int *len, char **value)
  84 {
  85   *value = getenv (name);
  86   if (!*value)
  87     *len = 0;
  88   else
  89     *len = strlen (*value);
  90
  91   return;
  92 }
  93
  94 /* VMS specific declarations for set_env_value.  */
  95
  96 #ifdef VMS
  97
  98 static char *to_host_path_spec (char *);
  99
 100 typedef struct _ile3
 101 {
 102   unsigned short len, code;
 103   __char_ptr32 adr;
 104   __char_ptr32 retlen_adr;
 105 } ile_s;
 106
 107 #endif
 108
 109 void
 110 __gnat_setenv (char *name, char *value)
 111 {
 112 #if defined (VMS)
 113   struct dsc$descriptor_s name_desc;
 114   /* Put in JOB table for now, so that the project stuff at least works.  */
 115   $DESCRIPTOR (table_desc, "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.dsc$w_length = strlen (name);
 123   name_desc.dsc$b_dtype = DSC$K_DTYPE_T;
 124   name_desc.dsc$b_class = DSC$K_CLASS_S;
 125   name_desc.dsc$a_pointer = name; /* ??? Danger, not 64bit safe.  */
 126
 127   if (*host_pathspec == 0)
 128     /* deassign */
 129     {
 130       status = LIB$DELETE_LOGICAL (&name_desc, &table_desc);
 131       /* no need to check status; if the logical name is not
 132          defined, that's fine. */
 133       return;
 134     }
 135
 136   ptr = host_pathspec;
 137   while (*ptr++)
 138     if (*ptr == ',')
 139       num_dirs_in_pathspec++;
 140
 141   {
 142     int i, status;
 143     /* Alloca is guaranteed to be 32bit.  */
 144     ile_s *ile_array = alloca (sizeof (ile_s) * (num_dirs_in_pathspec + 1));
 145     char *copy_pathspec = alloca (strlen (host_pathspec) + 1);
 146     char *curr, *next;
 147
 148     strcpy (copy_pathspec, host_pathspec);
 149     curr = copy_pathspec;
 150     for (i = 0; i < num_dirs_in_pathspec; i++)
 151       {
 152         next = strchr (curr, ',');
 153         if (next == 0)
 154           next = strchr (curr, 0);
 155
 156         *next = 0;
 157         ile_array[i].len = strlen (curr);
 158
 159         /* Code 2 from lnmdef.h means it's a string.  */
 160         ile_array[i].code = 2;
 161         ile_array[i].adr = curr;
 162
 163         /* retlen_adr is ignored.  */
 164         ile_array[i].retlen_adr = 0;
 165         curr = next + 1;
 166       }
 167
 168     /* Terminating item must be zero.  */
 169     ile_array[i].len = 0;
 170     ile_array[i].code = 0;
 171     ile_array[i].adr = 0;
 172     ile_array[i].retlen_adr = 0;
 173
 174     status = LIB$SET_LOGICAL (&name_desc, 0, &table_desc, 0, ile_array);
 175     if ((status & 1) != 1)
 176       LIB$SIGNAL (status);
 177   }
 178
 179 #elif (defined (__vxworks) && defined (__RTP__)) || defined (__APPLE__)
 180   setenv (name, value, 1);
 181
 182 #else
 183   size_t size = strlen (name) + strlen (value) + 2;
 184   char *expression;
 185
 186   expression = (char *) xmalloc (size * sizeof (char));
 187
 188   sprintf (expression, "%s=%s", name, value);
 189   putenv (expression);
 190 #if (defined (__FreeBSD__) && (__FreeBSD__ < 7)) \
 191    || defined (__MINGW32__) \
 192    ||(defined (__vxworks) && ! defined (__RTP__))
 193   /* On some systems like FreeBSD 6.x and earlier, MacOS X and Windows,
 194      putenv is making a copy of the expression string so we can free
 195      it after the call to putenv */
 196   free (expression);
 197 #endif
 198 #endif
 199 }
 200
 201 char **
 202 __gnat_environ (void)
 203 {
 204 #if defined (VMS) || defined (RTX) \
 205    || (defined (VTHREADS) && ! defined (__VXWORKSMILS__))
 206   /* Not implemented */
 207   return NULL;
 208 #elif defined (__APPLE__)
 209   char ***result = _NSGetEnviron ();
 210   return *result;
 211 #elif defined (__MINGW32__)
 212   return _environ;
 213 #elif defined (sun)
 214   extern char **_environ;
 215   return _environ;
 216 #else
 217 #if ! (defined (__vxworks) \
 218    && ! (defined (__RTP__) || defined (__COREOS__) \
 219    || defined (__VXWORKSMILS__)))
 220   /* in VxWorks kernel mode environ is macro and not a variable */
 221   /* same thing on 653 in the CoreOS and for VxWorks MILS vThreads */
 222   extern char **environ;
 223 #endif
 224   return environ;
 225 #endif
 226 }
 227
 228 void __gnat_unsetenv (char *name) {
 229 #if defined (VMS)
 230   /* Not implemented */
 231   return;
 232 #elif defined (__hpux__) || defined (sun) \
 233      || (defined (__mips) && defined (__sgi)) \
 234      || (defined (__vxworks) && ! defined (__RTP__)) \
 235      || defined (_AIX) || defined (__Lynx__)
 236
 237   /* On Solaris, HP-UX and IRIX 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 #if defined (VMS)
 289   /* not implemented */
 290   return;
 291 #elif defined (sun) || (defined (__mips) && defined (__sgi)) \
 292    || (defined (__vxworks) && ! defined (__RTP__)) || defined (__Lynx__)
 293   /* On Solaris, IRIX, VxWorks (not RTPs), and Lynx there is no system
 294      call to unset a variable or to clear the environment so set all
 295      the entries in the environ table to NULL (see comment in
 296      __gnat_unsetenv for more explanation). */
 297   char **env = __gnat_environ ();
 298   int index = 0;
 299
 300   while (env[index] != NULL) {
 301     env[index]=NULL;
 302     index++;
 303   }
 304 #elif defined (__MINGW32__) || defined (__FreeBSD__) || defined (__APPLE__) \
 305    || (defined (__vxworks) && defined (__RTP__)) || defined (__CYGWIN__) \
 306    || defined (__NetBSD__) || defined (__OpenBSD__) || defined (__rtems__)
 307   /* On Windows, FreeBSD and MacOS there is no function to clean all the
 308      environment but there is a "clean" way to unset a variable. So go
 309      through the environ table and call __gnat_unsetenv on all entries */
 310   char **env = __gnat_environ ();
 311   size_t size;
 312
 313   while (env[0] != NULL) {
 314     size = 0;
 315     while (env[0][size] != '=')
 316       size++;
 317     /* create a string that contains "name" */
 318     size++;
 319     {
 320       char expression[size];
 321       strncpy (expression, env[0], size);
 322       expression[size - 1] = 0;
 323       __gnat_unsetenv (expression);
 324     }
 325   }
 326 #else
 327   clearenv ();
 328 #endif
 329 }
 330
 331 #ifdef __cplusplus
 332 }
 333 #endif