X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=os2%2Fos2.c;h=3103012df2174a39f4cf9fab645eb52dc4cdfbf2;hb=cceca5ed003bac658cb0392a14bb2f26d434bd78;hp=f24c3af5ce37a8dbc4cff82e74b81c935835d949;hpb=c2267164204a961273c71c9c103831895724b0b1;p=p5sagit%2Fp5-mst-13.2.git diff --git a/os2/os2.c b/os2/os2.c index f24c3af..3103012 100644 --- a/os2/os2.c +++ b/os2/os2.c @@ -5,6 +5,8 @@ #define INCL_DOSERRORS #include +#include + /* * Various Unix compatibility functions for OS/2 */ @@ -40,16 +42,16 @@ const char *pthreads_states[] = { typedef struct { void *status; - pthread_cond_t cond; + perl_cond cond; enum pthreads_state state; } thread_join_t; thread_join_t *thread_join_data; int thread_join_count; -pthread_mutex_t start_thread_mutex; +perl_mutex start_thread_mutex; int -pthread_join(pthread_t tid, void **status) +pthread_join(perl_os_thread tid, void **status) { MUTEX_LOCK(&start_thread_mutex); switch (thread_join_data[tid].state) { @@ -117,7 +119,7 @@ pthread_startit(void *arg) } int -pthread_create(pthread_t *tid, const pthread_attr_t *attr, +pthread_create(perl_os_thread *tid, const pthread_attr_t *attr, void *(*start_routine)(void*), void *arg) { void *args[2]; @@ -134,7 +136,7 @@ pthread_create(pthread_t *tid, const pthread_attr_t *attr, } int -pthread_detach(pthread_t tid) +pthread_detach(perl_os_thread tid) { MUTEX_LOCK(&start_thread_mutex); switch (thread_join_data[tid].state) { @@ -157,14 +159,18 @@ pthread_detach(pthread_t tid) /* This is a very bastardized version: */ int -os2_cond_wait(pthread_cond_t *c, pthread_mutex_t *m) +os2_cond_wait(perl_cond *c, perl_mutex *m) { int rc; - if ((rc = DosResetEventSem(*c,&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))) + if (CheckOSError(DosWaitEventSem(*c,SEM_INDEFINITE_WAIT)) + && (rc != ERROR_INTERRUPT)) croak("panic: COND_WAIT: rc=%i", rc); + if (rc == ERROR_INTERRUPT) + errno = EINTR; if (m) MUTEX_LOCK(m); } #endif @@ -175,9 +181,10 @@ static PFN ExtFCN[2]; /* Labeled by ord below. */ static USHORT loadOrd[2] = { 874, 873 }; /* Query=874, Set=873. */ #define ORD_QUERY_ELP 0 #define ORD_SET_ELP 1 +struct PMWIN_entries_t PMWIN_entries; APIRET -loadByOrd(ULONG ord) +loadByOrd(char *modname, ULONG ord) { if (ExtFCN[ord] == NULL) { static HMODULE hdosc = 0; @@ -186,15 +193,46 @@ loadByOrd(ULONG ord) APIRET rc; if ((!hdosc && CheckOSError(DosLoadModule(buf, sizeof buf, - "doscalls", &hdosc))) + modname, &hdosc))) || CheckOSError(DosQueryProcAddr(hdosc, loadOrd[ord], NULL, &fcn))) - die("This version of OS/2 does not support doscalls.%i", - loadOrd[ord]); + croak("This version of OS/2 does not support %s.%i", + modname, loadOrd[ord]); ExtFCN[ord] = fcn; } - if ((long)ExtFCN[ord] == -1) die("panic queryaddr"); + if ((long)ExtFCN[ord] == -1) + croak("panic queryaddr"); +} + +void +init_PMWIN_entries(void) +{ + static HMODULE hpmwin = 0; + static const int ords[] = { + 763, /* Initialize */ + 716, /* CreateMsgQueue */ + 726, /* DestroyMsgQueue */ + 918, /* PeekMsg */ + 915, /* GetMsg */ + 912, /* DispatchMsg */ + }; + BYTE buf[20]; + int i = 0; + unsigned long rc; + + if (hpmwin) + return; + + if (CheckOSError(DosLoadModule(buf, sizeof buf, "pmwin", &hpmwin))) + croak("This version of OS/2 does not support pmwin: error in %s", buf); + while (i <= 5) { + if (CheckOSError(DosQueryProcAddr(hpmwin, ords[i], NULL, + ((PFN*)&PMWIN_entries)+i))) + croak("This version of OS/2 does not support pmwin.%d", ords[i]); + i++; + } } + /* priorities */ static signed char priors[] = {0, 1, 3, 2}; /* Last two interchanged, self inverse. */ @@ -307,7 +345,28 @@ getpriority(int which /* ignored */, int pid) /*****************************************************************************/ /* spawn */ -typedef void (*Sigfunc) _((int)); + +/* There is no big sense to make it thread-specific, since signals + are delivered to thread 1 only. XXXX Maybe make it into an array? */ +static int spawn_pid; +static int spawn_killed; + +static Signal_t +spawn_sighandler(int sig) +{ + /* Some programs do not arrange for the keyboard signals to be + delivered to them. We need to deliver the signal manually. */ + /* We may get a signal only if + a) kid does not receive keyboard signal: deliver it; + b) kid already died, and we get a signal. We may only hope + that the pid number was not reused. + */ + + if (spawn_killed) + sig = SIGKILL; /* Try harder. */ + kill(spawn_pid, sig); + spawn_killed = 1; +} static int result(int flag, int pid) @@ -324,15 +383,17 @@ result(int flag, int pid) return pid; #ifdef __EMX__ - ihand = rsignal(SIGINT, SIG_IGN); - qhand = rsignal(SIGQUIT, SIG_IGN); + spawn_pid = pid; + spawn_killed = 0; + ihand = rsignal(SIGINT, &spawn_sighandler); + qhand = rsignal(SIGQUIT, &spawn_sighandler); do { r = wait4pid(pid, &status, 0); } while (r == -1 && errno == EINTR); rsignal(SIGINT, ihand); rsignal(SIGQUIT, qhand); - statusvalue = (U16)status; + PL_statusvalue = (U16)status; if (r < 0) return -1; return status & 0xFFFF; @@ -340,13 +401,419 @@ result(int flag, int pid) ihand = rsignal(SIGINT, SIG_IGN); r = DosWaitChild(DCWA_PROCESS, DCWW_WAIT, &res, &rpid, pid); rsignal(SIGINT, ihand); - statusvalue = res.codeResult << 8 | res.codeTerminate; + PL_statusvalue = res.codeResult << 8 | res.codeTerminate; if (r) return -1; - return statusvalue; + return PL_statusvalue; #endif } +#define EXECF_SPAWN 0 +#define EXECF_EXEC 1 +#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 +do_spawn_ve(really, flag, execf, inicmd, addflag) +SV *really; +U32 flag; +U32 execf; +char *inicmd; +U32 addflag; +{ + dTHR; + int trueflag = flag; + int rc, pass = 1; + char *tmps; + 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; + int new_stderr = -1, nostderr = 0, fl_stderr; + STRLEN n_a; + + if (flag == P_WAIT) + flag = P_NOWAIT; + + retry: + if (strEQ(PL_Argv[0],"/bin/sh")) + PL_Argv[0] = PL_sh_path; + + if (PL_Argv[0][0] != '/' && PL_Argv[0][0] != '\\' + && !(PL_Argv[0][0] && PL_Argv[0][1] == ':' + && (PL_Argv[0][2] == '/' || PL_Argv[0][2] != '\\')) + ) /* 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, n_a))) + 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 (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 (execf == EXECF_TRUEEXEC) + rc = execvp(tmps,PL_Argv); + else if (execf == EXECF_EXEC) + rc = spawnvp(trueflag | P_OVERLAY,tmps,PL_Argv); + else if (execf == EXECF_SPAWN_NOWAIT) + rc = spawnvp(flag,tmps,PL_Argv); + else /* EXECF_SPAWN */ + rc = result(trueflag, + 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) { + /* No such file, or is a script. */ + /* Try adding script extensions to the file name, and + search on PATH. */ + char *scr = find_script(PL_Argv[0], TRUE, NULL, 0); + + if (scr) { + FILE *file; + char *s = 0, *s1; + int l; + + l = strlen(scr); + + if (l >= sizeof scrbuf) { + Safefree(scr); + longbuf: + warn("Size of scriptname too big: %d", l); + rc = -1; + goto finish; + } + strcpy(scrbuf, scr); + Safefree(scr); + scr = scrbuf; + + file = fopen(scr, "r"); + PL_Argv[0] = scr; + if (!file) + goto panic_file; + if (!fgets(buf, sizeof buf, file)) { /* Empty... */ + + buf[0] = 0; + fclose(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: + warn("Error reading \"%s\": %s", + scr, Strerror(errno)); + buf[0] = 0; /* Not #! */ + goto doshell_args; + } + if (buf[0] == '#') { + if (buf[1] == '!') + s = buf + 2; + } else if (buf[0] == 'e') { + if (strnEQ(buf, "extproc", 7) + && isSPACE(buf[7])) + s = buf + 8; + } else if (buf[0] == 'E') { + if (strnEQ(buf, "EXTPROC", 7) + && isSPACE(buf[7])) + s = buf + 8; + } + if (!s) { + buf[0] = 0; /* Not #! */ + goto doshell_args; + } + + s1 = s; + nargs = 0; + argsp = args; + while (1) { + /* Do better than pdksh: allow a few args, + strip trailing whitespace. */ + while (isSPACE(*s)) + s++; + if (*s == 0) + break; + if (nargs == 4) { + nargs = -1; + break; + } + args[nargs++] = s; + while (*s && !isSPACE(*s)) + s++; + if (*s == 0) + break; + *s++ = 0; + } + if (nargs == -1) { + warn("Too many args on %.*s line of \"%s\"", + s1 - buf, buf, scr); + nargs = 4; + argsp = fargs; + } + doshell_args: + { + char **a = PL_Argv; + char *exec_args[2]; + + 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. */ + char *shell = getenv("EXECSHELL"); + char *shell_opt = NULL; + + if (!shell) { + char *s; + + shell_opt = "/c"; + shell = getenv("OS2_SHELL"); + if (inicmd) { /* No spaces at start! */ + s = inicmd; + while (*s && !isSPACE(*s)) { + if (*s++ = '/') { + inicmd = NULL; /* Cannot use */ + break; + } + } + } + if (!inicmd) { + s = PL_Argv[0]; + while (*s) { + /* Dosish shells will choke on slashes + in paths, fortunately, this is + important for zeroth arg only. */ + if (*s == '/') + *s = '\\'; + s++; + } + } + } + /* If EXECSHELL is set, we do not set */ + + if (!shell) + shell = ((_emx_env & 0x200) + ? "c:/os2/cmd.exe" + : "c:/command.com"); + nargs = shell_opt ? 2 : 1; /* shell file args */ + exec_args[0] = shell; + exec_args[1] = shell_opt; + argsp = exec_args; + if (nargs == 2 && inicmd) { + /* Use the original cmd line */ + /* XXXX This is good only until we refuse + quoted arguments... */ + PL_Argv[0] = inicmd; + PL_Argv[1] = Nullch; + } + } else if (!buf[0] && inicmd) { /* No file */ + /* Start with the original cmdline. */ + /* XXXX This is good only until we refuse + quoted arguments... */ + + PL_Argv[0] = inicmd; + PL_Argv[1] = Nullch; + nargs = 2; /* shell -c */ + } + + while (a[1]) /* Get to the end */ + a++; + a++; /* Copy finil NULL too */ + while (a >= PL_Argv) { + *(a + nargs) = *a; /* PL_Argv was preallocated to be + long enough. */ + a--; + } + while (nargs-- >= 0) + PL_Argv[nargs] = argsp[nargs]; + /* Enable pathless exec if #! (as pdksh). */ + pass = (buf[0] == '#' ? 2 : 3); + goto retry; + } + } + /* 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 as pdksh port does: if not found with /, try without + path. */ + if (no_dir) { + PL_Argv[0] = no_dir + 1; + pass++; + goto retry; + } + } + if (rc < 0 && PL_dowarn) + warn("Can't %s \"%s\": %s\n", + ((execf != EXECF_EXEC && execf != EXECF_TRUEEXEC) + ? "spawn" : "exec"), + PL_Argv[0], Strerror(errno)); + if (rc < 0 && (execf != EXECF_SPAWN_NOWAIT) + && ((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; +} + +/* Array spawn. */ int do_aspawn(really,mark,sp) SV *really; @@ -358,10 +825,11 @@ register SV **sp; char *tmps = NULL; int rc; int flag = P_WAIT, trueflag, err, secondtry = 0; + STRLEN n_a; if (sp > mark) { - New(1301,Argv, sp - mark + 3, char*); - a = Argv; + New(1301,PL_Argv, sp - mark + 3, char*); + a = PL_Argv; if (mark < sp && SvNIOKp(*(mark+1)) && !SvPOKp(*(mark+1))) { ++mark; @@ -370,73 +838,20 @@ register SV **sp; while (++mark <= sp) { if (*mark) - *a++ = SvPVx(*mark, na); + *a++ = SvPVx(*mark, n_a); else *a++ = ""; } *a = Nullch; - trueflag = flag; - if (flag == P_WAIT) - flag = P_NOWAIT; - - if (strEQ(Argv[0],"/bin/sh")) Argv[0] = sh_path; - - if (Argv[0][0] != '/' && Argv[0][0] != '\\' - && !(Argv[0][0] && Argv[0][1] == ':' - && (Argv[0][2] == '/' || Argv[0][2] != '\\')) - ) /* will swawnvp use PATH? */ - TAINT_ENV(); /* testing IFS here is overkill, probably */ - /* We should check PERL_SH* and PERLLIB_* as well? */ - retry: - if (really && *(tmps = SvPV(really, na))) - rc = result(trueflag, spawnvp(flag,tmps,Argv)); - else - rc = result(trueflag, spawnvp(flag,Argv[0],Argv)); - - if (rc < 0 && secondtry == 0 - && (!tmps || !*tmps)) { /* Cannot transfer `really' via shell. */ - err = errno; - if (err == ENOENT) { /* No such file. */ - /* One reason may be that EMX added .exe. We suppose - that .exe-less files are automatically shellable. */ - char *no_dir; - (no_dir = strrchr(Argv[0], '/')) - || (no_dir = strrchr(Argv[0], '\\')) - || (no_dir = Argv[0]); - if (!strchr(no_dir, '.')) { - struct stat buffer; - if (stat(Argv[0], &buffer) != -1) { /* File exists. */ - /* Maybe we need to specify the full name here? */ - goto doshell; - } - } - } else if (err == ENOEXEC) { /* Need to send to shell. */ - doshell: - while (a >= Argv) { - *(a + 2) = *a; - a--; - } - *Argv = sh_path; - *(Argv + 1) = "-c"; - secondtry = 1; - goto retry; - } - } - if (rc < 0 && dowarn) - warn("Can't spawn \"%s\": %s", Argv[0], Strerror(errno)); - if (rc < 0) rc = 255 << 8; /* Emulate the fork(). */ + rc = do_spawn_ve(really, flag, EXECF_SPAWN, NULL, 0); } else rc = -1; do_execfree(); return rc; } -#define EXECF_SPAWN 0 -#define EXECF_EXEC 1 -#define EXECF_TRUEEXEC 2 -#define EXECF_SPAWN_NOWAIT 3 - +/* Try converting 1-arg form to (usually shell-less) multi-arg form. */ int do_spawn2(cmd, execf) char *cmd; @@ -446,7 +861,7 @@ int execf; register char *s; char flags[10]; char *shell, *copt, *news = NULL; - int rc, added_shell = 0, err, seenspace = 0; + int rc, err, seenspace = 0, mergestderr = 0; char fullcmd[MAXNAMLEN + 1]; #ifdef TRYSHELL @@ -463,7 +878,7 @@ int execf; have a shell which will not change between computers with the same architecture, to avoid "action on a distance". And to have simple build, this shell should be sh. */ - shell = sh_path; + shell = PL_sh_path; copt = "-c"; #endif @@ -471,13 +886,12 @@ int execf; cmd++; if (strnEQ(cmd,"/bin/sh",7) && isSPACE(cmd[7])) { - STRLEN l = strlen(sh_path); + STRLEN l = strlen(PL_sh_path); New(1302, news, strlen(cmd) - 7 + l + 1, char); - strcpy(news, sh_path); + strcpy(news, PL_sh_path); strcpy(news + l, cmd + 7); cmd = news; - added_shell = 1; } /* save an extra exec if possible */ @@ -500,33 +914,51 @@ int execf; 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. */ doshell: if (execf == EXECF_TRUEEXEC) - return execl(shell,shell,copt,cmd,(char*)0); + rc = execl(shell,shell,copt,cmd,(char*)0); else if (execf == EXECF_EXEC) - return spawnl(P_OVERLAY,shell,shell,copt,cmd,(char*)0); + rc = spawnl(P_OVERLAY,shell,shell,copt,cmd,(char*)0); else if (execf == EXECF_SPAWN_NOWAIT) - return spawnl(P_NOWAIT,shell,shell,copt,cmd,(char*)0); - /* In the ak code internal P_NOWAIT is P_WAIT ??? */ - rc = result(P_WAIT, - spawnl(P_NOWAIT,shell,shell,copt,cmd,(char*)0)); - if (rc < 0 && dowarn) - warn("Can't %s \"%s\": %s", - (execf == EXECF_SPAWN ? "spawn" : "exec"), - shell, Strerror(errno)); - if (rc < 0) rc = 255 << 8; /* Emulate the fork(). */ - if (news) Safefree(news); + rc = spawnl(P_NOWAIT,shell,shell,copt,cmd,(char*)0); + else { + /* In the ak code internal P_NOWAIT is P_WAIT ??? */ + rc = result(P_WAIT, + spawnl(P_NOWAIT,shell,shell,copt,cmd,(char*)0)); + if (rc < 0 && PL_dowarn) + warn("Can't %s \"%s\": %s", + (execf == EXECF_SPAWN ? "spawn" : "exec"), + shell, Strerror(errno)); + if (rc < 0) rc = 255 << 8; /* Emulate the fork(). */ + } + if (news) + Safefree(news); return rc; } else if (*s == ' ' || *s == '\t') { seenspace = 1; } } - New(1303,Argv, (s - cmd) / 2 + 2, char*); - Cmd = savepvn(cmd, s-cmd); - a = Argv; - for (s = Cmd; *s;) { + /* cmd="a" may lead to "sh", "-c", "\"$@\"", "a", "a.cmd", NULL */ + New(1303,PL_Argv, (s - cmd + 11) / 2, char*); + PL_Cmd = savepvn(cmd, s-cmd); + a = PL_Argv; + for (s = PL_Cmd; *s;) { while (*s && isSPACE(*s)) s++; if (*s) *(a++) = s; @@ -535,46 +967,12 @@ int execf; *s++ = '\0'; } *a = Nullch; - if (Argv[0]) { - int err; - - if (execf == EXECF_TRUEEXEC) - rc = execvp(Argv[0],Argv); - else if (execf == EXECF_EXEC) - rc = spawnvp(P_OVERLAY,Argv[0],Argv); - else if (execf == EXECF_SPAWN_NOWAIT) - rc = spawnvp(P_NOWAIT,Argv[0],Argv); - else - rc = result(P_WAIT, spawnvp(P_NOWAIT,Argv[0],Argv)); - if (rc < 0) { - err = errno; - if (err == ENOENT) { /* No such file. */ - /* One reason may be that EMX added .exe. We suppose - that .exe-less files are automatically shellable. */ - char *no_dir; - (no_dir = strrchr(Argv[0], '/')) - || (no_dir = strrchr(Argv[0], '\\')) - || (no_dir = Argv[0]); - if (!strchr(no_dir, '.')) { - struct stat buffer; - if (stat(Argv[0], &buffer) != -1) { /* File exists. */ - /* Maybe we need to specify the full name here? */ - goto doshell; - } - } - } else if (err == ENOEXEC) { /* Need to send to shell. */ - goto doshell; - } - } - if (rc < 0 && dowarn) - warn("Can't %s \"%s\": %s", - ((execf != EXECF_EXEC && execf != EXECF_TRUEEXEC) - ? "spawn" : "exec"), - Argv[0], Strerror(err)); - if (rc < 0) rc = 255 << 8; /* Emulate the fork(). */ - } else + if (PL_Argv[0]) + rc = do_spawn_ve(NULL, 0, execf, cmd, mergestderr); + else rc = -1; - if (news) Safefree(news); + if (news) + Safefree(news); do_execfree(); return rc; } @@ -597,7 +995,8 @@ bool do_exec(cmd) char *cmd; { - return do_spawn2(cmd, EXECF_EXEC); + do_spawn2(cmd, EXECF_EXEC); + return FALSE; } bool @@ -619,44 +1018,71 @@ char *mode; 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'); that = !this; - if (tainting) { + if (PL_tainting) { taint_env(); taint_proper("Insecure %s%s", "EXEC"); } 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); - } - close(p[that]); + 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]; } - sv = *av_fetch(fdpid,p[this],TRUE); + sv = *av_fetch(PL_fdpid,p[this],TRUE); (void)SvUPGRADE(sv,SVt_IV); SvIVX(sv) = pid; - forkprocess = pid; + PL_forkprocess = pid; return PerlIO_fdopen(p[this], mode); #else /* USE_POPEN */ @@ -669,11 +1095,11 @@ char *mode; # else char *shell = getenv("EMXSHELL"); - my_setenv("EMXSHELL", sh_path); + my_setenv("EMXSHELL", PL_sh_path); res = popen(cmd, mode); my_setenv("EMXSHELL", shell); # endif - sv = *av_fetch(fdpid, PerlIO_fileno(res), TRUE); + sv = *av_fetch(PL_fdpid, PerlIO_fileno(res), TRUE); (void)SvUPGRADE(sv,SVt_IV); SvIVX(sv) = -1; /* A cooky. */ return res; @@ -688,7 +1114,7 @@ char *mode; int fork(void) { - die(no_func, "Unsupported function fork"); + croak(PL_no_func, "Unsupported function fork"); errno = EINVAL; return -1; } @@ -793,7 +1219,8 @@ sys_alloc(int size) { if (rc == ERROR_NOT_ENOUGH_MEMORY) { return (void *) -1; - } else if ( rc ) die("Got an error from DosAllocMem: %li", (long)rc); + } else if ( rc ) + croak("Got an error from DosAllocMem: %li", (long)rc); return got; } @@ -827,8 +1254,9 @@ XS(XS_File__Copy_syscopy) if (items < 2 || items > 3) croak("Usage: File::Copy::syscopy(src,dst,flag=0)"); { - char * src = (char *)SvPV(ST(0),na); - char * dst = (char *)SvPV(ST(1),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; @@ -845,6 +1273,8 @@ XS(XS_File__Copy_syscopy) XSRETURN(1); } +#include "patchlevel.h" + char * mod2fname(sv) SV *sv; @@ -855,6 +1285,7 @@ mod2fname(sv) AV *av; SV *svp; char *s; + STRLEN n_a; if (!SvROK(sv)) croak("Not a reference given to mod2fname"); sv = SvRV(sv); @@ -865,7 +1296,7 @@ mod2fname(sv) if (avlen < 0) croak("Empty array reference given to mod2fname"); - s = SvPV(*av_fetch((AV*)sv, avlen, FALSE), na); + s = SvPV(*av_fetch((AV*)sv, avlen, FALSE), n_a); strncpy(fname, s, 8); len = strlen(s); if (len < 6) pos = len; @@ -875,12 +1306,16 @@ mod2fname(sv) } avlen --; while (avlen >= 0) { - s = SvPV(*av_fetch((AV*)sv, avlen, FALSE), na); + s = SvPV(*av_fetch((AV*)sv, avlen, FALSE), n_a); while (*s) { sum = 33 * sum + *(s++); /* 7 is primitive mod 13. */ } avlen --; } +#ifdef USE_THREADS + sum++; /* Avoid conflict of DLLs in memory. */ +#endif + sum += PERL_VERSION * 200 + PERL_SUBVERSION * 2; /* */ fname[pos] = 'A' + (sum % 26); fname[pos + 1] = 'A' + (sum / 26 % 26); fname[pos + 2] = '\0'; @@ -916,6 +1351,12 @@ os2error(int rc) 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; } @@ -940,7 +1381,7 @@ perllib_mangle(char *s, unsigned int l) } newl = strlen(newp); if (newl == 0 || oldl == 0) { - die("Malformed PERLLIB_PREFIX"); + croak("Malformed PERLLIB_PREFIX"); } strcpy(ret, newp); s = ret; @@ -962,12 +1403,102 @@ perllib_mangle(char *s, unsigned int l) return s; } if (l + newl - oldl > STATIC_FILE_LENGTH || newl > STATIC_FILE_LENGTH) { - die("Malformed PERLLIB_PREFIX"); + croak("Malformed PERLLIB_PREFIX"); } strcpy(ret + newl, s + oldl); return ret; } +unsigned long +Perl_hab_GET() /* Needed if perl.h cannot be included */ +{ + return perl_hab_GET(); +} + +HMQ +Perl_Register_MQ(int serve) +{ + PPIB pib; + PTIB tib; + + if (Perl_os2_initial_mode++) + return Perl_hmq; + DosGetInfoBlocks(&tib, &pib); + Perl_os2_initial_mode = pib->pib_ultype; + Perl_hmq_refcnt = 1; + /* Try morphing into a PM application. */ + if (pib->pib_ultype != 3) /* 2 is VIO */ + pib->pib_ultype = 3; /* 3 is PM */ + init_PMWIN_entries(); + /* 64 messages if before OS/2 3.0, ignored otherwise */ + Perl_hmq = (*PMWIN_entries.CreateMsgQueue)(perl_hab_GET(), 64); + if (!Perl_hmq) { + static int cnt; + if (cnt++) + _exit(188); /* Panic can try to create a window. */ + croak("Cannot create a message queue, or morph to a PM application"); + } + return Perl_hmq; +} + +int +Perl_Serve_Messages(int force) +{ + int cnt = 0; + QMSG msg; + + if (Perl_hmq_servers && !force) + return 0; + if (!Perl_hmq_refcnt) + croak("No message queue"); + while ((*PMWIN_entries.PeekMsg)(Perl_hab, &msg, NULLHANDLE, 0, 0, PM_REMOVE)) { + cnt++; + if (msg.msg == WM_QUIT) + croak("QUITing..."); + (*PMWIN_entries.DispatchMsg)(Perl_hab, &msg); + } + return cnt; +} + +int +Perl_Process_Messages(int force, I32 *cntp) +{ + QMSG msg; + + if (Perl_hmq_servers && !force) + return 0; + if (!Perl_hmq_refcnt) + croak("No message queue"); + while ((*PMWIN_entries.GetMsg)(Perl_hab, &msg, NULLHANDLE, 0, 0)) { + if (cntp) + (*cntp)++; + (*PMWIN_entries.DispatchMsg)(Perl_hab, &msg); + if (msg.msg == WM_DESTROY) + return -1; + if (msg.msg == WM_CREATE) + return +1; + } + croak("QUITing..."); +} + +void +Perl_Deregister_MQ(int serve) +{ + PPIB pib; + PTIB tib; + + if (--Perl_hmq_refcnt == 0) { + (*PMWIN_entries.DestroyMsgQueue)(Perl_hmq); + Perl_hmq = 0; + /* Try morphing back from a PM application. */ + if (pib->pib_ultype == 3) /* 3 is PM */ + pib->pib_ultype = Perl_os2_initial_mode; + else + warn("Unexpected program mode %d when morphing back from PM", + pib->pib_ultype); + } +} + extern void dlopen(); void *fakedl = &dlopen; /* Pull in dynaloading part. */ @@ -981,6 +1512,206 @@ void *fakedl = &dlopen; /* Pull in dynaloading part. */ #define sys_chdir(p) (chdir(p) == 0) #define change_drive(d) (_chdrive(d), (current_drive() == toupper(d))) +static int DOS_harderr_state = -1; + +XS(XS_OS2_Error) +{ + dXSARGS; + if (items != 2) + croak("Usage: OS2::Error(harderr, exception)"); + { + int arg1 = SvIV(ST(0)); + int arg2 = SvIV(ST(1)); + int a = ((arg1 ? FERR_ENABLEHARDERR : FERR_DISABLEHARDERR) + | (arg2 ? FERR_ENABLEEXCEPTION : FERR_DISABLEEXCEPTION)); + int RETVAL = ((arg1 ? 1 : 0) | (arg2 ? 2 : 0)); + unsigned long rc; + + if (CheckOSError(DosError(a))) + croak("DosError(%d) failed", a); + ST(0) = sv_newmortal(); + if (DOS_harderr_state >= 0) + sv_setiv(ST(0), DOS_harderr_state); + DOS_harderr_state = RETVAL; + } + XSRETURN(1); +} + +static signed char DOS_suppression_state = -1; + +XS(XS_OS2_Errors2Drive) +{ + dXSARGS; + if (items != 1) + croak("Usage: OS2::Errors2Drive(drive)"); + { + STRLEN n_a; + SV *sv = ST(0); + int suppress = SvOK(sv); + char *s = suppress ? SvPV(sv, n_a) : NULL; + char drive = (s ? *s : 0); + unsigned long rc; + + if (suppress && !isALPHA(drive)) + croak("Non-char argument '%c' to OS2::Errors2Drive()", drive); + if (CheckOSError(DosSuppressPopUps((suppress + ? SPU_ENABLESUPPRESSION + : SPU_DISABLESUPPRESSION), + drive))) + croak("DosSuppressPopUps(%c) failed", drive); + ST(0) = sv_newmortal(); + if (DOS_suppression_state > 0) + sv_setpvn(ST(0), &DOS_suppression_state, 1); + else if (DOS_suppression_state == 0) + sv_setpvn(ST(0), "", 0); + DOS_suppression_state = drive; + } + XSRETURN(1); +} + +static const char * const si_fields[QSV_MAX] = { + "MAX_PATH_LENGTH", + "MAX_TEXT_SESSIONS", + "MAX_PM_SESSIONS", + "MAX_VDM_SESSIONS", + "BOOT_DRIVE", + "DYN_PRI_VARIATION", + "MAX_WAIT", + "MIN_SLICE", + "MAX_SLICE", + "PAGE_SIZE", + "VERSION_MAJOR", + "VERSION_MINOR", + "VERSION_REVISION", + "MS_COUNT", + "TIME_LOW", + "TIME_HIGH", + "TOTPHYSMEM", + "TOTRESMEM", + "TOTAVAILMEM", + "MAXPRMEM", + "MAXSHMEM", + "TIMER_INTERVAL", + "MAX_COMP_LENGTH", + "FOREGROUND_FS_SESSION", + "FOREGROUND_PROCESS" +}; + +XS(XS_OS2_SysInfo) +{ + dXSARGS; + if (items != 0) + croak("Usage: OS2::SysInfo()"); + { + ULONG si[QSV_MAX] = {0}; /* System Information Data Buffer */ + APIRET rc = NO_ERROR; /* Return code */ + int i = 0, j = 0; + + if (CheckOSError(DosQuerySysInfo(1L, /* Request all available system */ + QSV_MAX, /* information */ + (PVOID)si, + sizeof(si)))) + croak("DosQuerySysInfo() failed"); + EXTEND(SP,2*QSV_MAX); + while (i < QSV_MAX) { + ST(j) = sv_newmortal(); + sv_setpv(ST(j++), si_fields[i]); + ST(j) = sv_newmortal(); + sv_setiv(ST(j++), si[i]); + i++; + } + } + XSRETURN(2 * QSV_MAX); +} + +XS(XS_OS2_BootDrive) +{ + dXSARGS; + if (items != 0) + croak("Usage: OS2::BootDrive()"); + { + ULONG si[1] = {0}; /* System Information Data Buffer */ + APIRET rc = NO_ERROR; /* Return code */ + char c; + + if (CheckOSError(DosQuerySysInfo(QSV_BOOT_DRIVE, QSV_BOOT_DRIVE, + (PVOID)si, sizeof(si)))) + croak("DosQuerySysInfo() failed"); + ST(0) = sv_newmortal(); + c = 'a' - 1 + si[0]; + sv_setpvn(ST(0), &c, 1); + } + XSRETURN(1); +} + +XS(XS_OS2_MorphPM) +{ + dXSARGS; + if (items != 1) + croak("Usage: OS2::MorphPM(serve)"); + { + bool serve = SvOK(ST(0)); + unsigned long pmq = perl_hmq_GET(serve); + + ST(0) = sv_newmortal(); + sv_setiv(ST(0), pmq); + } + XSRETURN(1); +} + +XS(XS_OS2_UnMorphPM) +{ + dXSARGS; + if (items != 1) + croak("Usage: OS2::UnMorphPM(serve)"); + { + bool serve = SvOK(ST(0)); + + perl_hmq_UNSET(serve); + } + XSRETURN(0); +} + +XS(XS_OS2_Serve_Messages) +{ + dXSARGS; + if (items != 1) + croak("Usage: OS2::Serve_Messages(force)"); + { + bool force = SvOK(ST(0)); + unsigned long cnt = Perl_Serve_Messages(force); + + ST(0) = sv_newmortal(); + sv_setiv(ST(0), cnt); + } + XSRETURN(1); +} + +XS(XS_OS2_Process_Messages) +{ + dXSARGS; + if (items < 1 || items > 2) + croak("Usage: OS2::Process_Messages(force [, cnt])"); + { + bool force = SvOK(ST(0)); + unsigned long cnt; + I32 *cntp = NULL; + + if (items == 2) { + SV *sv = ST(1); + int fake = SvIV(sv); /* Force SvIVX */ + + if (!SvIOK(sv)) + croak("Can't upgrade count to IV"); + cntp = &SvIVX(sv); + } + cnt = Perl_Process_Messages(force, cntp); + ST(0) = sv_newmortal(); + sv_setiv(ST(0), cnt); + } + XSRETURN(1); +} + XS(XS_Cwd_current_drive) { dXSARGS; @@ -1002,7 +1733,8 @@ XS(XS_Cwd_sys_chdir) if (items != 1) croak("Usage: Cwd::sys_chdir(path)"); { - char * path = (char *)SvPV(ST(0),na); + STRLEN n_a; + char * path = (char *)SvPV(ST(0),n_a); bool RETVAL; RETVAL = sys_chdir(path); @@ -1018,7 +1750,8 @@ XS(XS_Cwd_change_drive) if (items != 1) croak("Usage: Cwd::change_drive(d)"); { - char d = (char)*SvPV(ST(0),na); + STRLEN n_a; + char d = (char)*SvPV(ST(0),n_a); bool RETVAL; RETVAL = change_drive(d); @@ -1034,7 +1767,8 @@ XS(XS_Cwd_sys_is_absolute) if (items != 1) croak("Usage: Cwd::sys_is_absolute(path)"); { - char * path = (char *)SvPV(ST(0),na); + STRLEN n_a; + char * path = (char *)SvPV(ST(0),n_a); bool RETVAL; RETVAL = sys_is_absolute(path); @@ -1050,7 +1784,8 @@ XS(XS_Cwd_sys_is_rooted) if (items != 1) croak("Usage: Cwd::sys_is_rooted(path)"); { - char * path = (char *)SvPV(ST(0),na); + STRLEN n_a; + char * path = (char *)SvPV(ST(0),n_a); bool RETVAL; RETVAL = sys_is_rooted(path); @@ -1066,7 +1801,8 @@ XS(XS_Cwd_sys_is_relative) if (items != 1) croak("Usage: Cwd::sys_is_relative(path)"); { - char * path = (char *)SvPV(ST(0),na); + STRLEN n_a; + char * path = (char *)SvPV(ST(0),n_a); bool RETVAL; RETVAL = sys_is_relative(path); @@ -1097,7 +1833,8 @@ XS(XS_Cwd_sys_abspath) if (items < 1 || items > 2) croak("Usage: Cwd::sys_abspath(path, dir = NULL)"); { - char * path = (char *)SvPV(ST(0),na); + STRLEN n_a; + char * path = (char *)SvPV(ST(0),n_a); char * dir; char p[MAXPATHLEN]; char * RETVAL; @@ -1105,7 +1842,7 @@ XS(XS_Cwd_sys_abspath) if (items < 2) dir = NULL; else { - dir = (char *)SvPV(ST(1),na); + dir = (char *)SvPV(ST(1),n_a); } if (path[0] == '.' && (path[1] == '/' || path[1] == '\\')) { path += 2; @@ -1202,7 +1939,7 @@ typedef APIRET (*PELP)(PSZ path, ULONG type); APIRET ExtLIBPATH(ULONG ord, PSZ path, ULONG type) { - loadByOrd(ord); /* Guarantied to load or die! */ + loadByOrd("doscalls",ord); /* Guarantied to load or die! */ return (*(PELP)ExtFCN[ord])(path, type); } @@ -1245,7 +1982,8 @@ XS(XS_Cwd_extLibpath_set) if (items < 1 || items > 2) croak("Usage: Cwd::extLibpath_set(s, type = 0)"); { - char * s = (char *)SvPV(ST(0),na); + STRLEN n_a; + char * s = (char *)SvPV(ST(0),n_a); bool type; U32 rc; bool RETVAL; @@ -1275,6 +2013,14 @@ Xs_OS2_init() newXS("Cwd::extLibpath", XS_Cwd_extLibpath, file); newXS("Cwd::extLibpath_set", XS_Cwd_extLibpath_set, file); } + newXS("OS2::Error", XS_OS2_Error, file); + newXS("OS2::Errors2Drive", XS_OS2_Errors2Drive, file); + newXS("OS2::SysInfo", XS_OS2_SysInfo, file); + newXS("OS2::BootDrive", XS_OS2_BootDrive, file); + newXS("OS2::MorphPM", XS_OS2_MorphPM, file); + newXS("OS2::UnMorphPM", XS_OS2_UnMorphPM, file); + newXS("OS2::Serve_Messages", XS_OS2_Serve_Messages, file); + newXS("OS2::Process_Messages", XS_OS2_Process_Messages, file); newXS("DynaLoader::mod2fname", XS_DynaLoader_mod2fname, file); newXS("Cwd::current_drive", XS_Cwd_current_drive, file); newXS("Cwd::sys_chdir", XS_Cwd_sys_chdir, file); @@ -1289,6 +2035,17 @@ Xs_OS2_init() #ifdef PERL_IS_AOUT sv_setiv(GvSV(gv), 1); #endif + gv = gv_fetchpv("OS2::emx_rev", TRUE, SVt_PV); + GvMULTI_on(gv); + sv_setiv(GvSV(gv), _emx_rev); + sv_setpv(GvSV(gv), _emx_vprt); + SvIOK_on(GvSV(gv)); + gv = gv_fetchpv("OS2::emx_env", TRUE, SVt_PV); + GvMULTI_on(gv); + sv_setiv(GvSV(gv), _emx_env); + gv = gv_fetchpv("OS2::os_ver", TRUE, SVt_PV); + GvMULTI_on(gv); + sv_setnv(GvSV(gv), _osmajor + 0.001 * _osminor); } } @@ -1302,26 +2059,28 @@ Perl_OS2_init(char **env) MALLOC_INIT; settmppath(); OS2_Perl_data.xs_init = &Xs_OS2_init; + _uflags (_UF_SBRK_MODEL, _UF_SBRK_ARBITRARY); if (environ == NULL) { environ = env; } if ( (shell = getenv("PERL_SH_DRIVE")) ) { - New(1304, sh_path, strlen(SH_PATH) + 1, char); - strcpy(sh_path, SH_PATH); - sh_path[0] = shell[0]; + New(1304, PL_sh_path, strlen(SH_PATH) + 1, char); + strcpy(PL_sh_path, SH_PATH); + PL_sh_path[0] = shell[0]; } else if ( (shell = getenv("PERL_SH_DIR")) ) { int l = strlen(shell), i; if (shell[l-1] == '/' || shell[l-1] == '\\') { l--; } - New(1304, sh_path, l + 8, char); - strncpy(sh_path, shell, l); - strcpy(sh_path + l, "/sh.exe"); + New(1304, PL_sh_path, l + 8, char); + strncpy(PL_sh_path, shell, l); + strcpy(PL_sh_path + l, "/sh.exe"); for (i = 0; i < l; i++) { - if (sh_path[i] == '\\') sh_path[i] = '/'; + if (PL_sh_path[i] == '\\') PL_sh_path[i] = '/'; } } MUTEX_INIT(&start_thread_mutex); + os2_mytype = my_type(); /* Do it before morphing. Needed? */ } #undef tmpnam