[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;

    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, na);
           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, na)))
           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);
             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);
             (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,"-"))
      {
         pid = spawn_cmd(cmd, Perl_stdin_fd, Perl_stdout_fd);
         if (pid >= 0)
         {
            sv = *av_fetch(PL_fdpid,pFd[this],TRUE);
            (void) SvUPGRADE(sv, SVt_IV);
            SvIVX(sv) = pid;
            fd = PerlIO_fdopen(pFd[this], mode);
            close(pFd[that]);
         }
         else
            fd = Nullfp;
      }
      else
      {
         sv = *av_fetch(PL_fdpid,pFd[that],TRUE);
         (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;

   sv        = av_fetch(PL_fdpid,PerlIO_fileno(fp),TRUE);
   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);

}

/*===================== End of my_pclose ===================*/

/************************************************************/
/*                                                          */
/* Name      - getTHR.                                      */
/*                                                          */
/* Function  - Use pclose to terminate a piped command      */
/*             file stream.                                 */
/*                                                          */
/* On Exit   - Thread specific data returned.               */
/*                                                          */
/************************************************************/

struct perl_thread *
getTHR()
{
 int status;
 struct perl_thread *pThread;

   status = pthread_getspecific(PL_thr_key, (void **) &pThread);
   if (status != 0)
      pThread = NULL;
   return (pThread);
}

/*===================== End of getTHR ======================*/

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