Change 31326 by [EMAIL PROTECTED] on 2007/06/02 16:02:03
Assorted fixes for VMS version of cando_by_name:
-- Restore pre-5.9.x behavior of expanding logical names and fileifying
directory specs regardless of whether input spec is in VMS syntax.
-- VMSify input spec unless explicitly told we don't need to (this was
backwards since introduced in #27733).
-- Various memory handling robustifications.
Affected files ...
... //depot/perl/vms/vms.c#196 edit
Differences ...
==== //depot/perl/vms/vms.c#196 (text) ====
Index: perl/vms/vms.c
--- perl/vms/vms.c#195~31320~ 2007-05-31 15:17:17.000000000 -0700
+++ perl/vms/vms.c 2007-06-02 09:02:03.000000000 -0700
@@ -5182,7 +5182,7 @@
(!decc_posix_compliant_pathnames && decc_disable_posix_root)) {
strcpy(trndir,*dir == '/' ? dir + 1: dir);
trnlnm_iter_count = 0;
- while (!strpbrk(trndir,"/]>:>") && my_trnlnm(trndir,trndir,0)) {
+ while (!strpbrk(trndir,"/]>:") && my_trnlnm(trndir,trndir,0)) {
trnlnm_iter_count++;
if (trnlnm_iter_count >= PERL_LNM_MAX_ITER) break;
}
@@ -10920,11 +10920,10 @@
Perl_cando_by_name_int
(pTHX_ I32 bit, bool effective, const char *fname, int opts)
{
- static char usrname[L_cuserid];
- static struct dsc$descriptor_s usrdsc =
+ char usrname[L_cuserid];
+ struct dsc$descriptor_s usrdsc =
{0, DSC$K_DTYPE_T, DSC$K_CLASS_S, usrname};
- char vmsname[NAM$C_MAXRSS+1];
- char *fileified;
+ char *vmsname = NULL, *fileified = NULL;
unsigned long int objtyp = ACL$C_FILE, access, retsts, privused, iosb[2],
flags;
unsigned short int retlen, trnlnm_iter_count;
struct dsc$descriptor_s namdsc = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0};
@@ -10941,38 +10940,52 @@
static int profile_context = -1;
if (!fname || !*fname) return FALSE;
- /* Make sure we expand logical names, since sys$check_access doesn't */
- fileified = NULL;
- if ((opts & PERL_RMSEXPAND_M_VMS_IN) != 0) {
- fileified = PerlMem_malloc(VMS_MAXRSS);
- if (!strpbrk(fname,"/]>:")) {
+ /* Make sure we expand logical names, since sys$check_access doesn't */
+ fileified = PerlMem_malloc(VMS_MAXRSS);
+ if (fileified == NULL) _ckvmssts(SS$_INSFMEM);
+ if (!strpbrk(fname,"/]>:")) {
strcpy(fileified,fname);
trnlnm_iter_count = 0;
- while (!strpbrk(fileified,"/]>:>") && my_trnlnm(fileified,fileified,0)) {
+ while (!strpbrk(fileified,"/]>:") && my_trnlnm(fileified,fileified,0)) {
trnlnm_iter_count++;
if (trnlnm_iter_count >= PERL_LNM_MAX_ITER) break;
}
fname = fileified;
- }
+ }
+
+ vmsname = PerlMem_malloc(VMS_MAXRSS);
+ if (vmsname == NULL) _ckvmssts(SS$_INSFMEM);
+ if ( !(opts & PERL_RMSEXPAND_M_VMS_IN) ) {
+ /* Don't know if already in VMS format, so make sure */
if (!do_rmsexpand(fname, vmsname, 0, NULL, PERL_RMSEXPAND_M_VMS, NULL,
NULL)) {
PerlMem_free(fileified);
+ PerlMem_free(vmsname);
return FALSE;
}
- retlen = namdsc.dsc$w_length = strlen(vmsname);
- namdsc.dsc$a_pointer = vmsname;
- if (vmsname[retlen-1] == ']' || vmsname[retlen-1] == '>' ||
- vmsname[retlen-1] == ':') {
- if (!do_fileify_dirspec(vmsname,fileified,1,NULL)) return FALSE;
- namdsc.dsc$w_length = strlen(fileified);
- namdsc.dsc$a_pointer = fileified;
- }
}
else {
- retlen = namdsc.dsc$w_length = strlen(fname);
- namdsc.dsc$a_pointer = (char *)fname; /* cast ok */
+ strcpy(vmsname,fname);
}
+ /* sys$check_access needs a file spec, not a directory spec */
+
+ retlen = namdsc.dsc$w_length = strlen(vmsname);
+ if (vmsname[retlen-1] == ']'
+ || vmsname[retlen-1] == '>'
+ || vmsname[retlen-1] == ':') {
+
+ if (!do_fileify_dirspec(vmsname,fileified,1,NULL)) {
+ PerlMem_free(fileified);
+ PerlMem_free(vmsname);
+ return FALSE;
+ }
+ fname = fileified;
+ }
+
+ retlen = namdsc.dsc$w_length = strlen(fname);
+ namdsc.dsc$a_pointer = (char *)fname;
+
switch (bit) {
case S_IXUSR: case S_IXGRP: case S_IXOTH:
access = ARM$M_EXECUTE;
@@ -10993,6 +11006,8 @@
default:
if (fileified != NULL)
PerlMem_free(fileified);
+ if (vmsname != NULL)
+ PerlMem_free(vmsname);
return FALSE;
}
@@ -11039,17 +11054,23 @@
else set_errno(ENOENT);
if (fileified != NULL)
PerlMem_free(fileified);
+ if (vmsname != NULL)
+ PerlMem_free(vmsname);
return FALSE;
}
if (retsts == SS$_NORMAL || retsts == SS$_ACCONFLICT) {
if (fileified != NULL)
PerlMem_free(fileified);
+ if (vmsname != NULL)
+ PerlMem_free(vmsname);
return TRUE;
}
_ckvmssts(retsts);
if (fileified != NULL)
PerlMem_free(fileified);
+ if (vmsname != NULL)
+ PerlMem_free(vmsname);
return FALSE; /* Should never get here */
}
End of Patch.
