[p5sagit/p5-mst-13.2.git] / vmesa / vmesa.c

/************************************************************/
/*                                                          */
/* Module ID  - vmesa.c                                     */
/*                                                          */
/* Function   - Provide operating system dependent process- */
/*              ing for perl under VM/ESA.                  */
/*                                                          */
/* Parameters - See individual entry points.                */
/*                                                          */
/* Called By  - N/A - see individual entry points.          */
/*                                                          */
/* Calling To - N/A - see individual entry points.          */
/*                                                          */
/* Notes      - (1) ....................................... */
/*                                                          */
/*              (2) ....................................... */
/*                                                          */
/* Name       - Neale Ferguson.                             */
/*                                                          */
/* Date       - August, 1998.                               */
/*                                                          */
/*                                                          */
/* Associated    - (1) Refer To ........................... */
/* Documentation                                            */
/*                 (2) Refer To ........................... */
/*                                                          */
/************************************************************/
/************************************************************/
/*                                                          */
/*                MODULE MAINTENANCE HISTORY                */
/*                --------------------------                */
/*                                                          */
static char REQ_REL_WHO [13] =
/*--------------       -------------------------------------*/
    "9999_99 NAF "; /* Original module                      */
/*                                                          */
/*============ End of Module Maintenance History ===========*/

/************************************************************/
/*                                                          */
/*                       DEFINES                            */
/*                       -------                            */
/*                                                          */
/************************************************************/

#define FAIL  65280

/*=============== END OF DEFINES ===========================*/

/************************************************************/
/*                                                          */
/*                INCLUDE STATEMENTS                        */
/*                ------------------                        */
/*                                                          */
/************************************************************/

#include <stdio.h>
#include <stdlib.h>
#include <spawn.h>
#include <fcntl.h>
#include <unistd.h>
#include <pthread.h>
#include <dll.h>
#include "EXTERN.h"
#include "perl.h"
#pragma map(truncate, "@@TRUNC")

/*================== End of Include Statements =============*/

/************************************************************/
/*                                                          */
/*               Global Variables                           */
/*               ----------------                           */
/*                                                          */
/************************************************************/

static int Perl_stdin_fd  = STDIN_FILENO,
           Perl_stdout_fd = STDOUT_FILENO;

static long dl_retcode = 0;

/*================== End of Global Variables ===============*/

/************************************************************/
/*                                                          */
/*               FUNCTION PROTOTYPES                        */
/*               -------------------                        */
/*                                                          */
/************************************************************/

int    do_aspawn(SV *, SV **, SV **);
int    do_spawn(char *, int);
static int spawnit(char *);
static pid_t spawn_cmd(char *, int, int);
struct perl_thread * getTHR(void);

/*================== End of Prototypes =====================*/

/************************************************************/
/*                                                          */
/*                     D O _ A S P A W N                    */
/*                     -----------------                    */
/*                                                          */
/************************************************************/

int
do_aspawn(SV* really, SV **mark, SV **sp)
{
 char   **a,
        *tmps;
 struct inheritance inherit;
 pid_t  pid;
 int    status,
        fd,
        nFd,
        fdMap[3];
 SV     *sv,
        **p_sv;
 STRLEN	n_a;

    status = FAIL;
    if (sp > mark)
    {
       dTHR;
       New(401,PL_Argv, sp - mark + 1, char*);
       a = PL_Argv;
       while (++mark <= sp)
       {
           if (*mark)
              *a++ = SvPVx(*mark, n_a);
           else
              *a++ = "";
       }
       inherit.flags        = SPAWN_SETGROUP;
       inherit.pgroup       = SPAWN_NEWPGROUP;
       fdMap[STDIN_FILENO]  = Perl_stdin_fd;
       fdMap[STDOUT_FILENO] = Perl_stdout_fd;
       fdMap[STDERR_FILENO] = STDERR_FILENO;
       nFd                  = 3;
       *a = Nullch;
       /*-----------------------------------------------------*/
       /* Will execvp() use PATH?                             */
       /*-----------------------------------------------------*/
       if (*PL_Argv[0] != '/')
           TAINT_ENV();
       if (really && *(tmps = SvPV(really, n_a)))
           pid = spawnp(tmps, nFd, fdMap, &inherit,
                        (const char **) PL_Argv,
                        (const char **) environ);
       else
           pid = spawnp(PL_Argv[0], nFd, fdMap, &inherit,
                        (const char **) PL_Argv,
                        (const char **) environ);
       if (pid < 0)
       {
          status = FAIL;
          if (ckWARN(WARN_EXEC))
             warner(WARN_EXEC,"Can't exec \"%s\": %s",
                    PL_Argv[0],
                    Strerror(errno));
       }
       else
       {
          /*------------------------------------------------*/
          /* If the file descriptors have been remapped then*/
          /* we've been called following a my_popen request */
          /* therefore we don't want to wait for spawnned   */
          /* program to complete. We need to set the fdpid  */
          /* value to the value of the spawnned process' pid*/
          /*------------------------------------------------*/
          fd = 0;
          if (Perl_stdin_fd != STDIN_FILENO)
             fd = Perl_stdin_fd;
          else
             if (Perl_stdout_fd != STDOUT_FILENO)
                fd = Perl_stdout_fd;
          if (fd != 0)
          {
             /*---------------------------------------------*/
             /* Get the fd of the other end of the pipe,    */
             /* use this to reference the fdpid which will  */
             /* be used by my_pclose                        */
             /*---------------------------------------------*/
             close(fd);
             MUTEX_LOCK(&PL_fdpid_mutex);
             p_sv  = av_fetch(PL_fdpid,fd,TRUE);
             fd    = (int) SvIVX(*p_sv);
             SvREFCNT_dec(*p_sv);
             *p_sv = &PL_sv_undef;
             sv    = *av_fetch(PL_fdpid,fd,TRUE);
             MUTEX_UNLOCK(&PL_fdpid_mutex);
             (void) SvUPGRADE(sv, SVt_IV);
             SvIVX(sv) = pid;
             status    = 0;
          }
          else
             wait4pid(pid, &status, 0);
       }
       do_execfree();
    }
    return (status);
}

/*===================== End of do_aspawn ===================*/

/************************************************************/
/*                                                          */
/*                     D O _ S P A W N                      */
/*                     ---------------                      */
/*                                                          */
/************************************************************/

int
do_spawn(char *cmd, int execf)
{
 char   **a,
        *s,
        flags[10];
 int    status,
        nFd,
        fdMap[3];
 struct inheritance inherit;
 pid_t  pid;

    while (*cmd && isSPACE(*cmd))
       cmd++;

    /*------------------------------------------------------*/
    /* See if there are shell metacharacters in it          */
    /*------------------------------------------------------*/

    if (*cmd == '.' && isSPACE(cmd[1]))
       return (spawnit(cmd));
    else
    {
       if (strnEQ(cmd,"exec",4) && isSPACE(cmd[4]))
          return (spawnit(cmd));
       else
       {
          /*------------------------------------------------*/
          /* Catch VAR=val gizmo                            */
          /*------------------------------------------------*/
          for (s = cmd; *s && isALPHA(*s); s++);
          if (*s != '=')
          {
             for (s = cmd; *s; s++)
             {
                if (*s != ' ' &&
                    !isALPHA(*s) &&
                    strchr("$&*(){}[]'\";\\|?<>~`\n",*s))
                {
                   if (*s == '\n' && !s[1])
                   {
                      *s = '\0';
                      break;
                   }
                   return(spawnit(cmd));
                }
             }
          }
       }
    }

    New(402,PL_Argv, (s - cmd) / 2 + 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;
       while (*s && !isSPACE(*s)) s++;
       if (*s)
           *s++ = '\0';
    }
    *a                   = Nullch;
    fdMap[STDIN_FILENO]  = Perl_stdin_fd;
    fdMap[STDOUT_FILENO] = Perl_stdout_fd;
    fdMap[STDERR_FILENO] = STDERR_FILENO;
    nFd                  = 3;
    inherit.flags        = 0;
    if (PL_Argv[0])
    {
       pid = spawnp(PL_Argv[0], nFd, fdMap, &inherit,
                    (const char **) PL_Argv,
                    (const char **) environ);
       if (pid < 0)
       {
          dTHR;
          status = FAIL;
          if (ckWARN(WARN_EXEC))
             warner(WARN_EXEC,"Can't exec \"%s\": %s",
                    PL_Argv[0],
                    Strerror(errno));
       }
       else
          wait4pid(pid, &status, 0);
    }
    do_execfree();
    return (status);
}

/*===================== End of do_spawn ====================*/

/************************************************************/
/*                                                          */
/* Name      - spawnit.                                     */
/*                                                          */
/* Function  - Spawn command and return status.             */
/*                                                          */
/* On Entry  - cmd - command to be spawned.                 */
/*                                                          */
/* On Exit   - status returned.                             */
/*                                                          */
/************************************************************/

int
spawnit(char *cmd)
{
 pid_t  pid;
 int    status;

    pid = spawn_cmd(cmd, STDIN_FILENO, STDOUT_FILENO);
    if (pid < 0)
       status = FAIL;
    else
       wait4pid(pid, &status, 0);

    return (status);
}

/*===================== End of spawnit =====================*/

/************************************************************/
/*                                                          */
/* Name      - spawn_cmd.                                   */
/*                                                          */
/* Function  - Spawn command and return pid.                */
/*                                                          */
/* On Entry  - cmd - command to be spawned.                 */
/*                                                          */
/* On Exit   - pid returned.                                */
/*                                                          */
/************************************************************/

pid_t
spawn_cmd(char *cmd, int inFd, int outFd)
{
 struct inheritance inherit;
 pid_t  pid;
 const  char *argV[4] = {"/bin/sh","-c",NULL,NULL};
 int    nFd,
        fdMap[3];

    argV[2]              = cmd;
    fdMap[STDIN_FILENO]  = inFd;
    fdMap[STDOUT_FILENO] = outFd;
    fdMap[STDERR_FILENO] = STDERR_FILENO;
    nFd                  = 3;
    inherit.flags        = SPAWN_SETGROUP;
    inherit.pgroup       = SPAWN_NEWPGROUP;
    pid = spawn(argV[0], nFd, fdMap, &inherit,
                argV, (const char **) environ);
    return (pid);
}

/*===================== End of spawnit =====================*/

/************************************************************/
/*                                                          */
/* Name      - my_popen.                                    */
/*                                                          */
/* Function  - Use popen to execute a command return a      */
/*             file descriptor.                             */
/*                                                          */
/* On Entry  - cmd - command to be executed.                */
/*                                                          */
/* On Exit   - FILE * returned.                             */
/*                                                          */
/************************************************************/

#include <ctest.h>
PerlIO *
my_popen(char *cmd, char *mode)
{
 FILE *fd;
 int  pFd[2],
      this,
      that,
      pid;
 SV   *sv;

   if (PerlProc_pipe(pFd) >= 0)
   {
      this = (*mode == 'w');
      that = !this;
      /*-------------------------------------------------*/
      /* If this is a read mode pipe                     */
      /* - map the write end of the pipe to STDOUT       */
      /* - return the *FILE for the read end of the pipe */
      /*-------------------------------------------------*/
      if (!this)
         Perl_stdout_fd = pFd[that];
      /*-------------------------------------------------*/
      /* Else                                            */
      /* - map the read end of the pipe to STDIN         */
      /* - return the *FILE for the write end of the pipe*/
      /*-------------------------------------------------*/
      else
         Perl_stdin_fd = pFd[that];
      if (strNE(cmd,"-"))
      {
         PERL_FLUSHALL_FOR_CHILD;
         pid = spawn_cmd(cmd, Perl_stdin_fd, Perl_stdout_fd);
         if (pid >= 0)
         {
            MUTEX_LOCK(&PL_fdpid_mutex);
            sv = *av_fetch(PL_fdpid,pFd[this],TRUE);
            MUTEX_UNLOCK(&PL_fdpid_mutex);
            (void) SvUPGRADE(sv, SVt_IV);
            SvIVX(sv) = pid;
            fd = PerlIO_fdopen(pFd[this], mode);
            close(pFd[that]);
         }
         else
            fd = Nullfp;
      }
      else
      {
         MUTEX_LOCK(&PL_fdpid_mutex);
         sv = *av_fetch(PL_fdpid,pFd[that],TRUE);
         MUTEX_UNLOCK(&PL_fdpid_mutex);
         (void) SvUPGRADE(sv, SVt_IV);
         SvIVX(sv) = pFd[this];
         fd = PerlIO_fdopen(pFd[this], mode);
      }
   }
   else
      fd = Nullfp;
   return (fd);
}

/*===================== End of my_popen ====================*/

/************************************************************/
/*                                                          */
/* Name      - my_pclose.                                   */
/*                                                          */
/* Function  - Use pclose to terminate a piped command      */
/*             file stream.                                 */
/*                                                          */
/* On Entry  - fd  - FILE pointer.                          */
/*                                                          */
/* On Exit   - Status returned.                             */
/*                                                          */
/************************************************************/

long
my_pclose(FILE *fp)
{
 int  pid,
      saveErrno,
      status;
 long rc,
      wRc;
 SV   **sv;
 FILE *other;

   MUTEX_LOCK(&PL_fdpid_mutex);
   sv        = av_fetch(PL_fdpid,PerlIO_fileno(fp),TRUE);
   MUTEX_UNLOCK(&PL_fdpid_mutex);
   pid       = (int) SvIVX(*sv);
   SvREFCNT_dec(*sv);
   *sv       = &PL_sv_undef;
   rc        = PerlIO_close(fp);
   saveErrno = errno;
   do
   {
      wRc = waitpid(pid, &status, 0);
   } while ((wRc == -1) && (errno == EINTR));
   Perl_stdin_fd  = STDIN_FILENO;
   Perl_stdout_fd = STDOUT_FILENO;
   errno          = saveErrno;
   if (rc != 0)
      SETERRNO(errno, garbage);
   return (rc);

}

/************************************************************/
/*                                                          */
/* Name      - dlopen.                                      */
/*                                                          */
/* Function  - Load a DLL.                                  */
/*                                                          */
/* On Exit   -                                              */
/*                                                          */
/************************************************************/

void *
dlopen(const char *path)
{
 dllhandle *handle;

fprintf(stderr,"Loading %s\n",path);
   handle     = dllload(path);
   dl_retcode = errno;
fprintf(stderr,"Handle %08X %s\n",handle,strerror(errno));
   return ((void *) handle);
}

/*===================== End of dlopen ======================*/

/************************************************************/
/*                                                          */
/* Name      - dlsym.                                       */
/*                                                          */
/* Function  - Locate a DLL symbol.                         */
/*                                                          */
/* On Exit   -                                              */
/*                                                          */
/************************************************************/

void *
dlsym(void *handle, const char *symbol)
{
 void *symLoc;

fprintf(stderr,"Finding %s\n",symbol);
   symLoc  = dllqueryvar((dllhandle *) handle, (char *) symbol);
   if (symLoc == NULL)
      symLoc = (void *) dllqueryfn((dllhandle *) handle,
                                   (char *) symbol);
   dl_retcode = errno;
   return(symLoc);
}

/*===================== End of dlsym =======================*/

/************************************************************/
/*                                                          */
/* Name      - dlerror.                                     */
/*                                                          */
/* Function  - Return the last errno pertaining to a DLL    */
/*             operation.                                   */
/*                                                          */
/* On Exit   -                                              */
/*                                                          */
/************************************************************/

void *
dlerror(void)
{
 char * dlEmsg;

 dlEmsg     = strerror(dl_retcode);
 dl_retcode = 0;
 return(dlEmsg);
}

/*===================== End of dlerror =====================*/

/************************************************************/
/*                                                          */
/* Name      - TRUNCATE.                                    */
/*                                                          */
/* Function  - Truncate a file identified by 'path' to      */
/*             a given length.                              */
/*                                                          */
/* On Entry  - path - Path of file to be truncated.         */
/*             length - length of truncated file.           */
/*                                                          */
/* On Exit   - retC - return code.                          */
/*                                                          */
/************************************************************/

int
truncate(const unsigned char *path, off_t length)
{
 int fd,
     retC;

   fd = open((const char *) path, O_RDWR);
   if (fd > 0)
   {
      retC = ftruncate(fd, length);
      close(fd);
   }
   else
      retC = fd;
   return(retC);
}

/*===================== End of trunc =======================*/
Commit	Line	Data
092bebab	1	/************************************************************/
	2	/* */
	3	/* Module ID - vmesa.c */
	4	/* */
	5	/* Function - Provide operating system dependent process- */
	6	/* ing for perl under VM/ESA. */
	7	/* */
	8	/* Parameters - See individual entry points. */
	9	/* */
	10	/* Called By - N/A - see individual entry points. */
	11	/* */
	12	/* Calling To - N/A - see individual entry points. */
	13	/* */
	14	/* Notes - (1) ....................................... */
	15	/* */
	16	/* (2) ....................................... */
	17	/* */
	18	/* Name - Neale Ferguson. */
	19	/* */
	20	/* Date - August, 1998. */
	21	/* */
	22	/* */
	23	/* Associated - (1) Refer To ........................... */
	24	/* Documentation */
	25	/* (2) Refer To ........................... */
	26	/* */
	27	/************************************************************/
	28	/************************************************************/
	29	/* */
	30	/* MODULE MAINTENANCE HISTORY */
	31	/* -------------------------- */
	32	/* */
	33	static char REQ_REL_WHO [13] =
	34	/-------------- -------------------------------------/
	35	"9999_99 NAF "; /* Original module */
	36	/* */
	37	/============ End of Module Maintenance History ===========/
	38
	39	/************************************************************/
	40	/* */
	41	/* DEFINES */
	42	/* ------- */
	43	/* */
	44	/************************************************************/
	45
	46	#define FAIL 65280
	47
	48	/=============== END OF DEFINES ===========================/
	49
	50	/************************************************************/
	51	/* */
	52	/* INCLUDE STATEMENTS */
	53	/* ------------------ */
	54	/* */
	55	/************************************************************/
	56
	57	#include <stdio.h>
	58	#include <stdlib.h>
	59	#include <spawn.h>
	60	#include <fcntl.h>
	61	#include <unistd.h>
	62	#include <pthread.h>
	63	#include <dll.h>
	64	#include "EXTERN.h"
65	#include "perl.h"
66	#pragma map(truncate, "@@TRUNC")
67
68	/================== End of Include Statements =============/
69
70	/************************************************************/
71	/* */
72	/* Global Variables */
73	/* ---------------- */
74	/* */
75	/************************************************************/
76
77	static int Perl_stdin_fd = STDIN_FILENO,
78	Perl_stdout_fd = STDOUT_FILENO;
79
80	static long dl_retcode = 0;
81
82	/================== End of Global Variables ===============/
83
84	/************************************************************/
85	/* */
86	/* FUNCTION PROTOTYPES */
87	/* ------------------- */
88	/* */
89	/************************************************************/
90
91	int do_aspawn(SV , SV , SV *);
92	int do_spawn(char *, int);
93	static int spawnit(char *);
94	static pid_t spawn_cmd(char *, int, int);
95	struct perl_thread * getTHR(void);
96
97	/================== End of Prototypes =====================/
98
99	/************************************************************/
100	/* */
101	/* D O _ A S P A W N */
102	/* ----------------- */
103	/* */
104	/************************************************************/
105
106	int
107	do_aspawn(SV* really, SV mark, SV sp)
108	{
109	char **a,
110	*tmps;
111	struct inheritance inherit;
112	pid_t pid;
113	int status,
114	fd,
115	nFd,
116	fdMap[3];
117	SV *sv,
118	**p_sv;
2d8e6c8d	119	STRLEN n_a;
092bebab	120
	121	status = FAIL;
	122	if (sp > mark)
	123	{
	124	dTHR;
	125	New(401,PL_Argv, sp - mark + 1, char*);
	126	a = PL_Argv;
	127	while (++mark <= sp)
	128	{
	129	if (*mark)
2d8e6c8d	130	a++ = SvPVx(mark, n_a);
092bebab	131	else
	132	*a++ = "";
	133	}
	134	inherit.flags = SPAWN_SETGROUP;
	135	inherit.pgroup = SPAWN_NEWPGROUP;
	136	fdMap[STDIN_FILENO] = Perl_stdin_fd;
	137	fdMap[STDOUT_FILENO] = Perl_stdout_fd;
	138	fdMap[STDERR_FILENO] = STDERR_FILENO;
	139	nFd = 3;
	140	*a = Nullch;
	141	/-----------------------------------------------------/
	142	/* Will execvp() use PATH? */
	143	/-----------------------------------------------------/
	144	if (*PL_Argv[0] != '/')
	145	TAINT_ENV();
2d8e6c8d	146	if (really && *(tmps = SvPV(really, n_a)))
092bebab	147	pid = spawnp(tmps, nFd, fdMap, &inherit,
	148	(const char **) PL_Argv,
	149	(const char **) environ);
	150	else
	151	pid = spawnp(PL_Argv[0], nFd, fdMap, &inherit,
	152	(const char **) PL_Argv,
	153	(const char **) environ);
	154	if (pid < 0)
	155	{
	156	status = FAIL;
	157	if (ckWARN(WARN_EXEC))
	158	warner(WARN_EXEC,"Can't exec \"%s\": %s",
	159	PL_Argv[0],
	160	Strerror(errno));
	161	}
	162	else
	163	{
	164	/------------------------------------------------/
	165	/* If the file descriptors have been remapped then*/
	166	/* we've been called following a my_popen request */
	167	/* therefore we don't want to wait for spawnned */
	168	/* program to complete. We need to set the fdpid */
	169	/* value to the value of the spawnned process' pid*/
	170	/------------------------------------------------/
	171	fd = 0;
	172	if (Perl_stdin_fd != STDIN_FILENO)
	173	fd = Perl_stdin_fd;
	174	else
	175	if (Perl_stdout_fd != STDOUT_FILENO)
	176	fd = Perl_stdout_fd;
	177	if (fd != 0)
	178	{
	179	/---------------------------------------------/
	180	/* Get the fd of the other end of the pipe, */
	181	/* use this to reference the fdpid which will */
	182	/* be used by my_pclose */
	183	/---------------------------------------------/
	184	close(fd);
9d8fd706	185	MUTEX_LOCK(&PL_fdpid_mutex);
092bebab	186	p_sv = av_fetch(PL_fdpid,fd,TRUE);
	187	fd = (int) SvIVX(*p_sv);
	188	SvREFCNT_dec(*p_sv);
	189	*p_sv = &PL_sv_undef;
	190	sv = *av_fetch(PL_fdpid,fd,TRUE);
9d8fd706	191	MUTEX_UNLOCK(&PL_fdpid_mutex);
092bebab	192	(void) SvUPGRADE(sv, SVt_IV);
	193	SvIVX(sv) = pid;
	194	status = 0;
	195	}
	196	else
	197	wait4pid(pid, &status, 0);
	198	}
	199	do_execfree();
	200	}
	201	return (status);
	202	}
	203
	204	/===================== End of do_aspawn ===================/
	205
	206	/************************************************************/
	207	/* */
	208	/* D O _ S P A W N */
	209	/* --------------- */
	210	/* */
	211	/************************************************************/
	212
	213	int
	214	do_spawn(char *cmd, int execf)
	215	{
	216	char **a,
	217	*s,
	218	flags[10];
	219	int status,
	220	nFd,
	221	fdMap[3];
	222	struct inheritance inherit;
	223	pid_t pid;
	224
	225	while (cmd && isSPACE(cmd))
	226	cmd++;
	227
	228	/------------------------------------------------------/
	229	/* See if there are shell metacharacters in it */
	230	/------------------------------------------------------/
	231
	232	if (*cmd == '.' && isSPACE(cmd[1]))
	233	return (spawnit(cmd));
	234	else
	235	{
	236	if (strnEQ(cmd,"exec",4) && isSPACE(cmd[4]))
	237	return (spawnit(cmd));
	238	else
	239	{
	240	/------------------------------------------------/
	241	/* Catch VAR=val gizmo */
	242	/------------------------------------------------/
	243	for (s = cmd; s && isALPHA(s); s++);
	244	if (*s != '=')
	245	{
	246	for (s = cmd; *s; s++)
	247	{
	248	if (*s != ' ' &&
	249	!isALPHA(*s) &&
	250	strchr("$&(){}[]'\";\\\|?<>~`\n",s))
	251	{
	252	if (*s == '\n' && !s[1])
	253	{
	254	*s = '\0';
	255	break;
256	}
257	return(spawnit(cmd));
258	}
259	}
260	}
261	}
262	}
263
264	New(402,PL_Argv, (s - cmd) / 2 + 2, char*);
265	PL_Cmd = savepvn(cmd, s-cmd);
266	a = PL_Argv;
267	for (s = PL_Cmd; *s;)
268	{
269	while (s && isSPACE(s)) s++;
270	if (*s)
271	*(a++) = s;
272	while (s && !isSPACE(s)) s++;
273	if (*s)
274	*s++ = '\0';
275	}
276	*a = Nullch;
277	fdMap[STDIN_FILENO] = Perl_stdin_fd;
278	fdMap[STDOUT_FILENO] = Perl_stdout_fd;
279	fdMap[STDERR_FILENO] = STDERR_FILENO;
280	nFd = 3;
281	inherit.flags = 0;
282	if (PL_Argv[0])
283	{
284	pid = spawnp(PL_Argv[0], nFd, fdMap, &inherit,
285	(const char **) PL_Argv,
286	(const char **) environ);
287	if (pid < 0)
288	{
289	dTHR;
290	status = FAIL;
291	if (ckWARN(WARN_EXEC))
292	warner(WARN_EXEC,"Can't exec \"%s\": %s",
293	PL_Argv[0],
294	Strerror(errno));
295	}
296	else
297	wait4pid(pid, &status, 0);
298	}
299	do_execfree();
300	return (status);
301	}
302
303	/===================== End of do_spawn ====================/
304
305	/************************************************************/
306	/* */
307	/* Name - spawnit. */
308	/* */
309	/* Function - Spawn command and return status. */
310	/* */
311	/* On Entry - cmd - command to be spawned. */
312	/* */
313	/* On Exit - status returned. */
314	/* */
315	/************************************************************/
316
317	int
318	spawnit(char *cmd)
319	{
320	pid_t pid;
321	int status;
322
323	pid = spawn_cmd(cmd, STDIN_FILENO, STDOUT_FILENO);
324	if (pid < 0)
325	status = FAIL;
326	else
327	wait4pid(pid, &status, 0);
328
329	return (status);
330	}
331
332	/===================== End of spawnit =====================/
333
334	/************************************************************/
335	/* */
336	/* Name - spawn_cmd. */
337	/* */
338	/* Function - Spawn command and return pid. */
339	/* */
340	/* On Entry - cmd - command to be spawned. */
341	/* */
342	/* On Exit - pid returned. */
343	/* */
344	/************************************************************/
345
346	pid_t
347	spawn_cmd(char *cmd, int inFd, int outFd)
348	{
349	struct inheritance inherit;
350	pid_t pid;
351	const char *argV[4] = {"/bin/sh","-c",NULL,NULL};
352	int nFd,
353	fdMap[3];
354
355	argV[2] = cmd;
356	fdMap[STDIN_FILENO] = inFd;
357	fdMap[STDOUT_FILENO] = outFd;
358	fdMap[STDERR_FILENO] = STDERR_FILENO;
359	nFd = 3;
360	inherit.flags = SPAWN_SETGROUP;
361	inherit.pgroup = SPAWN_NEWPGROUP;
362	pid = spawn(argV[0], nFd, fdMap, &inherit,
363	argV, (const char **) environ);
364	return (pid);
365	}
366
367	/===================== End of spawnit =====================/
368
369	/************************************************************/
370	/* */
371	/* Name - my_popen. */
372	/* */
373	/* Function - Use popen to execute a command return a */
374	/* file descriptor. */
375	/* */
376	/* On Entry - cmd - command to be executed. */
377	/* */
378	/* On Exit - FILE * returned. */
379	/* */
380	/************************************************************/
381
382	#include <ctest.h>
383	PerlIO *
384	my_popen(char cmd, char mode)
385	{
386	FILE *fd;
387	int pFd[2],
388	this,
389	that,
390	pid;
391	SV *sv;
392
393	if (PerlProc_pipe(pFd) >= 0)
394	{
395	this = (*mode == 'w');
396	that = !this;
397	/-------------------------------------------------/
398	/* If this is a read mode pipe */
399	/* - map the write end of the pipe to STDOUT */
400	/* - return the FILE for the read end of the pipe /
401	/-------------------------------------------------/
402	if (!this)
403	Perl_stdout_fd = pFd[that];
404	/-------------------------------------------------/
405	/* Else */
406	/* - map the read end of the pipe to STDIN */
407	/* - return the FILE for the write end of the pipe/
408	/-------------------------------------------------/
409	else
410	Perl_stdin_fd = pFd[that];
411	if (strNE(cmd,"-"))
412	{
3d35f11b	413	PERL_FLUSHALL_FOR_CHILD;
092bebab	414	pid = spawn_cmd(cmd, Perl_stdin_fd, Perl_stdout_fd);
	415	if (pid >= 0)
	416	{
9d8fd706	417	MUTEX_LOCK(&PL_fdpid_mutex);
092bebab	418	sv = *av_fetch(PL_fdpid,pFd[this],TRUE);
9d8fd706	419	MUTEX_UNLOCK(&PL_fdpid_mutex);
092bebab	420	(void) SvUPGRADE(sv, SVt_IV);
	421	SvIVX(sv) = pid;
	422	fd = PerlIO_fdopen(pFd[this], mode);
	423	close(pFd[that]);
	424	}
	425	else
	426	fd = Nullfp;
	427	}
	428	else
	429	{
9d8fd706	430	MUTEX_LOCK(&PL_fdpid_mutex);
092bebab	431	sv = *av_fetch(PL_fdpid,pFd[that],TRUE);
9d8fd706	432	MUTEX_UNLOCK(&PL_fdpid_mutex);
092bebab	433	(void) SvUPGRADE(sv, SVt_IV);
	434	SvIVX(sv) = pFd[this];
	435	fd = PerlIO_fdopen(pFd[this], mode);
	436	}
	437	}
	438	else
	439	fd = Nullfp;
	440	return (fd);
	441	}
	442
	443	/===================== End of my_popen ====================/
	444
	445	/************************************************************/
	446	/* */
	447	/* Name - my_pclose. */
	448	/* */
	449	/* Function - Use pclose to terminate a piped command */
	450	/* file stream. */
	451	/* */
	452	/* On Entry - fd - FILE pointer. */
	453	/* */
	454	/* On Exit - Status returned. */
	455	/* */
	456	/************************************************************/
	457
	458	long
	459	my_pclose(FILE *fp)
	460	{
	461	int pid,
	462	saveErrno,
	463	status;
	464	long rc,
	465	wRc;
	466	SV **sv;
	467	FILE *other;
	468
9d8fd706	469	MUTEX_LOCK(&PL_fdpid_mutex);
092bebab	470	sv = av_fetch(PL_fdpid,PerlIO_fileno(fp),TRUE);
9d8fd706	471	MUTEX_UNLOCK(&PL_fdpid_mutex);
092bebab	472	pid = (int) SvIVX(*sv);
	473	SvREFCNT_dec(*sv);
	474	*sv = &PL_sv_undef;
	475	rc = PerlIO_close(fp);
	476	saveErrno = errno;
	477	do
	478	{
	479	wRc = waitpid(pid, &status, 0);
	480	} while ((wRc == -1) && (errno == EINTR));
	481	Perl_stdin_fd = STDIN_FILENO;
	482	Perl_stdout_fd = STDOUT_FILENO;
	483	errno = saveErrno;
	484	if (rc != 0)
	485	SETERRNO(errno, garbage);
	486	return (rc);
	487
	488	}
	489
092bebab	490	/************************************************************/
	491	/* */
	492	/* Name - dlopen. */
	493	/* */
	494	/* Function - Load a DLL. */
	495	/* */
	496	/* On Exit - */
	497	/* */
	498	/************************************************************/
	499
	500	void *
	501	dlopen(const char *path)
	502	{
	503	dllhandle *handle;
	504
	505	fprintf(stderr,"Loading %s\n",path);
	506	handle = dllload(path);
	507	dl_retcode = errno;
	508	fprintf(stderr,"Handle %08X %s\n",handle,strerror(errno));
	509	return ((void *) handle);
	510	}
	511
	512	/===================== End of dlopen ======================/
	513
	514	/************************************************************/
	515	/* */
	516	/* Name - dlsym. */
	517	/* */
	518	/* Function - Locate a DLL symbol. */
	519	/* */
	520	/* On Exit - */
	521	/* */
	522	/************************************************************/
	523
	524	void *
	525	dlsym(void handle, const char symbol)
	526	{
	527	void *symLoc;
	528
	529	fprintf(stderr,"Finding %s\n",symbol);
	530	symLoc = dllqueryvar((dllhandle ) handle, (char ) symbol);
	531	if (symLoc == NULL)
	532	symLoc = (void ) dllqueryfn((dllhandle ) handle,
	533	(char *) symbol);
	534	dl_retcode = errno;
	535	return(symLoc);
	536	}
	537
	538	/===================== End of dlsym =======================/
	539
	540	/************************************************************/
	541	/* */
	542	/* Name - dlerror. */
	543	/* */
	544	/* Function - Return the last errno pertaining to a DLL */
	545	/* operation. */
	546	/* */
	547	/* On Exit - */
	548	/* */
	549	/************************************************************/
	550
	551	void *
	552	dlerror(void)
	553	{
554	char * dlEmsg;
555
556	dlEmsg = strerror(dl_retcode);
557	dl_retcode = 0;
558	return(dlEmsg);
559	}
560
561	/===================== End of dlerror =====================/
562
563	/************************************************************/
564	/* */
565	/* Name - TRUNCATE. */
566	/* */
567	/* Function - Truncate a file identified by 'path' to */
568	/* a given length. */
569	/* */
570	/* On Entry - path - Path of file to be truncated. */
571	/* length - length of truncated file. */
572	/* */
573	/* On Exit - retC - return code. */
574	/* */
575	/************************************************************/
576
577	int
578	truncate(const unsigned char *path, off_t length)
579	{
580	int fd,
581	retC;
582
583	fd = open((const char *) path, O_RDWR);
584	if (fd > 0)
585	{
586	retC = ftruncate(fd, length);
587	close(fd);
588	}
589	else
590	retC = fd;
591	return(retC);
592	}
593
594	/===================== End of trunc =======================/