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

#define INCL_DOS
#define INCL_NOPM
#ifndef NO_SYS_ALLOC 
#  define INCL_DOSMEMMGR
#  define INCL_DOSERRORS
#endif /* ! defined NO_SYS_ALLOC */
#include <os2.h>

/*
 * Various Unix compatibility functions for OS/2
 */

#include <stdio.h>
#include <errno.h>
#include <limits.h>
#include <process.h>

#include "EXTERN.h"
#include "perl.h"

/*****************************************************************************/
/* priorities */

int setpriority(int which, int pid, int val)
{
  return DosSetPriority((pid < 0) ? PRTYS_PROCESSTREE : PRTYS_PROCESS,
			val >> 8, val & 0xFF, abs(pid));
}

int getpriority(int which /* ignored */, int pid)
{
  TIB *tib;
  PIB *pib;
  DosGetInfoBlocks(&tib, &pib);
  return tib->tib_ptib2->tib2_ulpri;
}

/*****************************************************************************/
/* spawn */

static int
result(int flag, int pid)
{
	int r, status;
	Signal_t (*ihand)();     /* place to save signal during system() */
	Signal_t (*qhand)();     /* place to save signal during system() */

	if (pid < 0 || flag != 0) 
		return pid;

	ihand = signal(SIGINT, SIG_IGN);
	qhand = signal(SIGQUIT, SIG_IGN);
	do {
	    r = wait4pid(pid, &status, 0);
	} while (r == -1 && errno == EINTR);
	signal(SIGINT, ihand);
	signal(SIGQUIT, qhand);

	statusvalue = (U16)status;
	if (r < 0)
		return -1;
	return status & 0xFFFF;
}

int
do_aspawn(really,mark,sp)
SV *really;
register SV **mark;
register SV **sp;
{
    register char **a;
    char *tmps;
    int rc;
    int flag = P_WAIT, trueflag;

    if (sp > mark) {
	New(401,Argv, sp - mark + 1, char*);
	a = Argv;

	if (mark < sp && SvIOKp(*(mark+1))) {
		++mark;
		flag = SvIVx(*mark);
	}

	while (++mark <= sp) {
	    if (*mark)
		*a++ = SvPVx(*mark, na);
	    else
		*a++ = "";
	}
	*a = Nullch;

	trueflag = flag;
	if (flag == P_WAIT)
		flag = P_NOWAIT;

	if (*Argv[0] != '/' && *Argv[0] != '\\') /* will swawnvp use PATH? */
	    TAINT_ENV();	/* testing IFS here is overkill, probably */
	if (really && *(tmps = SvPV(really, na)))
	    rc = result(trueflag, spawnvp(flag,tmps,Argv));
	else
	    rc = result(trueflag, spawnvp(flag,Argv[0],Argv));

	if (rc < 0 && dowarn)
	    warn("Can't spawn \"%s\": %s", Argv[0], Strerror(errno));
	if (rc < 0) rc = 255 << 8; /* Emulate the fork(). */
    } else
    	rc = -1;
    do_execfree();
    return rc;
}

int
do_spawn(cmd)
char *cmd;
{
    register char **a;
    register char *s;
    char flags[10];
    char *shell, *copt;
    int rc;

#ifdef TRYSHELL
    if ((shell = getenv("EMXSHELL")) != NULL)
    	copt = "-c";
    else if ((shell = getenv("SHELL")) != NULL)
    	copt = "-c";
    else if ((shell = getenv("COMSPEC")) != NULL)
    	copt = "/C";
    else
    	shell = "cmd.exe";
#else
    /* Consensus on perl5-porters is that it is _very_ important to
       have a shell which will not change between computers with the
       same architecture, to avoid "action on a distance". 
       And to have simple build, this shell should be sh. */
    shell = "sh.exe";
    copt = "-c";
#endif 

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

    /* save an extra exec if possible */
    /* see if there are shell metacharacters in it */

    if (*cmd == '.' && isSPACE(cmd[1]))
	goto doshell;

    if (strnEQ(cmd,"exec",4) && isSPACE(cmd[4]))
	goto doshell;

    for (s = cmd; *s && isALPHA(*s); s++) ;	/* catch VAR=val gizmo */
    if (*s == '=')
	goto doshell;

    for (s = cmd; *s; s++) {
	if (*s != ' ' && !isALPHA(*s) && strchr("$&*(){}[]'\";\\|?<>~`\n",*s)) {
	    if (*s == '\n' && !s[1]) {
		*s = '\0';
		break;
	    }
	  doshell:
	    rc = result(P_WAIT,
			  spawnl(P_NOWAIT,shell,shell,copt,cmd,(char*)0));
	    if (rc < 0 && dowarn)
		warn("Can't spawn \"%s\": %s", shell, Strerror(errno));
	    if (rc < 0) rc = 255 << 8; /* Emulate the fork(). */
	    return rc;
	}
    }

    New(402,Argv, (s - cmd) / 2 + 2, char*);
    Cmd = savepvn(cmd, s-cmd);
    a = Argv;
    for (s = Cmd; *s;) {
	while (*s && isSPACE(*s)) s++;
	if (*s)
	    *(a++) = s;
	while (*s && !isSPACE(*s)) s++;
	if (*s)
	    *s++ = '\0';
    }
    *a = Nullch;
    if (Argv[0]) {
	rc = result(P_WAIT, spawnvp(P_NOWAIT,Argv[0],Argv));
	if (rc < 0 && dowarn)
	    warn("Can't spawn \"%s\": %s", Argv[0], Strerror(errno));
	if (rc < 0) rc = 255 << 8; /* Emulate the fork(). */
    } else
    	rc = -1;
    do_execfree();
    return rc;
}

FILE *
my_popen(cmd,mode)
char	*cmd;
char	*mode;
{
    char *shell = getenv("EMXSHELL");
    FILE *res;
    
    my_setenv("EMXSHELL", "sh.exe");
    res = popen(cmd, mode);
    my_setenv("EMXSHELL", shell);
    return res;
}

/*****************************************************************************/

#ifndef HAS_FORK
int
fork(void)
{
    die(no_func, "Unsupported function fork");
    errno = EINVAL;
    return -1;
}
#endif

/*****************************************************************************/
/* not implemented in EMX 0.9a */

void *	ctermid(x)	{ return 0; }

#ifdef MYTTYNAME /* was not in emx0.9a */
void *	ttyname(x)	{ return 0; }
#endif

void *	gethostent()	{ return 0; }
void *	getnetent()	{ return 0; }
void *	getprotoent()	{ return 0; }
void *	getservent()	{ return 0; }
void	sethostent(x)	{}
void	setnetent(x)	{}
void	setprotoent(x)	{}
void	setservent(x)	{}
void	endhostent(x)	{}
void	endnetent(x)	{}
void	endprotoent(x)	{}
void	endservent(x)	{}

/*****************************************************************************/
/* stat() hack for char/block device */

#if OS2_STAT_HACK

    /* First attempt used DosQueryFSAttach which crashed the system when
       used with 5.001. Now just look for /dev/. */

int
os2_stat(char *name, struct stat *st)
{
    static int ino = SHRT_MAX;

    if (stricmp(name, "/dev/con") != 0
     && stricmp(name, "/dev/tty") != 0)
	return stat(name, st);

    memset(st, 0, sizeof *st);
    st->st_mode = S_IFCHR|0666;
    st->st_ino = (ino-- & 0x7FFF);
    st->st_nlink = 1;
    return 0;
}

#endif

#ifndef NO_SYS_ALLOC

static char *old2K;

#define ONE_K (1<<10)
#define TWO_K (1<<11)
#define FOUR_K (1<<12)
#define FOUR_K_FLAG (FOUR_K - 1)


void *
sbrk(int size)
{
    char *got;
    APIRET rc;
    int is2K = 0;

    if (!size) return 0;
    else if (size == TWO_K) {
	is2K = 1;
	if (old2K) {
	    char *ret = old2K;

	    old2K = 0;
	    return (void *)ret;
	}
	size = FOUR_K;
    } else if (size & FOUR_K_FLAG) {
	croak("Memory allocation in units %li not multiple to 4K", size);
    }
    rc = DosAllocMem((void **)&got, size, PAG_COMMIT | PAG_WRITE);
    if (rc == ERROR_NOT_ENOUGH_MEMORY) {
	return (void *) -1;
    } else if ( rc ) die("Got an error from DosAllocMem: %li", (long)rc);
    if (is2K) old2K = got + TWO_K;
    return (void *)got;
}
#endif /* ! defined NO_SYS_ALLOC */

/* tmp path */

char *tmppath = TMPPATH1;

void
settmppath()
{
    char *p = getenv("TMP"), *tpath;
    int len;

    if (!p) p = getenv("TEMP");
    if (!p) return;
    len = strlen(p);
    tpath = (char *)malloc(len + strlen(TMPPATH1) + 2);
    strcpy(tpath, p);
    tpath[len] = '/';
    strcpy(tpath + len + 1, TMPPATH1);
    tmppath = tpath;
}
Commit	Line	Data
4633a7c4	1	#define INCL_DOS
4633a7c4	2	#define INCL_NOPM
c0c09dfd	3	#ifndef NO_SYS_ALLOC
	4	# define INCL_DOSMEMMGR
	5	# define INCL_DOSERRORS
	6	#endif /* ! defined NO_SYS_ALLOC */
4633a7c4	7	#include <os2.h>
	8
	9	/*
	10	* Various Unix compatibility functions for OS/2
	11	*/
	12
	13	#include <stdio.h>
	14	#include <errno.h>
	15	#include <limits.h>
	16	#include <process.h>
	17
	18	#include "EXTERN.h"
	19	#include "perl.h"
	20
	21	/*****************************************************************************/
	22	/* priorities */
	23
	24	int setpriority(int which, int pid, int val)
	25	{
	26	return DosSetPriority((pid < 0) ? PRTYS_PROCESSTREE : PRTYS_PROCESS,
	27	val >> 8, val & 0xFF, abs(pid));
	28	}
	29
	30	int getpriority(int which /* ignored */, int pid)
	31	{
	32	TIB *tib;
	33	PIB *pib;
	34	DosGetInfoBlocks(&tib, &pib);
	35	return tib->tib_ptib2->tib2_ulpri;
	36	}
	37
	38	/*****************************************************************************/
	39	/* spawn */
	40
	41	static int
	42	result(int flag, int pid)
	43	{
	44	int r, status;
	45	Signal_t (ihand)(); / place to save signal during system() */
	46	Signal_t (qhand)(); / place to save signal during system() */
	47
c0c09dfd	48	if (pid < 0 \|\| flag != 0)
4633a7c4	49	return pid;
	50
	51	ihand = signal(SIGINT, SIG_IGN);
	52	qhand = signal(SIGQUIT, SIG_IGN);
c0c09dfd	53	do {
	54	r = wait4pid(pid, &status, 0);
	55	} while (r == -1 && errno == EINTR);
4633a7c4	56	signal(SIGINT, ihand);
	57	signal(SIGQUIT, qhand);
	58
	59	statusvalue = (U16)status;
	60	if (r < 0)
	61	return -1;
	62	return status & 0xFFFF;
	63	}
	64
	65	int
	66	do_aspawn(really,mark,sp)
	67	SV *really;
	68	register SV **mark;
	69	register SV **sp;
	70	{
	71	register char **a;
	72	char *tmps;
	73	int rc;
	74	int flag = P_WAIT, trueflag;
	75
	76	if (sp > mark) {
	77	New(401,Argv, sp - mark + 1, char*);
	78	a = Argv;
	79
	80	if (mark < sp && SvIOKp(*(mark+1))) {
	81	++mark;
	82	flag = SvIVx(*mark);
	83	}
	84
	85	while (++mark <= sp) {
	86	if (*mark)
	87	a++ = SvPVx(mark, na);
	88	else
	89	*a++ = "";
	90	}
	91	*a = Nullch;
	92
	93	trueflag = flag;
	94	if (flag == P_WAIT)
	95	flag = P_NOWAIT;
	96
c0c09dfd	97	if (Argv[0] != '/' && Argv[0] != '\\') /* will swawnvp use PATH? */
c0c09dfd	98	TAINT_ENV(); /* testing IFS here is overkill, probably */
4633a7c4	99	if (really && *(tmps = SvPV(really, na)))
	100	rc = result(trueflag, spawnvp(flag,tmps,Argv));
	101	else
	102	rc = result(trueflag, spawnvp(flag,Argv[0],Argv));
	103
	104	if (rc < 0 && dowarn)
	105	warn("Can't spawn \"%s\": %s", Argv[0], Strerror(errno));
c0c09dfd	106	if (rc < 0) rc = 255 << 8; /* Emulate the fork(). */
4633a7c4	107	} else
	108	rc = -1;
	109	do_execfree();
	110	return rc;
	111	}
	112
	113	int
	114	do_spawn(cmd)
	115	char *cmd;
	116	{
	117	register char **a;
	118	register char *s;
	119	char flags[10];
	120	char shell, copt;
	121	int rc;
	122
c0c09dfd	123	#ifdef TRYSHELL
	124	if ((shell = getenv("EMXSHELL")) != NULL)
	125	copt = "-c";
	126	else if ((shell = getenv("SHELL")) != NULL)
4633a7c4	127	copt = "-c";
	128	else if ((shell = getenv("COMSPEC")) != NULL)
	129	copt = "/C";
	130	else
	131	shell = "cmd.exe";
c0c09dfd	132	#else
	133	/* Consensus on perl5-porters is that it is _very_ important to
	134	have a shell which will not change between computers with the
	135	same architecture, to avoid "action on a distance".
	136	And to have simple build, this shell should be sh. */
	137	shell = "sh.exe";
	138	copt = "-c";
	139	#endif
	140
	141	while (cmd && isSPACE(cmd))
	142	cmd++;
4633a7c4	143
	144	/* save an extra exec if possible */
	145	/* see if there are shell metacharacters in it */
	146
c0c09dfd	147	if (*cmd == '.' && isSPACE(cmd[1]))
	148	goto doshell;
	149
	150	if (strnEQ(cmd,"exec",4) && isSPACE(cmd[4]))
	151	goto doshell;
	152
	153	for (s = cmd; s && isALPHA(s); s++) ; /* catch VAR=val gizmo */
	154	if (*s == '=')
	155	goto doshell;
	156
4633a7c4	157	for (s = cmd; *s; s++) {
c0c09dfd	158	if (s != ' ' && !isALPHA(s) && strchr("$&(){}[]'\";\\\|?<>~`\n",s)) {
4633a7c4	159	if (*s == '\n' && !s[1]) {
	160	*s = '\0';
	161	break;
	162	}
c0c09dfd	163	doshell:
	164	rc = result(P_WAIT,
	165	spawnl(P_NOWAIT,shell,shell,copt,cmd,(char*)0));
	166	if (rc < 0 && dowarn)
	167	warn("Can't spawn \"%s\": %s", shell, Strerror(errno));
	168	if (rc < 0) rc = 255 << 8; /* Emulate the fork(). */
	169	return rc;
4633a7c4	170	}
4633a7c4	171	}
c0c09dfd	172
4633a7c4	173	New(402,Argv, (s - cmd) / 2 + 2, char*);
	174	Cmd = savepvn(cmd, s-cmd);
	175	a = Argv;
	176	for (s = Cmd; *s;) {
	177	while (s && isSPACE(s)) s++;
	178	if (*s)
	179	*(a++) = s;
	180	while (s && !isSPACE(s)) s++;
	181	if (*s)
	182	*s++ = '\0';
	183	}
	184	*a = Nullch;
	185	if (Argv[0]) {
	186	rc = result(P_WAIT, spawnvp(P_NOWAIT,Argv[0],Argv));
	187	if (rc < 0 && dowarn)
	188	warn("Can't spawn \"%s\": %s", Argv[0], Strerror(errno));
c0c09dfd	189	if (rc < 0) rc = 255 << 8; /* Emulate the fork(). */
4633a7c4	190	} else
	191	rc = -1;
	192	do_execfree();
	193	return rc;
	194	}
	195
c0c09dfd	196	FILE *
	197	my_popen(cmd,mode)
	198	char *cmd;
	199	char *mode;
	200	{
	201	char *shell = getenv("EMXSHELL");
	202	FILE *res;
	203
	204	my_setenv("EMXSHELL", "sh.exe");
	205	res = popen(cmd, mode);
	206	my_setenv("EMXSHELL", shell);
	207	return res;
	208	}
	209
4633a7c4	210	/*****************************************************************************/
	211
	212	#ifndef HAS_FORK
	213	int
	214	fork(void)
	215	{
	216	die(no_func, "Unsupported function fork");
	217	errno = EINVAL;
	218	return -1;
	219	}
	220	#endif
	221
	222	/*****************************************************************************/
	223	/* not implemented in EMX 0.9a */
	224
	225	void * ctermid(x) { return 0; }
eacfb5f1	226
eacfb5f1	227	#ifdef MYTTYNAME /* was not in emx0.9a */
4633a7c4	228	void * ttyname(x) { return 0; }
eacfb5f1	229	#endif
4633a7c4	230
	231	void * gethostent() { return 0; }
	232	void * getnetent() { return 0; }
	233	void * getprotoent() { return 0; }
	234	void * getservent() { return 0; }
	235	void sethostent(x) {}
	236	void setnetent(x) {}
	237	void setprotoent(x) {}
	238	void setservent(x) {}
	239	void endhostent(x) {}
	240	void endnetent(x) {}
	241	void endprotoent(x) {}
	242	void endservent(x) {}
	243
	244	/*****************************************************************************/
	245	/* stat() hack for char/block device */
	246
	247	#if OS2_STAT_HACK
	248
	249	/* First attempt used DosQueryFSAttach which crashed the system when
	250	used with 5.001. Now just look for /dev/. */
	251
	252	int
	253	os2_stat(char name, struct stat st)
	254	{
	255	static int ino = SHRT_MAX;
	256
	257	if (stricmp(name, "/dev/con") != 0
	258	&& stricmp(name, "/dev/tty") != 0)
	259	return stat(name, st);
	260
	261	memset(st, 0, sizeof *st);
	262	st->st_mode = S_IFCHR\|0666;
	263	st->st_ino = (ino-- & 0x7FFF);
	264	st->st_nlink = 1;
	265	return 0;
	266	}
	267
	268	#endif
c0c09dfd	269
	270	#ifndef NO_SYS_ALLOC
	271
	272	static char *old2K;
	273
	274	#define ONE_K (1<<10)
	275	#define TWO_K (1<<11)
	276	#define FOUR_K (1<<12)
	277	#define FOUR_K_FLAG (FOUR_K - 1)
	278
	279
	280	void *
	281	sbrk(int size)
	282	{
	283	char *got;
	284	APIRET rc;
	285	int is2K = 0;
	286
	287	if (!size) return 0;
	288	else if (size == TWO_K) {
	289	is2K = 1;
	290	if (old2K) {
	291	char *ret = old2K;
	292
	293	old2K = 0;
	294	return (void *)ret;
	295	}
	296	size = FOUR_K;
	297	} else if (size & FOUR_K_FLAG) {
	298	croak("Memory allocation in units %li not multiple to 4K", size);
	299	}
	300	rc = DosAllocMem((void **)&got, size, PAG_COMMIT \| PAG_WRITE);
	301	if (rc == ERROR_NOT_ENOUGH_MEMORY) {
	302	return (void *) -1;
	303	} else if ( rc ) die("Got an error from DosAllocMem: %li", (long)rc);
	304	if (is2K) old2K = got + TWO_K;
	305	return (void *)got;
	306	}
	307	#endif /* ! defined NO_SYS_ALLOC */
	308
	309	/* tmp path */
	310
	311	char *tmppath = TMPPATH1;
	312
	313	void
	314	settmppath()
	315	{
	316	char p = getenv("TMP"), tpath;
	317	int len;
	318
	319	if (!p) p = getenv("TEMP");
	320	if (!p) return;
	321	len = strlen(p);
	322	tpath = (char *)malloc(len + strlen(TMPPATH1) + 2);
	323	strcpy(tpath, p);
	324	tpath[len] = '/';
	325	strcpy(tpath + len + 1, TMPPATH1);
	326	tmppath = tpath;
	327	}