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-2008, 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 (__MINGW32__)
  45 #include <stdlib.h>
  46 #endif
  47
  48 #if defined (__vxworks) && ! (defined (__RTP__) || defined (__COREOS__))
  49 #include "envLib.h"
  50 extern char** ppGlobalEnviron;
  51 #endif
  52
  53 /* We don't have libiberty, so use malloc.  */
  54 #define xmalloc(S) malloc (S)
  55 #else /* IN_RTS */
  56 #include "config.h"
  57 #include "system.h"
  58 #endif /* IN_RTS */
  59
  60 #if defined (__APPLE__)
  61 #include <crt_externs.h>
  62 #endif
  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__)) || defined (__APPLE__)
 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__) && (__FreeBSD__ < 7)) \
 181    || defined (__MINGW32__) \
 182    ||(defined (__vxworks) && ! defined (__RTP__))
 183   /* On some systems like FreeBSD 6.x and earlier, MacOS X and Windows,
 184      putenv is making a copy of the expression string so we can free
 185      it after the call to putenv */
 186   free (expression);
 187 #endif
 188 #endif
 189 }
 190
 191 char **
 192 __gnat_environ (void)
 193 {
 194 #if defined (VMS)
 195   /* Not implemented */
 196   return NULL;
 197 #elif defined (__APPLE__)
 198   char ***result = _NSGetEnviron ();
 199   return *result;
 200 #elif defined (__MINGW32__)
 201   return _environ;
 202 #elif defined (sun)
 203   extern char **_environ;
 204   return _environ;
 205 #else
 206 #if ! (defined (__vxworks) && ! (defined (__RTP__) || defined (__COREOS__)))
 207   /* in VxWorks kernel mode environ is macro and not a variable */
 208   /* same thing on 653 in the CoreOS */
 209   extern char **environ;
 210 #endif
 211   return environ;
 212 #endif
 213 }
 214
 215 void __gnat_unsetenv (char *name) {
 216 #if defined (VMS)
 217   /* Not implemented */
 218   return;
 219 #elif defined (__hpux__) || defined (sun) \
 220      || (defined (__mips) && defined (__sgi)) \
 221      || (defined (__vxworks) && ! defined (__RTP__)) \
 222      || defined (_AIX) || defined (__Lynx__)
 223
 224   /* On Solaris, HP-UX and IRIX there is no function to clear an environment
 225      variable. So we look for the variable in the environ table and delete it
 226      by setting the entry to NULL. This can clearly cause some memory leaks
 227      but free cannot be used on this context as not all strings in the environ
 228      have been allocated using malloc. To avoid this memory leak another
 229      method can be used. It consists in forcing the reallocation of all the
 230      strings in the environ table using malloc on the first call on the
 231      functions related to environment variable management. The disadvantage
 232      is that if a program makes a direct call to getenv the return string
 233      may be deallocated at some point. */
 234   /* Note that on AIX, unsetenv is not supported on 5.1 but it is on 5.3.
 235      As we are still supporting AIX 5.1 we cannot use unsetenv */
 236   char **env = __gnat_environ ();
 237   int index = 0;
 238   size_t size = strlen (name);
 239
 240   while (env[index] != NULL) {
 241      if (strlen (env[index]) > size) {
 242        if (strstr (env[index], name) == env[index] &&
 243            env[index][size] == '=') {
 244 #if defined (__vxworks) && ! defined (__RTP__)
 245          /* on Vxworks we are sure that the string has been allocated using
 246             malloc */
 247          free (env[index]);
 248 #endif
 249          while (env[index] != NULL) {
 250           env[index]=env[index + 1];
 251           index++;
 252          }
 253        } else
 254            index++;
 255      } else
 256          index++;
 257   }
 258 #elif defined (__MINGW32__)
 259   /* On Windows platform putenv ("key=") is equivalent to unsetenv (a
 260      subsequent call to getenv ("key") will return NULL and not the "\0"
 261      string */
 262   size_t size = strlen (name) + 2;
 263   char *expression;
 264   expression = (char *) xmalloc (size * sizeof (char));
 265
 266   sprintf (expression, "%s=", name);
 267   putenv (expression);
 268   free (expression);
 269 #else
 270   unsetenv (name);
 271 #endif
 272 }
 273
 274 void __gnat_clearenv (void) {
 275 #if defined (VMS)
 276   /* not implemented */
 277   return;
 278 #elif defined (sun) || (defined (__mips) && defined (__sgi)) \
 279    || (defined (__vxworks) && ! defined (__RTP__)) || defined (__Lynx__)
 280   /* On Solaris, IRIX, VxWorks (not RTPs), and Lynx there is no system
 281      call to unset a variable or to clear the environment so set all
 282      the entries in the environ table to NULL (see comment in
 283      __gnat_unsetenv for more explanation). */
 284   char **env = __gnat_environ ();
 285   int index = 0;
 286
 287   while (env[index] != NULL) {
 288     env[index]=NULL;
 289     index++;
 290   }
 291 #elif defined (__MINGW32__) || defined (__FreeBSD__) || defined (__APPLE__) \
 292    || (defined (__vxworks) && defined (__RTP__)) || defined (__CYGWIN__) \
 293    || defined (__NetBSD__) || defined (__OpenBSD__) || defined (__rtems__)
 294   /* On Windows, FreeBSD and MacOS there is no function to clean all the
 295      environment but there is a "clean" way to unset a variable. So go
 296      through the environ table and call __gnat_unsetenv on all entries */
 297   char **env = __gnat_environ ();
 298   size_t size;
 299
 300   while (env[0] != NULL) {
 301     size = 0;
 302     while (env[0][size] != '=')
 303       size++;
 304     /* create a string that contains "name" */
 305     size++;
 306     {
 307       char expression[size];
 308       strncpy (expression, env[0], size);
 309       expression[size - 1] = 0;
 310       __gnat_unsetenv (expression);
 311     }
 312   }
 313 #else
 314   clearenv ();
 315 #endif
 316 }