#define EXECF_TRUEEXEC 2
#define EXECF_SPAWN_NOWAIT 3
+/* const char* const ptypes[] = { "FS", "DOS", "VIO", "PM", "DETACH" }; */
+
+static int
+my_type()
+{
+ int rc;
+ TIB *tib;
+ PIB *pib;
+
+ if (!(_emx_env & 0x200)) return 1; /* not OS/2. */
+ if (CheckOSError(DosGetInfoBlocks(&tib, &pib)))
+ return -1;
+
+ return (pib->pib_ultype);
+}
+
+static ULONG
+file_type(char *path)
+{
+ int rc;
+ ULONG apptype;
+
+ if (!(_emx_env & 0x200))
+ croak("file_type not implemented on DOS"); /* not OS/2. */
+ if (CheckOSError(DosQueryAppType(path, &apptype))) {
+ switch (rc) {
+ case ERROR_FILE_NOT_FOUND:
+ case ERROR_PATH_NOT_FOUND:
+ return -1;
+ case ERROR_ACCESS_DENIED: /* Directory with this name found? */
+ return -3;
+ default: /* Found, but not an
+ executable, or some other
+ read error. */
+ return -2;
+ }
+ }
+ return apptype;
+}
+
+static ULONG os2_mytype;
+
/* Spawn/exec a program, revert to shell if needed. */
/* global PL_Argv[] contains arguments. */
int trueflag = flag;
int rc, pass = 1;
char *tmps;
- char buf[256], *s = 0;
+ char buf[256], *s = 0, scrbuf[280];
char *args[4];
static char * fargs[4]
= { "/bin/sh", "-c", "\"$@\"", "spawn-via-shell", };
char **argsp = fargs;
char nargs = 4;
+ int force_shell;
if (flag == P_WAIT)
flag = P_NOWAIT;
/* We should check PERL_SH* and PERLLIB_* as well? */
if (!really || !*(tmps = SvPV(really, PL_na)))
tmps = PL_Argv[0];
+
+ reread:
+ force_shell = 0;
+ if (_emx_env & 0x200) { /* OS/2. */
+ int type = file_type(tmps);
+ type_again:
+ if (type == -1) { /* Not found */
+ errno = ENOENT;
+ rc = -1;
+ goto do_script;
+ }
+ else if (type == -2) { /* Not an EXE */
+ errno = ENOEXEC;
+ rc = -1;
+ goto do_script;
+ }
+ else if (type == -3) { /* Is a directory? */
+ /* Special-case this */
+ char tbuf[512];
+ int l = strlen(tmps);
+
+ if (l + 5 <= sizeof tbuf) {
+ strcpy(tbuf, tmps);
+ strcpy(tbuf + l, ".exe");
+ type = file_type(tbuf);
+ if (type >= -3)
+ goto type_again;
+ }
+
+ errno = ENOEXEC;
+ rc = -1;
+ goto do_script;
+ }
+ switch (type & 7) {
+ /* Ignore WINDOWCOMPAT and FAPI, start them the same type we are. */
+ case FAPPTYP_WINDOWAPI:
+ {
+ if (os2_mytype != 3) { /* not PM */
+ if (flag == P_NOWAIT)
+ flag = P_PM;
+ else if ((flag & 7) != P_PM && (flag & 7) != P_SESSION)
+ warn("Starting PM process with flag=%d, mytype=%d",
+ flag, os2_mytype);
+ }
+ }
+ break;
+ case FAPPTYP_NOTWINDOWCOMPAT:
+ {
+ if (os2_mytype != 0) { /* not full screen */
+ if (flag == P_NOWAIT)
+ flag = P_SESSION;
+ else if ((flag & 7) != P_SESSION)
+ warn("Starting Full Screen process with flag=%d, mytype=%d",
+ flag, os2_mytype);
+ }
+ }
+ break;
+ case FAPPTYP_NOTSPEC:
+ /* Let the shell handle this... */
+ force_shell = 1;
+ goto doshell_args;
+ break;
+ }
+ }
+
#if 0
rc = result(trueflag, spawnvp(flag,tmps,PL_Argv));
#else
else if (execf == EXECF_EXEC)
rc = spawnvp(trueflag | P_OVERLAY,tmps,PL_Argv);
else if (execf == EXECF_SPAWN_NOWAIT)
- rc = spawnvp(trueflag | P_NOWAIT,tmps,PL_Argv);
+ rc = spawnvp(flag,tmps,PL_Argv);
else /* EXECF_SPAWN */
rc = result(trueflag,
- spawnvp(trueflag | P_NOWAIT,tmps,PL_Argv));
+ spawnvp(flag,tmps,PL_Argv));
#endif
if (rc < 0 && pass == 1
&& (tmps == PL_Argv[0])) { /* Cannot transfer `really' via shell. */
+ do_script:
+ {
int err = errno;
if (err == ENOENT || err == ENOEXEC) {
/* Try adding script extensions to the file name, and
search on PATH. */
char *scr = find_script(PL_Argv[0], TRUE, NULL, 0);
+ int l = strlen(scr);
+
+ if (l >= sizeof scrbuf) {
+ Safefree(scr);
+ longbuf:
+ croak("Size of scriptname too big: %d", l);
+ }
+ strcpy(scrbuf, scr);
+ Safefree(scr);
+ scr = scrbuf;
if (scr) {
FILE *file = fopen(scr, "r");
PL_Argv[0] = scr;
if (!file)
goto panic_file;
- if (!fgets(buf, sizeof buf, file)) {
+ if (!fgets(buf, sizeof buf, file)) { /* Empty... */
+
+ buf[0] = 0;
fclose(file);
- goto panic_file;
+ /* Special case: maybe from -Zexe build, so
+ there is an executable around (contrary to
+ documentation, DosQueryAppType sometimes (?)
+ does not append ".exe", so we could have
+ reached this place). */
+ if (l + 5 < sizeof scrbuf) {
+ strcpy(scrbuf + l, ".exe");
+ if (PerlLIO_stat(scrbuf,&PL_statbuf) >= 0
+ && !S_ISDIR(PL_statbuf.st_mode)) {
+ /* Found */
+ tmps = scr;
+ pass++;
+ goto reread;
+ } else
+ scrbuf[l] = 0;
+ } else
+ goto longbuf;
}
if (fclose(file) != 0) { /* Failure */
panic_file:
char **a = PL_Argv;
char *exec_args[2];
- if (!buf[0] && file) { /* File without magic */
+ if (force_shell
+ || (!buf[0] && file)) { /* File without magic */
/* In fact we tried all what pdksh would
try. There is no point in calling
pdksh, we may just emulate its logic. */
/* Not found: restore errno */
errno = err;
}
+ }
} else if (rc < 0 && pass == 2 && errno == ENOENT) { /* File not found */
char *no_dir = strrchr(PL_Argv[0], '/');
do_exec(cmd)
char *cmd;
{
- return do_spawn2(cmd, EXECF_EXEC);
+ do_spawn2(cmd, EXECF_EXEC);
+ return FALSE;
}
bool
XSRETURN(1);
}
+#include "patchlevel.h"
+
char *
mod2fname(sv)
SV *sv;
#ifdef USE_THREADS
sum++; /* Avoid conflict of DLLs in memory. */
#endif
+ sum += PATCHLEVEL * 200 + SUBVERSION * 2; /* */
fname[pos] = 'A' + (sum % 26);
fname[pos + 1] = 'A' + (sum / 26 % 26);
fname[pos + 2] = '\0';
sprintf(buf, "OS/2 system error code %d=0x%x", rc, rc);
else
buf[len] = '\0';
+ if (len > 0 && buf[len - 1] == '\n')
+ buf[len - 1] = '\0';
+ if (len > 1 && buf[len - 2] == '\r')
+ buf[len - 2] = '\0';
+ if (len > 2 && buf[len - 3] == '.')
+ buf[len - 3] = '\0';
return buf;
}
}
}
MUTEX_INIT(&start_thread_mutex);
+ os2_mytype = my_type(); /* Do it before morphing. Needed? */
}
#undef tmpnam
https://perl5.git.perl.org / perl5.git / blobdiff