summaryrefslogtreecommitdiff
path: root/vms
diff options
context:
space:
mode:
authorCraig A. Berry <craigberry@mac.com>2013-09-07 06:55:25 -0500
committerCraig A. Berry <craigberry@mac.com>2013-09-07 07:27:25 -0500
commit88e3936f9263b4a3622ca03a8c99eb54aeeb192b (patch)
tree078f9f353b030a98a2ff074709efb3b153c75281 /vms
parentb66f3475d343bb78e55b4ba343433044f5966b6b (diff)
downloadperl-88e3936f9263b4a3622ca03a8c99eb54aeeb192b.tar.gz
Fix processing of PERL_ENV_TABLES.
In a35dcc95dd24524931e I "improved" string safety in vms/vms.c by converting to my_strlcpy and my_strlcat, but mangled the length argument to my_strlcat when adding the name of the logical name table specified in PERL_ENV_TABLES. This caused the command string to be truncated, so a command that, for example, should have been: $ Show Logical * /Table=LNM$JOB ... actually became: $ Show Logical * /Table= %DCL-W-VALREQ, missing qualifier or keyword value - supply all required values Plus it turns out the strings holding the names of the tables were being stored in dynamic string descriptors and were not NUL-terminated, but the strl* functions require NUL-terminated arguments. So change those to static string descriptors and allocate the exact amount of storage needed including room for a NUL. This was a regression in 5.16.0, first reported a couple of days ago by Mark Daniel on comp.os.vms: Date: Fri, 06 Sep 2013 12:56:01 +0930 From: Mark Daniel <mark.daniel [AT] wasd.vsm.com.au> Newsgroups: comp.os.vms Message-ID: <52294b4a$0$2875$c3e8da3$76491128@news.astraweb.com> TODO: Figure out how and where to test this.
Diffstat (limited to 'vms')
-rw-r--r--vms/vms.c11
1 files changed, 6 insertions, 5 deletions
diff --git a/vms/vms.c b/vms/vms.c
index 0c44baf014..bf59e1595b 100644
--- a/vms/vms.c
+++ b/vms/vms.c
@@ -1371,7 +1371,7 @@ prime_env_iter(void)
my_strlcpy(cmd, "Show Logical *", sizeof(cmd));
if (str$case_blind_compare(env_tables[i],&fildevdsc)) {
my_strlcat(cmd," /Table=", sizeof(cmd));
- cmddsc.dsc$w_length = my_strlcat(cmd, env_tables[i]->dsc$a_pointer, env_tables[i]->dsc$w_length + 1);
+ cmddsc.dsc$w_length = my_strlcat(cmd, env_tables[i]->dsc$a_pointer, sizeof(cmd));
}
else cmddsc.dsc$w_length = 14; /* N.B. We test this below */
flags = defflags | CLI$M_NOCLISYM;
@@ -9658,11 +9658,12 @@ vms_image_init(int *argcp, char ***argvp)
}
tabvec[tabidx] = (struct dsc$descriptor_s *) PerlMem_malloc(sizeof(struct dsc$descriptor_s));
if (tabvec[tabidx] == NULL) _ckvmssts_noperl(SS$_INSFMEM);
- tabvec[tabidx]->dsc$w_length = 0;
+ tabvec[tabidx]->dsc$w_length = len;
tabvec[tabidx]->dsc$b_dtype = DSC$K_DTYPE_T;
- tabvec[tabidx]->dsc$b_class = DSC$K_CLASS_D;
- tabvec[tabidx]->dsc$a_pointer = NULL;
- _ckvmssts_noperl(lib$scopy_r_dx(&len,eqv,tabvec[tabidx]));
+ tabvec[tabidx]->dsc$b_class = DSC$K_CLASS_S;
+ tabvec[tabidx]->dsc$a_pointer = PerlMem_malloc(len + 1);
+ if (tabvec[tabidx]->dsc$a_pointer == NULL) _ckvmssts_noperl(SS$_INSFMEM);
+ my_strlcpy(tabvec[tabidx]->dsc$a_pointer, eqv, len + 1);
}
if (tabidx) { tabvec[tabidx] = NULL; env_tables = tabvec; }