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