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-2018, 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__) || defined (__arm64__))
  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 (__MINGW32__) || (defined (__vxworks) && ! defined (__RTP__))
 196   /* On some systems like MacOS X and Windows, putenv is making a copy of the
 197      expression string so we can free it after the call to putenv */
 198   free (expression);
 199 #endif
 200 #endif
 201 }
 202
 203 char **
 204 __gnat_environ (void)
 205 {
 206 #if defined (VMS) || defined (RTX)
 207   /* Not implemented */
 208   return NULL;
 209 #elif defined (__MINGW32__)
 210   return _environ;
 211 #elif defined (__sun__)
 212   extern char **_environ;
 213   return _environ;
 214 #elif defined (__APPLE__) && !(defined (__arm__) || defined (__arm64__))
 215   return *_NSGetEnviron ();
 216 #elif ! (defined (__vxworks))
 217   extern char **environ;
 218   return environ;
 219 #else
 220   return environ;
 221 #endif
 222 }
 223
 224 void __gnat_unsetenv (char *name)
 225 {
 226 #if defined (VMS)
 227   /* Not implemented */
 228   return;
 229 #elif defined (__hpux__) || defined (__sun__) \
 230      || (defined (__vxworks) && ! defined (__RTP__)) \
 231      || defined (_AIX) || defined (__Lynx__)
 232
 233   /* On Solaris and HP-UX there is no function to clear an environment
 234      variable. So we look for the variable in the environ table and delete it
 235      by setting the entry to NULL. This can clearly cause some memory leaks
 236      but free cannot be used on this context as not all strings in the environ
 237      have been allocated using malloc. To avoid this memory leak another
 238      method can be used. It consists in forcing the reallocation of all the
 239      strings in the environ table using malloc on the first call on the
 240      functions related to environment variable management. The disadvantage
 241      is that if a program makes a direct call to getenv the return string
 242      may be deallocated at some point. */
 243   /* Note that on AIX, unsetenv is not supported on 5.1 but it is on 5.3.
 244      As we are still supporting AIX 5.1 we cannot use unsetenv */
 245   char **env = __gnat_environ ();
 246   int index = 0;
 247   size_t size = strlen (name);
 248
 249   while (env[index] != NULL) {
 250      if (strlen (env[index]) > size) {
 251        if (strstr (env[index], name) == env[index] &&
 252            env[index][size] == '=') {
 253 #if defined (__vxworks) && ! defined (__RTP__)
 254          /* on Vxworks we are sure that the string has been allocated using
 255             malloc */
 256          free (env[index]);
 257 #endif
 258          while (env[index] != NULL) {
 259           env[index]=env[index + 1];
 260           index++;
 261          }
 262        } else
 263            index++;
 264      } else
 265          index++;
 266   }
 267 #elif defined (__MINGW32__)
 268   /* On Windows platform putenv ("key=") is equivalent to unsetenv (a
 269      subsequent call to getenv ("key") will return NULL and not the "\0"
 270      string */
 271   size_t size = strlen (name) + 2;
 272   char *expression;
 273   expression = (char *) xmalloc (size * sizeof (char));
 274
 275   sprintf (expression, "%s=", name);
 276   putenv (expression);
 277   free (expression);
 278 #else
 279   unsetenv (name);
 280 #endif
 281 }
 282
 283 void __gnat_clearenv (void)
 284 {
 285 #if defined (VMS)
 286   /* not implemented */
 287   return;
 288 #elif defined (__sun__) \
 289   || (defined (__vxworks) && ! defined (__RTP__)) || defined (__Lynx__) \
 290   || defined (__PikeOS__)
 291   /* On Solaris, VxWorks (not RTPs), and Lynx there is no system
 292      call to unset a variable or to clear the environment so set all
 293      the entries in the environ table to NULL (see comment in
 294      __gnat_unsetenv for more explanation). */
 295   char **env = __gnat_environ ();
 296   int index = 0;
 297
 298   while (env[index] != NULL) {
 299     env[index]=NULL;
 300     index++;
 301   }
 302 #elif defined (__MINGW32__) || defined (__FreeBSD__) || defined (__APPLE__) \
 303    || (defined (__vxworks) && defined (__RTP__)) || defined (__CYGWIN__) \
 304    || defined (__NetBSD__) || defined (__OpenBSD__) || defined (__rtems__) \
 305    || defined (__DragonFly__) || defined (__DJGPP__)
 306   /* On Windows, FreeBSD and MacOS there is no function to clean all the
 307      environment but there is a "clean" way to unset a variable. So go
 308      through the environ table and call __gnat_unsetenv on all entries */
 309   char **env = __gnat_environ ();
 310   size_t size;
 311
 312   while (env[0] != NULL) {
 313     size = 0;
 314     while (env[0][size] != '=')
 315       size++;
 316     /* create a string that contains "name" */
 317     size++;
 318     {
 319       char *expression;
 320       expression = (char *) xmalloc (size * sizeof (char));
 321       strncpy (expression, env[0], size);
 322       expression[size - 1] = 0;
 323       __gnat_unsetenv (expression);
 324       free (expression);
 325     }
 326   }
 327 #else
 328   clearenv ();
 329 #endif
 330 }
 331
 332 #ifdef __cplusplus
 333 }
 334 #endif