From 29cd838eab01ed7110f3ccb2e8c6a35c8a31dbcc Mon Sep 17 00:00:00 2001 From: Daniel Baumann Date: Thu, 11 Apr 2024 10:21:29 +0200 Subject: Adding upstream version 1:0.1.9998svn3589+dfsg. Signed-off-by: Daniel Baumann --- src/kmk/vms_export_symbol.c | 527 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 527 insertions(+) create mode 100644 src/kmk/vms_export_symbol.c (limited to 'src/kmk/vms_export_symbol.c') diff --git a/src/kmk/vms_export_symbol.c b/src/kmk/vms_export_symbol.c new file mode 100644 index 0000000..954f3f4 --- /dev/null +++ b/src/kmk/vms_export_symbol.c @@ -0,0 +1,527 @@ +/* File: vms_export_symbol.c + * + * Some programs need special environment variables deported as DCL + * DCL symbols. + */ + +/* Copyright (C) 2014-2016 Free Software Foundation, Inc. + +GNU Make is free software; you can redistribute it and/or modify it under the +terms of the GNU General Public License as published by the Free Software +Foundation; either version 3 of the License, or (at your option) any later +version. + +GNU Make is distributed in the hope that it will be useful, but WITHOUT ANY +WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR +A PARTICULAR PURPOSE. See the GNU General Public License for more details. + +You should have received a copy of the GNU General Public License along with +this program. If not, see . */ + + +/* Per copyright assignment agreement with the Free Software Foundation + this software may be available under under other license agreements + and copyrights. */ + + +#include +#include +#include +#include + +#include +#include +#include +#include +#include + +#pragma member_alignment save +#pragma nomember_alignment longword +struct item_list_3 +{ + unsigned short len; + unsigned short code; + void * bufadr; + unsigned short * retlen; +}; + + +#pragma member_alignment + +int +LIB$GET_SYMBOL (const struct dsc$descriptor_s * symbol, + struct dsc$descriptor_s * value, + unsigned short * value_len, + const unsigned long * table); + +int +LIB$SET_SYMBOL (const struct dsc$descriptor_s * symbol, + const struct dsc$descriptor_s * value, + const unsigned long * table); + +int +LIB$DELETE_SYMBOL (const struct dsc$descriptor_s * symbol, + const unsigned long * table); + +#define MAX_DCL_SYMBOL_LEN (255) +#if __CRTL_VER >= 70302000 && !defined(__VAX) +# define MAX_DCL_SYMBOL_VALUE (8192) +#else +# define MAX_DCL_SYMBOL_VALUE (1024) +#endif + +struct dcl_symbol +{ + struct dcl_symbol * link; + struct dsc$descriptor_s name_desc; + struct dsc$descriptor_s value_desc; + char name[MAX_DCL_SYMBOL_LEN + 1]; /* + 1 byte for null terminator */ + char value[MAX_DCL_SYMBOL_VALUE +1]; /* + 1 byte for null terminator */ + char pad[3]; /* Pad structure to longword allignment */ +}; + +static struct dcl_symbol * vms_dcl_symbol_head = NULL; + +/* Restore symbol state to original condition. */ +static unsigned long +clear_dcl_symbol (struct dcl_symbol * symbol) +{ + + const unsigned long symtbl = LIB$K_CLI_LOCAL_SYM; + int status; + + if (symbol->value_desc.dsc$w_length == (unsigned short)-1) + status = LIB$DELETE_SYMBOL (&symbol->name_desc, &symtbl); + else + status = LIB$SET_SYMBOL (&symbol->name_desc, + &symbol->value_desc, &symtbl); + return status; +} + + +/* Restore all exported symbols to their original conditions */ +static void +clear_exported_symbols (void) +{ + + struct dcl_symbol * symbol; + + symbol = vms_dcl_symbol_head; + + /* Walk the list of symbols. This is done durring exit, + * so no need to free memory. + */ + while (symbol != NULL) + { + clear_dcl_symbol (symbol); + symbol = symbol->link; + } + +} + + +/* Restore the symbol back to the original value + * symbol name is either a plain name or of the form "symbol=name" where + * the name portion is ignored. + */ +void +vms_restore_symbol (const char * string) +{ + + struct dcl_symbol * symbol; + char name[MAX_DCL_SYMBOL_LEN + 1]; + int status; + char * value; + int name_len; + + symbol = vms_dcl_symbol_head; + + /* Isolate the name from the value */ + value = strchr (string, '='); + if (value != NULL) + { + /* Copy the name from the string */ + name_len = (value - string); + } + else + name_len = strlen (string); + + if (name_len > MAX_DCL_SYMBOL_LEN) + name_len = MAX_DCL_SYMBOL_LEN; + + strncpy (name, string, name_len); + name[name_len] = 0; + + /* Walk the list of symbols. The saved symbol is not freed + * symbols are likely to be overwritten multiple times, so this + * saves time in saving them each time. + */ + while (symbol != NULL) + { + int result; + result = strcmp (symbol->name, name); + if (result == 0) + { + clear_dcl_symbol (symbol); + break; + } + symbol = symbol->link; + } +} + +int +vms_export_dcl_symbol (const char * name, const char * value) +{ + + struct dcl_symbol * symbol; + struct dcl_symbol * next; + struct dcl_symbol * link; + int found; + const unsigned long symtbl = LIB$K_CLI_LOCAL_SYM; + struct dsc$descriptor_s value_desc; + int string_len; + int status; + char new_value[MAX_DCL_SYMBOL_VALUE + 1]; + char * dollarp; + + next = vms_dcl_symbol_head; + link = vms_dcl_symbol_head; + + /* Is symbol already exported? */ + found = 0; + while ((found == 0) && (link != NULL)) + { + int x; + found = !strncasecmp (link->name, name, MAX_DCL_SYMBOL_LEN); + if (found) + symbol = link; + next = link; + link = link->link; + } + + /* New symbol, set it up */ + if (found == 0) + { + symbol = malloc (sizeof (struct dcl_symbol)); + if (symbol == NULL) + return SS$_INSFMEM; + + /* Construct the symbol descriptor, used for both saving + * the old symbol and creating the new symbol. + */ + symbol->name_desc.dsc$w_length = strlen (name); + if (symbol->name_desc.dsc$w_length > MAX_DCL_SYMBOL_LEN) + symbol->name_desc.dsc$w_length = MAX_DCL_SYMBOL_LEN; + + strncpy (symbol->name, name, symbol->name_desc.dsc$w_length); + symbol->name[symbol->name_desc.dsc$w_length] = 0; + symbol->name_desc.dsc$a_pointer = symbol->name; + symbol->name_desc.dsc$b_dtype = DSC$K_DTYPE_T; + symbol->name_desc.dsc$b_class = DSC$K_CLASS_S; + + /* construct the value descriptor, used only for saving + * the old symbol. + */ + symbol->value_desc.dsc$a_pointer = symbol->value; + symbol->value_desc.dsc$w_length = MAX_DCL_SYMBOL_VALUE; + symbol->value_desc.dsc$b_dtype = DSC$K_DTYPE_T; + symbol->value_desc.dsc$b_class = DSC$K_CLASS_S; + } + + if (found == 0) + { + unsigned long old_symtbl; + unsigned short value_len; + + /* Look up the symbol */ + status = LIB$GET_SYMBOL (&symbol->name_desc, &symbol->value_desc, + &value_len, &old_symtbl); + if (!$VMS_STATUS_SUCCESS (status)) + value_len = (unsigned short)-1; + else if (old_symtbl != symtbl) + value_len = (unsigned short)-1; + + symbol->value_desc.dsc$w_length = value_len; + + /* Store it away */ + if (value_len != (unsigned short) -1) + symbol->value[value_len] = 0; + + /* Make sure atexit scheduled */ + if (vms_dcl_symbol_head == NULL) + { + vms_dcl_symbol_head = symbol; + atexit (clear_exported_symbols); + } + else + { + /* Extend the chain */ + next->link = symbol; + } + } + + /* Create or replace a symbol */ + value_desc.dsc$a_pointer = new_value; + string_len = strlen (value); + if (string_len > MAX_DCL_SYMBOL_VALUE) + string_len = MAX_DCL_SYMBOL_VALUE; + + strncpy (new_value, value, string_len); + new_value[string_len] = 0; + + /* Special handling for GNU Make. GNU Make doubles the dollar signs + * in environment variables read in from getenv(). Make exports symbols + * with the dollar signs already doubled. So all $$ must be converted + * back to $. + * If the first $ is not doubled, then do not convert at all. + */ + dollarp = strchr (new_value, '$'); + while (dollarp && dollarp[1] == '$') + { + int left; + dollarp++; + left = string_len - (dollarp - new_value - 1); + string_len--; + if (left > 0) + { + memmove (dollarp, &dollarp[1], left); + dollarp = strchr (&dollarp[1], '$'); + } + else + { + /* Ended with $$, simple case */ + dollarp[1] = 0; + break; + } + } + value_desc.dsc$w_length = string_len; + value_desc.dsc$b_dtype = DSC$K_DTYPE_T; + value_desc.dsc$b_class = DSC$K_CLASS_S; + status = LIB$SET_SYMBOL (&symbol->name_desc, &value_desc, &symtbl); + return status; +} + +/* export a DCL symbol using a string in the same syntax as putenv */ +int +vms_putenv_symbol (const char * string) +{ + + char name[MAX_DCL_SYMBOL_LEN + 1]; + int status; + char * value; + int name_len; + + /* Isolate the name from the value */ + value = strchr (string, '='); + if (value == NULL) + { + errno = EINVAL; + return -1; + } + + /* Copy the name from the string */ + name_len = (value - string); + if (name_len > MAX_DCL_SYMBOL_LEN) + name_len = MAX_DCL_SYMBOL_LEN; + + strncpy (name, string, name_len); + name[name_len] = 0; + + /* Skip past the "=" */ + value++; + + /* Export the symbol */ + status = vms_export_dcl_symbol (name, value); + + /* Convert the error to Unix format */ + if (!$VMS_STATUS_SUCCESS (status)) + { + errno = EVMSERR; + vaxc$errno = status; + return -1; + } + return 0; +} + +#if __CRTL_VER >= 70301000 +# define transpath_parm transpath +#else +static char transpath[MAX_DCL_SYMBOL_VALUE]; +#endif + +/* Helper callback routine for converting Unix paths to VMS */ +static int +to_vms_action (char * vms_spec, int flag, char * transpath_parm) +{ + strncpy (transpath, vms_spec, MAX_DCL_SYMBOL_VALUE - 1); + transpath[MAX_DCL_SYMBOL_VALUE - 1] = 0; + return 0; +} + +#ifdef __DECC +# pragma message save + /* Undocumented extra parameter use triggers a ptrmismatch warning */ +# pragma message disable ptrmismatch +#endif + +/* Create a foreign command only visible to children */ +int +create_foreign_command (const char * command, const char * image) +{ + char vms_command[MAX_DCL_SYMBOL_VALUE + 1]; + int status; + + vms_command[0] = '$'; + vms_command[1] = 0; + if (image[0] == '/') + { +#if __CRTL_VER >= 70301000 + /* Current decc$to_vms is reentrant */ + decc$to_vms (image, to_vms_action, 0, 1, &vms_command[1]); +#else + /* Older decc$to_vms is not reentrant */ + decc$to_vms (image, to_vms_action, 0, 1); + strncpy (&vms_command[1], transpath, MAX_DCL_SYMBOL_VALUE - 1); + vms_command[MAX_DCL_SYMBOL_VALUE] = 0; +#endif + } + else + { + strncpy (&vms_command[1], image, MAX_DCL_SYMBOL_VALUE - 1); + vms_command[MAX_DCL_SYMBOL_VALUE] = 0; + } + status = vms_export_dcl_symbol (command, vms_command); + + return status; +} +#ifdef __DECC +# pragma message restore +#endif + + +#ifdef DEBUG + +int +main(int argc, char ** argv, char **env) +{ + + char value[MAX_DCL_SYMBOL_VALUE +1]; + int status = 0; + int putenv_status; + int vms_status; + struct dsc$descriptor_s name_desc; + struct dsc$descriptor_s value_desc; + const unsigned long symtbl = LIB$K_CLI_LOCAL_SYM; + unsigned short value_len; + unsigned long old_symtbl; + int result; + const char * vms_command = "vms_export_symbol"; + const char * vms_image = "test_image.exe"; + const char * vms_symbol1 = "test_symbol1"; + const char * value1 = "test_value1"; + const char * vms_symbol2 = "test_symbol2"; + const char * putenv_string = "test_symbol2=value2"; + const char * value2 = "value2"; + + /* Test creating a foreign command */ + vms_status = create_foreign_command (vms_command, vms_image); + if (!$VMS_STATUS_SUCCESS (vms_status)) + { + printf("Create foreign command failed: %d\n", vms_status); + status = 1; + } + + name_desc.dsc$a_pointer = (char *)vms_command; + name_desc.dsc$w_length = strlen (vms_command); + name_desc.dsc$b_dtype = DSC$K_DTYPE_T; + name_desc.dsc$b_class = DSC$K_CLASS_S; + + value_desc.dsc$a_pointer = value; + value_desc.dsc$w_length = MAX_DCL_SYMBOL_VALUE; + value_desc.dsc$b_dtype = DSC$K_DTYPE_T; + value_desc.dsc$b_class = DSC$K_CLASS_S; + + vms_status = LIB$GET_SYMBOL (&name_desc, &value_desc, + &value_len, &old_symtbl); + if (!$VMS_STATUS_SUCCESS (vms_status)) + { + printf ("lib$get_symbol for command failed: %d\n", vms_status); + status = 1; + } + + value[value_len] = 0; + result = strncasecmp (&value[1], vms_image, value_len - 1); + if (result != 0) + { + printf ("create_foreign_command failed! expected '%s', got '%s'\n", + vms_image, &value[1]); + status = 1; + } + + /* Test exporting a symbol */ + vms_status = vms_export_dcl_symbol (vms_symbol1, value1); + if (!$VMS_STATUS_SUCCESS (vms_status)) + { + printf ("vms_export_dcl_symbol for command failed: %d\n", vms_status); + status = 1; + } + + name_desc.dsc$a_pointer = (char *)vms_symbol1; + name_desc.dsc$w_length = strlen (vms_symbol1); + vms_status = LIB$GET_SYMBOL(&name_desc, &value_desc, + &value_len, &old_symtbl); + if (!$VMS_STATUS_SUCCESS(vms_status)) + { + printf ("lib$get_symbol for command failed: %d\n", vms_status); + status = 1; + } + + value[value_len] = 0; + result = strncmp (value, value1, value_len); + if (result != 0) + { + printf ("vms_export_dcl_symbol failed! expected '%s', got '%s'\n", + value1, value); + status = 1; + } + + /* Test putenv for DCL symbols */ + putenv_status = vms_putenv_symbol (putenv_string); + if (putenv_status != 0) + { + perror ("vms_putenv_symbol"); + status = 1; + } + + name_desc.dsc$a_pointer = (char *)vms_symbol2; + name_desc.dsc$w_length = strlen(vms_symbol2); + vms_status = LIB$GET_SYMBOL (&name_desc, &value_desc, + &value_len, &old_symtbl); + if (!$VMS_STATUS_SUCCESS (vms_status)) + { + printf ("lib$get_symbol for command failed: %d\n", vms_status); + status = 1; + } + + value[value_len] = 0; + result = strncmp (value, value2, value_len); + if (result != 0) + { + printf ("vms_putenv_symbol failed! expected '%s', got '%s'\n", + value2, value); + status = 1; + } + + vms_restore_symbol (putenv_string); + vms_status = LIB$GET_SYMBOL (&name_desc, &value_desc, + &value_len, &old_symtbl); + if ($VMS_STATUS_SUCCESS (vms_status)) + { + printf ("lib$get_symbol for command succeeded, should have failed\n"); + status = 1; + } + + exit (status); +} + +#endif -- cgit v1.2.3