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