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 Csar 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 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 * 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 * 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 * 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 * 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 * 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 * 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 * 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 * 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 * 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 * 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 * 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 * 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 * 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 * 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 * 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 * 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 * 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
Indexes created Wed Jul 01 00:25:26 UTC 2026