src/vms_export_symbol.c

   1 /* File: vms_export_symbol.c
   2  *
   3  * Some programs need special environment variables deported as DCL
   4  * DCL symbols.
   5  */
   6
   7 /* Copyright (C) 2014-2020 Free Software Foundation, Inc.
   8
   9 GNU Make is free software; you can redistribute it and/or modify it under the
  10 terms of the GNU General Public License as published by the Free Software
  11 Foundation; either version 3 of the License, or (at your option) any later
  12 version.
  13
  14 GNU Make is distributed in the hope that it will be useful, but WITHOUT ANY
  15 WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  16 A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  17
  18 You should have received a copy of the GNU General Public License along with
  19 this program.  If not, see <http://www.gnu.org/licenses/>.  */
  20
  21
  22 /* Per copyright assignment agreement with the Free Software Foundation
  23    this software may be available under under other license agreements
  24    and copyrights. */
  25
  26
  27 #include <stdio.h>
  28 #include <string.h>
  29 #include <stdlib.h>
  30 #include <errno.h>
  31
  32 #include <descrip.h>
  33 #include <stsdef.h>
  34 #include <ssdef.h>
  35 #include <unixlib.h>
  36 #include <libclidef.h>
  37
  38 #pragma member_alignment save
  39 #pragma nomember_alignment longword
  40 struct item_list_3
  41 {
  42   unsigned short len;
  43   unsigned short code;
  44   void * bufadr;
  45   unsigned short * retlen;
  46 };
  47
  48
  49 #pragma member_alignment
  50
  51 int
  52 LIB$GET_SYMBOL (const struct dsc$descriptor_s * symbol,
  53                 struct dsc$descriptor_s * value,
  54                 unsigned short * value_len,
  55                 const unsigned long * table);
  56
  57 int
  58 LIB$SET_SYMBOL (const struct dsc$descriptor_s * symbol,
  59                 const struct dsc$descriptor_s * value,
  60                 const unsigned long * table);
  61
  62 int
  63 LIB$DELETE_SYMBOL (const struct dsc$descriptor_s * symbol,
  64                    const unsigned long * table);
  65
  66 #define MAX_DCL_SYMBOL_LEN (255)
  67 #if __CRTL_VER >= 70302000 && !defined(__VAX)
  68 # define MAX_DCL_SYMBOL_VALUE (8192)
  69 #else
  70 # define MAX_DCL_SYMBOL_VALUE (1024)
  71 #endif
  72
  73 struct dcl_symbol
  74 {
  75   struct dcl_symbol * link;
  76   struct dsc$descriptor_s name_desc;
  77   struct dsc$descriptor_s value_desc;
  78   char name[MAX_DCL_SYMBOL_LEN + 1];    /* + 1 byte for null terminator */
  79   char value[MAX_DCL_SYMBOL_VALUE +1];  /* + 1 byte for null terminator */
  80   char pad[3]; /* Pad structure to longword allignment */
  81 };
  82
  83 static struct dcl_symbol * vms_dcl_symbol_head = NULL;
  84
  85 /* Restore symbol state to original condition. */
  86 static unsigned long
  87 clear_dcl_symbol (struct dcl_symbol * symbol)
  88 {
  89
  90   const unsigned long symtbl = LIB$K_CLI_LOCAL_SYM;
  91   int status;
  92
  93   if (symbol->value_desc.dsc$w_length == (unsigned short)-1)
  94     status = LIB$DELETE_SYMBOL (&symbol->name_desc, &symtbl);
  95   else
  96     status = LIB$SET_SYMBOL (&symbol->name_desc,
  97                              &symbol->value_desc, &symtbl);
  98   return status;
  99 }
 100
 101
 102 /* Restore all exported symbols to their original conditions */
 103 static void
 104 clear_exported_symbols (void)
 105 {
 106
 107   struct dcl_symbol * symbol;
 108
 109   symbol = vms_dcl_symbol_head;
 110
 111   /* Walk the list of symbols.  This is done durring exit,
 112    * so no need to free memory.
 113    */
 114   while (symbol != NULL)
 115   {
 116     clear_dcl_symbol (symbol);
 117     symbol = symbol->link;
 118   }
 119
 120 }
 121
 122
 123 /* Restore the symbol back to the original value
 124  * symbol name is either a plain name or of the form "symbol=name" where
 125  * the name portion is ignored.
 126  */
 127 void
 128 vms_restore_symbol (const char * string)
 129 {
 130
 131   struct dcl_symbol * symbol;
 132   char name[MAX_DCL_SYMBOL_LEN + 1];
 133   int status;
 134   char * value;
 135   int name_len;
 136
 137   symbol = vms_dcl_symbol_head;
 138
 139   /* Isolate the name from the value */
 140   value = strchr (string, '=');
 141   if (value != NULL)
 142     {
 143       /* Copy the name from the string */
 144       name_len = (value - string);
 145     }
 146   else
 147     name_len = strlen (string);
 148
 149   if (name_len > MAX_DCL_SYMBOL_LEN)
 150     name_len = MAX_DCL_SYMBOL_LEN;
 151
 152   strncpy (name, string, name_len);
 153   name[name_len] = 0;
 154
 155   /* Walk the list of symbols.  The saved symbol is not freed
 156    * symbols are likely to be overwritten multiple times, so this
 157    * saves time in saving them each time.
 158    */
 159   while (symbol != NULL)
 160     {
 161       int result;
 162       result = strcmp (symbol->name, name);
 163       if (result == 0)
 164         {
 165           clear_dcl_symbol (symbol);
 166           break;
 167         }
 168       symbol = symbol->link;
 169     }
 170 }
 171
 172 int
 173 vms_export_dcl_symbol (const char * name, const char * value)
 174 {
 175
 176   struct dcl_symbol * symbol;
 177   struct dcl_symbol * next;
 178   struct dcl_symbol * link;
 179   int found;
 180   const unsigned long symtbl = LIB$K_CLI_LOCAL_SYM;
 181   struct dsc$descriptor_s value_desc;
 182   int string_len;
 183   int status;
 184   char new_value[MAX_DCL_SYMBOL_VALUE + 1];
 185   char * dollarp;
 186
 187   next = vms_dcl_symbol_head;
 188   link = vms_dcl_symbol_head;
 189
 190   /* Is symbol already exported? */
 191   found = 0;
 192   while ((found == 0) && (link != NULL))
 193     {
 194       int x;
 195       found = !strncasecmp (link->name, name, MAX_DCL_SYMBOL_LEN);
 196       if (found)
 197         symbol = link;
 198       next = link;
 199       link = link->link;
 200     }
 201
 202   /* New symbol, set it up */
 203   if (found == 0)
 204     {
 205       symbol = malloc (sizeof (struct dcl_symbol));
 206       if (symbol == NULL)
 207         return SS$_INSFMEM;
 208
 209       /* Construct the symbol descriptor, used for both saving
 210        * the old symbol and creating the new symbol.
 211        */
 212       symbol->name_desc.dsc$w_length = strlen (name);
 213       if (symbol->name_desc.dsc$w_length > MAX_DCL_SYMBOL_LEN)
 214         symbol->name_desc.dsc$w_length = MAX_DCL_SYMBOL_LEN;
 215
 216       strncpy (symbol->name, name, symbol->name_desc.dsc$w_length);
 217       symbol->name[symbol->name_desc.dsc$w_length] = 0;
 218       symbol->name_desc.dsc$a_pointer = symbol->name;
 219       symbol->name_desc.dsc$b_dtype = DSC$K_DTYPE_T;
 220       symbol->name_desc.dsc$b_class = DSC$K_CLASS_S;
 221
 222       /* construct the value descriptor, used only for saving
 223        * the old symbol.
 224        */
 225       symbol->value_desc.dsc$a_pointer = symbol->value;
 226       symbol->value_desc.dsc$w_length = MAX_DCL_SYMBOL_VALUE;
 227       symbol->value_desc.dsc$b_dtype = DSC$K_DTYPE_T;
 228       symbol->value_desc.dsc$b_class = DSC$K_CLASS_S;
 229     }
 230
 231   if (found == 0)
 232     {
 233       unsigned long old_symtbl;
 234       unsigned short value_len;
 235
 236       /* Look up the symbol */
 237       status = LIB$GET_SYMBOL (&symbol->name_desc, &symbol->value_desc,
 238                                &value_len, &old_symtbl);
 239       if (!$VMS_STATUS_SUCCESS (status))
 240         value_len = (unsigned short)-1;
 241       else if (old_symtbl != symtbl)
 242         value_len = (unsigned short)-1;
 243
 244       symbol->value_desc.dsc$w_length = value_len;
 245
 246       /* Store it away */
 247       if (value_len != (unsigned short) -1)
 248         symbol->value[value_len] = 0;
 249
 250       /* Make sure atexit scheduled */
 251       if (vms_dcl_symbol_head == NULL)
 252         {
 253           vms_dcl_symbol_head = symbol;
 254           atexit (clear_exported_symbols);
 255         }
 256       else
 257         {
 258           /* Extend the chain */
 259           next->link = symbol;
 260         }
 261     }
 262
 263   /* Create or replace a symbol */
 264   value_desc.dsc$a_pointer = new_value;
 265   string_len = strlen (value);
 266   if (string_len > MAX_DCL_SYMBOL_VALUE)
 267     string_len = MAX_DCL_SYMBOL_VALUE;
 268
 269   strncpy (new_value, value, string_len);
 270   new_value[string_len] = 0;
 271
 272   /* Special handling for GNU Make.  GNU Make doubles the dollar signs
 273    * in environment variables read in from getenv().  Make exports symbols
 274    * with the dollar signs already doubled.  So all $$ must be converted
 275    * back to $.
 276    * If the first $ is not doubled, then do not convert at all.
 277    */
 278   dollarp = strchr (new_value, '$');
 279   while (dollarp && dollarp[1] == '$')
 280     {
 281       int left;
 282       dollarp++;
 283       left = string_len - (dollarp - new_value - 1);
 284       string_len--;
 285       if (left > 0)
 286         {
 287           memmove (dollarp, &dollarp[1], left);
 288           dollarp = strchr (&dollarp[1], '$');
 289         }
 290       else
 291         {
 292           /* Ended with $$, simple case */
 293           dollarp[1] = 0;
 294           break;
 295         }
 296     }
 297   value_desc.dsc$w_length = string_len;
 298   value_desc.dsc$b_dtype = DSC$K_DTYPE_T;
 299   value_desc.dsc$b_class = DSC$K_CLASS_S;
 300   status = LIB$SET_SYMBOL (&symbol->name_desc, &value_desc, &symtbl);
 301   return status;
 302 }
 303
 304 /* export a DCL symbol using a string in the same syntax as putenv */
 305 int
 306 vms_putenv_symbol (const char * string)
 307 {
 308
 309   char name[MAX_DCL_SYMBOL_LEN + 1];
 310   int status;
 311   char * value;
 312   int name_len;
 313
 314   /* Isolate the name from the value */
 315   value = strchr (string, '=');
 316   if (value == NULL)
 317     {
 318       errno = EINVAL;
 319       return -1;
 320     }
 321
 322   /* Copy the name from the string */
 323   name_len = (value - string);
 324   if (name_len > MAX_DCL_SYMBOL_LEN)
 325     name_len = MAX_DCL_SYMBOL_LEN;
 326
 327   strncpy (name, string, name_len);
 328   name[name_len] = 0;
 329
 330   /* Skip past the "=" */
 331   value++;
 332
 333   /* Export the symbol */
 334   status = vms_export_dcl_symbol (name, value);
 335
 336   /* Convert the error to Unix format */
 337   if (!$VMS_STATUS_SUCCESS (status))
 338     {
 339       errno = EVMSERR;
 340       vaxc$errno = status;
 341       return -1;
 342     }
 343   return 0;
 344 }
 345
 346 #if __CRTL_VER >= 70301000
 347 # define transpath_parm transpath
 348 #else
 349 static char transpath[MAX_DCL_SYMBOL_VALUE];
 350 #endif
 351
 352 /* Helper callback routine for converting Unix paths to VMS */
 353 static int
 354 to_vms_action (char * vms_spec, int flag, char * transpath_parm)
 355 {
 356   strncpy (transpath, vms_spec, MAX_DCL_SYMBOL_VALUE - 1);
 357   transpath[MAX_DCL_SYMBOL_VALUE - 1] = 0;
 358   return 0;
 359 }
 360
 361 #ifdef __DECC
 362 # pragma message save
 363   /* Undocumented extra parameter use triggers a ptrmismatch warning */
 364 # pragma message disable ptrmismatch
 365 #endif
 366
 367 /* Create a foreign command only visible to children */
 368 int
 369 create_foreign_command (const char * command, const char * image)
 370 {
 371   char vms_command[MAX_DCL_SYMBOL_VALUE + 1];
 372   int status;
 373
 374   vms_command[0] = '$';
 375   vms_command[1] = 0;
 376   if (image[0] == '/')
 377     {
 378 #if __CRTL_VER >= 70301000
 379       /* Current decc$to_vms is reentrant */
 380       decc$to_vms (image, to_vms_action, 0, 1, &vms_command[1]);
 381 #else
 382       /* Older decc$to_vms is not reentrant */
 383       decc$to_vms (image, to_vms_action, 0, 1);
 384       strncpy (&vms_command[1], transpath, MAX_DCL_SYMBOL_VALUE - 1);
 385       vms_command[MAX_DCL_SYMBOL_VALUE] = 0;
 386 #endif
 387     }
 388   else
 389     {
 390       strncpy (&vms_command[1], image, MAX_DCL_SYMBOL_VALUE - 1);
 391       vms_command[MAX_DCL_SYMBOL_VALUE] = 0;
 392     }
 393   status = vms_export_dcl_symbol (command, vms_command);
 394
 395   return status;
 396 }
 397 #ifdef __DECC
 398 # pragma message restore
 399 #endif
 400
 401
 402 #ifdef DEBUG
 403
 404 int
 405 main(int argc, char ** argv, char **env)
 406 {
 407
 408   char value[MAX_DCL_SYMBOL_VALUE +1];
 409   int status = 0;
 410   int putenv_status;
 411   int vms_status;
 412   struct dsc$descriptor_s name_desc;
 413   struct dsc$descriptor_s value_desc;
 414   const unsigned long symtbl = LIB$K_CLI_LOCAL_SYM;
 415   unsigned short value_len;
 416   unsigned long old_symtbl;
 417   int result;
 418   const char * vms_command = "vms_export_symbol";
 419   const char * vms_image = "test_image.exe";
 420   const char * vms_symbol1 = "test_symbol1";
 421   const char * value1 = "test_value1";
 422   const char * vms_symbol2 = "test_symbol2";
 423   const char * putenv_string = "test_symbol2=value2";
 424   const char * value2 = "value2";
 425
 426   /* Test creating a foreign command */
 427   vms_status = create_foreign_command (vms_command, vms_image);
 428   if (!$VMS_STATUS_SUCCESS (vms_status))
 429     {
 430       printf("Create foreign command failed: %d\n", vms_status);
 431       status = 1;
 432     }
 433
 434   name_desc.dsc$a_pointer = (char *)vms_command;
 435   name_desc.dsc$w_length = strlen (vms_command);
 436   name_desc.dsc$b_dtype = DSC$K_DTYPE_T;
 437   name_desc.dsc$b_class = DSC$K_CLASS_S;
 438
 439   value_desc.dsc$a_pointer = value;
 440   value_desc.dsc$w_length = MAX_DCL_SYMBOL_VALUE;
 441   value_desc.dsc$b_dtype = DSC$K_DTYPE_T;
 442   value_desc.dsc$b_class = DSC$K_CLASS_S;
 443
 444   vms_status = LIB$GET_SYMBOL (&name_desc, &value_desc,
 445                                &value_len, &old_symtbl);
 446   if (!$VMS_STATUS_SUCCESS (vms_status))
 447     {
 448       printf ("lib$get_symbol for command failed: %d\n", vms_status);
 449       status = 1;
 450     }
 451
 452   value[value_len] = 0;
 453   result = strncasecmp (&value[1], vms_image, value_len - 1);
 454   if (result != 0)
 455     {
 456       printf ("create_foreign_command failed!  expected '%s', got '%s'\n",
 457               vms_image, &value[1]);
 458       status = 1;
 459     }
 460
 461   /* Test exporting a symbol */
 462   vms_status = vms_export_dcl_symbol (vms_symbol1, value1);
 463   if (!$VMS_STATUS_SUCCESS (vms_status))
 464     {
 465       printf ("vms_export_dcl_symbol for command failed: %d\n", vms_status);
 466       status = 1;
 467     }
 468
 469   name_desc.dsc$a_pointer = (char *)vms_symbol1;
 470   name_desc.dsc$w_length = strlen (vms_symbol1);
 471   vms_status = LIB$GET_SYMBOL(&name_desc, &value_desc,
 472                               &value_len, &old_symtbl);
 473   if (!$VMS_STATUS_SUCCESS(vms_status))
 474     {
 475       printf ("lib$get_symbol for command failed: %d\n", vms_status);
 476       status = 1;
 477     }
 478
 479   value[value_len] = 0;
 480   result = strncmp (value, value1, value_len);
 481   if (result != 0)
 482     {
 483       printf ("vms_export_dcl_symbol failed!  expected '%s', got '%s'\n",
 484               value1, value);
 485       status = 1;
 486     }
 487
 488   /* Test putenv for DCL symbols */
 489   putenv_status = vms_putenv_symbol (putenv_string);
 490   if (putenv_status != 0)
 491     {
 492       perror ("vms_putenv_symbol");
 493       status = 1;
 494     }
 495
 496   name_desc.dsc$a_pointer = (char *)vms_symbol2;
 497   name_desc.dsc$w_length = strlen(vms_symbol2);
 498   vms_status = LIB$GET_SYMBOL (&name_desc, &value_desc,
 499                                &value_len, &old_symtbl);
 500   if (!$VMS_STATUS_SUCCESS (vms_status))
 501     {
 502       printf ("lib$get_symbol for command failed: %d\n", vms_status);
 503       status = 1;
 504     }
 505
 506   value[value_len] = 0;
 507   result = strncmp (value, value2, value_len);
 508   if (result != 0)
 509   {
 510     printf ("vms_putenv_symbol failed!  expected '%s', got '%s'\n",
 511             value2, value);
 512     status = 1;
 513   }
 514
 515   vms_restore_symbol (putenv_string);
 516   vms_status = LIB$GET_SYMBOL (&name_desc, &value_desc,
 517                                &value_len, &old_symtbl);
 518   if ($VMS_STATUS_SUCCESS (vms_status))
 519     {
 520       printf ("lib$get_symbol for command succeeded, should have failed\n");
 521       status = 1;
 522     }
 523
 524   exit (status);
 525 }
 526
 527 #endif