os2_cond_wait(perl_cond *c, perl_mutex *m)
{
int rc;
- if ((rc = DosResetEventSem(*c,&PL_na)) && (rc != ERROR_ALREADY_RESET))
+ STRLEN n_a;
+ if ((rc = DosResetEventSem(*c,&n_a)) && (rc != ERROR_ALREADY_RESET))
croak("panic: COND_WAIT-reset: rc=%i", rc);
if (m) MUTEX_UNLOCK(m);
if (CheckOSError(DosWaitEventSem(*c,SEM_INDEFINITE_WAIT))
/* global PL_Argv[] contains arguments. */
int
-do_spawn_ve(really, flag, execf, inicmd)
+do_spawn_ve(really, flag, execf, inicmd, addflag)
SV *really;
U32 flag;
U32 execf;
char *inicmd;
+U32 addflag;
{
dTHR;
int trueflag = flag;
char **argsp = fargs;
char nargs = 4;
int force_shell;
+ int new_stderr = -1, nostderr = 0, fl_stderr;
+ STRLEN n_a;
if (flag == P_WAIT)
flag = P_NOWAIT;
) /* will spawnvp use PATH? */
TAINT_ENV(); /* testing IFS here is overkill, probably */
/* We should check PERL_SH* and PERLLIB_* as well? */
- if (!really || !*(tmps = SvPV(really, PL_na)))
+ if (!really || !*(tmps = SvPV(really, n_a)))
tmps = PL_Argv[0];
reread:
}
}
+ if (addflag) {
+ addflag = 0;
+ new_stderr = dup(2); /* Preserve stderr */
+ if (new_stderr == -1) {
+ if (errno == EBADF)
+ nostderr = 1;
+ else {
+ rc = -1;
+ goto finish;
+ }
+ } else
+ fl_stderr = fcntl(2, F_GETFD);
+ rc = dup2(1,2);
+ if (rc == -1)
+ goto finish;
+ fcntl(new_stderr, F_SETFD, FD_CLOEXEC);
+ }
+
#if 0
rc = result(trueflag, spawnvp(flag,tmps,PL_Argv));
#else
if (l >= sizeof scrbuf) {
Safefree(scr);
longbuf:
- croak("Size of scriptname too big: %d", l);
+ warn("Size of scriptname too big: %d", l);
+ rc = -1;
+ goto finish;
}
strcpy(scrbuf, scr);
Safefree(scr);
&& ((trueflag & 0xFF) == P_WAIT))
rc = 255 << 8; /* Emulate the fork(). */
+ finish:
+ if (new_stderr != -1) { /* How can we use error codes? */
+ dup2(new_stderr, 2);
+ close(new_stderr);
+ fcntl(2, F_SETFD, fl_stderr);
+ } else if (nostderr)
+ close(2);
return rc;
}
char *tmps = NULL;
int rc;
int flag = P_WAIT, trueflag, err, secondtry = 0;
+ STRLEN n_a;
if (sp > mark) {
New(1301,PL_Argv, sp - mark + 3, char*);
while (++mark <= sp) {
if (*mark)
- *a++ = SvPVx(*mark, PL_na);
+ *a++ = SvPVx(*mark, n_a);
else
*a++ = "";
}
*a = Nullch;
- rc = do_spawn_ve(really, flag, EXECF_SPAWN, NULL);
+ rc = do_spawn_ve(really, flag, EXECF_SPAWN, NULL, 0);
} else
rc = -1;
do_execfree();
register char *s;
char flags[10];
char *shell, *copt, *news = NULL;
- int rc, err, seenspace = 0;
+ int rc, err, seenspace = 0, mergestderr = 0;
char fullcmd[MAXNAMLEN + 1];
#ifdef TRYSHELL
break;
} else if (*s == '\\' && !seenspace) {
continue; /* Allow backslashes in names */
+ } else if (*s == '>' && s >= cmd + 3
+ && s[-1] == '2' && s[1] == '&' && s[2] == '1'
+ && isSPACE(s[-2]) ) {
+ char *t = s + 3;
+
+ while (*t && isSPACE(*t))
+ t++;
+ if (!*t) {
+ s[-2] = '\0';
+ mergestderr = 1;
+ break; /* Allow 2>&1 as the last thing */
+ }
}
/* We do not convert this to do_spawn_ve since shell
should be smart enough to start itself gloriously. */
}
*a = Nullch;
if (PL_Argv[0])
- rc = do_spawn_ve(NULL, 0, execf, cmd);
+ rc = do_spawn_ve(NULL, 0, execf, cmd, mergestderr);
else
rc = -1;
if (news)
register I32 pid, rc;
PerlIO *res;
SV *sv;
+ int fh_fl;
/* `this' is what we use in the parent, `that' in the child. */
this = (*mode == 'w');
if (pipe(p) < 0)
return Nullfp;
/* Now we need to spawn the child. */
+ if (p[this] == (*mode == 'r')) { /* if fh 0/1 was initially closed. */
+ int new = dup(p[this]);
+
+ if (new == -1)
+ goto closepipes;
+ close(p[this]);
+ p[this] = new;
+ }
newfd = dup(*mode == 'r'); /* Preserve std* */
- if (p[that] != (*mode == 'r')) {
+ if (newfd == -1) {
+ /* This cannot happen due to fh being bad after pipe(), since
+ pipe() should have created fh 0 and 1 even if they were
+ initially closed. But we closed p[this] before. */
+ if (errno != EBADF) {
+ closepipes:
+ close(p[0]);
+ close(p[1]);
+ return Nullfp;
+ }
+ } else
+ fh_fl = fcntl(*mode == 'r', F_GETFD);
+ if (p[that] != (*mode == 'r')) { /* if fh 0/1 was initially closed. */
dup2(p[that], *mode == 'r');
close(p[that]);
}
/* Where is `this' and newfd now? */
fcntl(p[this], F_SETFD, FD_CLOEXEC);
- fcntl(newfd, F_SETFD, FD_CLOEXEC);
+ if (newfd != -1)
+ fcntl(newfd, F_SETFD, FD_CLOEXEC);
pid = do_spawn_nowait(cmd);
- if (newfd != (*mode == 'r')) {
+ if (newfd == -1)
+ close(*mode == 'r'); /* It was closed initially */
+ else if (newfd != (*mode == 'r')) { /* Probably this check is not needed */
dup2(newfd, *mode == 'r'); /* Return std* back. */
close(newfd);
- }
+ fcntl(*mode == 'r', F_SETFD, fh_fl);
+ } else
+ fcntl(*mode == 'r', F_SETFD, fh_fl);
if (p[that] == (*mode == 'r'))
close(p[that]);
if (pid == -1) {
close(p[this]);
- return NULL;
+ return Nullfp;
}
- if (p[that] < p[this]) {
+ if (p[that] < p[this]) { /* Make fh as small as possible */
dup2(p[this], p[that]);
close(p[this]);
p[this] = p[that];
if (!p) return;
len = strlen(p);
tpath = (char *)malloc(len + strlen(TMPPATH1) + 2);
- strcpy(tpath, p);
- tpath[len] = '/';
- strcpy(tpath + len + 1, TMPPATH1);
- tmppath = tpath;
+ if (tpath) {
+ strcpy(tpath, p);
+ tpath[len] = '/';
+ strcpy(tpath + len + 1, TMPPATH1);
+ tmppath = tpath;
+ }
}
#include "XSUB.h"
if (items < 2 || items > 3)
croak("Usage: File::Copy::syscopy(src,dst,flag=0)");
{
- char * src = (char *)SvPV(ST(0),PL_na);
- char * dst = (char *)SvPV(ST(1),PL_na);
+ STRLEN n_a;
+ char * src = (char *)SvPV(ST(0),n_a);
+ char * dst = (char *)SvPV(ST(1),n_a);
U32 flag;
int RETVAL, rc;
AV *av;
SV *svp;
char *s;
+ STRLEN n_a;
if (!SvROK(sv)) croak("Not a reference given to mod2fname");
sv = SvRV(sv);
if (avlen < 0)
croak("Empty array reference given to mod2fname");
- s = SvPV(*av_fetch((AV*)sv, avlen, FALSE), PL_na);
+ s = SvPV(*av_fetch((AV*)sv, avlen, FALSE), n_a);
strncpy(fname, s, 8);
len = strlen(s);
if (len < 6) pos = len;
}
avlen --;
while (avlen >= 0) {
- s = SvPV(*av_fetch((AV*)sv, avlen, FALSE), PL_na);
+ s = SvPV(*av_fetch((AV*)sv, avlen, FALSE), n_a);
while (*s) {
sum = 33 * sum + *(s++); /* 7 is primitive mod 13. */
}
#ifdef USE_THREADS
sum++; /* Avoid conflict of DLLs in memory. */
#endif
- sum += PATCHLEVEL * 200 + SUBVERSION * 2; /* */
+ sum += PERL_VERSION * 200 + PERL_SUBVERSION * 2; /* */
fname[pos] = 'A' + (sum % 26);
fname[pos + 1] = 'A' + (sum / 26 % 26);
fname[pos + 2] = '\0';
if (items != 1)
croak("Usage: OS2::Errors2Drive(drive)");
{
+ STRLEN n_a;
SV *sv = ST(0);
int suppress = SvOK(sv);
- char *s = suppress ? SvPV(sv, PL_na) : NULL;
+ char *s = suppress ? SvPV(sv, n_a) : NULL;
char drive = (s ? *s : 0);
unsigned long rc;
if (items != 1)
croak("Usage: Cwd::sys_chdir(path)");
{
- char * path = (char *)SvPV(ST(0),PL_na);
+ STRLEN n_a;
+ char * path = (char *)SvPV(ST(0),n_a);
bool RETVAL;
RETVAL = sys_chdir(path);
if (items != 1)
croak("Usage: Cwd::change_drive(d)");
{
- char d = (char)*SvPV(ST(0),PL_na);
+ STRLEN n_a;
+ char d = (char)*SvPV(ST(0),n_a);
bool RETVAL;
RETVAL = change_drive(d);
if (items != 1)
croak("Usage: Cwd::sys_is_absolute(path)");
{
- char * path = (char *)SvPV(ST(0),PL_na);
+ STRLEN n_a;
+ char * path = (char *)SvPV(ST(0),n_a);
bool RETVAL;
RETVAL = sys_is_absolute(path);
if (items != 1)
croak("Usage: Cwd::sys_is_rooted(path)");
{
- char * path = (char *)SvPV(ST(0),PL_na);
+ STRLEN n_a;
+ char * path = (char *)SvPV(ST(0),n_a);
bool RETVAL;
RETVAL = sys_is_rooted(path);
if (items != 1)
croak("Usage: Cwd::sys_is_relative(path)");
{
- char * path = (char *)SvPV(ST(0),PL_na);
+ STRLEN n_a;
+ char * path = (char *)SvPV(ST(0),n_a);
bool RETVAL;
RETVAL = sys_is_relative(path);
if (items < 1 || items > 2)
croak("Usage: Cwd::sys_abspath(path, dir = NULL)");
{
- char * path = (char *)SvPV(ST(0),PL_na);
+ STRLEN n_a;
+ char * path = (char *)SvPV(ST(0),n_a);
char * dir;
char p[MAXPATHLEN];
char * RETVAL;
if (items < 2)
dir = NULL;
else {
- dir = (char *)SvPV(ST(1),PL_na);
+ dir = (char *)SvPV(ST(1),n_a);
}
if (path[0] == '.' && (path[1] == '/' || path[1] == '\\')) {
path += 2;
if (items < 1 || items > 2)
croak("Usage: Cwd::extLibpath_set(s, type = 0)");
{
- char * s = (char *)SvPV(ST(0),PL_na);
+ STRLEN n_a;
+ char * s = (char *)SvPV(ST(0),n_a);
bool type;
U32 rc;
bool RETVAL;
projects / p5sagit/p5-mst-13.2.git / blobdiff