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