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-2012, 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 #ifdef __cplusplus
  33 extern "C" {
  34 #endif
  35
  36 #ifdef IN_RTS
  37 #include "tconfig.h"
  38 #include "tsystem.h"
  39
  40 #include <sys/stat.h>
  41 #include <fcntl.h>
  42 #include <time.h>
  43 #ifdef VMS
  44 #include <unixio.h>
  45 #endif
  46
  47 #if defined (__MINGW32__)
  48 #include <stdlib.h>
  49 #endif
  50
  51 #if defined (__vxworks)
  52   #if defined (__RTP__)
  53     /* On VxWorks 6 Real-Time process mode, environ is defined in unistd.h.  */
  54     #include <unistd.h>
  55   #elif defined (VTHREADS)
  56     /* VTHREADS mode applies to both VxWorks 653 and VxWorks MILS. The
  57        inclusion of vThreadsData.h is necessary to workaround a bug with
  58        envLib.h on VxWorks MILS and VxWorks 653.  */
  59     #include <vThreadsData.h>
  60     #include <envLib.h>
  61   #else
  62     /* This should work for kernel mode on both VxWorks 5 and VxWorks 6.  */
  63     #include <envLib.h>
  64
  65     /* In that mode environ is a macro which reference the following symbol.
  66        As the symbol is not defined in any VxWorks include files we declare
  67        it as extern.  */
  68     extern char** ppGlobalEnviron;
  69   #endif
  70 #endif
  71
  72 /* We don't have libiberty, so use malloc.  */
  73 #define xmalloc(S) malloc (S)
  74 #else /* IN_RTS */
  75 #include "config.h"
  76 #include "system.h"
  77 #endif /* IN_RTS */
  78
  79 #if defined (__APPLE__)
  80 #include <crt_externs.h>
  81 #endif
  82
  83 #ifdef VMS
  84 #include <vms/descrip.h>
  85 #endif
  86
  87 #include "env.h"
  88
  89 void
  90 __gnat_getenv (char *name, int *len, char **value)
  91 {
  92   *value = getenv (name);
  93   if (!*value)
  94     *len = 0;
  95   else
  96     *len = strlen (*value);
  97
  98   return;
  99 }
 100
 101 /* VMS specific declarations for set_env_value.  */
 102
 103 #ifdef VMS
 104
 105 typedef struct _ile3
 106 {
 107   unsigned short len, code;
 108   __char_ptr32 adr;
 109   __char_ptr32 retlen_adr;
 110 } ile_s;
 111
 112 #endif
 113
 114 void
 115 __gnat_setenv (char *name, char *value)
 116 {
 117 #if defined (VMS)
 118   struct dsc$descriptor_s name_desc;
 119   $DESCRIPTOR (table_desc, "LNM$PROCESS");
 120   char *host_pathspec = value;
 121   char *copy_pathspec;
 122   int num_dirs_in_pathspec = 1;
 123   char *ptr;
 124   long status;
 125
 126   name_desc.dsc$w_length = strlen (name);
 127   name_desc.dsc$b_dtype = DSC$K_DTYPE_T;
 128   name_desc.dsc$b_class = DSC$K_CLASS_S;
 129   name_desc.dsc$a_pointer = name; /* ??? Danger, not 64bit safe.  */
 130
 131   if (*host_pathspec == 0)
 132     /* deassign */
 133     {
 134       status = LIB$DELETE_LOGICAL (&name_desc, &table_desc);
 135       /* no need to check status; if the logical name is not
 136          defined, that's fine. */
 137       return;
 138     }
 139
 140   ptr = host_pathspec;
 141   while (*ptr++)
 142     if (*ptr == ',')
 143       num_dirs_in_pathspec++;
 144
 145   {
 146     int i, status;
 147     /* Alloca is guaranteed to be 32bit.  */
 148     ile_s *ile_array = alloca (sizeof (ile_s) * (num_dirs_in_pathspec + 1));
 149     char *copy_pathspec = alloca (strlen (host_pathspec) + 1);
 150     char *curr, *next;
 151
 152     strcpy (copy_pathspec, host_pathspec);
 153     curr = copy_pathspec;
 154     for (i = 0; i < num_dirs_in_pathspec; i++)
 155       {
 156         next = strchr (curr, ',');
 157         if (next == 0)
 158           next = strchr (curr, 0);
 159
 160         *next = 0;
 161         ile_array[i].len = strlen (curr);
 162
 163         /* Code 2 from lnmdef.h means it's a string.  */
 164         ile_array[i].code = 2;
 165         ile_array[i].adr = curr;
 166
 167         /* retlen_adr is ignored.  */
 168         ile_array[i].retlen_adr = 0;
 169         curr = next + 1;
 170       }
 171
 172     /* Terminating item must be zero.  */
 173     ile_array[i].len = 0;
 174     ile_array[i].code = 0;
 175     ile_array[i].adr = 0;
 176     ile_array[i].retlen_adr = 0;
 177
 178     status = LIB$SET_LOGICAL (&name_desc, 0, &table_desc, 0, ile_array);
 179     if ((status & 1) != 1)
 180       LIB$SIGNAL (status);
 181   }
 182
 183 #elif (defined (__vxworks) && defined (__RTP__)) || defined (__APPLE__)
 184   setenv (name, value, 1);
 185
 186 #else
 187   size_t size = strlen (name) + strlen (value) + 2;
 188   char *expression;
 189
 190   expression = (char *) xmalloc (size * sizeof (char));
 191
 192   sprintf (expression, "%s=%s", name, value);
 193   putenv (expression);
 194 #if (defined (__FreeBSD__) && (__FreeBSD__ < 7)) \
 195    || defined (__MINGW32__) \
 196    ||(defined (__vxworks) && ! defined (__RTP__))
 197   /* On some systems like FreeBSD 6.x and earlier, MacOS X and Windows,
 198      putenv is making a copy of the expression string so we can free
 199      it after the call to putenv */
 200   free (expression);
 201 #endif
 202 #endif
 203 }
 204
 205 char **
 206 __gnat_environ (void)
 207 {
 208 #if defined (VMS) || defined (RTX)
 209   /* Not implemented */
 210   return NULL;
 211 #elif defined (__APPLE__)
 212   char ***result = _NSGetEnviron ();
 213   return *result;
 214 #elif defined (__MINGW32__)
 215   return _environ;
 216 #elif defined (sun)
 217   extern char **_environ;
 218   return _environ;
 219 #elif ! (defined (__vxworks))
 220   extern char **environ;
 221   return environ;
 222 #else
 223   return environ;
 224 #endif
 225 }
 226
 227 void __gnat_unsetenv (char *name) {
 228 #if defined (VMS)
 229   /* Not implemented */
 230   return;
 231 #elif defined (__hpux__) || defined (sun) \
 232      || (defined (__vxworks) && ! defined (__RTP__)) \
 233      || defined (_AIX) || defined (__Lynx__)
 234
 235   /* On Solaris and HP-UX 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) \
 290    || (defined (__vxworks) && ! defined (__RTP__)) || defined (__Lynx__)
 291   /* On Solaris, 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;
 319       expression = (char *) xmalloc (size * sizeof (char));
 320       strncpy (expression, env[0], size);
 321       expression[size - 1] = 0;
 322       __gnat_unsetenv (expression);
 323       free (expression);
 324     }
 325   }
 326 #else
 327   clearenv ();
 328 #endif
 329 }
 330
 331 #ifdef __cplusplus
 332 }
 333 #endif