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
65 extern char **environ;
66
67 LispObj *Oopen, *Oclose, *Otruename;
68
69 LispObj *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 */
76 void
LispStreamInit(void)77 LispStreamInit(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
97 LispObj *
Lisp_DeleteFile(LispBuiltin * builtin)98 Lisp_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
126 LispObj *
Lisp_RenameFile(LispBuiltin * builtin)127 Lisp_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
182 LispObj *
Lisp_Streamp(LispBuiltin * builtin)183 Lisp_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
195 LispObj *
Lisp_InputStreamP(LispBuiltin * builtin)196 Lisp_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
210 LispObj *
Lisp_OpenStreamP(LispBuiltin * builtin)211 Lisp_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
226 LispObj *
Lisp_OutputStreamP(LispBuiltin * builtin)227 Lisp_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
241 LispObj *
Lisp_Open(LispBuiltin * builtin)242 Lisp_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
451 LispObj *
Lisp_Close(LispBuiltin * builtin)452 Lisp_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
495 LispObj *
Lisp_Listen(LispBuiltin * builtin)496 Lisp_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
556 LispObj *
Lisp_MakeStringInputStream(LispBuiltin * builtin)557 Lisp_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
584 LispObj *
Lisp_MakeStringOutputStream(LispBuiltin * builtin)585 Lisp_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
609 LispObj *
Lisp_GetOutputStreamString(LispBuiltin * builtin)610 Lisp_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 */
642 LispObj *
Lisp_MakePipe(LispBuiltin * builtin)643 Lisp_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 */
772 LispObj *
Lisp_PipeBroken(LispBuiltin * builtin)773 Lisp_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 */
802 LispObj *
Lisp_PipeErrorStream(LispBuiltin * builtin)803 Lisp_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 */
823 LispObj *
Lisp_PipeInputDescriptor(LispBuiltin * builtin)824 Lisp_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 */
847 LispObj *
Lisp_PipeErrorDescriptor(LispBuiltin * builtin)848 Lisp_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