From aa779de11089a0113274275ef26a76ef1270014a Mon Sep 17 00:00:00 2001 From: Charles Bailey Date: Sun, 27 Feb 2000 04:58:01 +0000 Subject: [PATCH] Accept filespecs as command verbs for subprocesses p4raw-id: //depot/vmsperl@5280 --- vms/perlvms.pod | 30 ++++++++++------- vms/vms.c | 99 ++++++++++++++++++++++++++++++++++++--------------------- 2 files changed, 82 insertions(+), 47 deletions(-) diff --git a/vms/perlvms.pod b/vms/perlvms.pod index 1705bf8..53925b2 100644 --- a/vms/perlvms.pod +++ b/vms/perlvms.pod @@ -194,11 +194,13 @@ so we can try to work around them. =head2 Wildcard expansion File specifications containing wildcards are allowed both on -the command line and within Perl globs (e.g. *.cE>). If +the command line and within Perl globs (e.g. *.cE>). If the wildcard filespec uses VMS syntax, the resultant filespecs will follow VMS syntax; if a Unix-style filespec is passed in, Unix-style filespecs will be returned. +In both cases, VMS wildcard expansion is performed. (csh-style +wildcard expansion is available if you use C.) If the wildcard filespec contains a device or directory specification, then the resultant filespecs will also contain a device and directory; otherwise, device and directory @@ -225,9 +227,9 @@ subprocesses around when Perl exits. You may also use backticks to invoke a DCL subprocess, whose output is used as the return value of the expression. The -string between the backticks is passed directly to lib$spawn -as the command to execute. In this case, Perl will wait for -the subprocess to complete before continuing. +string between the backticks is handled as if it were the +argument to the C operator (see below). In this case, +Perl will wait for the subprocess to complete before continuing. =head1 PERL5LIB and PERLLIB @@ -456,7 +458,7 @@ handlers to the subprocess are limited.) If the call to C does not follow a call to C, it will cause Perl to exit, and to invoke the command given as an argument to C via C. If the argument -begins with a '$' (other than as part of a filespec), then it +begins with '@' or '$' (other than as part of a filespec), then it is executed as a DCL command. Otherwise, the first token on the command line is treated as the filespec of an image to run, and an attempt is made to invoke it (using F<.Exe> and @@ -549,7 +551,14 @@ though, so caveat scriptor. The C operator creates a subprocess, and passes its arguments to the subprocess for execution as a DCL command. Since the subprocess is created directly via C, any -valid DCL command string may be specified. If LIST consists +valid DCL command string may be specified. If the string begins with +'@', it is treated as a DCL command unconditionally. Otherwise, if +the first token contains a character used as a delimiter in file +specification (e.g. C<:> or C<]>), an attempt is made to expand it +using a default type of F<.Exe> and the process defaults, and if +successful, the resulting file is invoked via C. This allows you +to invoke an image directly simply by passing the file specification +to C, a common Unixish idiom. If LIST consists of the empty string, C spawns an interactive DCL subprocess, in the same fashion as typiing B at the DCL prompt. Perl waits for the subprocess to complete before continuing @@ -846,11 +855,10 @@ problems. =head1 Revision date -This document was last updated on 26-Feb-1998, for Perl 5, -patchlevel 5. +This document was last updated on 26-Feb-2000, for Perl 5, +patchlevel 6. =head1 AUTHOR -Charles Bailey bailey@cor.newman.upenn.edu - -Last revision by Dan Sugalski sugalskd@ous.edu +Charles Bailey +Dan Sugalski diff --git a/vms/vms.c b/vms/vms.c index fac9243..c80de00 100644 --- a/vms/vms.c +++ b/vms/vms.c @@ -2,7 +2,7 @@ * * VMS-specific routines for perl5 * - * Last revised: 15-Aug-1999 by Charles Bailey bailey@newman.upenn.edu + * Last revised: 24-Feb-2000 by Charles Bailey bailey@newman.upenn.edu * Version: 5.5.60 */ @@ -95,6 +95,9 @@ static bool will_taint = FALSE; /* tainting active, but no PL_curinterp yet */ /* munching */ static int no_translate_barewords; +/* Temp for subprocess commands */ +static struct dsc$descriptor_s VMScmd = {0,DSC$K_DTYPE_T,DSC$K_CLASS_S,Nullch}; + /*{{{int vmstrnenv(const char *lnm, char *eqv, unsigned long int idx, struct dsc$descriptor_s **tabvec, unsigned long int flags) */ int vmstrnenv(const char *lnm, char *eqv, unsigned long int idx, @@ -1025,13 +1028,16 @@ popen_completion_ast(struct pipe_details *thispipe) } } +static unsigned long int setup_cmddsc(char *cmd, int check_img); +static void vms_execfree(); + static PerlIO * safe_popen(char *cmd, char *mode) { static int handler_set_up = FALSE; char mbxname[64]; unsigned short int chan; - unsigned long int flags=1; /* nowait - gnu c doesn't allow &1 */ + unsigned long int sts, flags=1; /* nowait - gnu c doesn't allow &1 */ dTHX; struct pipe_details *info; struct dsc$descriptor_s namdsc = {sizeof mbxname, DSC$K_DTYPE_T, @@ -1040,13 +1046,7 @@ safe_popen(char *cmd, char *mode) DSC$K_CLASS_S, 0}; - cmddsc.dsc$w_length=strlen(cmd); - cmddsc.dsc$a_pointer=cmd; - if (cmddsc.dsc$w_length > 255) { - set_errno(E2BIG); set_vaxc_errno(CLI$_BUFOVF); - return Nullfp; - } - + if (!(setup_cmddsc(cmd,0) & 1)) { set_errno(EINVAL); return Nullfp; } New(1301,info,1,struct pipe_details); /* create mailbox */ @@ -1066,16 +1066,17 @@ safe_popen(char *cmd, char *mode) info->completion=0; if (*mode == 'r') { - _ckvmssts(lib$spawn(&cmddsc, &nl_desc, &namdsc, &flags, + _ckvmssts(lib$spawn(&VMScmd, &nl_desc, &namdsc, &flags, 0 /* name */, &info->pid, &info->completion, 0, popen_completion_ast,info,0,0,0)); } else { - _ckvmssts(lib$spawn(&cmddsc, &namdsc, 0 /* sys$output */, &flags, + _ckvmssts(lib$spawn(&VMScmd, &namdsc, 0 /* sys$output */, &flags, 0 /* name */, &info->pid, &info->completion, 0, popen_completion_ast,info,0,0,0)); } + vms_execfree(); if (!handler_set_up) { _ckvmssts(sys$dclexh(&pipe_exitblock)); handler_set_up = TRUE; @@ -3286,12 +3287,10 @@ my_vfork() /*}}}*/ -static struct dsc$descriptor_s VMScmd = {0,DSC$K_DTYPE_T,DSC$K_CLASS_S,Nullch}; - static void vms_execfree() { if (PL_Cmd) { - Safefree(PL_Cmd); + if (PL_Cmd != VMScmd.dsc$a_pointer) Safefree(PL_Cmd); PL_Cmd = Nullch; } if (VMScmd.dsc$a_pointer) { @@ -3349,38 +3348,69 @@ setup_argstr(SV *really, SV **mark, SV **sp) static unsigned long int setup_cmddsc(char *cmd, int check_img) { - char resspec[NAM$C_MAXRSS+1]; + char vmsspec[NAM$C_MAXRSS+1], resspec[NAM$C_MAXRSS+1]; $DESCRIPTOR(defdsc,".EXE"); $DESCRIPTOR(resdsc,resspec); struct dsc$descriptor_s imgdsc = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0}; unsigned long int cxt = 0, flags = 1, retsts = SS$_NORMAL; - register char *s, *rest, *cp; - register int isdcl = 0; + register char *s, *rest, *cp, *wordbreak; + register int isdcl; dTHX; + if (strlen(cmd) > + (sizeof(vmsspec) > sizeof(resspec) ? sizeof(resspec) : sizeof(vmsspec))) + return LIB$_INVARG; s = cmd; while (*s && isspace(*s)) s++; - if (check_img) { - if (*s == '$') { /* Check whether this is a DCL command: leading $ and */ - isdcl = 1; /* no dev/dir separators (i.e. not a foreign command) */ - for (cp = s; *cp && *cp != '/' && !isspace(*cp); cp++) { - if (*cp == ':' || *cp == '[' || *cp == '<') { - isdcl = 0; - break; - } + + if (*s == '@' || *s == '$') { + vmsspec[0] = *s; rest = s + 1; + for (cp = &vmsspec[1]; *rest && isspace(*rest); rest++,cp++) *cp = *rest; + } + else { cp = vmsspec; rest = s; } + if (*rest == '.' || *rest == '/') { + char *cp2; + for (cp2 = resspec; + *rest && !isspace(*rest) && cp2 - resspec < sizeof resspec; + rest++, cp2++) *cp2 = *rest; + *cp2 = '\0'; + if (do_tovmsspec(resspec,cp,0)) { + s = vmsspec; + if (*rest) { + for (cp2 = vmsspec + strlen(vmsspec); + *rest && cp2 - vmsspec < sizeof vmsspec; + rest++, cp2++) *cp2 = *rest; + *cp2 = '\0'; } } } - else isdcl = 1; + /* Intuit whether verb (first word of cmd) is a DCL command: + * - if first nonspace char is '@', it's a DCL indirection + * otherwise + * - if verb contains a filespec separator, it's not a DCL command + * - if it doesn't, caller tells us whether to default to a DCL + * command, or to a local image unless told it's DCL (by leading '$') + */ + if (*s == '@') isdcl = 1; + else { + register char *filespec = strpbrk(s,":<[.;"); + rest = wordbreak = strpbrk(s," \"\t/"); + if (!wordbreak) wordbreak = s + strlen(s); + if (*s == '$') check_img = 0; + if (filespec && (filespec < wordbreak)) isdcl = 0; + else isdcl = !check_img; + } + if (!isdcl) { - cmd = s; - while (*s && !isspace(*s)) s++; - rest = *s ? s : 0; - imgdsc.dsc$a_pointer = cmd; - imgdsc.dsc$w_length = s - cmd; + imgdsc.dsc$a_pointer = s; + imgdsc.dsc$w_length = wordbreak - s; retsts = lib$find_file(&imgdsc,&resdsc,&cxt,&defdsc,0,0,&flags); - if (retsts & 1) { + if (!(retsts & 1) && *s == '$') { + imgdsc.dsc$a_pointer++; imgdsc.dsc$w_length--; + retsts = lib$find_file(&imgdsc,&resdsc,&cxt,&defdsc,0,0,&flags); _ckvmssts(lib$find_file_end(&cxt)); + } + if (retsts & 1) { s = resspec; while (*s && !isspace(*s)) s++; *s = '\0'; @@ -3397,10 +3427,7 @@ setup_cmddsc(char *cmd, int check_img) } /* It's either a DCL command or we couldn't find a suitable image */ VMScmd.dsc$w_length = strlen(cmd); - if (cmd == PL_Cmd) { - VMScmd.dsc$a_pointer = PL_Cmd; - PL_Cmd = Nullch; /* Don't try to free twice in vms_execfree() */ - } + if (cmd == PL_Cmd) VMScmd.dsc$a_pointer = PL_Cmd; else VMScmd.dsc$a_pointer = savepvn(cmd,VMScmd.dsc$w_length); if (!(retsts & 1)) { /* just hand off status values likely to be due to user error */ -- 2.7.4