From: Ilya Zakharevich Date: Mon, 13 Jul 1998 19:36:05 +0000 (-0400) Subject: OS/2 update X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=2c2e0e8c03d67909bd8b889b6cdbb201bea519fc;p=p5sagit%2Fp5-mst-13.2.git OS/2 update Message-Id: <199807132336.TAA12967@monk.mps.ohio-state.edu> Subject: [PATCH 5.004_72] OS/2 system() and friends additions p4raw-id: //depot/perl@1483 --- diff --git a/README.os2 b/README.os2 index 903702a..a0b3d97 100644 --- a/README.os2 +++ b/README.os2 @@ -305,11 +305,63 @@ sh-syntax shell installed (see L<"Pdksh">, L<"Frequently asked questions">), and perl should be able to find it (see L<"PERL_SH_DIR">). -The only cases when the shell is not used is the multi-argument -system() (see L)/exec() (see L), and -one-argument version thereof without redirection and shell -meta-characters. Perl may also start scripts which start with cookies -C or C<#!> directly, without an intervention of shell. +The cases when the shell is used are: + +=over + +=item 1 + +One-argument system() (see L), exec() (see L) +with redirection or shell meta-characters; + +=item 2 + +Pipe-open (see L) with the command which contains redirection +or shell meta-characters; + +=item 3 + +Backticks C<``> (see L) with the command which contains +redirection or shell meta-characters; + +=item 4 + +If the executable called by system()/exec()/pipe-open()/C<``> is a script +with the "magic" C<#!> line or C line which specifies shell; + +=item 5 + +If the executable called by system()/exec()/pipe-open()/C<``> is a script +without "magic" line, and C<$ENV{EXECSHELL}> is set to shell; + +=item 6 + +If the executable called by system()/exec()/pipe-open()/C<``> is not +found; + +=item 7 + +For globbing (see L, L). + +=back + +For the sake of speed for a common case, in the above algorithms +backslashes in the command name are not considered as shell metacharacters. + +Perl starts scripts which begin with cookies +C or C<#!> directly, without an intervention of shell. Perl uses the +same algorithm to find the executable as F: if the path +on C<#!> line does not work, and contains C, then the executable +is searched in F<.> and on C. To find arguments for these scripts +Perl uses a different algorithm than F: up to 3 arguments are +recognized, and trailing whitespace is stripped. + +If a script +does not contain such a cooky, then to avoid calling F, Perl uses +the same algorithm as F: if C<$ENV{EXECSHELL}> is set, the +script is given as the first argument to this command, if not set, then +C<$ENV{COMSPEC} /c> is used (or a hardwired guess if C<$ENV{COMSPEC}> is +not set). If starting scripts directly, Perl will use exactly the same algorithm as for the search of script given by B<-S> command-line option: it will look in @@ -684,6 +736,9 @@ check use ). You need the latest version of F installed as F. +Check that you have B libraries and headers installed, and - +optionally - Berkeley DB headers and libraries, and crypt. + Possible locations to get this from are ftp://hobbes.nmsu.edu/os2/unix/ @@ -769,6 +824,22 @@ compatibility with XFree86-OS/2). Get a corrected one from ftp://ftp.math.ohio-state.edu/pub/users/ilya/os2/db_mt.zip +To make C<-p> filetest work, one may also need to apply the following patch +to EMX headers: + + --- /emx/include/sys/stat.h.orig Thu May 23 13:48:16 1996 + +++ /emx/include/sys/stat.h Sun Jul 12 14:11:32 1998 + @@ -53,7 +53,7 @@ struct stat + #endif + + #if !defined (S_IFMT) + -#define S_IFMT 0160000 /* Mask for file type */ + +#define S_IFMT 0170000 /* Mask for file type */ + #define S_IFIFO 0010000 /* Pipe */ + #define S_IFCHR 0020000 /* Character device */ + #define S_IFDIR 0040000 /* Directory */ + + =head2 Hand-editing You may look into the file F<./hints/os2.sh> and correct anything @@ -804,7 +875,7 @@ F. =head2 Testing -If you haven't yet moved perl.dll onto LIBPATH, do it now(alternatively, if +If you haven't yet moved perl.dll onto LIBPATH, do it now (alternatively, if you have a previous perl installation you'd rather not disrupt until this one is installed, copy perl.dll to the t directory). @@ -813,10 +884,9 @@ Now run make test Some tests (4..6) should fail. Some perl invocations should end in a -segfault (system error C). To get finer error reports, +segfault (system error C). To get finer error reports, call - cd t - perl harness + perl t/harness The report you get may look like @@ -828,7 +898,7 @@ The report you get may look like op/stat.t 56 5 8.93% 3-4, 20, 35, 39 Failed 4/140 test scripts, 97.14% okay. 27/2937 subtests failed, 99.08% okay. -Note that using `make test' target two more tests may fail: C +Note that using C target two more tests may fail: C because of (mis)feature of pdksh, and C, which checks that the buffers are not flushed on C<_exit> (this is a bug in the test which assumes that tty output is buffered). @@ -909,7 +979,7 @@ In addition to errors, you should get a lot of warnings. =over 4 -=item A lot of `bad free' +=item A lot of C in databases related to Berkeley DB. This is a confirmed bug of DB. You may disable this warnings, see L<"PERL_BADFREE">. @@ -933,7 +1003,7 @@ the system it runs on is not I *nixish. =back -A lot of `bad free'... in databases, bug in DB confirmed on other +A lot of C... in databases, bug in DB confirmed on other platforms. You may disable it by setting PERL_BADFREE environment variable to 1. @@ -999,9 +1069,9 @@ You have a very old pdksh. See L. You do not have MT-safe F. See L. -=head2 Problems with tr +=head2 Problems with tr or sed -reported with very old version of tr. +reported with very old version of tr and sed. =head2 Some problem (forget which ;-) @@ -1038,8 +1108,9 @@ if script was started via cmd.exe). =head2 Additional modules: -L, L, L, L. This -modules provide access to additional numeric argument for C, +L, L, L, L. These +modules provide access to additional numeric argument for C +and to the list of the running processes, to DLLs having functions with REXX signature and to REXX runtime, to OS/2 databases in the F<.INI> format, and to Extended Attributes. @@ -1408,7 +1479,7 @@ caching DLLs. =head2 Threading As of release 5.003_01 perl is linked to multithreaded CRT -DLL. Perl itself is not multithread-safe, as is not perl +DLL. If perl itself is not compiled multithread-enabled, so will not be perl malloc(). However, extensions may use multiple thread on their own risk. @@ -1422,7 +1493,7 @@ external program I, the F will be called, or whatever is the override, see L<"PERL_SH_DIR">. Thus means that you need to get some copy of a F as well (I -use one from pdksh). The drive F: above is set up automatically during +use one from pdksh). The drive F above is set up automatically during the build to a correct value on the builder machine, but is overridable at runtime, @@ -1464,6 +1535,18 @@ If you have some working code for C, please send it to me, I will include it into distribution. I have no need for such a module, so cannot test it. +For the details of the current situation with calling external programs, +see L. + +=over + +=item + +External scripts may be called by name. Perl will try the same extensions +as when processing B<-S> command-line switch. + +=back + =head2 Memory allocation Perl uses its own malloc() under OS/2 - interpreters are usually malloc-bound diff --git a/hints/os2.sh b/hints/os2.sh index 7a980bd..78d370a 100644 --- a/hints/os2.sh +++ b/hints/os2.sh @@ -123,8 +123,8 @@ fi aout_ldflags="$aout_ldflags" aout_d_fork='define' -aout_ccflags='-DPERL_CORE -DDOSISH -DPERL_IS_AOUT -DOS2=2 -DEMBED -I. -DPACK_MALLOC -DTWO_POT_OPTIMIZE -DPERL_EMERGENCY_SBRK' -aout_cppflags='-DPERL_CORE -DDOSISH -DPERL_IS_AOUT -DOS2=2 -DEMBED -I. -DPACK_MALLOC -DTWO_POT_OPTIMIZE -DPERL_EMERGENCY_SBRK' +aout_ccflags='-DPERL_CORE -DDOSISH -DPERL_IS_AOUT -DOS2=2 -DEMBED -I.' +aout_cppflags='-DPERL_CORE -DDOSISH -DPERL_IS_AOUT -DOS2=2 -DEMBED -I.' aout_use_clib='c' aout_usedl='undef' aout_archobjs="os2.o dl_os2.o" @@ -164,9 +164,9 @@ else # Recursive regmatch may eat 2.5M of stack alone. ldflags='-Zexe -Zomf -Zmt -Zcrtdll -Zstack 32000' if [ $emxcrtrev -ge 50 ]; then - ccflags='-Zomf -Zmt -DDOSISH -DOS2=2 -DEMBED -I. -DPACK_MALLOC -DDEBUGGING_MSTATS -DTWO_POT_OPTIMIZE -DPERL_EMERGENCY_SBRK' + ccflags='-Zomf -Zmt -DDOSISH -DOS2=2 -DEMBED -I.' else - ccflags='-Zomf -Zmt -DDOSISH -DOS2=2 -DEMBED -I. -DPACK_MALLOC -DDEBUGGING_MSTATS -DEMX_BAD_SBRK' + ccflags='-Zomf -Zmt -DDOSISH -DOS2=2 -DEMBED -I. -DEMX_BAD_SBRK' fi use_clib='c_import' usedl='define' diff --git a/os2/Changes b/os2/Changes index e2506f5..70370a4 100644 --- a/os2/Changes +++ b/os2/Changes @@ -181,3 +181,20 @@ after 5.004_53: after 5.004_64: Make DLL names different if thread-enabled. Emit more informative internal DLL descriptions. + +5.004_72: + Updated OS2::Process (v0.2) included. + +after 5.004_73: + Fixed a bug with argv not NULL-terminated when starting scripts. + Support all the forms of starting scripts. + Support killing a child when receiving a signal during system() + (in two stage, on first send the same signal, on the next + send SIGKILL). + Add the same logic for scripts as in pdksh, including + stripping the path from #! line if needed, + calling EXECSHELL or COMSPEC for magic-less scripts; + Now pdksh is called only if one-arg system()/friends contains + metachars, or if magic-line asks for sh, or there is no magic + line and EXECSHELL is set to sh. + Shell is supplied the original command line if possible. diff --git a/os2/os2.c b/os2/os2.c index d545703..5b62fac 100644 --- a/os2/os2.c +++ b/os2/os2.c @@ -310,7 +310,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) @@ -327,8 +348,10 @@ 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); @@ -359,14 +382,15 @@ result(int flag, int pid) /* global Argv[] contains arguments. */ int -do_spawn_ve(really, flag, execf) +do_spawn_ve(really, flag, execf, inicmd) SV *really; U32 flag; U32 execf; +char *inicmd; { dTHR; int trueflag = flag; - int rc, secondtry = 0, err; + int rc, pass = 1, err; char *tmps; char buf[256], *s = 0; char *args[4]; @@ -385,7 +409,7 @@ U32 execf; if (Argv[0][0] != '/' && Argv[0][0] != '\\' && !(Argv[0][0] && Argv[0][1] == ':' && (Argv[0][2] == '/' || Argv[0][2] != '\\')) - ) /* will swawnvp use PATH? */ + ) /* 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, na))) @@ -403,105 +427,169 @@ U32 execf; rc = result(trueflag, spawnvp(trueflag | P_NOWAIT,tmps,Argv)); #endif - if (rc < 0 && secondtry == 0 + if (rc < 0 && pass == 1 && (tmps == Argv[0])) { /* 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. - It might have also been .cmd file without - extension. */ - 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 { - /* Try adding script extensions to the file name */ - char *scr; - if ((scr = find_script(Argv[0], TRUE, NULL, 0))) { - FILE *file = fopen(scr, "r"); - char *s = 0, *s1; - - Argv[0] = scr; - if (!file) - goto panic_file; - if (!fgets(buf, sizeof buf, file)) { - fclose(file); - goto panic_file; - } - if (fclose(file) != 0) { /* Failure */ - panic_file: - warn("Error reading \"%s\": %s", - scr, Strerror(errno)); - goto doshell; - } - 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) - goto doshell; - s1 = s; - nargs = 0; - argsp = args; - while (1) { - while (isSPACE(*s)) - s++; - if (*s == 0) - break; - if (nargs == 4) { - nargs = -1; - break; + 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(Argv[0], TRUE, NULL, 0); + + if (scr) { + FILE *file = fopen(scr, "r"); + char *s = 0, *s1; + + Argv[0] = scr; + if (!file) + goto panic_file; + if (!fgets(buf, sizeof buf, file)) { + fclose(file); + goto panic_file; + } + 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 = Argv; + char *exec_args[2]; + + if (!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 = Argv[0]; + while (*s) { + /* Dosish shells will choke on slashes + in paths, fortunately, this is + important for zeroth arg only. */ + if (*s == '/') + *s = '\\'; + s++; + } } - 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; + /* 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... */ + Argv[0] = inicmd; + Argv[1] = Nullch; } - goto doshell; + } else if (!buf[0] && inicmd) { /* No file */ + /* Start with the original cmdline. */ + /* XXXX This is good only until we refuse + quoted arguments... */ + + Argv[0] = inicmd; + Argv[1] = Nullch; + nargs = 2; /* shell -c */ + } + + while (a[1]) /* Get to the end */ + a++; + a++; /* Copy finil NULL too */ + while (a >= Argv) { + *(a + nargs) = *a; /* Argv was preallocated to be + long enough. */ + a--; } + while (nargs-- >= 0) + Argv[nargs] = argsp[nargs]; + /* Enable pathless exec if #! (as pdksh). */ + pass = (buf[0] == '#' ? 2 : 3); + goto retry; } } - /* Restore errno */ + /* Not found: restore errno */ errno = err; - } else if (err == ENOEXEC) { /* Need to send to shell. */ - doshell: - { - char **a = Argv; - - while (a[1]) /* Get to the end */ - a++; - while (a >= Argv) { - *(a + nargs) = *a; /* Argv was preallocated to be - long enough. */ - a--; - } - while (nargs-- >= 0) - Argv[nargs] = argsp[nargs]; - secondtry = 1; + } + } else if (rc < 0 && pass == 2 && err == ENOENT) { /* File not found */ + char *no_dir = strrchr(Argv[0], '/'); + + /* Do as pdksh port does: if not found with /, try without + path. */ + if (no_dir) { + Argv[0] = no_dir + 1; + pass++; goto retry; - } } } if (rc < 0 && dowarn) @@ -516,6 +604,7 @@ U32 execf; return rc; } +/* Array spawn. */ int do_aspawn(really,mark,sp) SV *really; @@ -545,7 +634,7 @@ register SV **sp; } *a = Nullch; - rc = do_spawn_ve(really, flag, EXECF_SPAWN); + rc = do_spawn_ve(really, flag, EXECF_SPAWN, NULL); } else rc = -1; do_execfree(); @@ -562,7 +651,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; char fullcmd[MAXNAMLEN + 1]; #ifdef TRYSHELL @@ -593,7 +682,6 @@ int execf; strcpy(news, sh_path); strcpy(news + l, cmd + 7); cmd = news; - added_shell = 1; } /* save an extra exec if possible */ @@ -621,20 +709,23 @@ int execf; 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 && 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; @@ -655,10 +746,11 @@ int execf; } *a = Nullch; if (Argv[0]) - rc = do_spawn_ve(NULL, 0, execf); + rc = do_spawn_ve(NULL, 0, execf, cmd); else rc = -1; - if (news) Safefree(news); + if (news) + Safefree(news); do_execfree(); return rc; } diff --git a/t/op/magic.t b/t/op/magic.t index ec7fbb5..61e4522 100755 --- a/t/op/magic.t +++ b/t/op/magic.t @@ -136,10 +136,6 @@ __END__ EOT } $s1 = $s2 = "\$^X is $perl, \$0 is $script\n"; - if ($^O eq 'os2') { - # Started by ksh, which adds suffixes '.exe' and '.' to perl and script - $s2 = "\$^X is $wd/perl.exe, \$0 is $script.\n"; - } ok 19, open(SCRIPT, ">$script"), $!; ok 20, print(SCRIPT $headmaybe . <