/* see system service docs for $TRNLNM -- NOT the same as LNM$_MAX_INDEX */
#define PERL_LNM_MAX_ALLOWED_INDEX 127
-#define MAX_DCL_LINE_LENGTH 255
+#define MAX_DCL_SYMBOL 255 /* well, what *we* can set, at least*/
+#define MAX_DCL_LINE_LENGTH (4*MAX_DCL_SYMBOL-4)
static char *__mystrtolower(char *str)
{
/* 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};
-
#ifndef RTL_USES_UTC
static int tz_updated = 1;
#endif
return ifi; /* this is the RMS internal file id */
}
-#define MAX_DCL_SYMBOL 255
static void pipe_infromchild_ast(pPipe p);
/*
fprintf(fp,"$ pif perl_popen_in .nes. \"\" then perl_define/user/name_attributes=confine sys$input 'perl_popen_in'\n");
fprintf(fp,"$ pif perl_popen_err .nes. \"\" then perl_define/user/name_attributes=confine sys$error 'perl_popen_err'\n");
fprintf(fp,"$ pif perl_popen_out .nes. \"\" then perl_define sys$output 'perl_popen_out'\n");
- fprintf(fp,"$ cmd = perl_popen_cmd\n");
+ fprintf(fp,"$! --- build command line to get max possible length\n");
+ fprintf(fp,"$c=perl_popen_cmd0\n");
+ fprintf(fp,"$c=c+perl_popen_cmd1\n");
+ fprintf(fp,"$c=c+perl_popen_cmd2\n");
+ fprintf(fp,"$x=perl_popen_cmd3\n");
+ fprintf(fp,"$c=c+x\n");
fprintf(fp,"$! --- get rid of global symbols\n");
fprintf(fp,"$ perl_del/symbol/global perl_popen_in\n");
fprintf(fp,"$ perl_del/symbol/global perl_popen_err\n");
fprintf(fp,"$ perl_del/symbol/global perl_popen_out\n");
fprintf(fp,"$ perl_del/symbol/global perl_popen_cmd\n");
fprintf(fp,"$ perl_on\n");
- fprintf(fp,"$ 'cmd\n");
+ fprintf(fp,"$ 'c\n");
fprintf(fp,"$ perl_status = $STATUS\n");
fprintf(fp,"$ perl_del 'perl_cfile'\n");
fprintf(fp,"$ perl_exit 'perl_status'\n");
static int handler_set_up = FALSE;
unsigned long int sts, flags=1; /* nowait - gnu c doesn't allow &1 */
unsigned int table = LIB$K_CLI_GLOBAL_SYM;
- int wait = 0;
+ int j, wait = 0;
char *p, mode[10], symbol[MAX_DCL_SYMBOL+1], *vmspipe;
char in[512], out[512], err[512], mbx[512];
FILE *tpipe = 0;
char tfilebuf[NAM$C_MAXRSS+1];
pInfo info;
+ char cmd_sym_name[20];
struct dsc$descriptor_s d_symbol= {0, DSC$K_DTYPE_T,
DSC$K_CLASS_S, symbol};
struct dsc$descriptor_s vmspipedsc = {0, DSC$K_DTYPE_T,
DSC$K_CLASS_S, 0};
-
- $DESCRIPTOR(d_sym_cmd,"PERL_POPEN_CMD");
+ struct dsc$descriptor_s d_sym_cmd = {0, DSC$K_DTYPE_T,
+ DSC$K_CLASS_S, cmd_sym_name};
$DESCRIPTOR(d_sym_in ,"PERL_POPEN_IN");
$DESCRIPTOR(d_sym_out,"PERL_POPEN_OUT");
$DESCRIPTOR(d_sym_err,"PERL_POPEN_ERR");
while (*p == ' ' || *p == '\t') p++; /* remove leading whitespace */
if (*p == '$') p++; /* remove leading $ */
while (*p == ' ' || *p == '\t') p++;
+
+ for (j = 0; j < 4; j++) {
+ sprintf(cmd_sym_name,"PERL_POPEN_CMD%d",j);
+ d_sym_cmd.dsc$w_length = strlen(cmd_sym_name);
+
strncpy(symbol, p, MAX_DCL_SYMBOL);
d_symbol.dsc$w_length = strlen(symbol);
_ckvmssts(lib$set_symbol(&d_sym_cmd, &d_symbol, &table));
+ if (strlen(p) > MAX_DCL_SYMBOL) {
+ p += MAX_DCL_SYMBOL;
+ } else {
+ p += strlen(p);
+ }
+ }
_ckvmssts(sys$setast(0));
info->next=open_pipes; /* prepend to list */
open_pipes=info;
/* once the subprocess is spawned, it has copied the symbols and
we can get rid of ours */
+ for (j = 0; j < 4; j++) {
+ sprintf(cmd_sym_name,"PERL_POPEN_CMD%d",j);
+ d_sym_cmd.dsc$w_length = strlen(cmd_sym_name);
_ckvmssts(lib$delete_symbol(&d_sym_cmd, &table));
+ }
_ckvmssts(lib$delete_symbol(&d_sym_in, &table));
_ckvmssts(lib$delete_symbol(&d_sym_err, &table));
_ckvmssts(lib$delete_symbol(&d_sym_out, &table));
unsigned long int
Perl_do_spawn(pTHX_ char *cmd)
{
- unsigned long int sts, substs, hadcmd = 1;
+ unsigned long int sts, substs;
TAINT_ENV();
TAINT_PROPER("spawn");
if (!cmd || !*cmd) {
- hadcmd = 0;
sts = lib$spawn(0,0,0,0,0,0,&substs,0,0,0,0,0,0);
+ if (!(sts & 1)) {
+ switch (sts) {
+ case RMS$_FNF: case RMS$_DNF:
+ set_errno(ENOENT); break;
+ case RMS$_DIR:
+ set_errno(ENOTDIR); break;
+ case RMS$_DEV:
+ set_errno(ENODEV); break;
+ case RMS$_PRV:
+ set_errno(EACCES); break;
+ case RMS$_SYN:
+ set_errno(EINVAL); break;
+ case CLI$_BUFOVF: case RMS$_RTB: case CLI$_TKNOVF: case CLI$_RSLOVF:
+ set_errno(E2BIG); break;
+ case LIB$_INVARG: case LIB$_INVSTRDES: case SS$_ACCVIO: /* shouldn't happen */
+ _ckvmssts(sts); /* fall through */
+ default: /* SS$_DUPLNAM, SS$_CLI, resource exhaustion, etc. */
+ set_errno(EVMSERR);
+ }
+ set_vaxc_errno(sts);
+ if (ckWARN(WARN_EXEC)) {
+ Perl_warner(aTHX_ WARN_EXEC,"Can't spawn: %s",
+ Strerror(errno));
+ }
+ }
+ sts = substs;
}
else {
(void) safe_popen(cmd, "nW", (int *)&sts);
- substs = sts;
}
-
- if (!(sts & 1)) {
- switch (sts) {
- case RMS$_FNF: case RMS$_DNF:
- set_errno(ENOENT); break;
- case RMS$_DIR:
- set_errno(ENOTDIR); break;
- case RMS$_DEV:
- set_errno(ENODEV); break;
- case RMS$_PRV:
- set_errno(EACCES); break;
- case RMS$_SYN:
- set_errno(EINVAL); break;
- case CLI$_BUFOVF: case RMS$_RTB: case CLI$_TKNOVF: case CLI$_RSLOVF:
- set_errno(E2BIG); break;
- case LIB$_INVARG: case LIB$_INVSTRDES: case SS$_ACCVIO: /* shouldn't happen */
- _ckvmssts(sts); /* fall through */
- default: /* SS$_DUPLNAM, SS$_CLI, resource exhaustion, etc. */
- set_errno(EVMSERR);
- }
- set_vaxc_errno(sts);
- if (ckWARN(WARN_EXEC)) {
- Perl_warner(aTHX_ WARN_EXEC,"Can't spawn \"%s\": %s",
- hadcmd ? cmd : "",
- Strerror(errno));
- }
- }
- vms_execfree(aTHX);
- return substs;
-
+ return sts;
} /* end of do_spawn() */
/*}}}*/
int my_sigismember(sigset_t *set, int sig) {
if (!set) { SETERRNO(EFAULT,SS$_ACCVIO); return -1; }
if (sig > NSIG) { SETERRNO(EINVAL,LIB$_INVARG); return -1; }
- *set & (1 << (sig - 1));
+ return *set & (1 << (sig - 1));
}
/*}}}*/
projects / p5sagit/p5-mst-13.2.git / blobdiff