[perl5.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)
    {
       Newx(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 = NULL;
       /*-----------------------------------------------------*/
       /* 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));
                }
             }
          }
       }
    }

    Newx(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                   = NULL;
    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)
       {
          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 = NULL;
      }
      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 = NULL;
   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 JH	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 JH	120
	121	status = FAIL;
	122	if (sp > mark)
	123	{
a02a5408	124	Newx(PL_Argv, sp - mark + 1, char*);
092bebab JH	125	a = PL_Argv;
	126	while (++mark <= sp)
	127	{
	128	if (*mark)
2d8e6c8d	129	a++ = SvPVx(mark, n_a);
092bebab JH	130	else
	131	*a++ = "";
	132	}
	133	inherit.flags = SPAWN_SETGROUP;
	134	inherit.pgroup = SPAWN_NEWPGROUP;
	135	fdMap[STDIN_FILENO] = Perl_stdin_fd;
	136	fdMap[STDOUT_FILENO] = Perl_stdout_fd;
	137	fdMap[STDERR_FILENO] = STDERR_FILENO;
	138	nFd = 3;
4e205ed6	139	*a = NULL;
092bebab JH	140	/-----------------------------------------------------/
	141	/* Will execvp() use PATH? */
	142	/-----------------------------------------------------/
	143	if (*PL_Argv[0] != '/')
	144	TAINT_ENV();
2d8e6c8d	145	if (really && *(tmps = SvPV(really, n_a)))
092bebab JH	146	pid = spawnp(tmps, nFd, fdMap, &inherit,
	147	(const char **) PL_Argv,
	148	(const char **) environ);
	149	else
	150	pid = spawnp(PL_Argv[0], nFd, fdMap, &inherit,
	151	(const char **) PL_Argv,
	152	(const char **) environ);
	153	if (pid < 0)
	154	{
	155	status = FAIL;
	156	if (ckWARN(WARN_EXEC))
	157	warner(WARN_EXEC,"Can't exec \"%s\": %s",
	158	PL_Argv[0],
	159	Strerror(errno));
	160	}
	161	else
	162	{
	163	/------------------------------------------------/
	164	/* If the file descriptors have been remapped then*/
	165	/* we've been called following a my_popen request */
	166	/* therefore we don't want to wait for spawnned */
	167	/* program to complete. We need to set the fdpid */
	168	/* value to the value of the spawnned process' pid*/
	169	/------------------------------------------------/
	170	fd = 0;
	171	if (Perl_stdin_fd != STDIN_FILENO)
	172	fd = Perl_stdin_fd;
	173	else
	174	if (Perl_stdout_fd != STDOUT_FILENO)
	175	fd = Perl_stdout_fd;
	176	if (fd != 0)
	177	{
	178	/---------------------------------------------/
	179	/* Get the fd of the other end of the pipe, */
	180	/* use this to reference the fdpid which will */
	181	/* be used by my_pclose */
	182	/---------------------------------------------/
	183	close(fd);
9d8fd706	184	MUTEX_LOCK(&PL_fdpid_mutex);
092bebab JH	185	p_sv = av_fetch(PL_fdpid,fd,TRUE);
	186	fd = (int) SvIVX(*p_sv);
	187	SvREFCNT_dec(*p_sv);
	188	*p_sv = &PL_sv_undef;
	189	sv = *av_fetch(PL_fdpid,fd,TRUE);
9d8fd706	190	MUTEX_UNLOCK(&PL_fdpid_mutex);
092bebab JH	191	(void) SvUPGRADE(sv, SVt_IV);
	192	SvIVX(sv) = pid;
	193	status = 0;
	194	}
	195	else
	196	wait4pid(pid, &status, 0);
	197	}
	198	do_execfree();
	199	}
	200	return (status);
	201	}
	202
	203	/===================== End of do_aspawn ===================/
	204
	205	/************************************************************/
	206	/* */
	207	/* D O _ S P A W N */
	208	/* --------------- */
	209	/* */
	210	/************************************************************/
	211
	212	int
	213	do_spawn(char *cmd, int execf)
	214	{
	215	char **a,
	216	*s,
	217	flags[10];
	218	int status,
	219	nFd,
	220	fdMap[3];
	221	struct inheritance inherit;
	222	pid_t pid;
	223
	224	while (cmd && isSPACE(cmd))
	225	cmd++;
	226
	227	/------------------------------------------------------/
	228	/* See if there are shell metacharacters in it */
	229	/------------------------------------------------------/
	230
	231	if (*cmd == '.' && isSPACE(cmd[1]))
	232	return (spawnit(cmd));
	233	else
	234	{
	235	if (strnEQ(cmd,"exec",4) && isSPACE(cmd[4]))
	236	return (spawnit(cmd));
	237	else
	238	{
	239	/------------------------------------------------/
	240	/* Catch VAR=val gizmo */
	241	/------------------------------------------------/
	242	for (s = cmd; s && isALPHA(s); s++);
	243	if (*s != '=')
	244	{
	245	for (s = cmd; *s; s++)
	246	{
	247	if (*s != ' ' &&
	248	!isALPHA(*s) &&
	249	strchr("$&(){}[]'\";\\\|?<>~`\n",s))
	250	{
	251	if (*s == '\n' && !s[1])
	252	{
	253	*s = '\0';
	254	break;
255	}
256	return(spawnit(cmd));
257	}
258	}
259	}
260	}
261	}
262
a02a5408	263	Newx(PL_Argv, (s - cmd) / 2 + 2, char*);
092bebab JH	264	PL_Cmd = savepvn(cmd, s-cmd);
	265	a = PL_Argv;
	266	for (s = PL_Cmd; *s;)
	267	{
	268	while (s && isSPACE(s)) s++;
	269	if (*s)
	270	*(a++) = s;
	271	while (s && !isSPACE(s)) s++;
	272	if (*s)
	273	*s++ = '\0';
	274	}
4e205ed6	275	*a = NULL;
092bebab JH	276	fdMap[STDIN_FILENO] = Perl_stdin_fd;
	277	fdMap[STDOUT_FILENO] = Perl_stdout_fd;
	278	fdMap[STDERR_FILENO] = STDERR_FILENO;
	279	nFd = 3;
	280	inherit.flags = 0;
	281	if (PL_Argv[0])
	282	{
	283	pid = spawnp(PL_Argv[0], nFd, fdMap, &inherit,
	284	(const char **) PL_Argv,
	285	(const char **) environ);
	286	if (pid < 0)
	287	{
092bebab JH	288	status = FAIL;
	289	if (ckWARN(WARN_EXEC))
	290	warner(WARN_EXEC,"Can't exec \"%s\": %s",
	291	PL_Argv[0],
	292	Strerror(errno));
	293	}
	294	else
	295	wait4pid(pid, &status, 0);
	296	}
	297	do_execfree();
	298	return (status);
	299	}
	300
	301	/===================== End of do_spawn ====================/
	302
	303	/************************************************************/
	304	/* */
	305	/* Name - spawnit. */
	306	/* */
	307	/* Function - Spawn command and return status. */
	308	/* */
	309	/* On Entry - cmd - command to be spawned. */
	310	/* */
	311	/* On Exit - status returned. */
	312	/* */
	313	/************************************************************/
	314
	315	int
	316	spawnit(char *cmd)
	317	{
	318	pid_t pid;
	319	int status;
	320
	321	pid = spawn_cmd(cmd, STDIN_FILENO, STDOUT_FILENO);
	322	if (pid < 0)
	323	status = FAIL;
	324	else
	325	wait4pid(pid, &status, 0);
	326
	327	return (status);
	328	}
	329
	330	/===================== End of spawnit =====================/
	331
	332	/************************************************************/
	333	/* */
	334	/* Name - spawn_cmd. */
	335	/* */
	336	/* Function - Spawn command and return pid. */
	337	/* */
	338	/* On Entry - cmd - command to be spawned. */
	339	/* */
	340	/* On Exit - pid returned. */
	341	/* */
	342	/************************************************************/
	343
	344	pid_t
	345	spawn_cmd(char *cmd, int inFd, int outFd)
	346	{
	347	struct inheritance inherit;
	348	pid_t pid;
	349	const char *argV[4] = {"/bin/sh","-c",NULL,NULL};
	350	int nFd,
	351	fdMap[3];
352
353	argV[2] = cmd;
354	fdMap[STDIN_FILENO] = inFd;
355	fdMap[STDOUT_FILENO] = outFd;
356	fdMap[STDERR_FILENO] = STDERR_FILENO;
357	nFd = 3;
358	inherit.flags = SPAWN_SETGROUP;
359	inherit.pgroup = SPAWN_NEWPGROUP;
360	pid = spawn(argV[0], nFd, fdMap, &inherit,
361	argV, (const char **) environ);
362	return (pid);
363	}
364
365	/===================== End of spawnit =====================/
366
367	/************************************************************/
368	/* */
369	/* Name - my_popen. */
370	/* */
371	/* Function - Use popen to execute a command return a */
372	/* file descriptor. */
373	/* */
374	/* On Entry - cmd - command to be executed. */
375	/* */
376	/* On Exit - FILE * returned. */
377	/* */
378	/************************************************************/
379
380	#include <ctest.h>
381	PerlIO *
382	my_popen(char cmd, char mode)
383	{
384	FILE *fd;
385	int pFd[2],
386	this,
387	that,
388	pid;
389	SV *sv;
390
391	if (PerlProc_pipe(pFd) >= 0)
392	{
393	this = (*mode == 'w');
394	that = !this;
395	/-------------------------------------------------/
396	/* If this is a read mode pipe */
397	/* - map the write end of the pipe to STDOUT */
398	/* - return the FILE for the read end of the pipe /
399	/-------------------------------------------------/
400	if (!this)
401	Perl_stdout_fd = pFd[that];
402	/-------------------------------------------------/
403	/* Else */
404	/* - map the read end of the pipe to STDIN */
405	/* - return the FILE for the write end of the pipe/
406	/-------------------------------------------------/
407	else
408	Perl_stdin_fd = pFd[that];
409	if (strNE(cmd,"-"))
410	{
3d35f11b	411	PERL_FLUSHALL_FOR_CHILD;
092bebab JH	412	pid = spawn_cmd(cmd, Perl_stdin_fd, Perl_stdout_fd);
	413	if (pid >= 0)
	414	{
9d8fd706	415	MUTEX_LOCK(&PL_fdpid_mutex);
092bebab	416	sv = *av_fetch(PL_fdpid,pFd[this],TRUE);
9d8fd706	417	MUTEX_UNLOCK(&PL_fdpid_mutex);
092bebab JH	418	(void) SvUPGRADE(sv, SVt_IV);
	419	SvIVX(sv) = pid;
	420	fd = PerlIO_fdopen(pFd[this], mode);
	421	close(pFd[that]);
	422	}
	423	else
4e205ed6	424	fd = NULL;
092bebab JH	425	}
	426	else
	427	{
9d8fd706	428	MUTEX_LOCK(&PL_fdpid_mutex);
092bebab	429	sv = *av_fetch(PL_fdpid,pFd[that],TRUE);
9d8fd706	430	MUTEX_UNLOCK(&PL_fdpid_mutex);
092bebab JH	431	(void) SvUPGRADE(sv, SVt_IV);
	432	SvIVX(sv) = pFd[this];
	433	fd = PerlIO_fdopen(pFd[this], mode);
	434	}
	435	}
	436	else
4e205ed6	437	fd = NULL;
092bebab JH	438	return (fd);
	439	}
	440
	441	/===================== End of my_popen ====================/
	442
	443	/************************************************************/
	444	/* */
	445	/* Name - my_pclose. */
	446	/* */
	447	/* Function - Use pclose to terminate a piped command */
	448	/* file stream. */
	449	/* */
	450	/* On Entry - fd - FILE pointer. */
	451	/* */
	452	/* On Exit - Status returned. */
	453	/* */
	454	/************************************************************/
	455
	456	long
	457	my_pclose(FILE *fp)
	458	{
	459	int pid,
	460	saveErrno,
	461	status;
	462	long rc,
	463	wRc;
	464	SV **sv;
	465	FILE *other;
	466
9d8fd706	467	MUTEX_LOCK(&PL_fdpid_mutex);
092bebab	468	sv = av_fetch(PL_fdpid,PerlIO_fileno(fp),TRUE);
9d8fd706	469	MUTEX_UNLOCK(&PL_fdpid_mutex);
092bebab JH	470	pid = (int) SvIVX(*sv);
	471	SvREFCNT_dec(*sv);
	472	*sv = &PL_sv_undef;
	473	rc = PerlIO_close(fp);
	474	saveErrno = errno;
	475	do
	476	{
	477	wRc = waitpid(pid, &status, 0);
	478	} while ((wRc == -1) && (errno == EINTR));
	479	Perl_stdin_fd = STDIN_FILENO;
	480	Perl_stdout_fd = STDOUT_FILENO;
	481	errno = saveErrno;
	482	if (rc != 0)
	483	SETERRNO(errno, garbage);
	484	return (rc);
	485
	486	}
	487
092bebab JH	488	/************************************************************/
	489	/* */
	490	/* Name - dlopen. */
	491	/* */
	492	/* Function - Load a DLL. */
	493	/* */
	494	/* On Exit - */
	495	/* */
	496	/************************************************************/
	497
	498	void *
	499	dlopen(const char *path)
	500	{
	501	dllhandle *handle;
	502
	503	fprintf(stderr,"Loading %s\n",path);
	504	handle = dllload(path);
	505	dl_retcode = errno;
	506	fprintf(stderr,"Handle %08X %s\n",handle,strerror(errno));
	507	return ((void *) handle);
	508	}
	509
	510	/===================== End of dlopen ======================/
	511
	512	/************************************************************/
	513	/* */
	514	/* Name - dlsym. */
	515	/* */
	516	/* Function - Locate a DLL symbol. */
	517	/* */
	518	/* On Exit - */
	519	/* */
	520	/************************************************************/
	521
	522	void *
	523	dlsym(void handle, const char symbol)
	524	{
	525	void *symLoc;
	526
	527	fprintf(stderr,"Finding %s\n",symbol);
	528	symLoc = dllqueryvar((dllhandle ) handle, (char ) symbol);
	529	if (symLoc == NULL)
	530	symLoc = (void ) dllqueryfn((dllhandle ) handle,
	531	(char *) symbol);
	532	dl_retcode = errno;
	533	return(symLoc);
	534	}
	535
	536	/===================== End of dlsym =======================/
	537
	538	/************************************************************/
	539	/* */
	540	/* Name - dlerror. */
	541	/* */
	542	/* Function - Return the last errno pertaining to a DLL */
	543	/* operation. */
	544	/* */
	545	/* On Exit - */
	546	/* */
	547	/************************************************************/
	548
	549	void *
	550	dlerror(void)
	551	{
552	char * dlEmsg;
553
554	dlEmsg = strerror(dl_retcode);
555	dl_retcode = 0;
556	return(dlEmsg);
557	}
558
559	/===================== End of dlerror =====================/
560
561	/************************************************************/
562	/* */
563	/* Name - TRUNCATE. */
564	/* */
565	/* Function - Truncate a file identified by 'path' to */
566	/* a given length. */
567	/* */
568	/* On Entry - path - Path of file to be truncated. */
569	/* length - length of truncated file. */
570	/* */
571	/* On Exit - retC - return code. */
572	/* */
573	/************************************************************/
574
575	int
576	truncate(const unsigned char *path, off_t length)
577	{
578	int fd,
579	retC;
580
581	fd = open((const char *) path, O_RDWR);
582	if (fd > 0)
583	{
584	retC = ftruncate(fd, length);
585	close(fd);
586	}
587	else
588	retC = fd;
589	return(retC);
590	}
591
592	/===================== End of trunc =======================/