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

}

/************************************************************/
/*                                                          */
/* 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);
	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);
	190	(void) SvUPGRADE(sv, SVt_IV);
	191	SvIVX(sv) = pid;
	192	status = 0;
	193	}
	194	else
	195	wait4pid(pid, &status, 0);
	196	}
	197	do_execfree();
	198	}
	199	return (status);
	200	}
	201
	202	/===================== End of do_aspawn ===================/
	203
	204	/************************************************************/
	205	/* */
	206	/* D O _ S P A W N */
	207	/* --------------- */
	208	/* */
	209	/************************************************************/
	210
211	int
212	do_spawn(char *cmd, int execf)
213	{
214	char **a,
215	*s,
216	flags[10];
217	int status,
218	nFd,
219	fdMap[3];
220	struct inheritance inherit;
221	pid_t pid;
222
223	while (cmd && isSPACE(cmd))
224	cmd++;
225
226	/------------------------------------------------------/
227	/* See if there are shell metacharacters in it */
228	/------------------------------------------------------/
229
230	if (*cmd == '.' && isSPACE(cmd[1]))
231	return (spawnit(cmd));
232	else
233	{
234	if (strnEQ(cmd,"exec",4) && isSPACE(cmd[4]))
235	return (spawnit(cmd));
236	else
237	{
238	/------------------------------------------------/
239	/* Catch VAR=val gizmo */
240	/------------------------------------------------/
241	for (s = cmd; s && isALPHA(s); s++);
242	if (*s != '=')
243	{
244	for (s = cmd; *s; s++)
245	{
246	if (*s != ' ' &&
247	!isALPHA(*s) &&
248	strchr("$&(){}[]'\";\\\|?<>~`\n",s))
249	{
250	if (*s == '\n' && !s[1])
251	{
252	*s = '\0';
253	break;
254	}
255	return(spawnit(cmd));
256	}
257	}
258	}
259	}
260	}
261
262	New(402,PL_Argv, (s - cmd) / 2 + 2, char*);
263	PL_Cmd = savepvn(cmd, s-cmd);
264	a = PL_Argv;
265	for (s = PL_Cmd; *s;)
266	{
267	while (s && isSPACE(s)) s++;
268	if (*s)
269	*(a++) = s;
270	while (s && !isSPACE(s)) s++;
271	if (*s)
272	*s++ = '\0';
273	}
274	*a = Nullch;
275	fdMap[STDIN_FILENO] = Perl_stdin_fd;
276	fdMap[STDOUT_FILENO] = Perl_stdout_fd;
277	fdMap[STDERR_FILENO] = STDERR_FILENO;
278	nFd = 3;
279	inherit.flags = 0;
280	if (PL_Argv[0])
281	{
282	pid = spawnp(PL_Argv[0], nFd, fdMap, &inherit,
283	(const char **) PL_Argv,
284	(const char **) environ);
285	if (pid < 0)
286	{
287	dTHR;
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	{
411	pid = spawn_cmd(cmd, Perl_stdin_fd, Perl_stdout_fd);
412	if (pid >= 0)
413	{
414	sv = *av_fetch(PL_fdpid,pFd[this],TRUE);
415	(void) SvUPGRADE(sv, SVt_IV);
416	SvIVX(sv) = pid;
417	fd = PerlIO_fdopen(pFd[this], mode);
418	close(pFd[that]);
419	}
420	else
421	fd = Nullfp;
422	}
423	else
424	{
425	sv = *av_fetch(PL_fdpid,pFd[that],TRUE);
426	(void) SvUPGRADE(sv, SVt_IV);
427	SvIVX(sv) = pFd[this];
428	fd = PerlIO_fdopen(pFd[this], mode);
429	}
430	}
431	else
432	fd = Nullfp;
433	return (fd);
434	}
435
436	/===================== End of my_popen ====================/
437
438	/************************************************************/
439	/* */
440	/* Name - my_pclose. */
441	/* */
442	/* Function - Use pclose to terminate a piped command */
443	/* file stream. */
444	/* */
445	/* On Entry - fd - FILE pointer. */
446	/* */
447	/* On Exit - Status returned. */
448	/* */
449	/************************************************************/
450
451	long
452	my_pclose(FILE *fp)
453	{
454	int pid,
455	saveErrno,
456	status;
457	long rc,
458	wRc;
459	SV **sv;
460	FILE *other;
461
462	sv = av_fetch(PL_fdpid,PerlIO_fileno(fp),TRUE);
463	pid = (int) SvIVX(*sv);
464	SvREFCNT_dec(*sv);
465	*sv = &PL_sv_undef;
466	rc = PerlIO_close(fp);
467	saveErrno = errno;
468	do
469	{
470	wRc = waitpid(pid, &status, 0);
471	} while ((wRc == -1) && (errno == EINTR));
472	Perl_stdin_fd = STDIN_FILENO;
473	Perl_stdout_fd = STDOUT_FILENO;
474	errno = saveErrno;
475	if (rc != 0)
476	SETERRNO(errno, garbage);
477	return (rc);
478
479	}
480
092bebab	481	/************************************************************/
	482	/* */
	483	/* Name - dlopen. */
	484	/* */
	485	/* Function - Load a DLL. */
	486	/* */
	487	/* On Exit - */
	488	/* */
	489	/************************************************************/
	490
	491	void *
	492	dlopen(const char *path)
	493	{
	494	dllhandle *handle;
	495
	496	fprintf(stderr,"Loading %s\n",path);
	497	handle = dllload(path);
	498	dl_retcode = errno;
	499	fprintf(stderr,"Handle %08X %s\n",handle,strerror(errno));
	500	return ((void *) handle);
	501	}
	502
	503	/===================== End of dlopen ======================/
	504
	505	/************************************************************/
	506	/* */
	507	/* Name - dlsym. */
	508	/* */
	509	/* Function - Locate a DLL symbol. */
	510	/* */
	511	/* On Exit - */
	512	/* */
	513	/************************************************************/
	514
	515	void *
	516	dlsym(void handle, const char symbol)
	517	{
	518	void *symLoc;
	519
	520	fprintf(stderr,"Finding %s\n",symbol);
	521	symLoc = dllqueryvar((dllhandle ) handle, (char ) symbol);
	522	if (symLoc == NULL)
	523	symLoc = (void ) dllqueryfn((dllhandle ) handle,
	524	(char *) symbol);
	525	dl_retcode = errno;
	526	return(symLoc);
	527	}
	528
	529	/===================== End of dlsym =======================/
	530
	531	/************************************************************/
	532	/* */
	533	/* Name - dlerror. */
	534	/* */
	535	/* Function - Return the last errno pertaining to a DLL */
	536	/* operation. */
	537	/* */
	538	/* On Exit - */
	539	/* */
	540	/************************************************************/
	541
	542	void *
	543	dlerror(void)
	544	{
545	char * dlEmsg;
546
547	dlEmsg = strerror(dl_retcode);
548	dl_retcode = 0;
549	return(dlEmsg);
550	}
551
552	/===================== End of dlerror =====================/
553
554	/************************************************************/
555	/* */
556	/* Name - TRUNCATE. */
557	/* */
558	/* Function - Truncate a file identified by 'path' to */
559	/* a given length. */
560	/* */
561	/* On Entry - path - Path of file to be truncated. */
562	/* length - length of truncated file. */
563	/* */
564	/* On Exit - retC - return code. */
565	/* */
566	/************************************************************/
567
568	int
569	truncate(const unsigned char *path, off_t length)
570	{
571	int fd,
572	retC;
573
574	fd = open((const char *) path, O_RDWR);
575	if (fd > 0)
576	{
577	retC = ftruncate(fd, length);
578	close(fd);
579	}
580	else
581	retC = fd;
582	return(retC);
583	}
584
585	/===================== End of trunc =======================/