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