1/*
2 * Copyright (c) 2001 by The XFree86 Project, Inc.
3 *
4 * Permission is hereby granted, free of charge, to any person obtaining a
5 * copy of this software and associated documentation files (the "Software"),
6 * to deal in the Software without restriction, including without limitation
7 * the rights to use, copy, modify, merge, publish, distribute, sublicense,
8 * and/or sell copies of the Software, and to permit persons to whom the
9 * Software is furnished to do so, subject to the following conditions:
10 *
11 * The above copyright notice and this permission notice shall be included in
12 * all copies or substantial portions of the Software.
13 *
14 * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
15 * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
16 * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
17 * THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
18 * WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
19 * OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
20 * SOFTWARE.
21 *
22 * Except as contained in this notice, the name of the XFree86 Project shall
23 * not be used in advertising or otherwise to promote the sale, use or other
24 * dealings in this Software without prior written authorization from the
25 * XFree86 Project.
26 *
27 * Author: Paulo César Pereira de Andrade
28 */
29
30/* $XFree86: xc/programs/xedit/lisp/stream.c,v 1.21tsi Exp $ */
31
32#include "lisp/read.h"
33#include "lisp/stream.h"
34#include "lisp/pathname.h"
35#include "lisp/write.h"
36#include "lisp/private.h"
37#include <errno.h>
38#include <fcntl.h>
39#include <signal.h>
40#include <string.h>
41#include <sys/wait.h>
42
43/*
44 * Initialization
45 */
46#define DIR_PROBE		0
47#define DIR_INPUT		1
48#define DIR_OUTPUT		2
49#define DIR_IO			3
50
51#define EXT_NIL			0
52#define EXT_ERROR		1
53#define EXT_NEW_VERSION		2
54#define EXT_RENAME		3
55#define EXT_RENAME_DELETE	4
56#define EXT_OVERWRITE		5
57#define EXT_APPEND		6
58#define EXT_SUPERSEDE		7
59
60#define NOEXT_NIL		0
61#define NOEXT_ERROR		1
62#define NOEXT_CREATE		2
63#define NOEXT_NOTHING		3
64
65extern char **environ;
66
67LispObj *Oopen, *Oclose, *Otruename;
68
69LispObj *Kif_does_not_exist, *Kprobe, *Kinput, *Koutput, *Kio,
70	*Knew_version, *Krename, *Krename_and_delete, *Koverwrite,
71	*Kappend, *Ksupersede, *Kcreate;
72
73/*
74 * Implementation
75 */
76void
77LispStreamInit(void)
78{
79    Oopen		= STATIC_ATOM("OPEN");
80    Oclose		= STATIC_ATOM("CLOSE");
81    Otruename		= STATIC_ATOM("TRUENAME");
82
83    Kif_does_not_exist	= KEYWORD("IF-DOES-NOT-EXIST");
84    Kprobe		= KEYWORD("PROBE");
85    Kinput		= KEYWORD("INPUT");
86    Koutput		= KEYWORD("OUTPUT");
87    Kio			= KEYWORD("IO");
88    Knew_version	= KEYWORD("NEW-VERSION");
89    Krename		= KEYWORD("RENAME");
90    Krename_and_delete	= KEYWORD("RENAME-AND-DELETE");
91    Koverwrite		= KEYWORD("OVERWRITE");
92    Kappend		= KEYWORD("APPEND");
93    Ksupersede		= KEYWORD("SUPERSEDE");
94    Kcreate		= KEYWORD("CREATE");
95}
96
97LispObj *
98Lisp_DeleteFile(LispBuiltin *builtin)
99/*
100 delete-file filename
101 */
102{
103    GC_ENTER();
104    LispObj *filename;
105
106    filename = ARGUMENT(0);
107
108    if (STRINGP(filename)) {
109	filename = APPLY1(Oparse_namestring, filename);
110	GC_PROTECT(filename);
111    }
112    else if (STREAMP(filename)) {
113	if (filename->data.stream.type != LispStreamFile)
114	    LispDestroy("%s: %s is not a FILE-STREAM",
115			STRFUN(builtin), STROBJ(filename));
116	filename = filename->data.stream.pathname;
117    }
118    else {
119	CHECK_PATHNAME(filename);
120    }
121    GC_LEAVE();
122
123    return (LispUnlink(THESTR(CAR(filename->data.pathname))) ? NIL : T);
124}
125
126LispObj *
127Lisp_RenameFile(LispBuiltin *builtin)
128/*
129 rename-file filename new-name
130 */
131{
132    int code;
133    GC_ENTER();
134    char *from, *to;
135    LispObj *old_truename, *new_truename;
136
137    LispObj *filename, *new_name;
138
139    new_name = ARGUMENT(1);
140    filename = ARGUMENT(0);
141
142    if (STRINGP(filename)) {
143	filename = APPLY1(Oparse_namestring, filename);
144	GC_PROTECT(filename);
145    }
146    else if (STREAMP(filename)) {
147	if (filename->data.stream.type != LispStreamFile)
148	    LispDestroy("%s: %s is not a FILE-STREAM",
149			STRFUN(builtin), STROBJ(filename));
150	filename = filename->data.stream.pathname;
151    }
152    else {
153	CHECK_PATHNAME(filename);
154    }
155    old_truename = APPLY1(Otruename, filename);
156    GC_PROTECT(old_truename);
157
158    if (STRINGP(new_name)) {
159	new_name = APPLY3(Oparse_namestring, new_name, NIL, filename);
160	GC_PROTECT(new_name);
161    }
162    else {
163	CHECK_PATHNAME(new_name);
164    }
165
166    from = THESTR(CAR(filename->data.pathname));
167    to = THESTR(CAR(new_name->data.pathname));
168    code = LispRename(from, to);
169    if (code)
170	LispDestroy("%s: rename(%s, %s): %s",
171		    STRFUN(builtin), from, to, strerror(errno));
172    GC_LEAVE();
173
174    new_truename = APPLY1(Otruename, new_name);
175    RETURN_COUNT = 2;
176    RETURN(0) = old_truename;
177    RETURN(1) = new_truename;
178
179    return (new_name);
180}
181
182LispObj *
183Lisp_Streamp(LispBuiltin *builtin)
184/*
185 streamp object
186 */
187{
188    LispObj *object;
189
190    object = ARGUMENT(0);
191
192    return (STREAMP(object) ? T : NIL);
193}
194
195LispObj *
196Lisp_InputStreamP(LispBuiltin *builtin)
197/*
198 input-stream-p stream
199 */
200{
201    LispObj *stream;
202
203    stream = ARGUMENT(0);
204
205    CHECK_STREAM(stream);
206
207    return (stream->data.stream.readable ? T : NIL);
208}
209
210LispObj *
211Lisp_OpenStreamP(LispBuiltin *builtin)
212/*
213 open-stream-p stream
214 */
215{
216   LispObj *stream;
217
218    stream = ARGUMENT(0);
219
220    CHECK_STREAM(stream);
221
222    return (stream->data.stream.readable || stream->data.stream.writable ?
223	    T : NIL);
224}
225
226LispObj *
227Lisp_OutputStreamP(LispBuiltin *builtin)
228/*
229 output-stream-p stream
230 */
231{
232    LispObj *stream;
233
234    stream = ARGUMENT(0);
235
236    CHECK_STREAM(stream);
237
238    return (stream->data.stream.writable ? T : NIL);
239}
240
241LispObj *
242Lisp_Open(LispBuiltin *builtin)
243/*
244 open filename &key direction element-type if-exists if-does-not-exist external-format
245 */
246{
247    GC_ENTER();
248    char *string;
249    LispObj *stream = NIL;
250    int mode, flags, direction, exist, noexist, file_exist;
251    LispFile *file;
252
253    LispObj *filename, *odirection, *element_type, *if_exists,
254	    *if_does_not_exist, *external_format;
255
256    external_format = ARGUMENT(5);
257    if_does_not_exist = ARGUMENT(4);
258    if_exists = ARGUMENT(3);
259    element_type = ARGUMENT(2);
260    odirection = ARGUMENT(1);
261    filename = ARGUMENT(0);
262
263    if (STRINGP(filename)) {
264	filename = APPLY1(Oparse_namestring, filename);
265	GC_PROTECT(filename);
266    }
267    else if (STREAMP(filename)) {
268	if (filename->data.stream.type != LispStreamFile)
269	    LispDestroy("%s: %s is not a FILE-STREAM",
270			STRFUN(builtin), STROBJ(filename));
271	filename = filename->data.stream.pathname;
272    }
273    else {
274	CHECK_PATHNAME(filename);
275    }
276
277    if (odirection != UNSPEC) {
278	direction = -1;
279	if (KEYWORDP(odirection)) {
280	    if (odirection == Kprobe)
281		direction = DIR_PROBE;
282	    else if (odirection == Kinput)
283		direction = DIR_INPUT;
284	    else if (odirection == Koutput)
285		direction = DIR_OUTPUT;
286	    else if (odirection == Kio)
287		direction = DIR_IO;
288	}
289	if (direction == -1)
290	    LispDestroy("%s: bad :DIRECTION %s",
291			STRFUN(builtin), STROBJ(odirection));
292    }
293    else
294	direction = DIR_INPUT;
295
296    if (element_type != UNSPEC) {
297	/* just check argument... */
298	if (SYMBOLP(element_type) &&
299	    ATOMID(element_type) == Scharacter)
300	    ;	/* do nothing */
301	else if (KEYWORDP(element_type) &&
302	    ATOMID(element_type) == Sdefault)
303	    ;	/* do nothing */
304	else
305	    LispDestroy("%s: only :%s and %s supported for :ELEMENT-TYPE, not %s",
306			STRFUN(builtin), Sdefault->value, Scharacter->value, STROBJ(element_type));
307    }
308
309    if (if_exists != UNSPEC) {
310	exist = -1;
311	if (if_exists == NIL)
312	    exist = EXT_NIL;
313	else if (KEYWORDP(if_exists)) {
314	    if (if_exists == Kerror)
315		exist = EXT_ERROR;
316	    else if (if_exists == Knew_version)
317		exist = EXT_NEW_VERSION;
318	    else if (if_exists == Krename)
319		exist = EXT_RENAME;
320	    else if (if_exists == Krename_and_delete)
321		exist = EXT_RENAME_DELETE;
322	    else if (if_exists == Koverwrite)
323		exist = EXT_OVERWRITE;
324	    else if (if_exists == Kappend)
325		exist = EXT_APPEND;
326	    else if (if_exists == Ksupersede)
327		exist = EXT_SUPERSEDE;
328	}
329	if (exist == -1)
330	    LispDestroy("%s: bad :IF-EXISTS %s",
331			STRFUN(builtin), STROBJ(if_exists));
332    }
333    else
334	exist = EXT_ERROR;
335
336    if (if_does_not_exist != UNSPEC) {
337	noexist = -1;
338	if (if_does_not_exist == NIL)
339	    noexist = NOEXT_NIL;
340	if (KEYWORDP(if_does_not_exist)) {
341	    if (if_does_not_exist == Kerror)
342		noexist = NOEXT_ERROR;
343	    else if (if_does_not_exist == Kcreate)
344		noexist = NOEXT_CREATE;
345	}
346	if (noexist == -1)
347	    LispDestroy("%s: bad :IF-DOES-NO-EXISTS %s",
348			STRFUN(builtin), STROBJ(if_does_not_exist));
349    }
350    else
351	noexist = direction != DIR_INPUT ? NOEXT_NOTHING : NOEXT_ERROR;
352
353    if (external_format != UNSPEC) {
354	/* just check argument... */
355	if (SYMBOLP(external_format) &&
356	    ATOMID(external_format) == Scharacter)
357	    ;	/* do nothing */
358	else if (KEYWORDP(external_format) &&
359	    ATOMID(external_format) == Sdefault)
360	    ;	/* do nothing */
361	else
362	    LispDestroy("%s: only :%s and %s supported for :EXTERNAL-FORMAT, not %s",
363			STRFUN(builtin), Sdefault->value, Scharacter->value, STROBJ(external_format));
364    }
365
366    /* string representation of pathname */
367    string = THESTR(CAR(filename->data.pathname));
368    mode = 0;
369
370    file_exist = access(string, F_OK) == 0;
371    if (file_exist) {
372	if (exist == EXT_NIL) {
373	    GC_LEAVE();
374	    return (NIL);
375	}
376    }
377    else {
378	if (noexist == NOEXT_NIL) {
379	    GC_LEAVE();
380	    return (NIL);
381	}
382	if (noexist == NOEXT_ERROR)
383	    LispDestroy("%s: file %s does not exist",
384			STRFUN(builtin), STROBJ(CAR(filename->data.quote)));
385	else if (noexist == NOEXT_CREATE) {
386	    LispFile *tmp = LispFopen(string, FILE_WRITE);
387
388	    if (tmp)
389		LispFclose(tmp);
390	    else
391		LispDestroy("%s: cannot create file %s",
392			    STRFUN(builtin),
393			    STROBJ(CAR(filename->data.quote)));
394	}
395    }
396
397    if (direction == DIR_OUTPUT || direction == DIR_IO) {
398	if (file_exist) {
399	    if (exist == EXT_ERROR)
400		LispDestroy("%s: file %s already exists",
401			    STRFUN(builtin), STROBJ(CAR(filename->data.quote)));
402	    if (exist == EXT_RENAME) {
403		/* Add an ending '~' at the end of the backup file */
404		char tmp[PATH_MAX + 1];
405
406		strcpy(tmp, string);
407		if (strlen(tmp) + 1 > PATH_MAX)
408		    LispDestroy("%s: backup name for %s too long",
409				STRFUN(builtin),
410				STROBJ(CAR(filename->data.quote)));
411		strcat(tmp, "~");
412		if (rename(string, tmp))
413		    LispDestroy("%s: rename: %s",
414				STRFUN(builtin), strerror(errno));
415		mode |= FILE_WRITE;
416	    }
417	    else if (exist == EXT_OVERWRITE)
418		mode |= FILE_WRITE;
419	    else if (exist == EXT_APPEND)
420		mode |= FILE_APPEND;
421	}
422	else
423	    mode |= FILE_WRITE;
424	if (direction == DIR_IO)
425	    mode |= FILE_IO;
426    }
427    else
428	mode |= FILE_READ;
429
430    file = LispFopen(string, mode);
431    if (file == NULL)
432	LispDestroy("%s: open: %s", STRFUN(builtin), strerror(errno));
433
434    flags = 0;
435    if (direction == DIR_PROBE) {
436	LispFclose(file);
437	file = NULL;
438    }
439    else {
440	if (direction == DIR_INPUT || direction == DIR_IO)
441	    flags |= STREAM_READ;
442	if (direction == DIR_OUTPUT || direction == DIR_IO)
443	    flags |= STREAM_WRITE;
444    }
445    stream = FILESTREAM(file, filename, flags);
446    GC_LEAVE();
447
448    return (stream);
449}
450
451LispObj *
452Lisp_Close(LispBuiltin *builtin)
453/*
454 close stream &key abort
455 */
456{
457    LispObj *stream, *oabort;
458
459    oabort = ARGUMENT(1);
460    stream = ARGUMENT(0);
461
462    CHECK_STREAM(stream);
463
464    if (stream->data.stream.readable || stream->data.stream.writable) {
465	stream->data.stream.readable = stream->data.stream.writable = 0;
466	if (stream->data.stream.type == LispStreamFile) {
467	    LispFclose(stream->data.stream.source.file);
468	    stream->data.stream.source.file = NULL;
469	}
470	else if (stream->data.stream.type == LispStreamPipe) {
471	    if (IPSTREAMP(stream)) {
472		LispFclose(IPSTREAMP(stream));
473		IPSTREAMP(stream) = NULL;
474	    }
475	    if (OPSTREAMP(stream)) {
476		LispFclose(OPSTREAMP(stream));
477		OPSTREAMP(stream) = NULL;
478	    }
479	    if (EPSTREAMP(stream)) {
480		LispFclose(EPSTREAMP(stream));
481		EPSTREAMP(stream) = NULL;
482	    }
483	    if (PIDPSTREAMP(stream) > 0) {
484		kill(PIDPSTREAMP(stream),
485		     oabort == UNSPEC || oabort == NIL ? SIGTERM : SIGKILL);
486		waitpid(PIDPSTREAMP(stream), NULL, 0);
487	    }
488	}
489	return (T);
490    }
491
492    return (NIL);
493}
494
495LispObj *
496Lisp_Listen(LispBuiltin *builtin)
497/*
498 listen &optional input-stream
499 */
500{
501    LispFile *file = NULL;
502    LispObj *result = NIL;
503
504    LispObj *stream;
505
506    stream = ARGUMENT(0);
507
508    if (stream == UNSPEC)
509	stream = NIL;
510    else if (stream != NIL) {
511	CHECK_STREAM(stream);
512    }
513    else
514	stream = lisp__data.standard_input;
515
516    if (stream->data.stream.readable) {
517	switch (stream->data.stream.type) {
518	    case LispStreamString:
519		if (SSTREAMP(stream)->input < SSTREAMP(stream)->length)
520		    result = T;
521		break;
522	    case LispStreamFile:
523		file = FSTREAMP(stream);
524		break;
525	    case LispStreamStandard:
526		file = FSTREAMP(stream);
527		break;
528	    case LispStreamPipe:
529		file = IPSTREAMP(stream);
530		break;
531	}
532
533	if (file != NULL) {
534	    if (file->available || file->offset < file->length)
535		result = T;
536	    else {
537		unsigned char c;
538
539		if (!file->nonblock) {
540		    if (fcntl(file->descriptor, F_SETFL, O_NONBLOCK) < 0)
541			LispDestroy("%s: fcntl: %s",
542				    STRFUN(builtin), strerror(errno));
543		    file->nonblock = 1;
544		}
545		if (read(file->descriptor, &c, 1) == 1) {
546		    LispFungetc(file, c);
547		    result = T;
548		}
549	    }
550	}
551    }
552
553    return (result);
554}
555
556LispObj *
557Lisp_MakeStringInputStream(LispBuiltin *builtin)
558/*
559 make-string-input-stream string &optional start end
560 */
561{
562    char *string;
563    long start, end, length;
564
565    LispObj *ostring, *ostart, *oend, *result;
566
567    oend = ARGUMENT(2);
568    ostart = ARGUMENT(1);
569    ostring = ARGUMENT(0);
570
571    start = end = 0;
572    CHECK_STRING(ostring);
573    LispCheckSequenceStartEnd(builtin, ostring, ostart, oend,
574			      &start, &end, &length);
575    string = THESTR(ostring);
576
577    if (end - start != length)
578	length = end - start;
579    result = LSTRINGSTREAM(string + start, STREAM_READ, length);
580
581    return (result);
582}
583
584LispObj *
585Lisp_MakeStringOutputStream(LispBuiltin *builtin)
586/*
587 make-string-output-stream &key element-type
588 */
589{
590    LispObj *element_type;
591
592    element_type = ARGUMENT(0);
593
594    if (element_type != UNSPEC) {
595	/* just check argument... */
596	if (SYMBOLP(element_type) && ATOMID(element_type) == Scharacter)
597	    ;	/* do nothing */
598	else if (KEYWORDP(element_type) &&
599	    ATOMID(element_type) == Sdefault)
600	    ;	/* do nothing */
601	else
602	    LispDestroy("%s: only :%s and %s supported for :ELEMENT-TYPE, not %s",
603			STRFUN(builtin), Sdefault->value, Scharacter->value, STROBJ(element_type));
604    }
605
606    return (LSTRINGSTREAM("", STREAM_WRITE, 1));
607}
608
609LispObj *
610Lisp_GetOutputStreamString(LispBuiltin *builtin)
611/*
612 get-output-stream-string string-output-stream
613 */
614{
615    int length;
616    const char *string;
617    LispObj *string_output_stream, *result;
618
619    string_output_stream = ARGUMENT(0);
620
621    if (!STREAMP(string_output_stream) ||
622	string_output_stream->data.stream.type != LispStreamString ||
623	string_output_stream->data.stream.readable ||
624	!string_output_stream->data.stream.writable)
625	LispDestroy("%s: %s is not an output string stream",
626		    STRFUN(builtin), STROBJ(string_output_stream));
627
628    string = LispGetSstring(SSTREAMP(string_output_stream), &length);
629    result = LSTRING(string, length);
630
631    /* reset string */
632    SSTREAMP(string_output_stream)->output =
633	SSTREAMP(string_output_stream)->length =
634	SSTREAMP(string_output_stream)->column = 0;
635
636    return (result);
637}
638
639
640/* XXX Non standard functions below
641 */
642LispObj *
643Lisp_MakePipe(LispBuiltin *builtin)
644/*
645 make-pipe command-line &key :direction :element-type :external-format
646 */
647{
648    char *string;
649    LispObj *stream = NIL;
650    int flags, direction;
651    LispFile *error_file;
652    LispPipe *program;
653    int ifd[2];
654    int ofd[2];
655    int efd[2];
656    char *argv[4];
657
658    LispObj *command_line, *odirection, *element_type, *external_format;
659
660    external_format = ARGUMENT(3);
661    element_type = ARGUMENT(2);
662    odirection = ARGUMENT(1);
663    command_line = ARGUMENT(0);
664
665    if (PATHNAMEP(command_line))
666	command_line = CAR(command_line->data.quote);
667    else if (!STRINGP(command_line))
668	LispDestroy("%s: %s is a bad pathname",
669		    STRFUN(builtin), STROBJ(command_line));
670
671    if (odirection != UNSPEC) {
672	direction = -1;
673	if (KEYWORDP(odirection)) {
674	    if (odirection == Kprobe)
675		direction = DIR_PROBE;
676	    else if (odirection == Kinput)
677		direction = DIR_INPUT;
678	    else if (odirection == Koutput)
679		direction = DIR_OUTPUT;
680	    else if (odirection == Kio)
681		direction = DIR_IO;
682	}
683	if (direction == -1)
684	    LispDestroy("%s: bad :DIRECTION %s",
685			STRFUN(builtin), STROBJ(odirection));
686    }
687    else
688	direction = DIR_INPUT;
689
690    if (element_type != UNSPEC) {
691	/* just check argument... */
692	if (SYMBOLP(element_type) && ATOMID(element_type) == Scharacter)
693	    ;	/* do nothing */
694	else if (KEYWORDP(element_type) && ATOMID(element_type) == Sdefault)
695	    ;	/* do nothing */
696	else
697	    LispDestroy("%s: only :%s and %s supported for :ELEMENT-TYPE, not %s",
698			STRFUN(builtin), Sdefault->value, Scharacter->value, STROBJ(element_type));
699    }
700
701    if (external_format != UNSPEC) {
702	/* just check argument... */
703	if (SYMBOLP(external_format) && ATOMID(external_format) == Scharacter)
704	    ;	/* do nothing */
705	else if (KEYWORDP(external_format) &&
706		 ATOMID(external_format) == Sdefault)
707	    ;	/* do nothing */
708	else
709	    LispDestroy("%s: only :%s and %s supported for :EXTERNAL-FORMAT, not %s",
710			STRFUN(builtin), Sdefault->value, Scharacter->value, STROBJ(external_format));
711    }
712
713    string = THESTR(command_line);
714    program = LispMalloc(sizeof(LispPipe));
715    if (direction != DIR_PROBE) {
716	argv[0] = "sh";
717	argv[1] = "-c";
718	argv[2] = string;
719	argv[3] = NULL;
720	pipe(ifd);
721	pipe(ofd);
722	pipe(efd);
723	if ((program->pid = fork()) == 0) {
724	    close(0);
725	    close(1);
726	    close(2);
727	    dup2(ofd[0], 0);
728	    dup2(ifd[1], 1);
729	    dup2(efd[1], 2);
730	    close(ifd[0]);
731	    close(ifd[1]);
732	    close(ofd[0]);
733	    close(ofd[1]);
734	    close(efd[0]);
735	    close(efd[1]);
736	    execve("/bin/sh", argv, environ);
737	    exit(-1);
738	}
739	else if (program->pid < 0)
740	    LispDestroy("%s: fork: %s", STRFUN(builtin), strerror(errno));
741
742	program->input = LispFdopen(ifd[0], FILE_READ | FILE_UNBUFFERED);
743	close(ifd[1]);
744	program->output = LispFdopen(ofd[1], FILE_WRITE | FILE_UNBUFFERED);
745	close(ofd[0]);
746	error_file = LispFdopen(efd[0], FILE_READ | FILE_UNBUFFERED);
747	close(efd[1]);
748    }
749    else {
750	program->pid = -1;
751	program->input = program->output = error_file = NULL;
752    }
753
754    flags = direction == DIR_PROBE ? 0 : STREAM_READ;
755    program->errorp = FILESTREAM(error_file, command_line, flags);
756
757    flags = 0;
758    if (direction != DIR_PROBE) {
759	if (direction == DIR_INPUT || direction == DIR_IO)
760	    flags |= STREAM_READ;
761	if (direction == DIR_OUTPUT || direction == DIR_IO)
762	    flags |= STREAM_WRITE;
763    }
764    stream = PIPESTREAM(program, command_line, flags);
765    LispMused(program);
766
767    return (stream);
768}
769
770/* Helper function, primarily for use with the xt module
771 */
772LispObj *
773Lisp_PipeBroken(LispBuiltin *builtin)
774/*
775 pipe-broken pipe-stream
776 */
777{
778    int pid, status, retval;
779    LispObj *result = NIL;
780
781    LispObj *pipe_stream;
782
783    pipe_stream = ARGUMENT(0);
784
785    if (!STREAMP(pipe_stream) ||
786	pipe_stream->data.stream.type != LispStreamPipe)
787	LispDestroy("%s: %s is not a pipe stream",
788		    STRFUN(builtin), STROBJ(pipe_stream));
789
790    if ((pid = PIDPSTREAMP(pipe_stream)) > 0) {
791	retval = waitpid(pid, &status, WNOHANG | WUNTRACED);
792	if (retval == pid || (retval == -1 && errno == ECHILD))
793	    result = T;
794    }
795
796    return (result);
797}
798
799/*
800 Helper function, so that it is not required to redirect error output
801 */
802LispObj *
803Lisp_PipeErrorStream(LispBuiltin *builtin)
804/*
805 pipe-error-stream pipe-stream
806 */
807{
808    LispObj *pipe_stream;
809
810    pipe_stream = ARGUMENT(0);
811
812    if (!STREAMP(pipe_stream) ||
813	pipe_stream->data.stream.type != LispStreamPipe)
814	LispDestroy("%s: %s is not a pipe stream",
815		    STRFUN(builtin), STROBJ(pipe_stream));
816
817    return (pipe_stream->data.stream.source.program->errorp);
818}
819
820/*
821 Helper function, primarily for use with the xt module
822 */
823LispObj *
824Lisp_PipeInputDescriptor(LispBuiltin *builtin)
825/*
826 pipe-input-descriptor pipe-stream
827 */
828{
829    LispObj *pipe_stream;
830
831    pipe_stream = ARGUMENT(0);
832
833    if (!STREAMP(pipe_stream) ||
834	pipe_stream->data.stream.type != LispStreamPipe)
835	LispDestroy("%s: %s is not a pipe stream",
836		    STRFUN(builtin), STROBJ(pipe_stream));
837    if (!IPSTREAMP(pipe_stream))
838	LispDestroy("%s: pipe %s is unreadable",
839		    STRFUN(builtin), STROBJ(pipe_stream));
840
841    return (INTEGER(LispFileno(IPSTREAMP(pipe_stream))));
842}
843
844/*
845 Helper function, primarily for use with the xt module
846 */
847LispObj *
848Lisp_PipeErrorDescriptor(LispBuiltin *builtin)
849/*
850 pipe-error-descriptor pipe-stream
851 */
852{
853    LispObj *pipe_stream;
854
855    pipe_stream = ARGUMENT(0);
856
857    if (!STREAMP(pipe_stream) ||
858	pipe_stream->data.stream.type != LispStreamPipe)
859	LispDestroy("%s: %s is not a pipe stream",
860		    STRFUN(builtin), STROBJ(pipe_stream));
861    if (!EPSTREAMP(pipe_stream))
862	LispDestroy("%s: pipe %s is closed",
863		    STRFUN(builtin), STROBJ(pipe_stream));
864
865    return (INTEGER(LispFileno(EPSTREAMP(pipe_stream))));
866}
867