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