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-2006, 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 2,  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.  See the GNU General Public License *
  17  * for  more details.  You should have  received  a copy of the GNU General *
  18  * Public License  distributed with GNAT;  see file COPYING.  If not, write *
  19  * to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, *
  20  * Boston, MA 02110-1301, USA.                                              *
  21  *                                                                          *
  22  * As a  special  exception,  if you  link  this file  with other  files to *
  23  * produce an executable,  this file does not by itself cause the resulting *
  24  * executable to be covered by the GNU General Public License. This except- *
  25  * ion does not  however invalidate  any other reasons  why the  executable *
  26  * file might be covered by the  GNU Public License.                        *
  27  *                                                                          *
  28  * GNAT was originally developed  by the GNAT team at  New York University. *
  29  * Extensive contributions were provided by Ada Core Technologies Inc.      *
  30  *                                                                          *
  31  ****************************************************************************/
  32
  33 #ifdef IN_RTS
  34 #include "tconfig.h"
  35 #include "tsystem.h"
  36
  37 #include <sys/stat.h>
  38 #include <fcntl.h>
  39 #include <time.h>
  40 #ifdef VMS
  41 #include <unixio.h>
  42 #endif
  43
  44 #if defined (__APPLE__)
  45 #include <crt_externs.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 #include "env.h"
  65
  66 void
  67 __gnat_getenv (char *name, int *len, char **value)
  68 {
  69   *value = getenv (name);
  70   if (!*value)
  71     *len = 0;
  72   else
  73     *len = strlen (*value);
  74
  75   return;
  76 }
  77
  78 /* VMS specific declarations for set_env_value.  */
  79
  80 #ifdef VMS
  81
  82 static char *to_host_path_spec (char *);
  83
  84 struct descriptor_s
  85 {
  86   unsigned short len, mbz;
  87   __char_ptr32 adr;
  88 };
  89
  90 typedef struct _ile3
  91 {
  92   unsigned short len, code;
  93   __char_ptr32 adr;
  94   unsigned short *retlen_adr;
  95 } ile_s;
  96
  97 #endif
  98
  99 void
 100 __gnat_setenv (char *name, char *value)
 101 {
 102 #ifdef MSDOS
 103
 104 #elif defined (VMS)
 105   struct descriptor_s name_desc;
 106   /* Put in JOB table for now, so that the project stuff at least works.  */
 107   struct descriptor_s table_desc = {7, 0, "LNM$JOB"};
 108   char *host_pathspec = value;
 109   char *copy_pathspec;
 110   int num_dirs_in_pathspec = 1;
 111   char *ptr;
 112   long status;
 113
 114   name_desc.len = strlen (name);
 115   name_desc.mbz = 0;
 116   name_desc.adr = name;
 117
 118   if (*host_pathspec == 0)
 119     /* deassign */
 120     {
 121       status = LIB$DELETE_LOGICAL (&name_desc, &table_desc);
 122       /* no need to check status; if the logical name is not
 123          defined, that's fine. */
 124       return;
 125     }
 126
 127   ptr = host_pathspec;
 128   while (*ptr++)
 129     if (*ptr == ',')
 130       num_dirs_in_pathspec++;
 131
 132   {
 133     int i, status;
 134     ile_s *ile_array = alloca (sizeof (ile_s) * (num_dirs_in_pathspec + 1));
 135     char *copy_pathspec = alloca (strlen (host_pathspec) + 1);
 136     char *curr, *next;
 137
 138     strcpy (copy_pathspec, host_pathspec);
 139     curr = copy_pathspec;
 140     for (i = 0; i < num_dirs_in_pathspec; i++)
 141       {
 142         next = strchr (curr, ',');
 143         if (next == 0)
 144           next = strchr (curr, 0);
 145
 146         *next = 0;
 147         ile_array[i].len = strlen (curr);
 148
 149         /* Code 2 from lnmdef.h means it's a string.  */
 150         ile_array[i].code = 2;
 151         ile_array[i].adr = curr;
 152
 153         /* retlen_adr is ignored.  */
 154         ile_array[i].retlen_adr = 0;
 155         curr = next + 1;
 156       }
 157
 158     /* Terminating item must be zero.  */
 159     ile_array[i].len = 0;
 160     ile_array[i].code = 0;
 161     ile_array[i].adr = 0;
 162     ile_array[i].retlen_adr = 0;
 163
 164     status = LIB$SET_LOGICAL (&name_desc, 0, &table_desc, 0, ile_array);
 165     if ((status & 1) != 1)
 166       LIB$SIGNAL (status);
 167   }
 168
 169 #elif defined (__vxworks) && defined (__RTP__)
 170   setenv (name, value, 1);
 171
 172 #else
 173   size_t size = strlen (name) + strlen (value) + 2;
 174   char *expression;
 175
 176   expression = (char *) xmalloc (size * sizeof (char));
 177
 178   sprintf (expression, "%s=%s", name, value);
 179   putenv (expression);
 180 #if defined (__FreeBSD__) || defined (__APPLE__) || defined (__MINGW32__) \
 181    ||(defined (__vxworks) && ! defined (__RTP__))
 182   /* On some systems like FreeBSD, MacOS X and Windows, putenv is making
 183      a copy of the expression string so we can free it after the call to
 184      putenv */
 185   free (expression);
 186 #endif
 187 #endif
 188 }
 189
 190 char **
 191 __gnat_environ (void)
 192 {
 193 #if defined (VMS)
 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   /* On Windows, FreeBSD and MacOS there is no function to clean all the
 293      environment but there is a "clean" way to unset a variable. So go
 294      through the environ table and call __gnat_unsetenv on all entries */
 295   char **env = __gnat_environ ();
 296   size_t size;
 297
 298   while (env[0] != NULL) {
 299     size = 0;
 300     while (env[0][size] != '=')
 301       size++;
 302     /* create a string that contains "name" */
 303     size++;
 304     {
 305       char expression[size];
 306       strncpy (expression, env[0], size);
 307       expression[size - 1] = 0;
 308       __gnat_unsetenv (expression);
 309     }
 310   }
 311 #else
 312   clearenv ();
 313 #endif
 314 }