"Craig A. Berry" <[EMAIL PROTECTED]> writes:
> Thanks for allowing me to goad you into all this extra work :-).
%SYS-F-TUITQUOEXH, Tuit quota exhausted, add caffiene
> Option 3 does sound like the cleanest. If it's the definition of
> SYS$ERROR during image run-down that contradicts the rest of the
> redirection scheme, then redefining the logical does seem like the
> way to go. Unfortunately you'll have to use sys$crelnm with the 4th
> argument set to PSL$C_USER to get a user-mode logical since
> lib$set_logical doesn't do modes.
I've been mucking about with this today, with mixed results.
A little standalone program works fine, Perl from command line works fine.
But it seems that that in the perl piped subprocesses we have
SYS$ERROR defined /EXEC by lib$spawn, defined /SUPER by the VMSPIPE
procedure when it redirects to inherit the parent's i/o, and defined
/USER inside Perl when we try to use option #3.
My response is to change VMSPIPE to use a /USER definition of sys$error.
*That* now seems to work.
> I take it this would go in getredirection(). Would you redefine the
> logical for all 2> redirections, or only when the output is the
> special &1 case?
All of 'em (it's only two simple cases):
2>&1 DEFINE/USER SYS$ERROR SYS$OUTPUT
2>XYZ DEFINE/USER SYS$ERROR XYZ
Now, it's arguable that we should do the same with SYS$OUTPUT redirection,
since the error messages are also written to SYS$OUTPUT...but it does
rather look like the messages go to all of the SYS$OUTPUT and SYS$ERROR
logicals in all of their modes.
And since we really can't do much with /EXEC mode logicals without privs,
having a DEFINE/USER of SYS$OUTPUT might not really help us that much.
I *suspect* the writing of messages to various mode logicals because
a program like:
#! perl
if ($ARGV[0] ne 'foo') {
$a = `$^X $0 foo 2>&1`;
$a =~ s/\n/\nread from sub:\'/g;
print "read from sub:'$a'\n";
} else {
print STDERR "sub writing to stderr\n";
exit(44);
}
will give:
%SYSTEM-F-ABORT, abort sys$error [super] (inherited)
%SYSTEM-F-ABORT, abort ???
read from sub:'sub writing to stderr
read from sub:'%SYSTEM-F-ABORT, abort sys$output [exec]
read from sub:'%SYSTEM-F-ABORT, abort sys$error [exec]
read from sub:''
Four error messages from a single error?
After the patch below:
read from sub:'sub writing to stderr
read from sub:'%SYSTEM-F-ABORT, abort
read from sub:'%SYSTEM-F-ABORT, abort
read from sub:''
The following patch is very preliminary, and might well fail in various
nasty ways....the test suite does get "all tests ok" on my machine though.
It does *not* do anything about SYS$OUTPUT, nor does it handle stuff
like "open(STDERR, '>blah')", which it really should.
But it might be okay for testing whether the concept is valid. Bang
on it and lets find out if it breaks.
You know, all this stuff makes me think we should have a test in the
test suite that really exercises i/o redirection and inheritance. But
since such a test would likely point out problems in many implementations
(maybe even some unix ones) it might not be too popular :)
diff -uBb vms/vms.c-orig vms/vms.c
--- vms/vms.c-orig Wed Nov 29 23:21:34 2000
+++ vms/vms.c Fri Dec 1 15:04:35 2000
@@ -730,6 +730,30 @@
}
/*}}}*/
+/*{{{static void vmssetuserlnm(char *name, char *eqv);
+/* vmssetuserlnm
+ * sets a user-mode logical in the process logical name table
+ * used for redirection of sys$error
+ */
+static void
+vmssetuserlnm(char *name, char *eqv)
+{
+ $DESCRIPTOR(d_tab, "LNM$PROCESS");
+ struct dsc$descriptor_d d_name = {0,DSC$K_DTYPE_T,DSC$K_CLASS_D,0};
+ unsigned long int iss, attr = 0;
+ unsigned char acmode = PSL$C_USER;
+ struct itmlst_3 lnmlst[2] = {{0, LNM$_STRING, 0, 0},
+ {0, 0, 0, 0}};
+ d_name.dsc$a_pointer = name;
+ d_name.dsc$w_length = strlen(name);
+
+ lnmlst[0].buflen = strlen(eqv);
+ lnmlst[0].bufadr = eqv;
+
+ iss = sys$crelnm(&attr,&d_tab,&d_name,&acmode,lnmlst);
+ if (!(iss&1)) lib$signal(iss);
+}
+/*}}}*/
/*{{{ char *my_crypt(const char *textpasswd, const char *usrname)*/
@@ -3575,6 +3599,7 @@
if (err != NULL) {
if (strcmp(err,"&1") == 0) {
dup2(fileno(stdout), fileno(Perl_debug_log));
+ vmssetuserlnm("SYS$ERROR","SYS$OUTPUT");
} else {
FILE *tmperr;
if (NULL == (tmperr = fopen(err, errmode, "mbc=32", "mbf=2")))
@@ -3587,6 +3612,7 @@
{
exit(vaxc$errno);
}
+ vmssetuserlnm("SYS$ERROR",err);
}
}
#ifdef ARGPROC_DEBUG
diff -uBb vms/vmspipe.com-orig vms/vmspipe.com
--- vms/vmspipe.com-orig Fri Dec 1 17:00:43 2000
+++ vms/vmspipe.com Fri Dec 1 17:00:06 2000
@@ -7,7 +7,7 @@
$ pif = "if"
$! --- define i/o redirection (sys$output set by lib$spawn)
$ pif perl_popen_in .nes. "" then perl_define sys$input 'perl_popen_in'
-$ pif perl_popen_err .nes. "" then perl_define sys$error 'perl_popen_err'
+$ pif perl_popen_err .nes. "" then perl_define/user sys$error 'perl_popen_err'
$ cmd = perl_popen_cmd
$! --- get rid of global symbols
$ perl_del/symbol/global perl_popen_in
--
Drexel University \V --Chuck Lane
======]---------->--------*------------<-------[===========
(215) 895-1545 _/ \ Particle Physics
FAX: (215) 895-5934 /\ /~~~~~~~~~~~ [EMAIL PROTECTED]
