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