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-2022 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 <https://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 alignment */
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 during 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