Change 30163 by [EMAIL PROTECTED] on 2007/02/07 20:48:27
Integrate:
[ 27561]
Subject: [EMAIL PROTECTED] utime patch for VMS
From: "John E. Malmberg" <[EMAIL PROTECTED]>
Date: Mon, 20 Mar 2006 08:12:19 -0500
Message-ID: <[EMAIL PROTECTED]>
[ 27669]
fix typo in vms/gen_shrfls.pl itanium detector
[ 27706]
sort out some utime() issues on VMS
[ 27806]
Don't die after SS$_NOPRIV in Perl_vmssetenv, courtesy
of Scott Lepage at HP.
[ 27807]
Honor READALL privilege in cando_by_name (from Scott
Lepage of HP OpenVMS Engineering)
[ 27808]
Fix bug in prime_env_iter where the terms of a comparison were reversed
so we thought we didn't have a logical name table when we did.
Reported as:
Subject: LWP::Simple crashes on VMSperl
From: "juna" <[EMAIL PROTECTED]>
Date: 24 Mar 2006 13:52:41 -0800
Newsgroups: comp.os.vms,comp.lang.perl.misc
Message-ID: <[EMAIL PROTECTED]>
[ 28348]
It's all relative -- better handling of tainted directories
in PATH on VMS (and scrubbing them in t/test.pl).
[ 28351]
Subject: [PATCH] mg.c: using #ifdef inside a macro call ENONPORTABLE
(causes e.g. AIX to barf)
From: Jarkko Hietaniemi <[EMAIL PROTECTED]>
Date: Sun, 4 Jun 2006 11:21:30 +0300 (EEST)
Message-Id: <[EMAIL PROTECTED]>
[ 28368]
autosplit one level deeper so we don't miss anything
on a second pass (where lib/auto already exists)
[ 28448]
Updated handling of signal names and signals for VMS
Affected files ...
... //depot/maint-5.8/perl/configure.com#50 integrate
... //depot/maint-5.8/perl/mg.c#147 integrate
... //depot/maint-5.8/perl/t/test.pl#18 integrate
... //depot/maint-5.8/perl/vms/descrip_mms.template#45 integrate
... //depot/maint-5.8/perl/vms/gen_shrfls.pl#5 integrate
... //depot/maint-5.8/perl/vms/perlvms.pod#10 integrate
... //depot/maint-5.8/perl/vms/vms.c#25 integrate
... //depot/maint-5.8/perl/vms/vmsish.h#14 integrate
Differences ...
==== //depot/maint-5.8/perl/configure.com#50 (text) ====
Index: perl/configure.com
--- perl/configure.com#49~30162~ 2007-02-07 10:45:59.000000000 -0800
+++ perl/configure.com 2007-02-07 12:48:27.000000000 -0800
@@ -3535,6 +3535,13 @@
$ GOSUB inhdr
$ i_unistd = tmp
$!
+$! Check to see if we've got utime.h (which we should use if we have)
+$!
+$ i_netdb = "undef"
+$ tmp = "utime.h"
+$ GOSUB inhdr
+$ i_utime = tmp
+$!
$! do we have getppid()?
$!
$ IF i_unistd .EQS. "define"
@@ -5100,37 +5107,41 @@
$ d_wait4="define"
$ d_index="define"
$ pidtype="pid_t"
-$ sig_name1="ZERO HUP INT QUIT ILL TRAP IOT EMT FPE KILL BUS SEGV SYS PIPE
ALRM "
-$ sig_name2="TERM ABRT USR1 USR2 SPARE18 SPARE19 CHLD CONT STOP TSTP TTIN
TTOU "
-$ sig_name3="DEBUG SPARE27 SPARE28 SPARE29 SPARE30 SPARE31 SPARE32 "
-$ sig_name4="WINCH "
-$ sig_namert="RTMIN RTMAX"
-$
psnwc1="""ZERO"",""HUP"",""INT"",""QUIT"",""ILL"",""TRAP"",""IOT"",""EMT"",""FPE"",""KILL"",""BUS"",""SEGV"",""SYS"","
-$
psnwc2="""PIPE"",""ALRM"",""TERM"",""ABRT"",""USR1"",""USR2"",""SPARE18"",""SPARE19"",""CHLD"",""CONT"",""STOP"",""TSTP"","
-$
psnwc3="""TTIN"",""TTOU"",""DEBUG"",""SPARE27"",""SPARE28"",""SPARE29"",""SPARE30"",""SPARE31"",""SPARE32"","
-$ psnwc4_v7_3="""WINCH"","
-$ psnwcrt="""RTMIN"",""RTMAX"",0"
-$ sig_num1="0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 6 16 17 18 19 20 21 22 23
24 25 26 27 28 29 30 31 32 "
-$ sig_num_v7_3="28 "
-$ sig_numrt="33 64"
-$
sig_num_init1="0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,6,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,"
-$ sig_num_init_v7_3="28,"
-$ sig_num_initrt="33,64,0"
-$ if (vms_ver .GES. "7.3")
-$ then
-$ sig_name = sig_name1 + sig_name2 + sig_name3 + sig_name4 + sig_namert
-$ sig_name_init = psnwc1 + psnwc2 + psnwc3 + psnwc4_v7_3 + psnwcrt
-$ sig_num = sig_num1 + sig_num_v7_3 + sig_numrt
-$ sig_num_init = sig_num_init1 + sig_num_v7_3 + sig_num_initrt
-$ sig_size="37"
-$ else
-$ sig_name = sig_name1 + sig_name2 + sig_name3 + sig_namert
-$ sig_name_init = psnwc1 + psnwc2 + psnwc3 + psnwcrt
-$ sig_num = sig_num1 + sig_numrt
-$ sig_num_init = sig_num_init1 + sig_num_initrt
-$ sig_size="36"
-$ endif
-$ sig_count="64"
+$ sig_name1="ZERO HUP INT QUIT ILL TRAP ABRT EMT FPE KILL BUS SEGV SYS PIPE"
+$ sig_name2=" ALRM TERM USR1 USR2 NUM18 NUM19 CHLD CONT STOP TSTP TTIN TTOU
DEBUG"
+$ IF (vms_ver .GES. "7.3")
+$ THEN
+$ sig_name2 = sig_name2 + " NUM27 WINCH"
+$ ENDIF
+$!* signal.h defines SIGRTMIN as 33 and SIGRTMAX as 64, but there is no
+$!* sigqueue function or other apparent means to do realtime signalling,
+$!* so let's not try to include the realtime range for now.
+$!* sig_name3=" NUM29 NUM30 NUM31 NUM32 RTMIN NUM34 NUM35 NUM36 NUM37 NUM38
NUM39 NUM40 NUM41 NUM42 NUM43"
+$!* sig_name4=" NUM44 NUM45 NUM46 NUM47 NUM48 NUM49 NUM50 NUM51 NUM52 NUM53
NUM54 NUM55 NUM56 NUM57 NUM58"
+$!* sig_name5=" NUM59 NUM60 NUM61 NUMT62 NUM63 RTMAX"
+$ sig_name = sig_name1 + sig_name2
+$ sig_num = ""
+$ sig_num_init = ""
+$ sig_name_init = ""
+$ sig_index = 0
+$!
+$ PARSE_SIG_NAME_LOOP:
+$!
+$ tmp = F$ELEMENT(sig_index, " ", sig_name)
+$ IF F$LENGTH(F$EDIT(tmp,"TRIM")) .eq. 0 THEN GOTO END_SIG_NAME_LOOP
+$ sig_name_init = sig_name_init + """''tmp'"","
+$ sig_num = sig_num + "''sig_index' "
+$ sig_num_init = sig_num_init + "''sig_index',"
+$ sig_index = sig_index + 1
+$ GOTO PARSE_SIG_NAME_LOOP
+$!
+$ END_SIG_NAME_LOOP:
+$!
+$ sig_name_init = sig_name_init + "0"
+$ sig_num_init = sig_num_init + "0"
+$ sig_size = "''sig_index'"
+$ sig_index = sig_index - 1
+$ sig_count = "''sig_index'"
$ uidtype="uid_t"
$ d_pathconf="define"
$ d_fpathconf="define"
@@ -5505,20 +5516,12 @@
$ echo4 "Yep, we can."
$ kill_by_sigprc = "define"
$!
-$! since SIGBUS and SIGSEGV indistinguishable, make them the same here.
-$! sigusr1 and sigusr2 show up in VMS6.2 and later
+$! Use the same list of signals the CRTL does for recent systems, but cook
our own for very old systems.
+$! Note that the list controls what signals can be caught by name as well
as what can be raised via kill().
$!
-$ if vms_ver .GES. "6.2"
-$ then
-$ sig_name="ZERO HUP INT QUIT ILL TRAP IOT EMT FPE KILL BUS SEGV SYS
PIPE ALRM TERM ABRT USR1 USR2"
-$
psnwc1="""ZERO"",""HUP"",""INT"",""QUIT"",""ILL"",""TRAP"",""IOT"",""EMT"",""FPE"",""KILL"",""BUS"",""SEGV"",""SYS"","
-$ psnwc2="""PIPE"",""ALRM"",""TERM"",""ABRT"",""USR1"",""USR2"",0"
-$ sig_name_init = psnwc1 + psnwc2
-$ sig_num="0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 6 16 17"
-$ sig_num_init="0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,6,16,17,0"
-$ sig_size="19"
-$ sig_count="17"
-$ else
+$ if vms_ver .LT. "6.2"
+$ then
+$! since SIGBUS and SIGSEGV indistinguishable, make them the same
here.
$ sig_name="ZERO HUP INT QUIT ILL TRAP IOT EMT FPE KILL BUS SEGV SYS
PIPE ALRM TERM ABRT"
$
psnwc1="""ZERO"",""HUP"",""INT"",""QUIT"",""ILL"",""TRAP"",""IOT"",""EMT"",""FPE"",""KILL"",""BUS"",""SEGV"",""SYS"","
$ psnwc2="""PIPE"",""ALRM"",""TERM"",""ABRT"",0"
@@ -6149,7 +6152,7 @@
$ WC "i_time='define'"
$ WC "i_unistd='" + i_unistd + "'"
$ WC "i_ustat='undef'"
-$ WC "i_utime='undef'"
+$ WC "i_utime='" + i_utime + "'"
$ WC "i_values='undef'"
$ WC "i_varargs='undef'"
$ WC "i_vfork='undef'"
@@ -6281,8 +6284,15 @@
$ WC "shmattype='" + " '"
$ WC "shortsize='" + shortsize + "'"
$ WC "shrplib='define'"
-$ WC "sig_name='" + sig_name + "'"
-$ IF (f$length(sig_name_init) .GE. 1024)
+$ IF (f$length(sig_name) .GE. 244)
+$ THEN
+$ tmp = "sig_name='" + sig_name + "'"
+$ WC/symbol tmp
+$ DELETE/SYMBOL tmp
+$ ELSE
+$ WC "sig_name='" + sig_name + "'"
+$ ENDIF
+$ IF (f$length(sig_name_init) .GE. 244)
$ THEN
$ tmp = "sig_name_init='" + sig_name_init + "'"
$ WC/symbol tmp
==== //depot/maint-5.8/perl/mg.c#147 (text) ====
Index: perl/mg.c
--- perl/mg.c#146~30141~ 2007-02-05 14:46:22.000000000 -0800
+++ perl/mg.c 2007-02-07 12:48:27.000000000 -0800
@@ -1116,6 +1116,11 @@
#endif /* VMS */
if (s && klen == 4 && strEQ(ptr,"PATH")) {
const char * const strend = s + len;
+#ifdef VMS /* Hmm. How do we get $Config{path_sep} from C? */
+ const char path_sep = '|';
+#else
+ const char path_sep = ':';
+#endif
while (s < strend) {
char tmpbuf[256];
@@ -1127,10 +1132,14 @@
const char path_sep = ':';
#endif
s = delimcpy(tmpbuf, tmpbuf + sizeof tmpbuf,
- (char *) s, (char *) strend, ':', &i);
+ (char *) s, (char *) strend, path_sep, &i);
s++;
if (i >= (I32)sizeof tmpbuf /* too long -- assume the worst */
- || *tmpbuf != '/'
+#ifdef VMS
+ || !strchr(tmpbuf, ':') /* no colon thus no device name
-- assume relative path */
+#else
+ || *tmpbuf != '/' /* no starting slash -- assume
relative path */
+#endif
|| (PerlLIO_stat(tmpbuf, &st) == 0 && (st.st_mode & 2)) )
{
MgTAINTEDDIR_on(mg);
return 0;
==== //depot/maint-5.8/perl/t/test.pl#18 (text) ====
Index: perl/t/test.pl
--- perl/t/test.pl#17~28161~ 2006-05-11 05:16:42.000000000 -0700
+++ perl/t/test.pl 2007-02-07 12:48:27.000000000 -0800
@@ -523,10 +523,11 @@
my @keys = grep {exists $ENV{$_}} qw(CDPATH IFS ENV BASH_ENV);
local @[EMAIL PROTECTED] = ();
# Untaint, plus take out . and empty string:
+ local $ENV{'DCL$PATH'} = $1 if $is_vms && ($ENV{'DCL$PATH'} =~ /(.*)/s);
$ENV{PATH} =~ /(.*)/s;
local $ENV{PATH} =
join $sep, grep { $_ ne "" and $_ ne "." and
- ($is_mswin or !(stat && (stat _)[2]&0022)) }
+ ($is_mswin or $is_vms or !(stat && (stat _)[2]&0022)) }
split quotemeta ($sep), $1;
$runperl =~ /(.*)/s;
==== //depot/maint-5.8/perl/vms/descrip_mms.template#45 (text) ====
Index: perl/vms/descrip_mms.template
--- perl/vms/descrip_mms.template#44~30162~ 2007-02-07 10:45:59.000000000
-0800
+++ perl/vms/descrip_mms.template 2007-02-07 12:48:27.000000000 -0800
@@ -671,7 +671,7 @@
preplibrary : $(MINIPERL_EXE) $(LIBPREREQ)
@ Write Sys$Output "Autosplitting Perl library . . ."
@ Create/Directory [.lib.auto]
- @ $(MINIPERL) -e "use AutoSplit; autosplit_lib_modules(@ARGV)"
[.lib]*.pm [.lib.*]*.pm
+ @ $(MINIPERL) -e "use AutoSplit; autosplit_lib_modules(@ARGV)"
[.lib]*.pm [.lib.*]*.pm [.lib.*.*]*.pm
[.lib.pods]perl.pod : [.pod]perl.pod
@ If F$Search("[.lib]pods.dir").eqs."" Then Create/Directory [.lib.pods]
==== //depot/maint-5.8/perl/vms/gen_shrfls.pl#5 (text) ====
Index: perl/vms/gen_shrfls.pl
--- perl/vms/gen_shrfls.pl#4~30162~ 2007-02-07 10:45:59.000000000 -0800
+++ perl/vms/gen_shrfls.pl 2007-02-07 12:48:27.000000000 -0800
@@ -60,7 +60,7 @@
chomp $isvax;
print "\$isvax: \\$isvax\\\n" if $debug;
-$isi64 = `\$ Write Sys\$Output \(F\$GetSyI(\"HW_MODEL\") .GE. 4096`;
+$isi64 = `\$ Write Sys\$Output \(F\$GetSyI(\"HW_MODEL\") .GE. 4096)`;
chomp $isi64;
print "\$isi64: \\$isi64\\\n" if $debug;
==== //depot/maint-5.8/perl/vms/perlvms.pod#10 (text) ====
Index: perl/vms/perlvms.pod
--- perl/vms/perlvms.pod#9~30161~ 2007-02-07 09:31:52.000000000 -0800
+++ perl/vms/perlvms.pod 2007-02-07 12:48:27.000000000 -0800
@@ -881,9 +881,10 @@
=item utime LIST
-Since ODS-2, the VMS file structure for disk files, does not keep
-track of access times, this operator changes only the modification
-time of the file (VMS revision date).
+This operator changes only the modification time of the file (VMS
+revision date) on ODS-2 volumes and ODS-5 volumes without access
+dates enabled. On ODS-5 volumes with access dates enabled, the
+true access time is modified.
=item waitpid PID,FLAGS
==== //depot/maint-5.8/perl/vms/vms.c#25 (text) ====
Index: perl/vms/vms.c
--- perl/vms/vms.c#24~30161~ 2007-02-07 09:31:52.000000000 -0800
+++ perl/vms/vms.c 2007-02-07 12:48:27.000000000 -0800
@@ -736,7 +736,7 @@
for (i = 0; env_tables[i]; i++) {
if (!have_sym && (tmpdsc.dsc$a_pointer = env_tables[i]->dsc$a_pointer) &&
!str$case_blind_compare(&tmpdsc,&clisym)) have_sym = 1;
- if (!have_lnm && !str$case_blind_compare(env_tables[i],&crtlenv))
have_lnm = 1;
+ if (!have_lnm && str$case_blind_compare(env_tables[i],&crtlenv)) have_lnm
= 1;
}
if (have_sym || have_lnm) {
long int syiitm = SYI$_MAXBUF, dviitm = DVI$_DEVNAM;
@@ -1045,7 +1045,7 @@
case LIB$_NOSUCHSYM: case SS$_NOLOGNAM:
set_errno(EINVAL); break;
case SS$_NOPRIV:
- set_errno(EACCES);
+ set_errno(EACCES); break;
default:
_ckvmssts(retsts);
set_errno(EVMSERR);
@@ -1452,7 +1452,7 @@
than signalling with an unrecognized (and unhandled by CRTL) code.
*/
-#define _MY_SIG_MAX 17
+#define _MY_SIG_MAX 28
static unsigned int
Perl_sig_to_vmscondition_int(int sig)
@@ -1480,7 +1480,18 @@
SS$_ASTFLT, /* 14 SIGALRM */
4, /* 15 SIGTERM */
0, /* 16 SIGUSR1 */
- 0 /* 17 SIGUSR2 */
+ 0, /* 17 SIGUSR2 */
+ 0, /* 18 */
+ 0, /* 19 */
+ 0, /* 20 SIGCHLD */
+ 0, /* 21 SIGCONT */
+ 0, /* 22 SIGSTOP */
+ 0, /* 23 SIGTSTP */
+ 0, /* 24 SIGTTIN */
+ 0, /* 25 SIGTTOU */
+ 0, /* 26 */
+ 0, /* 27 */
+ 0 /* 28 SIGWINCH */
};
#if __VMS_VER >= 60200000
@@ -1489,6 +1500,12 @@
initted = 1;
sig_code[16] = C$_SIGUSR1;
sig_code[17] = C$_SIGUSR2;
+#if __CRTL_VER >= 70000000
+ sig_code[20] = C$_SIGCHLD;
+#endif
+#if __CRTL_VER >= 70300000
+ sig_code[28] = C$_SIGWINCH;
+#endif
}
#endif
@@ -7537,15 +7554,23 @@
#define time(t) my_time(t)
-/* my_utime - update modification time of a file
- * calling sequence is identical to POSIX utime(), but under
- * VMS only the modification time is changed; ODS-2 does not
- * maintain access times. Restrictions differ from the POSIX
+/* my_utime - update modification/access time of a file
+ *
+ * VMS 7.3 and later implementation
+ * Only the UTC translation is home-grown. The rest is handled by the
+ * CRTL utime(), which will take into account the relevant feature
+ * logicals and ODS-5 volume characteristics for true access times.
+ *
+ * pre VMS 7.3 implementation:
+ * The calling sequence is identical to POSIX utime(), but under
+ * VMS with ODS-2, only the modification time is changed; ODS-2 does
+ * not maintain access times. Restrictions differ from the POSIX
* definition in that the time can be changed as long as the
* caller has permission to execute the necessary IO$_MODIFY $QIO;
* no separate checks are made to insure that the caller is the
* owner of the file or has special privs enabled.
* Code here is based on Joe Meadows' FILE utility.
+ *
*/
/* Adjustment from Unix epoch (01-JAN-1970 00:00:00.00)
@@ -7557,6 +7582,29 @@
/*{{{int my_utime(const char *path, const struct utimbuf *utimes)*/
int Perl_my_utime(pTHX_ const char *file, const struct utimbuf *utimes)
{
+#if __CRTL_VER >= 70300000
+ struct utimbuf utc_utimes, *utc_utimesp;
+
+ if (utimes != NULL) {
+ utc_utimes.actime = utimes->actime;
+ utc_utimes.modtime = utimes->modtime;
+# ifdef VMSISH_TIME
+ /* If input was local; convert to UTC for sys svc */
+ if (VMSISH_TIME) {
+ utc_utimes.actime = _toutc(utimes->actime);
+ utc_utimes.modtime = _toutc(utimes->modtime);
+ }
+# endif
+ utc_utimesp = &utc_utimes;
+ }
+ else {
+ utc_utimesp = NULL;
+ }
+
+ return utime(file, utc_utimesp);
+
+#else /* __CRTL_VER < 70300000 */
+
register int i;
int sts;
long int bintime[2], len = 2, lowbit, unixtime,
@@ -7584,14 +7632,17 @@
struct dsc$descriptor fibdsc = {sizeof(myfib), DSC$K_DTYPE_Z,
DSC$K_CLASS_S,(char *) &myfib},
devdsc = {0,DSC$K_DTYPE_T, DSC$K_CLASS_S,0},
fnmdsc = {0,DSC$K_DTYPE_T, DSC$K_CLASS_S,0};
-
+
if (file == NULL || *file == '\0') {
- set_errno(ENOENT);
- set_vaxc_errno(LIB$_INVARG);
+ SETERRNO(ENOENT, LIB$_INVARG);
return -1;
}
- if (do_tovmsspec((char *)file,vmsspec,0) == NULL) return -1;
+ /* Convert to VMS format ensuring that it will fit in 255 characters */
+ if (do_rmsexpand(file, vmsspec, 0, NULL, PERL_RMSEXPAND_M_VMS) == NULL) {
+ SETERRNO(ENOENT, LIB$_INVARG);
+ return -1;
+ }
if (utimes != NULL) {
/* Convert Unix time (seconds since 01-JAN-1970 00:00:00.00)
* to VMS quadword time (100 nsec intervals since 01-JAN-1858 00:00:00.00).
@@ -7608,14 +7659,12 @@
unixtime >>= 1; secscale <<= 1;
retsts = lib$emul(&secscale, &unixtime, &lowbit, bintime);
if (!(retsts & 1)) {
- set_errno(EVMSERR);
- set_vaxc_errno(retsts);
+ SETERRNO(EVMSERR, retsts);
return -1;
}
retsts = lib$addx(bintime,utime_baseadjust,bintime,&len);
if (!(retsts & 1)) {
- set_errno(EVMSERR);
- set_vaxc_errno(retsts);
+ SETERRNO(EVMSERR, retsts);
return -1;
}
}
@@ -7623,8 +7672,7 @@
/* Just get the current time in VMS format directly */
retsts = sys$gettim(bintime);
if (!(retsts & 1)) {
- set_errno(EVMSERR);
- set_vaxc_errno(retsts);
+ SETERRNO(EVMSERR, retsts);
return -1;
}
}
@@ -7706,6 +7754,9 @@
}
return 0;
+
+#endif /* #if __CRTL_VER >= 70300000 */
+
} /* end of my_utime() */
/*}}}*/
@@ -7865,12 +7916,13 @@
static struct dsc$descriptor_s usrdsc =
{0, DSC$K_DTYPE_T, DSC$K_CLASS_S, usrname};
char vmsname[NAM$C_MAXRSS+1], fileified[NAM$C_MAXRSS+1];
- unsigned long int objtyp = ACL$C_FILE, access, retsts, privused, iosb[2];
+ 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};
union prvdef curprv;
- struct itmlst_3 armlst[3] = {{sizeof access, CHP$_ACCESS, &access, &retlen},
- {sizeof privused, CHP$_PRIVUSED, &privused, &retlen},{0,0,0,0}};
+ struct itmlst_3 armlst[4] = {{sizeof access, CHP$_ACCESS, &access, &retlen},
+ {sizeof privused, CHP$_PRIVUSED, &privused, &retlen},
+ {sizeof flags, CHP$_FLAGS, &flags, &retlen},{0,0,0,0}};
struct itmlst_3 jpilst[3] = {{sizeof curprv, JPI$_CURPRIV, &curprv, &retlen},
{sizeof usrname, JPI$_USERNAME, &usrname, &usrdsc.dsc$w_length},
{0,0,0,0}};
@@ -7901,13 +7953,21 @@
switch (bit) {
case S_IXUSR: case S_IXGRP: case S_IXOTH:
- access = ARM$M_EXECUTE; break;
+ access = ARM$M_EXECUTE;
+ flags = CHP$M_READ;
+ break;
case S_IRUSR: case S_IRGRP: case S_IROTH:
- access = ARM$M_READ; break;
+ access = ARM$M_READ;
+ flags = CHP$M_READ | CHP$M_USEREADALL;
+ break;
case S_IWUSR: case S_IWGRP: case S_IWOTH:
- access = ARM$M_WRITE; break;
+ access = ARM$M_WRITE;
+ flags = CHP$M_READ | CHP$M_WRITE;
+ break;
case S_IDUSR: case S_IDGRP: case S_IDOTH:
- access = ARM$M_DELETE; break;
+ access = ARM$M_DELETE;
+ flags = CHP$M_READ | CHP$M_WRITE;
+ break;
default:
return FALSE;
}
==== //depot/maint-5.8/perl/vms/vmsish.h#14 (text) ====
Index: perl/vms/vmsish.h
--- perl/vms/vmsish.h#13~30158~ 2007-02-07 08:33:27.000000000 -0800
+++ perl/vms/vmsish.h 2007-02-07 12:48:27.000000000 -0800
@@ -445,12 +445,18 @@
# include <signal.h>
#define ABORT() abort()
+#ifdef I_UTIME
+#include <utime.h>
+#else
/* Used with our my_utime() routine in vms.c */
struct utimbuf {
time_t actime;
time_t modtime;
};
+#endif
+#ifndef DONT_MASK_RTL_CALLS
#define utime my_utime
+#endif
/* This is what times() returns, but <times.h> calls it tbuffer_t on VMS
* prior to v7.0. We check the DECC manifest to see whether it's already
End of Patch.
