1/* BEGIN LICENSE BLOCK 2 * Version: CMPL 1.1 3 * 4 * The contents of this file are subject to the Cisco-style Mozilla Public 5 * License Version 1.1 (the "License"); you may not use this file except 6 * in compliance with the License. You may obtain a copy of the License 7 * at www.eclipse-clp.org/license. 8 * 9 * Software distributed under the License is distributed on an "AS IS" 10 * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See 11 * the License for the specific language governing rights and limitations 12 * under the License. 13 * 14 * The Original Code is The ECLiPSe Constraint Logic Programming System. 15 * The Initial Developer of the Original Code is Cisco Systems, Inc. 16 * Portions created by the Initial Developer are 17 * Copyright (C) 1989-2006 Cisco Systems, Inc. All Rights Reserved. 18 * 19 * Contributor(s): 20 * 21 * END LICENSE BLOCK */ 22 23/* 24 * VERSION $Id: bip_io.c,v 1.22 2015/01/14 01:31:09 jschimpf Exp $ 25 */ 26 27/**************************************************************************** 28 * 29 * SEPIA Built-in Predicates: I/O 30 * 31 * 32 *****************************************************************************/ 33 34#include "config.h" 35#include "os_support.h" 36 37#include <errno.h> 38#include <stdio.h> 39//#include <memory.h> 40#include <sys/types.h> 41#include <sys/stat.h> 42 43#ifdef HAVE_SYS_PARAM_H 44#include <sys/param.h> 45#endif 46 47#if defined(BARRELFISH) 48#include <barrelfish/debug.h> 49#endif 50 51#if defined(HAVE_UNISTD_H) 52#include <unistd.h> 53#endif 54 55#if defined(HAVE_SYS_SELECT_H) 56#include <sys/select.h> 57#endif 58 59#ifdef HAVE_VFORK_H 60#include <vfork.h> 61#endif 62 63#if HAVE_STRING_H 64# include <string.h> 65# ifdef MEMCPY_STRING 66# define bcopy(s1, s2, n) (void) memcpy((void *)(s2),(void *)(s1), n) 67# endif 68#endif 69#ifdef MEMCPY_MEMORY 70# define bcopy(s1, s2, n) (void) memcpy((char *)(s2), (char *)(s1), n) 71extern char *strcpy(), 72 *strncpy(), 73 *strcat(), 74 *strerror(); 75#endif 76 77#ifdef _WIN32 78#include <windows.h> 79#include <process.h> 80#else 81#include <sys/wait.h> 82#endif 83 84#ifdef SOCKETS 85#ifdef _WIN32 86 87#define StreamCanSignal(nst) IsSocket(nst) 88 89typedef SOCKET socket_t; 90 91#else 92 93#define StreamCanSignal(nst) (IsSocket(nst) || IsPipeStream(nst)) 94 95#define INVALID_SOCKET (-1) 96typedef int socket_t; 97#include <sys/socket.h> 98#include <sys/time.h> 99#ifdef HAVE_AF_UNIX 100#include <sys/un.h> 101#endif 102#include <netinet/in.h> 103#include <netdb.h> 104 105#endif /*_WIN32*/ 106 107#elif defined(BARRELFISH) 108#define StreamCanSignal(x) 0 109#else /*SOCKETS*/ 110#undef S_ISSOCK 111#define S_ISSOCK(m) 0 112#endif /*SOCKETS*/ 113 114#if defined(S_IFSOCK) && !defined (S_ISSOCK) 115# define S_ISSOCK(m) (((m)&S_IFMT) == S_IFSOCK) 116# define S_ISFIFO(m) (((m)&S_IFMT) == S_IFIFO) 117#endif 118 119#include <fcntl.h> 120 121/* directory access (see autoconf manual) */ 122 123#if HAVE_DIRENT_H 124# include <dirent.h> 125# define HAVE_READDIR 126#else 127# if HAVE_SYS_NDIR_H 128# include <sys/ndir.h> 129# define HAVE_READDIR 130# endif 131# if HAVE_SYS_DIR_H 132# include <sys/dir.h> 133# define HAVE_READDIR 134# endif 135# if HAVE_NDIR_H 136# include <ndir.h> 137# define HAVE_READDIR 138# endif 139# if !defined(dirent) 140# define dirent direct 141# endif 142#endif 143 144 145#include "sepia.h" 146#include "types.h" 147#include "embed.h" 148#include "mem.h" 149#include "error.h" 150#include "ec_io.h" 151#include "dict.h" 152#include "lex.h" 153#include "emu_export.h" 154#include "property.h" 155 156/* constants which are the same everywhere, but whose symbolic names vary */ 157#define ACCESS_OK 0 158 159#define StreamCanRaiseEvent(nst) (IsQueueStream(nst) || StreamCanSignal(nst)) 160 161#define GetStreamProperty(functor) \ 162 get_property(functor, STREAM_PROP) 163 164#define Bind_Stream(v, t, s) \ 165 if (IsAtom(t) || IsNil(t)) { \ 166 int _res; \ 167 if ((_res = set_stream(IsNil(t) ? d_.nil : (v).did, s)) < 0) \ 168 { Bip_Error(_res); } \ 169 } else { \ 170 pword hstream = StreamHandle(s); \ 171 Bind_Var(v, t, hstream.val.all, hstream.tag.kernel); \ 172 } 173 174#define MAX_ARGS 30 175 176struct pipe_desc { 177 int fd[2]; 178 int fd_orig; /* needed for Windows (no fork) */ 179 pword pw; 180 int flags; 181}; 182 183#define MAX_PIPES 32 184#define EXEC_PIPE_CON 1 /* connect it? */ 185#define EXEC_PIPE_SIG 2 /* make it a SIGIO stream */ 186#define EXEC_PIPE_IN 4 /* input */ 187#define EXEC_PIPE_OUT 8 /* output */ 188#define EXEC_PIPE_LAST 16 /* end marker, last fd used */ 189 190 191#ifdef _WIN32 192/* 193 * On Windows, maintain a list of child process handles to prevent the 194 * processes from disappearing before they have been waited for 195 * (Windows doesn't have zombies) 196 */ 197typedef struct child_desc { 198 struct child_desc *next; 199 struct child_desc **prev_next; 200 int pid; 201 HANDLE hProcess; 202} t_child_desc; 203 204static t_child_desc *child_processes = 0; 205 206#define Child_Unlink(pd) { \ 207 if (pd) { \ 208 *pd->prev_next = pd->next; \ 209 hp_free_size(pd, sizeof(t_child_desc)); \ 210 } \ 211} 212#endif 213 214 215extern pword *empty_string; 216extern t_ext_type heap_event_tid; 217extern int ec_sigio; 218 219static dident d_pipe, 220 d_fd, 221 d_fd1, 222 d_false, 223 d_force1, 224 d_dup1, 225 d_sigio, 226 d_in, 227 d_out, 228 d_at, 229 d_not, 230 d_past, 231 d_eof_code, 232 d_socket, 233 d_queue, 234 d_queue1, 235 d_unix, 236 d_internet, 237 d_stream, 238 d_datagram, 239 d_end_of_line, 240 d_lf, 241 d_crlf, 242 d_when_lost, 243 d_when_closed, 244 d_reprompt1, 245 d_block; 246 247static dident modes[SMODEBITS + 1]; 248static dident stream_types[STYPE_NUM]; 249static dident stream_encodings[SENC_NUM]; 250 251#ifdef __STDC__ 252 253static int _check_stream(value, type, pword *, int), 254 _check_streams(value, type, struct pipe_desc *), 255 _match(char *, char *); 256static void _get_args(char *cmd, char *argv[]); 257 258#else /* __STDC__ */ 259 260static int _check_stream(), 261 _check_streams(), 262 _match(); 263static void _get_args(); 264 265#endif /* __STDC__ */ 266 267static int _open_pipes(struct pipe_desc *pipes); 268static void _close_pipes(struct pipe_desc *pipes); 269#ifndef _WIN32 270static void _connect_pipes(struct pipe_desc *pipes); 271#endif 272 273static int p_nl(value vs, type ts), 274 p_open(value vfile, type tfile, value vmode, type tmode, value vstr, type tstr), 275 p_erase_stream_property(value v, type t), 276 p_close(value v, type t), 277 p_close2(value v, type t, value vopt, type topt), 278 p_tyo(value vs, type ts, value v, type t), 279 p_tyi(value vs, type ts, value v, type t), 280 p_delete(value v, type t), 281 p_mkdir(value v, type t), 282 p_rename(value vo, type to, value vd, type td), 283 p_get_prompt(value iv, type it, value pv, type pt, value ov, type ot), 284 p_set_prompt(value iv, type it, value pv, type pt, value ov, type ot), 285 p_is_open_stream(value vc, type tc), 286 p_check_valid_stream(value v, type t), 287 p_check_stream_spec(value v, type t), 288 p_set_stream(value ov, type ot, value nv, type nt), 289 p_read_string(value vs, type ts, value vdel, type tdel, value vl, type tl, value val, type tag), 290 p_read_string5(value vs, type ts, value vdel, type tdel, value vpad, type tpad, value vsep, type tsep, value val, type tag), 291 p_at(value vs, type ts, value vp, type tp), 292 p_get_char(value vs, type ts, value val, type tag), 293 p_get(value vs, type ts, value val, type tag), 294 p_get1(value val, type tag), 295 p_put_char(value vs, type ts, value val, type tag), 296 p_put(value vstr, type tstr, value v, type t), 297 p_put1(value v, type t), 298 p_getw(value vs, type ts, value val, type tag), 299 p_unget(value vs, type ts), 300 p_flush(value sv, type st), 301 p_at_eof(value vs, type ts), 302 p_read_dir(value vdir, type tdir, value vpat, type tpat, value vsubdirs, type tsubdirs, value vfiles, type tfiles), 303 p_socket(value vdom, type tdom, value vtp, type ttp, value vs, type ts), 304 p_bind(value v, type t, value vaddr, type taddr), 305 p_connect(value v, type t, value vaddr, type taddr), 306 p_accept(value v, type t, value vaddr, type taddr, value vs, type ts), 307 p_listen(value v, type t, value vn, type tn), 308 p_select(value vin, type tin, value vtime, type ttime, value vout, type tout), 309 p_pipe(value valr, type tagr, value valw, type tagw), 310 p_exec(value vc, type tc, value vstr, type tstr, value vp, type tp, value vpr, type tpr), 311 p_wait(value pv, type pt, value sv, type st, value vmode, type tmode), 312#if defined(HAVE_READLINE) 313 p_readline(), 314#endif 315 p_stream_number(value val1, type tag1), 316 p_get_stream(value vi, type ti, value vs, type ts), 317 p_next_open_stream(value v1, type t1, value v2, type t2), 318 p_seek(value vs, type ts, value vp, type tp), 319 p_stream_truncate(value vs, type ts), 320 p_stream_info_(value vs, type ts, value vi, type ti, value v, type t), 321 p_set_stream_prop_(value vs, type ts, value vi, type ti, value v, type t); 322 323 324void 325bip_io_init(int flags) 326{ 327 d_fd = in_dict("fd", 0); 328 d_fd1 = in_dict("fd", 1); 329 d_false = in_dict("false", 0); 330 d_force1 = in_dict("force", 1); 331 d_dup1 = in_dict("dup", 1); 332 d_sigio = in_dict("sigio", 1); 333 d_in = in_dict("in", 1); 334 d_out = in_dict("out", 1); 335 d_at = in_dict("at", 0); 336 d_not = in_dict("not", 0); 337 d_past = in_dict("past", 0); 338 d_eof_code = in_dict("eof_code", 0); 339 d_queue1 = in_dict("queue", 1); 340 d_unix = in_dict("unix", 0); 341 d_internet = in_dict("internet", 0); 342 d_stream = in_dict("stream", 0); 343 d_datagram = in_dict("datagram", 0); 344 d_reprompt1 = in_dict("reprompt", 1); 345 d_block = in_dict("block", 0); 346 d_end_of_line = in_dict("end_of_line", 0); 347 d_lf = in_dict("lf", 0); 348 d_crlf = in_dict("crlf", 0); 349 d_when_lost = in_dict("when_lost", 0); 350 d_when_closed = in_dict("when_closed", 0); 351 352 modes[SCLOSED] = in_dict("closed",0); 353 modes[SREAD] = d_.read; 354 modes[SWRITE] = d_.write; 355 modes[SRDWR] = d_.update; 356 modes[SAPPEND|SCLOSED] = in_dict("invalid",0); 357 modes[SAPPEND|SREAD] = in_dict("invalid",0); 358 modes[SAPPEND|SWRITE] = d_.append; 359 modes[SAPPEND|SRDWR] = in_dict("invalid",0); 360 361 stream_types[SFILE>>STYPE_SHIFT] = in_dict("file", 0); 362 stream_types[SSTRING>>STYPE_SHIFT] = d_.string0; 363 stream_types[SPIPE>>STYPE_SHIFT] = d_pipe = in_dict("pipe", 0); 364 stream_types[SQUEUE>>STYPE_SHIFT] = d_queue = in_dict("queue", 0); 365 stream_types[SNULL>>STYPE_SHIFT] = d_.null; 366 stream_types[SSOCKET>>STYPE_SHIFT] = d_socket = in_dict("socket", 0); 367 stream_types[STTY>>STYPE_SHIFT] = in_dict("tty", 0); 368 369 stream_encodings[SENC_OCTET] = in_dict("octet", 0); 370 stream_encodings[SENC_ASCII] = in_dict("ascii", 0); 371 stream_encodings[SENC_LATIN1] = in_dict("iso_latin_1", 0); 372 373#ifdef _WIN32 374 if (flags & INIT_PRIVATE) 375 { 376 child_processes = NULL; 377 } 378#endif 379 380 if (flags & INIT_SHARED) 381 { 382 (void) built_in(in_dict("nl", 1), p_nl, B_SAFE); 383 (void) built_in(in_dict("open", 3), p_open, B_UNSAFE|U_SIMPLE); 384 (void) built_in(in_dict("close", 1), p_close, B_SAFE); 385 (void) built_in(in_dict("close", 2), p_close2, B_SAFE); 386 (void) built_in(in_dict("tyo", 2), p_tyo, B_SAFE); 387 (void) built_in(in_dict("tyi", 2), p_tyi, B_UNSAFE|U_SIMPLE); 388 (void) built_in(in_dict("delete", 1), p_delete, B_SAFE); 389 (void) built_in(in_dict("mkdir", 1), p_mkdir, B_SAFE); 390 (void) built_in(in_dict("rename", 2), p_rename, B_SAFE); 391 built_in(in_dict("get_prompt", 3), p_get_prompt, B_UNSAFE|U_GROUND) 392 -> mode = BoundArg(2, CONSTANT) | BoundArg(3, CONSTANT); 393 (void) built_in(in_dict("set_prompt", 3), p_set_prompt, B_UNSAFE); 394 (void) local_built_in(in_dict("is_open_stream", 1), 395 p_is_open_stream, B_SAFE); 396 (void) local_built_in(in_dict("check_valid_stream", 1), 397 p_check_valid_stream, B_SAFE); 398 (void) local_built_in(in_dict("check_stream_spec", 1), 399 p_check_stream_spec, B_SAFE); 400 (void) built_in(in_dict("get_stream",2), p_get_stream, B_UNSAFE|U_SIMPLE); 401 (void) built_in(in_dict("set_stream",2), p_set_stream, B_SAFE); 402 (void) built_in(in_dict("seek",2), p_seek, B_SAFE); 403 (void) built_in(in_dict("stream_truncate",1), p_stream_truncate, B_SAFE); 404 (void) built_in(in_dict("at",2), p_at, B_UNSAFE|U_SIMPLE); 405 (void) built_in(in_dict("get_char",2), p_get_char, B_UNSAFE|U_SIMPLE); 406 (void) built_in(in_dict("get", 2), p_get, B_UNSAFE|U_SIMPLE); 407 (void) built_in(in_dict("get", 1), p_get1, B_UNSAFE|U_SIMPLE); 408 (void) built_in(in_dict("unget",1), p_unget, B_SAFE); 409 (void) built_in(in_dict("put_char",2), p_put_char, B_SAFE); 410 (void) built_in(in_dict("put", 2), p_put, B_SAFE); 411 (void) built_in(in_dict("put", 1), p_put1, B_SAFE); 412 (void) exported_built_in(in_dict("getw", 2), p_getw, B_UNSAFE|U_SIMPLE); 413 (void) built_in(in_dict("at_eof",1), p_at_eof, B_SAFE); 414 (void) built_in(in_dict("flush", 1), p_flush, B_SAFE); 415 (void) local_built_in(in_dict("stream_number", 1), 416 p_stream_number, B_UNSAFE|U_SIMPLE); 417 (void) local_built_in(in_dict("stream_info_", 3), p_stream_info_, B_UNSAFE|U_SIMPLE); 418 (void) local_built_in(in_dict("set_stream_prop_", 3), p_set_stream_prop_, B_SAFE); 419 (void) local_built_in(in_dict("erase_stream_property", 1), 420 p_erase_stream_property, B_SAFE); 421 built_in(in_dict("pipe", 2), p_pipe, B_UNSAFE|U_GROUND) 422 -> mode = BoundArg(1, CONSTANT) | BoundArg(2, CONSTANT); 423 local_built_in(in_dict("exec", 4), p_exec, B_UNSAFE|U_GROUND) 424 -> mode = BoundArg(3, CONSTANT) | BoundArg(4, CONSTANT); 425 built_in(in_dict("read_string", 4), p_read_string, B_UNSAFE|U_GROUND) 426 -> mode = BoundArg(3, CONSTANT) | BoundArg(4, CONSTANT); 427 built_in(in_dict("read_string", 5), p_read_string5, B_UNSAFE|U_GROUND) 428 -> mode = BoundArg(4, CONSTANT) | BoundArg(5, CONSTANT); 429 built_in(in_dict("read_directory", 4), p_read_dir, B_UNSAFE|U_GROUND) 430 -> mode = BoundArg(3, GROUND) | BoundArg(4, GROUND); 431 (void) built_in(in_dict("socket", 3), p_socket, B_UNSAFE|U_SIMPLE); 432 built_in(in_dict("bind", 2), p_bind, B_UNSAFE|U_GROUND) 433 -> mode = BoundArg(2, GROUND); 434 built_in(in_dict("connect", 2), p_connect, B_UNSAFE|U_GROUND) 435 -> mode = BoundArg(2, GROUND); 436 (void) built_in(in_dict("listen", 2), p_listen, B_UNSAFE); 437 (void) built_in(in_dict("accept", 3), p_accept, B_UNSAFE|U_SIMPLE); 438 built_in(in_dict("stream_select", 3), p_select, B_UNSAFE|U_GROUND) 439 -> mode = BoundArg(3, GROUND); 440 local_built_in(in_dict("next_open_stream", 2), 441 p_next_open_stream, B_UNSAFE|U_GROUND) 442 -> mode = BoundArg(2, CONSTANT); 443 b_built_in(in_dict("wait", 3), p_wait, d_.kernel_sepia) 444 -> mode = BoundArg(1, CONSTANT) | BoundArg(2, CONSTANT) | BoundArg(3, CONSTANT); 445#if defined(HAVE_READLINE) 446 (void) exported_built_in(in_dict("readline", 1), p_readline, B_SAFE); 447#endif 448 } 449} 450 451 452/* METHODS */ 453static void _lose_stream(stream_id nst); 454static stream_id _copy_stream(stream_id nst); 455static void _mark_stream(stream_id nst); 456static int _tostr_stream(stream_id nst, char *buf, int quoted); 457static int _strsz_stream(stream_id nst, int quoted); 458 459 460static void 461_lose_stream(stream_id nst) /* nst != NULL */ 462{ 463 assert(nst); 464 assert(nst->nref > 0); 465 if (--nst->nref == 0) 466 { 467 if (IsOpened(nst) && !(StreamMode(nst) & SSYSTEM) 468 && !(StreamMode(nst) & SNUMBERUSED)) 469 { 470 /* 471 p_fprintf(current_output_, "lose_stream(%d)\n", StreamNr(nst)); 472 ec_flush(current_output_); 473 */ 474 int res = ec_close_stream(nst, CLOSE_FORCE|CLOSE_LOST); 475 if (res != PSUCCEED) 476 { 477 p_fprintf(current_err_, "\nError %d during auto-close of stream_%d\n", -res, StreamNr(nst)); 478 ec_flush(current_err_); 479 } 480 } 481 /* once we get rid of the array: */ 482 /* hg_free_size(nst, sizeof(stream_desc)); */ 483 } 484} 485 486static stream_id 487_copy_stream(stream_id nst) /* nst != NULL */ 488{ 489 ++nst->nref; 490 return nst; 491} 492 493static void 494_mark_stream(stream_id nst) /* nst != NULL */ 495{ 496 if ((IsOpened(nst) || StreamNref(nst) > 0)) 497 { 498 if (StreamPrompt(nst) != D_UNKNOWN) /* == SocketUnix */ 499 Mark_Did(StreamPrompt(nst)); 500 if (StreamName(nst) != D_UNKNOWN) 501 Mark_Did(StreamName(nst)); 502 if (StreamPath(nst) != D_UNKNOWN) 503 Mark_Did(StreamPath(nst)); 504 mark_dids_from_pwords(&StreamEvent(nst), &StreamEvent(nst)+1); 505 } 506} 507 508 509static int 510_tostr_stream(stream_id nst, char *buf, int quoted) /* nst != NULL */ 511{ 512#define STRSZ_STREAM 30 513 sprintf(buf, "$&(stream(%d))", (int) StreamNr(nst)); 514 return strlen(buf); 515} 516 517 518static int 519_strsz_stream(stream_id nst, int quoted) /* nst != NULL */ 520{ 521 return STRSZ_STREAM; 522} 523 524 525/* CLASS DESCRIPTOR (method table) */ 526 527t_ext_type stream_tid = { 528 (void (*)(t_ext_ptr)) _lose_stream, 529 (t_ext_ptr (*)(t_ext_ptr)) _copy_stream, 530 (void (*)(t_ext_ptr)) _mark_stream, 531 (int (*)(t_ext_ptr,int)) _strsz_stream, 532 (int (*)(t_ext_ptr,char *,int)) _tostr_stream, 533 0, /* equal */ 534 (t_ext_ptr (*)(t_ext_ptr)) _copy_stream, 535 0, /* get */ 536 0 /* set */ 537}; 538 539 540/* 541 * FUNCTION NAME: get_stream_id() 542 * 543 * PARAMETERS: v, t - value and tag of a prolog word which 544 * specifies the stream 545 * mode - whether the stream should be input or output 546 * or none (used only for the 'user' stream) 547 * 548 * DESCRIPTION: 549 * An auxiliary function. 550 * if (v, t) is a number which is in the range [0, NbStreams], it returns the 551 * corresponding stream_id, 552 * else if it is an atom which denotes a stream, i.e. whose stream property 553 * is defined, it returns the corresponding stream_id. 554 * In all other cases, it returns a (negative) prolog error code. 555 * If the specified stream is 'user', it returns either input, output, or 556 * INCORRECT_USER. 557 */ 558stream_id 559get_stream_id(value v, type t, int mode, int *err) 560{ 561 pword *stream_prop; 562 stream_id nst; 563 564 if (IsRef(t)) 565 { 566 *err = INSTANTIATION_FAULT; 567 return NO_STREAM; 568 } 569 switch(TagType(t)) 570 { 571 case TNIL: 572 v.did = d_.nil; 573 /* fall through */ 574 case TDICT: 575 if ((stream_prop = GetStreamProperty(v.did)) == (pword *) NULL) 576 { 577 if (v.did == d_.user) 578 { 579 if (mode == SREAD) 580 nst = (stream_id) GetStreamProperty(d_.stdin0)->val.wptr; 581 else if (mode == SWRITE) 582 nst = (stream_id) GetStreamProperty(d_.stdout0)->val.wptr; 583 else 584 { 585 *err = INCORRECT_USER; 586 return NO_STREAM; 587 } 588 } 589 else 590 { 591 *err = STREAM_SPEC; 592 return NO_STREAM; 593 } 594 } 595 else 596 nst = (stream_id) stream_prop->val.wptr; 597 break; 598 599 case TINT: 600 /* backward compatibility: allow number iff it was obtained previously */ 601 if (v.nint < 0 || v.nint >= NbStreams 602 || !(StreamMode(StreamId(v.nint)) & SNUMBERUSED)) 603 { 604 *err = STREAM_SPEC; 605 return NO_STREAM; 606 } 607 nst = StreamId(v.nint); 608 break; 609 610 case THANDLE: 611 { 612 int res; 613 pword hstream; 614 hstream.val.all = v.all; 615 hstream.tag.all = t.all; 616 res = ec_get_handle(hstream, &stream_tid, (t_ext_ptr*) &nst); 617 if (res != PSUCCEED) { 618 *err = res==STALE_HANDLE ? STREAM_SPEC : res; 619 return NO_STREAM; 620 } 621 break; 622 } 623 624 default: 625 *err = TYPE_ERROR; 626 return NO_STREAM; 627 } 628 629 if (IsSocket(nst)) { 630 if (IsInvalidSocket(nst)) { 631 *err = STREAM_SPEC; 632 return NO_STREAM; 633 } 634 else if (mode & SREAD) 635 return SocketInputStream(nst); 636 } 637 return nst; 638} 639 640 641int Winapi 642ec_get_stream(const pword pw, stream_id* nst) 643{ 644 int err; 645 if ((*nst = get_stream_id(pw.val, pw.tag, 0, &err)) == NO_STREAM) 646 return err; 647 return PSUCCEED; 648} 649 650 651/* 652 * next_open_stream(+Stream, -Stream) 653 * Auxiliary for enumerating streams, should start with stdin> 654 * 655 */ 656static int 657p_next_open_stream(value v1, type t1, value v2, type t2) 658{ 659 int err, i; 660 pword hstream; 661 stream_id nst = get_stream_id(v1, t1, 0, &err); 662 if (nst == NO_STREAM) { Bip_Error(err); } 663 i = StreamNr(nst); 664 do { 665 if (++i >= NbStreams) { Fail_; } 666 nst = StreamId(i); 667 } while (!IsOpened(nst) || IsInvalidSocket(nst)); 668 hstream = StreamHandle(nst); 669 Return_Unify_Pw(v2, t2, hstream.val, hstream.tag); 670} 671 672 673static int 674p_set_stream(value ov, type ot, value nv, type nt) 675{ 676 stream_id nst; 677 int err; 678 679 Check_Atom_Or_Nil(ov, ot); /* must not be an integer */ 680 nst = get_stream_id(nv, nt, 0, &err); 681 if (nst == NO_STREAM) 682 { 683 if (!IsRef(nt) && IsAtom(nt) && nv.did == d_.user) 684 { 685 if (ov.did == d_.input) 686 { 687 nst = (stream_id) GetStreamProperty(d_.stdin0)->val.wptr; 688 } 689 else if ( 690 ov.did == d_.output || 691 ov.did == d_.warning_output || 692 ov.did == d_.log_output || 693 ov.did == d_.err) 694 { 695 nst = (stream_id) GetStreamProperty(d_.stdout0)->val.wptr; 696 } 697 else 698 { 699 Bip_Error(INCORRECT_USER); 700 } 701 } 702 else 703 { 704 Bip_Error(err); 705 } 706 } 707 return set_stream(ov.did, nst); 708} 709 710 711static int 712p_get_stream(value vi, type ti, value vs, type ts) 713{ 714 stream_id nst; 715 stream_id onst; 716 int res; 717 718 nst = get_stream_id(vi, ti, 0, &res); 719 if (nst == NO_STREAM) 720 { 721 Bip_Error(res); 722 } 723 if (!IsOpened(nst)) 724 { 725 Bip_Error(STREAM_SPEC); 726 } 727 if (IsRef(ts)) 728 { 729 pword hstream; 730 if (IsHandle(ti)) { 731 hstream.val.all = vi.all; /* reuse old anchor */ 732 hstream.tag.all = ti.all; 733 } else { 734 hstream = StreamHandle(nst); 735 } 736 Return_Unify_Pw(vs, ts, hstream.val, hstream.tag); 737 } 738 if ((onst = get_stream_id(vs, ts, 0, &res)) != NO_STREAM) 739 { 740 Succeed_If(nst == onst); 741 } 742 if (IsAtom(ts) && vs.did == d_.user) 743 { 744 if ((StreamMode(nst) & (SREAD | SWRITE)) == SREAD) 745 { 746 Succeed_If(nst == (stream_id) GetStreamProperty(d_.stdin0)->val.wptr); 747 } 748 else if ((StreamMode(nst) & (SREAD | SWRITE)) == SWRITE) 749 { 750 Succeed_If(nst == (stream_id) GetStreamProperty(d_.stdout0)->val.wptr); 751 } 752 else 753 { 754 Bip_Error(INCORRECT_USER); 755 } 756 } 757 Bip_Error(res); 758} 759 760int Winapi 761ec_stream_nr(const char *name) 762{ 763 stream_id nst; 764 int res; 765 value v; 766 v.did = enter_dict((char*) name, 0); 767 nst = get_stream_id(v, tdict, 0, &res); 768 if (nst == NO_STREAM || !IsOpened(nst)) 769 return -1; 770 StreamMode(nst) |= SNUMBERUSED; 771 return StreamNr(nst); /*DEPRECATE*/ 772} 773 774stream_id Winapi 775ec_stream_id(int nr) 776{ 777 return StreamId(nr); /*DEPRECATE*/ 778} 779 780 781/* 782 p_get_char() get_char/2 (standard) 783 Same as get, but the character is taken as a one element 784 string 785*/ 786static int 787p_get_char(value vs, type ts, value val, type tag) 788{ 789 int res; 790 stream_id nst = get_stream_id(vs, ts, SREAD, &res); 791 char *c; 792 793 Check_Output_String(tag); 794 if(IsString(tag) && (*(StringStart(val)) == 0 || *(StringStart(val) + 1) != 0)) 795 { 796 Bip_Error(TYPE_ERROR) 797 } 798 if (nst == NO_STREAM) { 799 Bip_Error(res) 800 } 801 if (!IsTextStream(nst)) { 802 Bip_Error(STREAM_MODE) 803 } 804 Lock_Stream(nst); 805 if (StreamMode(nst) & REPROMPT_ONLY) 806 StreamMode(nst) |= DONT_PROMPT; 807 /* ec_getch checks for mode errors */ 808 if ((res = ec_getch(nst)) < 0) { 809 Unlock_Stream(nst); 810 Bip_Error(res) 811 } 812 Unlock_Stream(nst); 813 { 814 value v; 815 Make_Stack_String(1, v, c) 816 c[0] = res; 817 c[1] = 0; 818 Return_Unify_String(val, tag, v.ptr); 819 } 820} 821 822 823/* 824 p_put_char() put_char/2 (standard) 825*/ 826static int 827p_put_char(value vs, type ts, value val, type tag) 828{ 829 int res, len; 830 char *s; 831 stream_id nst = get_stream_id(vs, ts, SWRITE, &res); 832 833 if(nst == NO_STREAM) { 834 Bip_Error(res) 835 } 836 837 if (IsAtom(tag)) { 838 len = DidLength(val.did); 839 s = DidName(val.did); 840 } else if (IsString(tag)) { 841 len = StringLength(val); 842 s = StringStart(val); 843 } else if (IsRef(tag)) { 844 Bip_Error(INSTANTIATION_FAULT) 845 } else { 846 Bip_Error(TYPE_ERROR) 847 } 848 if (len != 1) { 849 Bip_Error(TYPE_ERROR) 850 } 851 if (!IsTextStream(nst)) { 852 Bip_Error(STREAM_MODE) 853 } 854 Lock_Stream(nst); 855 if((res = ec_outfc(nst, *s)) < 0) { 856 Unlock_Stream(nst); 857 Bip_Error(res) 858 } 859 Unlock_Stream(nst); 860 Succeed_; 861} 862 863/* p_nl() nl/1 outputs a newline on the given stream. 864 * 865 */ 866static int 867p_nl(value vs, type ts) 868{ 869 int res; 870 stream_id nst = get_stream_id(vs,ts, SWRITE, &res); 871 872 if(nst == NO_STREAM) { 873 Bip_Error(res) 874 } 875 876 Lock_Stream(nst); 877 res = ec_newline(nst); 878 Unlock_Stream(nst); 879 return res; 880} 881 882 883/* 884 * p_open() open(+Spec, +Mode, ?Stream) 885 * 886 * +Spec: 887 * - File name as atom or string 888 * - string(?InitString) for string streams 889 * - queue(?InitString) for queue streams 890 * - fd(+FileDesc) to open (a duplicate of) an existing UNIX fd 891 * +Mode: 892 * atom read, write, append, update 893 * 894 * ?Stream: 895 * a variable which will be bound to a stream number or an atom 896 * which specifies the symbolic name of the stream. 897 * 898 * Obsolete forms still supported: 899 * 900 * open(?InitString, string, S) 901 * open(?InitString, string(+Size), S) 902 * open(_, queue, S) 903 * open(event, queue, S) 904 * open(dup(FD), M, S) is the same as open(fd(FD), M, S) 905 */ 906 907#define SFD SPIPE 908 909static int 910p_open(value vfile, type tfile, value vmode, type tmode, value vstr, type tstr) 911{ 912 char *namefile; 913 dident d_event = D_UNKNOWN; 914 pword *init_string = 0; 915 pword init_string_pw; 916 short mode; 917 int kind = SFILE; 918 stream_id nst; 919 int res; 920 int size = 1024; 921 int fd = NO_UNIT; 922 Prepare_Requests; 923 924 Check_Output_Atom_Or_Nil(vstr, tstr); 925 Error_If_Ref(tmode); 926 if (IsAtom(tmode)) 927 { 928 if(vmode.did == d_.read) 929 mode = SREAD; 930 else if (vmode.did == d_.write) 931 mode = SWRITE; 932 else if (vmode.did == d_.update) 933 mode = SRDWR; 934 else if (vmode.did == d_.append) 935 mode = SAPPEND|SWRITE; 936 else if (vmode.did == d_queue) /* obsolete */ 937 { 938 kind = SQUEUE; 939 mode = SRDWR; 940 if (IsRef(tfile)) 941 d_event = D_UNKNOWN; 942 else if (IsAtom(tfile)) 943 d_event = vfile.did; 944 else 945 { Bip_Error(TYPE_ERROR); } 946 } 947 else if (vmode.did == d_.string0) /* obsolete */ 948 { 949 kind = SSTRING; 950 mode = SRDWR|MREAD; 951 Check_Output_String(tfile); 952 init_string_pw.tag.all = tfile.all; 953 init_string_pw.val.all = vfile.all; 954 init_string = &init_string_pw; 955 } 956 else 957 { 958 Bip_Error(STREAM_MODE) 959 } 960 } 961 else if (IsStructure(tmode) && vmode.ptr->val.did == d_.string) /* obsolete */ 962 { 963 if (!IsRef(vmode.ptr[1].tag) && IsInteger(vmode.ptr[1].tag)) 964 size = vmode.ptr[1].val.nint; 965 else 966 { 967 Bip_Error(TYPE_ERROR); 968 } 969 if (size <= 0) 970 { 971 Bip_Error(RANGE_ERROR); 972 } 973 if (!IsRef(tfile)) /* size specified for a given string */ 974 { 975 Bip_Error(TYPE_ERROR); 976 } 977 kind = SSTRING; 978 mode = SRDWR|MREAD; 979 } 980 else 981 { 982 Bip_Error(TYPE_ERROR) 983 } 984 if (kind == SFILE) 985 { 986 /* New interpretation of 1st argument: 987 * Filename atom or string 988 * string(InitStr) 989 * queue(InitStr) 990 * fd(Integer) 991 */ 992 if (IsRef(tfile)) 993 { 994 Bip_Error(INSTANTIATION_FAULT); 995 } 996 else if (IsStructure(tfile)) 997 { 998 if (vfile.ptr->val.did == d_.string) 999 { 1000 /* the stream is always MREAD to mark that 1001 * the contents of the buffer is always significant 1002 */ 1003 kind = SSTRING; 1004 mode |= MREAD; 1005 init_string = vfile.ptr + 1; 1006 Dereference_(init_string); 1007 Check_String(init_string->tag); 1008 } 1009 else if (vfile.ptr->val.did == d_queue1) 1010 { 1011 kind = SQUEUE; 1012 init_string = vfile.ptr + 1; 1013 Dereference_(init_string); 1014 Check_String(init_string->tag); 1015 } 1016 else if (vfile.ptr->val.did == d_fd1 || vfile.ptr->val.did == d_dup1) 1017 { 1018 pword *pw = vfile.ptr + 1; 1019 Dereference_(pw); 1020 Check_Integer(pw->tag); 1021 fd = dup((int) pw->val.nint); 1022 if (fd == -1) 1023 { 1024 Set_Errno 1025 Bip_Error(SYS_ERROR) 1026 } 1027 kind = SFD; /* preliminary */ 1028 } 1029 else { Bip_Error(RANGE_ERROR); } 1030 } 1031 else if (!IsString(tfile) && !IsAtom(tfile)) 1032 { 1033 Bip_Error(TYPE_ERROR); 1034 } 1035 } 1036 1037 /* At this point: kind, mode, size are set. 1038 * init_string is NULL or checked for Output_String. 1039 */ 1040 if (init_string && IsString(init_string->tag) && 1041 size < StringLength(init_string->val)) 1042 { 1043 size = StringLength(init_string->val); 1044 } 1045 1046 if (kind == SSTRING || kind == SQUEUE) 1047 { 1048 nst = find_free_stream(); 1049 init_stream(nst, NO_UNIT, mode|kind, 1050 kind == SSTRING? d_.string0: d_queue, 1051 NO_PROMPT, NO_STREAM, size); 1052 } 1053 else if (kind == SFD) /* connect to an existing fd */ 1054 { 1055 struct_stat fs; 1056 1057 if (fstat(fd, &fs)) 1058 { 1059 Set_Errno 1060 Bip_Error(SYS_ERROR) 1061 } 1062 if (isatty(fd)) 1063 kind = STTY; 1064#ifndef _WIN32 1065 else if (S_ISSOCK(fs.st_mode) || S_ISFIFO(fs.st_mode)) 1066#else 1067 else if (S_ISFIFO(fs.st_mode)) 1068#endif 1069 kind = SPIPE; 1070 else 1071 kind = SFILE; 1072 1073 nst = find_free_stream(); 1074 init_stream(nst, fd, mode|kind, d_fd, NO_PROMPT, NO_STREAM, 0); 1075 } 1076 else /* open by name */ 1077 { 1078 Get_Name(vfile, tfile, namefile); 1079 nst = ec_open_file(namefile, mode, &res); 1080 if (nst == NO_STREAM) 1081 { 1082 Bip_Error(res); 1083 } 1084 } 1085 1086 if (init_string) /* init buffer if needed */ 1087 { 1088 if (IsRef(init_string->tag)) /* obsolete */ 1089 { 1090 Request_Unify_String(init_string->val, init_string->tag, empty_string); 1091 } 1092 else if (StringLength(init_string->val) > 0) 1093 { 1094 StreamLastWritten(nst) = StringStart(init_string->val)[StringLength(init_string->val)-1]; 1095 StreamMethods(nst).outf(nst, StringStart(init_string->val), StringLength(init_string->val)); 1096 if (IsStringStream(nst)) 1097 { 1098 if (!(mode & SAPPEND)) 1099 StreamMethods(nst).seek(nst, 0, LSEEK_SET); 1100 } 1101 } 1102 } 1103 if (d_event == D_UNKNOWN || d_event == d_.nil) { 1104 Make_Nil(&StreamEvent(nst)); 1105 } else { 1106 Make_Atom(&StreamEvent(nst), d_event); 1107 } 1108 1109 if (StreamNref(nst) != 0) 1110 { 1111 ec_panic("New stream has refs", "p_open()"); 1112 } 1113 if (IsRef(tstr)) 1114 { 1115 pword hstream = ec_handle(&stream_tid, (t_ext_ptr) nst); 1116 ++StreamNref(nst); 1117 Request_Unify_Pw(vstr, tstr, hstream.val, hstream.tag); 1118 } 1119 else if ((res = set_stream(vstr.did, nst)) < 0) 1120 { 1121 (void) ec_close_stream(nst, 0); 1122 Bip_Error(res); 1123 } 1124 Return_Unify; 1125} 1126 1127 1128/* p_close() close/1 1129 * one argument: a stream id 1130 * return an error code if something is wrong. Never fails. 1131 * Note: "user" cannot be closed. 1132 */ 1133 1134static int 1135p_close2(value v, type t, value vopt, type topt) 1136{ 1137 stream_id nst; 1138 int res; 1139 int close_options = 0; 1140 1141 /* process the options list */ 1142 while (IsList(topt)) 1143 { 1144 pword *car = vopt.ptr; 1145 pword *cdr = car + 1; 1146 1147 Dereference_(car); 1148 Error_If_Ref(car->tag); 1149 if (!IsStructure(car->tag)) { 1150 Bip_Error(RANGE_ERROR); /* not TYPE_ERROR (ISO) */ 1151 } 1152 car = car->val.ptr; 1153 if (car->val.did == d_force1) { 1154 Check_Atom(car[1].tag); 1155 if (car[1].val.did == d_.true0) close_options |= CLOSE_FORCE; 1156 else if (car[1].val.did == d_false) close_options &= ~CLOSE_FORCE; 1157 else { Bip_Error(RANGE_ERROR); } 1158 } else { 1159 Bip_Error(RANGE_ERROR); 1160 } 1161 Dereference_(cdr); 1162 topt = cdr->tag; 1163 vopt = cdr->val; 1164 } 1165 Check_Nil(topt); 1166 1167 Error_If_Ref(t); 1168 1169 nst = get_stream_id(v,t, 0, &res); 1170 if (nst == NO_STREAM) 1171 { 1172 switch (res) { 1173 case STREAM_SPEC: 1174 case STALE_HANDLE: 1175 if (close_options&CLOSE_FORCE) { Succeed_; } 1176 /* fall through */ 1177 default: 1178 Bip_Error(res); 1179 } 1180 } 1181 1182 if (SystemStream(nst) || (StreamMode(nst) & SSYSTEM)) 1183 { 1184 /* It is (or is pointing to) one of the predefined streams. 1185 * Let the close_handler take care of the details. 1186 */ 1187 Bip_Error(SYSTEM_STREAM); 1188 } 1189 1190 /* close the stream, reporting errors only if necessary */ 1191 Lock_Stream(nst); 1192 res = ec_close_stream(nst, close_options); 1193 Unlock_Stream(nst); 1194 if ((res < 0) && !(close_options & CLOSE_FORCE) && 1195 !(res==STREAM_SPEC && (IsAtom(t)||IsNil(t)))) 1196 { 1197 Bip_Error(res) 1198 } 1199 1200 /* free handle or property */ 1201 if (IsNil(t)) 1202 v.did = d_.nil; 1203 if ((IsAtom(t) || IsNil(t)) && !IsOpened(nst)) 1204 { 1205 (void) erase_property(v.did, STREAM_PROP); 1206 stream_tid.free((t_ext_ptr) nst); 1207 } 1208 else if (IsHandle(t)) 1209 { 1210 pword hstream; 1211 hstream.val.all = v.all; 1212 hstream.tag.all = t.all; 1213 res = ec_free_handle(hstream, &stream_tid); 1214 return (close_options & CLOSE_FORCE) ? PSUCCEED : res; 1215 } 1216 Succeed_; 1217} 1218 1219 1220static int 1221p_close(value v, type t) 1222{ 1223 pword nil; 1224 Make_Nil(&nil); 1225 return p_close2(v, t, nil.val, nil.tag); 1226} 1227 1228 1229static int 1230p_erase_stream_property(value v, type t) 1231{ 1232 int res; 1233 stream_id nst; 1234 1235 Check_Atom_Or_Nil(v, t); 1236 if ((nst = get_stream_id(v,t, 0, &res)) != NO_STREAM) 1237 { 1238 (void) erase_property(v.did, STREAM_PROP); 1239 StreamNref(nst)--; 1240 } 1241 Succeed_; 1242} 1243 1244static int 1245p_tyi(value vs, type ts, value v, type t) 1246{ 1247 int res; 1248 stream_id nst = get_stream_id(vs,ts, SREAD, &res); 1249 1250 if (nst == NO_STREAM) { 1251 Bip_Error(res); 1252 } 1253 if( !IsRef(t) && !IsInteger(t) ) { 1254 Bip_Error(TYPE_ERROR); 1255 } 1256 Lock_Stream(nst); 1257 res = ec_tty_in(nst); 1258 Unlock_Stream(nst); 1259 if (res < 0) { 1260 Bip_Error(res) 1261 } 1262 Return_Unify_Integer(v,t,res); 1263} 1264 1265static int 1266p_tyo(value vs, type ts, value v, type t) 1267{ 1268 int res; 1269 stream_id nst = get_stream_id(vs,ts, SWRITE, &res); 1270 1271 if (nst == NO_STREAM) { 1272 Bip_Error(res); 1273 } 1274 1275 Check_Integer(t) 1276 Lock_Stream(nst); 1277 res = ec_tty_out(nst, v.nint); 1278 Unlock_Stream(nst); 1279 if (res < 0) { 1280 Bip_Error(res) 1281 } 1282 Succeed_; 1283} 1284 1285 1286static int 1287p_delete(value v, type t) 1288{ 1289 int err; 1290 char *name; 1291 char fullname[MAX_PATH_LEN]; 1292 struct_stat file_stat; 1293 1294 Get_Name(v,t,name) 1295 name = expand_filename(name, fullname, EXPAND_STANDARD); 1296 1297 if (ec_stat(name, &file_stat) < 0) 1298 { 1299 Set_Errno 1300 Bip_Error(SYS_ERROR) 1301 } 1302 if ((file_stat.st_mode & S_IFMT) == S_IFDIR) /* it's a directory */ 1303 err = ec_rmdir(name); 1304 else 1305 err = ec_unlink(name); 1306 if (err < 0) 1307 { 1308 Set_Errno 1309 Bip_Error(SYS_ERROR) 1310 } 1311 Succeed_; 1312} 1313 1314static int 1315p_mkdir(value v, type t) 1316{ 1317 char *name; 1318 char fullname[MAX_PATH_LEN]; 1319 1320 Get_Name(v,t,name) 1321 name = expand_filename(name, fullname, EXPAND_STANDARD); 1322 1323 if (ec_mkdir(name, 0777) < 0) 1324 { 1325 Set_Errno 1326 Bip_Error(SYS_ERROR) 1327 } 1328 Succeed_; 1329} 1330 1331#ifdef HAVE_RENAME 1332 1333static int 1334p_rename(value vo, type to, value vd, type td) 1335{ 1336 char *old, *new; 1337 char fullold[MAX_PATH_LEN]; 1338 char fullnew[MAX_PATH_LEN]; 1339 Get_Name(vo,to,old) 1340 Get_Name(vd,td,new) 1341 old = expand_filename(old, fullold, EXPAND_STANDARD); 1342 new = expand_filename(new, fullnew, EXPAND_STANDARD); 1343 if (ec_rename(old, new) < 0) { 1344 Set_Errno 1345 Bip_Error(SYS_ERROR) 1346 } 1347 Succeed_; 1348} 1349 1350#else /*rename*/ 1351 1352static int 1353p_rename(value vo, type to, value vd, type td) 1354{ 1355 char *nameo; 1356 char *named; 1357 char buf[2*MAX_PATH_LEN + 5]; 1358 1359 Get_Name(vo,to,nameo) 1360 Get_Name(vd,td,named) 1361 (void) strcpy(buf, "mv "); 1362 (void) expand_filename(nameo, &buf[3], EXPAND_STANDARD); 1363 (void) strcat(buf, " "); 1364 (void) expand_filename(named, &buf[strlen(buf)], EXPAND_STANDARD); 1365#ifdef NO_SYSTEM_RETURN 1366 (void) system(buf); 1367#else 1368 if(system(buf) < 0) { 1369 Set_Errno 1370 Bip_Error(SYS_ERROR) 1371 } 1372#endif /* no system return code check */ 1373 Succeed_; 1374} 1375 1376#endif 1377 1378/* 1379 * get_prompt(InputStream, Prompt, OutputStream) 1380 */ 1381static int 1382p_get_prompt(value iv, type it, value pv, type pt, value ov, type ot) 1383{ 1384 stream_id nst; 1385 stream_id onst; 1386 stream_id ps; 1387 int res; 1388 dident pr; 1389 Prepare_Requests; 1390 1391 nst = get_stream_id(iv, it, SREAD, &res); 1392 if (nst == NO_STREAM) 1393 { 1394 Bip_Error(res); 1395 } 1396 if(!(IsReadStream(nst))) 1397 { 1398 Bip_Error(STREAM_MODE) 1399 } 1400 pr = StreamPrompt(nst); 1401 if (pr == NO_PROMPT) 1402 pr = in_dict("",0); 1403 ps = StreamPromptStream(nst); 1404 if (ps == NO_STREAM) 1405 ps = null_; 1406 1407 if (IsRef(pt) || IsString(pt)) { 1408 Request_Unify_String(pv, pt, DidString(pr)); 1409 } 1410 else if (IsAtom(pt) || IsNil(pt)) { 1411 Request_Unify_Atom(pv, pt, pr); 1412 } 1413 else { 1414 Bip_Error(TYPE_ERROR); 1415 } 1416 if (IsRef(ot)) 1417 { 1418 pword hstream = StreamHandle(ps); 1419 Return_Unify_Pw(ov, ot, hstream.val, hstream.tag); 1420 } 1421 else if ((onst = get_stream_id(ov, ot, SWRITE, &res)) == NO_STREAM) 1422 { /* stream checking */ 1423 Bip_Error(res); 1424 } 1425 else if (onst != ps) 1426 { 1427 Fail_; 1428 } 1429 Return_Unify; 1430} 1431 1432#define Get_String_Did(v,t,d) \ 1433 if (IsRef(t)) { Bip_Error(INSTANTIATION_FAULT) } \ 1434 if (IsAtom(t)) { \ 1435 d = v.did; \ 1436 } else if (IsString(t)) { \ 1437 d = enter_dict_n(StringStart(v), StringLength(v), 0); \ 1438 } else if IsNil(t) { \ 1439 d = d_.nil; \ 1440 } else { Bip_Error(TYPE_ERROR) } 1441 1442 1443/* 1444 * set_prompt(InputStream, Prompt, OutputStream) 1445 */ 1446static int 1447p_set_prompt(value iv, type it, value pv, type pt, value ov, type ot) 1448{ 1449 stream_id nst; 1450 stream_id onst; 1451 int res; 1452 dident d; 1453 1454 if ((nst = get_stream_id(iv, it, SREAD, &res)) == NO_STREAM) 1455 { 1456 Bip_Error(res); 1457 } 1458 if(!(IsReadStream(nst))) 1459 { 1460 Bip_Error(STREAM_MODE) 1461 } 1462 if ((onst = get_stream_id(ov, ot, SWRITE, &res)) == NO_STREAM) 1463 { 1464 Bip_Error(res); 1465 } 1466 if (!(IsWriteStream(onst))) 1467 { 1468 Bip_Error(STREAM_MODE) 1469 } 1470 if (IsStructure(pt) && pv.ptr->val.did == d_reprompt1) 1471 { 1472 pt.all = pv.ptr[1].tag.all; 1473 pv.all = pv.ptr[1].val.all; 1474 StreamMode(nst) |= REPROMPT_ONLY; 1475 } 1476 else 1477 { 1478 StreamMode(nst) &= ~REPROMPT_ONLY; 1479 } 1480 Get_String_Did(pv, pt, d); 1481 StreamPrompt(nst) = d; 1482 if (StreamPromptStream(nst) != NO_STREAM) 1483 _lose_stream(StreamPromptStream(nst)); 1484 StreamPromptStream(nst) = (onst == null_) ? NO_STREAM : 1485 _copy_stream(onst); 1486 Succeed_; 1487} 1488 1489 1490/* 1491 * Succeed if the given stream is open. System-use only. 1492 */ 1493static int 1494p_is_open_stream(value vc, type tc) 1495{ 1496 int res; 1497 stream_id nst; 1498 1499 nst = get_stream_id(vc,tc, 0, &res); 1500 if (nst == NO_STREAM) { 1501 Fail_; 1502 } 1503 else if (!(IsOpened(nst))) { 1504 Fail_; 1505 } 1506 Succeed_; 1507} 1508 1509 1510/* 1511 * stream_info_(Stream, Info, Value) 1512 * Stream must be instantiated to an open stream, 1513 * does not backtrack, system-use only 1514 */ 1515static int 1516p_stream_info_(value vs, type ts, value vi, type ti, value v, type t) 1517{ 1518 int res; 1519 stream_id nst = get_stream_id(vs, ts, 0, &res); 1520 pword result; 1521 1522 Check_Integer(ti); 1523 if (nst == NO_STREAM) { 1524 Bip_Error(res) 1525 } 1526 1527 switch(vi.nint) 1528 { 1529 case 0: /* name */ 1530 if (IsStringStream(nst) || IsQueueStream(nst)) 1531 { 1532 char *buf; 1533 int inbuf = StreamMethods(nst).size(nst); 1534 Make_Stack_String(inbuf, result.val, buf); 1535 if (StreamMethods(nst).content(nst, buf) != inbuf) 1536 { 1537 p_fprintf(current_err_, "queue_avail/read inconsistency\n"); 1538 ec_flush(current_err_); 1539 } 1540 buf[inbuf] = '\0'; 1541 result.tag.kernel = TSTRG; 1542 } 1543 else 1544 { 1545 if ((result.val.did = StreamName(nst)) == d_.nil) 1546 result.tag.kernel = TNIL; 1547 else 1548 result.tag.kernel = TDICT; 1549 } 1550 break; 1551 case 1: /* prompt */ 1552 if (IsReadStream(nst) && StreamPromptStream(nst) != NO_STREAM) 1553 { 1554 dident pr = StreamPrompt(nst); 1555 if (pr == NO_PROMPT) 1556 pr = in_dict("",0); 1557 result.val.ptr = DidString(pr); 1558 result.tag.kernel = TSTRG; 1559 } 1560 else { Fail_; } 1561 break; 1562 case 2: /* old style mode, not very clean, for backward compatibility */ 1563 if (IsStringStream(nst)) 1564 result.val.did = d_.string0; 1565 else if (IsQueueStream(nst)) 1566 result.val.did = d_queue; 1567 else if (IsSocket(nst)) 1568 result.val.did = d_socket; 1569 else 1570 result.val.did = modes[StreamMode(nst) & SMODEBITS]; 1571 result.tag.kernel = TDICT; 1572 break; 1573 case 3: /* aliases */ 1574 result.val.nint = StreamNref(nst); 1575 result.tag.kernel = TINT; 1576 break; 1577 case 4: /* physical_stream - deprecated */ 1578 StreamMode(nst) |= SNUMBERUSED; 1579 result.val.nint = StreamNr(nst); 1580 result.tag.kernel = TINT; 1581 break; 1582 case 5: /* line */ 1583 if (IsSocket(nst)) 1584 nst = SocketInputStream(nst); 1585 if (IsReadStream(nst)) 1586 { 1587 result.val.nint = StreamLine(nst); 1588 result.tag.kernel = TINT; 1589 } 1590 else { Fail_; } 1591 break; 1592 case 6: /* offset */ 1593 { 1594 long offset; 1595 res = ec_stream_at(nst, &offset); 1596 if (res != PSUCCEED) 1597 { Bip_Error(res); } 1598 result.val.nint = offset; 1599 result.tag.kernel = TINT; 1600 break; 1601 } 1602 case 7: /* system_use */ 1603 if (SystemStream(nst)) 1604 result.val.did = d_.on; 1605 else 1606 result.val.did = d_.off; 1607 result.tag.kernel = TDICT; 1608 break; 1609 case 8: /* prompt_stream */ 1610 if (!IsReadStream(nst) || StreamPromptStream(nst) == NO_STREAM) 1611 { Fail_; } 1612 result = StreamHandle(StreamPromptStream(nst)); 1613 break; 1614 case 9: /* fd */ 1615 if (StreamUnit(nst) == NO_UNIT) 1616 { Fail_; } 1617 result.tag.kernel = TINT; 1618 result.val.nint = StreamUnit(nst); 1619 break; 1620#ifdef SOCKETS 1621 case 10: /* socket port */ 1622 if (IsSocket(nst) && !SocketUnix(nst)) 1623 { 1624 struct sockaddr_in name; 1625 int length = sizeof(name); 1626 1627 memset(&name, 0, length); 1628 1629 if (getsockname(StreamUnit(nst), (struct sockaddr *) &name, &length) < 0) { 1630 Set_Errno; 1631 Bip_Error(SYS_ERROR); 1632 } 1633 result.tag.kernel = TINT; 1634 result.val.nint = ntohs(name.sin_port); 1635 } 1636 else { Fail_; } 1637 break; 1638 case 11: /* connection */ 1639 if (IsSocket(nst) && SocketConnection(nst)) 1640 { 1641 result.tag.kernel = TDICT; 1642 result.val.did = (dident) SocketConnection(nst); 1643 } 1644 else { Fail_; } 1645 break; 1646#endif 1647 case 12: /* reprompt_only */ 1648 if (IsReadStream(nst) && StreamPromptStream(nst) != NO_STREAM) 1649 { 1650 if (StreamMode(nst) & REPROMPT_ONLY) 1651 result.val.did = d_.on; 1652 else 1653 result.val.did = d_.off; 1654 result.tag.kernel = TDICT; 1655 } 1656 else { Fail_; } 1657 break; 1658 1659 case 13: /* device */ 1660 Make_Atom(&result, stream_types[StreamType(nst)>>STYPE_SHIFT]); 1661 break; 1662 1663 case 14: /* smallest offset in the buffer - system only */ 1664 if (IsSocket(nst)) 1665 nst = SocketInputStream(nst); 1666 if (IsTty(nst) && !(StreamMode(nst) & MREAD)) { 1667 Fail_ 1668 } 1669 result.tag.kernel = TINT; 1670 result.val.nint = StreamOffset(nst); 1671 break; 1672 1673 case 15: /* mode */ 1674 Make_Atom(&result, modes[StreamMode(nst) & SMODEBITS]); 1675 break; 1676 1677 case 16: /* buffer size - system only */ 1678 result.tag.kernel = TINT; 1679 result.val.nint = StreamSize(nst); 1680 break; 1681 1682 case 17: /* event name, if any */ 1683 if (IsNil(StreamEvent(nst).tag)) { 1684 Fail_; 1685 } else if (IsTag(StreamEvent(nst).tag.kernel, TPTR)) { 1686 result = ec_handle(&heap_event_tid, 1687 (t_ext_ptr) heap_event_tid.copy(StreamEvent(nst).val.wptr)); 1688 } else { 1689 result = StreamEvent(nst); 1690 } 1691 break; 1692 1693 case 18: /* get flush mode */ 1694 if (!IsWriteStream(nst)) 1695 { Fail_; } 1696 if (StreamMode(nst) & SFLUSHEOL) { 1697 Make_Atom(&result, d_end_of_line) 1698 } else { 1699 Make_Atom(&result, d_.flush) 1700 } 1701 break; 1702 1703 case 19: /* get yield */ 1704 if (!IsQueueStream(nst)) 1705 { Fail_; } 1706 result.val.did = StreamMode(nst) & SYIELD ? d_.on : d_.off; 1707 result.tag.kernel = TDICT; 1708 break; 1709 1710 case 20: /* get end_of_line mode */ 1711 if (IsWriteStream(nst)) { 1712 if (StreamMode(nst) & SEOLCR) { 1713 Make_Atom(&result, d_crlf) 1714 } else { 1715 Make_Atom(&result, d_lf) 1716 } 1717 } else { 1718 Fail_; 1719 } 1720 break; 1721 1722 case 21: /* get scramble mode */ 1723 if (!(StreamMode(nst) & SSCRAMBLE)) 1724 { Fail_; } 1725 Make_Atom(&result, d_.on); 1726 break; 1727 1728 case 22: /* get sigio flag */ 1729 if (!ec_is_sigio_stream(nst, SREAD)) 1730 { Fail_; } 1731 Make_Atom(&result, d_.on); 1732 break; 1733 1734 case 23: /* `usable' */ 1735 if (g_emu_.nesting_level > 1 && IsQueueStream(nst) && (StreamMode(nst) & SYIELD)) { 1736 Make_Atom(&result, d_.off); 1737 } else { 1738 Make_Atom(&result, d_.on); 1739 } 1740 break; 1741 1742 case 24: /* macro_expansion */ 1743 if (!IsReadStream(nst)) 1744 { Fail_; } 1745 result.val.did = StreamMode(nst) & SNOMACROEXP ? d_.off : d_.on; 1746 result.tag.kernel = TDICT; 1747 break; 1748 1749 case 25: /* output_options */ 1750 if (!IsWriteStream(nst)) 1751 { Fail_; } 1752 Make_Integer(&result, StreamOutputMode(nst)); 1753 break; 1754 1755 case 26: /* print_depth */ 1756 if (!IsWriteStream(nst)) 1757 { Fail_; } 1758 Make_Integer(&result, StreamPrintDepth(nst)); 1759 break; 1760 1761 case 27: /* compress */ 1762 if (!IsWriteStream(nst)) 1763 { Fail_; } 1764 result.val.did = StreamMode(nst) & SCOMPRESS ? d_.on : d_.off; 1765 result.tag.kernel = TDICT; 1766 break; 1767 1768 case 28: /* last_written */ 1769 if (!IsWriteStream(nst) || StreamLastWritten(nst) == -1) 1770 { Fail_; } 1771 Make_Integer(&result, StreamLastWritten(nst)); 1772 break; 1773 1774 case 29: /* handle */ 1775 result = StreamHandle(nst); 1776 break; 1777 1778 case 30: /* delete_file */ 1779 if (!IsFileStream(nst)) 1780 { Fail_; } 1781 result.val.did = 1782 StreamMode(nst) & SDELETELOST ? d_when_lost : 1783 StreamMode(nst) & SDELETECLOSED ? d_when_closed : d_.off; 1784 result.tag.kernel = TDICT; 1785 break; 1786 1787 case 31: /* full file path */ 1788 if ((StreamPath(nst)) == D_UNKNOWN) 1789 { Fail_; } 1790 if ((result.val.did = StreamPath(nst)) == d_.nil) 1791 result.tag.kernel = TNIL; 1792 else 1793 result.tag.kernel = TDICT; 1794 break; 1795 1796 case 32: /* reposition */ 1797 Make_Atom(&result, StreamMode(nst) & SREPOSITION ? d_.true0 : d_false); 1798 break; 1799 1800 case 33: /* encoding */ 1801 Make_Atom(&result, stream_encodings[StreamEncoding(nst)]); 1802 break; 1803 1804 case 34: /* input */ 1805 Make_Atom(&result, StreamMode(nst) & SREAD ? d_.true0 : d_false); 1806 break; 1807 1808 case 35: /* output */ 1809 Make_Atom(&result, StreamMode(nst) & SWRITE ? d_.true0 : d_false); 1810 break; 1811 1812 case 36: /* end_of_stream */ 1813 if (!IsReadStream(nst)) 1814 { Fail_; } 1815 /* Only a SoftEofStream can recover from being "past" eof */ 1816 result.val.did = 1817 ( IsSoftEofStream(nst) ? 1818 (StreamMethods(nst).at_eof(nst) == PSUCCEED ? 1819 (StreamPastEof(nst) ? d_past : d_at) 1820 : d_not) 1821 : StreamPastEof(nst) ? d_past 1822 : StreamMethods(nst).at_eof(nst) == PSUCCEED ? d_at 1823 : d_not 1824 ); 1825 result.tag.kernel = TDICT; 1826 break; 1827 1828 case 37: /* eof_action */ 1829 if (!IsReadStream(nst)) 1830 { Fail_; } 1831 result.val.did = 1832 (StreamMode(nst) & SEOF_ACTION) == SEOF_ERROR ? d_.err : 1833 (StreamMode(nst) & SEOF_ACTION) == SEOF_RESET ? d_.reset : d_eof_code; 1834 result.tag.kernel = TDICT; 1835 break; 1836 1837 default: 1838 Fail_; 1839 } 1840 Return_Unify_Pw(v, t, result.val, result.tag); 1841} 1842 1843 1844#undef Bip_Error 1845#define Bip_Error(N) Bip_Error_Fail(N) 1846 1847static int 1848p_set_stream_prop_(value vs, type ts, value vi, type ti, value v, type t) 1849{ 1850 int res; 1851 stream_id nst = get_stream_id(vs, ts, 0, &res); 1852 stream_id onst; 1853 dident d; 1854 1855 Check_Integer(ti); 1856 if (nst == NO_STREAM) { 1857 Bip_Error(res) 1858 } 1859 1860 switch(vi.nint) 1861 { 1862 case 1: /* prompt */ 1863 if (!IsReadStream(nst)) 1864 { 1865 Bip_Error(STREAM_MODE); 1866 } 1867 Get_String_Did(v, t, d); 1868 StreamPrompt(nst) = d; 1869 break; 1870 1871 case 5: /* set line */ 1872 Check_Integer(t) 1873 StreamLine(nst) = v.nint; 1874 Succeed_; 1875 1876 case 6: /* offset */ 1877 res = p_seek(vs, ts, v, t); 1878 if (res != PSUCCEED) 1879 { 1880 Bip_Error(res); 1881 } 1882 break; 1883 1884 case 8: /* prompt_stream */ 1885 if(!(IsReadStream(nst))) 1886 { 1887 Bip_Error(STREAM_MODE) 1888 } 1889 if ((onst = get_stream_id(v, t, SWRITE, &res)) == NO_STREAM) 1890 { 1891 Bip_Error(res); 1892 } 1893 if (!(IsWriteStream(onst))) 1894 { 1895 Bip_Error(STREAM_MODE) 1896 } 1897 if (StreamPromptStream(nst) != NO_STREAM) 1898 _lose_stream(StreamPromptStream(nst)); 1899 StreamPromptStream(nst) = (onst == null_) ? NO_STREAM : 1900 _copy_stream(onst); 1901 break; 1902 1903 case 12: /* reprompt_only */ 1904 Check_Atom(t); 1905 if (v.did == d_.on) { 1906 StreamMode(nst) |= REPROMPT_ONLY; 1907 } else if (v.did == d_.off) { 1908 StreamMode(nst) &= ~REPROMPT_ONLY; 1909 } else { 1910 Bip_Error(RANGE_ERROR); 1911 } 1912 break; 1913 1914 case 15: /* mode */ 1915 Check_Atom(t); 1916 if( !IsOpened(nst) || !(IsQueueStream(nst) || IsStringStream(nst))) 1917 { 1918 Bip_Error(STREAM_MODE) 1919 } 1920 if (v.did == d_.update) { 1921 StreamMode(nst) |= SRDWR; 1922 } else if (v.did == d_.read) { 1923 StreamMode(nst) = (StreamMode(nst) & ~SWRITE) | SREAD; 1924 } else if (v.did == d_.write) { 1925 StreamMode(nst) = (StreamMode(nst) & ~SREAD) | SWRITE; 1926 } else { 1927 Bip_Error(RANGE_ERROR); 1928 } 1929 if (StreamMode(nst) & SREAD && StreamLexAux(nst) == NO_BUF) 1930 { 1931 /* read streams need a lex_aux buffer */ 1932 StreamLexAux(nst) = (unsigned char *) hg_alloc(BUFSIZE); 1933 StreamLexSize(nst) = BUFSIZE; 1934 } 1935 break; 1936 1937 case 17: /* set event name */ 1938 if (!StreamCanRaiseEvent(nst)) { 1939 Bip_Error(UNIMPLEMENTED); 1940 } 1941 if (IsNil(t)) { 1942 if (IsTag(StreamEvent(nst).tag.kernel, TPTR)) { 1943 heap_event_tid.free(StreamEvent(nst).val.wptr); 1944 } 1945 Make_Nil(&StreamEvent(nst)); 1946 if (StreamCanSignal(nst)) 1947 { 1948 res = ec_stream_reset_sigio(nst, SREAD); 1949 Return_If_Error(res); 1950 } 1951 } else { 1952 if (IsAtom(t)) { 1953 Make_Atom(&StreamEvent(nst), v.did); 1954 } else { 1955 t_heap_event *event; 1956 Get_Typed_Object(v, t, &heap_event_tid, event); 1957 StreamEvent(nst).tag.kernel = TPTR; 1958 StreamEvent(nst).val.wptr = heap_event_tid.copy(event); 1959 } 1960 if (StreamCanSignal(nst)) 1961 { 1962 res = ec_stream_set_sigio(nst, SREAD); 1963 Return_If_Error(res); 1964 } 1965 } 1966 break; 1967 1968 case 18: /* set flush mode */ 1969 Check_Atom(t); 1970 if (v.did == d_end_of_line) { 1971 StreamMode(nst) |= SFLUSHEOL; 1972 } else if (v.did == d_.flush) { 1973 StreamMode(nst) &= ~SFLUSHEOL; 1974 } else { 1975 Bip_Error(RANGE_ERROR); 1976 } 1977 break; 1978 1979 case 19: /* set yield */ 1980 Check_Atom(t); 1981 if (v.did == d_.on) { 1982 StreamMode(nst) |= SYIELD; 1983 } 1984 else if (v.did == d_.off) { 1985 StreamMode(nst) &= ~SYIELD; 1986 } 1987 else { 1988 Bip_Error(RANGE_ERROR); 1989 } 1990 break; 1991 1992 case 20: /* set end_of_line mode */ 1993 Check_Atom(t); 1994 if (v.did == d_crlf) { 1995 StreamMode(nst) |= SEOLCR; 1996 } else if (v.did == d_lf) { 1997 StreamMode(nst) &= ~SEOLCR; 1998 } else { 1999 Bip_Error(RANGE_ERROR); 2000 } 2001 break; 2002 2003 case 21: /* set scramble key */ 2004 Check_Integer(t); 2005 if ((StreamType(nst) != SFILE) || IsReadWriteStream(nst)) { 2006 Bip_Error(STREAM_MODE) 2007 } 2008 /* the constant in the next line is arbitrary, just for confusion */ 2009 StreamRand(nst) = (uword) v.nint ^ 0x9bc33c86; 2010 StreamMode(nst) |= SSCRAMBLE; 2011 break; 2012 2013 case 22: /* set sigio */ 2014 Check_Atom(t); 2015 if (!StreamCanSignal(nst)) { 2016 Bip_Error(UNIMPLEMENTED); 2017 } 2018 if (v.did == d_.on) { 2019 ec_stream_set_sigio(nst, SREAD); 2020 } else if (v.did == d_.off) { 2021 ec_stream_reset_sigio(nst, SREAD); 2022 } else { 2023 Bip_Error(RANGE_ERROR); 2024 } 2025 break; 2026 2027 case 24: /* macro_expansion */ 2028 if (!IsReadStream(nst)) 2029 { 2030 Bip_Error(STREAM_MODE); 2031 } 2032 Check_Atom(t); 2033 if (v.did == d_.on) { 2034 StreamMode(nst) &= ~SNOMACROEXP; 2035 } else if (v.did == d_.off) { 2036 StreamMode(nst) |= SNOMACROEXP; 2037 } else { 2038 Bip_Error(RANGE_ERROR); 2039 } 2040 break; 2041 2042 case 25: /* output_options */ 2043 Check_Integer(t); 2044 if (!IsWriteStream(nst)) 2045 { 2046 Bip_Error(STREAM_MODE); 2047 } 2048 StreamOutputMode(nst) = (int) v.nint; 2049 break; 2050 2051 case 26: /* print_depth */ 2052 Check_Integer(t); 2053 if (!IsWriteStream(nst)) 2054 { 2055 Bip_Error(STREAM_MODE); 2056 } 2057 StreamPrintDepth(nst) = (int) v.nint; 2058 break; 2059 2060 case 27: /* compress */ 2061 if (!IsWriteStream(nst)) 2062 { 2063 Bip_Error(STREAM_MODE); 2064 } 2065 Check_Atom(t); 2066 if (v.did == d_.off) { 2067 StreamMode(nst) &= ~SCOMPRESS; 2068 } else if (v.did == d_.on) { 2069 StreamMode(nst) |= SCOMPRESS; 2070 } else { 2071 Bip_Error(RANGE_ERROR); 2072 } 2073 break; 2074 2075 case 30: /* delete_file {off|when_closed|when_lost} */ 2076 Check_Atom(t); 2077 if (v.did == d_when_lost) { 2078 StreamMode(nst) &= ~(SDELETELOST|SDELETECLOSED); 2079 StreamMode(nst) |= SDELETELOST; 2080 } 2081 else if (v.did == d_when_closed) { 2082 StreamMode(nst) &= ~(SDELETELOST|SDELETECLOSED); 2083 StreamMode(nst) |= SDELETECLOSED; 2084 } 2085 else if (v.did == d_.off) { 2086 StreamMode(nst) &= ~(SDELETELOST|SDELETECLOSED); 2087 } 2088 else { 2089 Bip_Error(RANGE_ERROR); 2090 } 2091 break; 2092 2093 case 33: /* encoding */ 2094 Check_Atom(t); 2095 { 2096 int i; 2097 for (i=0; i<SENC_NUM; ++i) { 2098 if (v.did == stream_encodings[i]) { 2099 StreamEncoding(nst) = i; 2100 Succeed_; 2101 } 2102 } 2103 } 2104 Bip_Error(RANGE_ERROR); 2105 2106 case 37: /* eof_action */ 2107 if (!IsReadStream(nst)) { 2108 Bip_Error(STREAM_MODE); 2109 } 2110 Check_Atom(t); 2111 StreamMode(nst) &= ~SEOF_ACTION; 2112 if (v.did == d_.err) { 2113 StreamMode(nst) |= SEOF_ERROR; 2114 } else if (v.did == d_.reset) { 2115 StreamMode(nst) |= SEOF_RESET; 2116 } else if (v.did == d_eof_code) { 2117 StreamMode(nst) |= SEOF_CODE; 2118 } else { 2119 Bip_Error(RANGE_ERROR); 2120 } 2121 break; 2122 2123 default: 2124 Bip_Error(RANGE_ERROR); 2125 } 2126 Succeed_; 2127} 2128 2129#undef Bip_Error 2130#define Bip_Error(N) return(N); 2131 2132 2133static int 2134p_at(value vs, type ts, value vp, type tp) 2135{ 2136 int res; 2137 stream_id nst = get_stream_id(vs,ts, 0, &res); 2138 long pos; 2139 2140 Check_Output_Integer(tp); 2141 if (nst == NO_STREAM) 2142 { 2143 if (res == INCORRECT_USER) 2144 res = STREAM_MODE; 2145 Bip_Error(res) 2146 } 2147 if (!IsOpened(nst)) 2148 { 2149 Bip_Error(STREAM_MODE); 2150 } 2151 res = ec_stream_at(nst, &pos); 2152 if (res != PSUCCEED) 2153 { 2154 Bip_Error(res); 2155 } 2156 Return_Unify_Integer(vp, tp, pos); 2157} 2158 2159 2160static int 2161p_seek(value vs, type ts, value vp, type tp) 2162{ 2163 int res; 2164 stream_id nst = get_stream_id(vs, ts, 0, &res); 2165 2166 Error_If_Ref(tp); 2167 if (nst == NO_STREAM) 2168 { 2169 Bip_Error(res) 2170 } 2171 /* no seek on scrambled files: synchronisation gets lost */ 2172 /* no seek on append files: always at eof */ 2173 else if(!IsOpened(nst) || (StreamMode(nst) & (SSCRAMBLE|SAPPEND))) 2174 { 2175 Bip_Error(STREAM_MODE); 2176 } 2177 if (IsAtom(tp) && vp.did == d_.eof) 2178 { 2179 return ec_seek_stream(nst, 0, LSEEK_END); 2180 } 2181 Check_Integer(tp); 2182 return ec_seek_stream(nst, vp.nint, LSEEK_SET); 2183} 2184 2185 2186static int 2187p_stream_truncate(value vs, type ts) 2188{ 2189 int res; 2190 stream_id nst = get_stream_id(vs, ts, 0, &res); 2191 2192 if (nst == NO_STREAM) 2193 { 2194 Bip_Error(res) 2195 } 2196 if (!IsWriteStream(nst)) 2197 { 2198 Bip_Error(STREAM_MODE); 2199 } 2200 return StreamMethods(nst).truncate(nst); 2201} 2202 2203 2204static int 2205p_get(value vs, type ts, value val, type tag) 2206{ 2207 int res; 2208 stream_id nst = get_stream_id(vs, ts, SREAD, &res); 2209 2210 Check_Output_Integer(tag); 2211 if (nst == NO_STREAM) 2212 { 2213 Bip_Error(res) 2214 } 2215 Lock_Stream(nst); 2216 if (StreamMode(nst) & REPROMPT_ONLY) 2217 StreamMode(nst) |= DONT_PROMPT; 2218 if ((res = ec_getch(nst)) < 0) 2219 { 2220 Unlock_Stream(nst); 2221 Bip_Error(res) 2222 } 2223 Unlock_Stream(nst); 2224 Return_Unify_Integer(val, tag, res); 2225} 2226 2227static int 2228p_unget(value vs, type ts) 2229{ 2230 int res; 2231 stream_id nst = get_stream_id(vs, ts, SREAD, &res); 2232 2233 if (nst == NO_STREAM) 2234 { 2235 Bip_Error(res) 2236 } 2237 Lock_Stream(nst); 2238 res = ec_ungetch(nst); 2239 Unlock_Stream(nst); 2240 return res; 2241} 2242 2243static int 2244p_getw(value vs, type ts, value val, type tag) 2245{ 2246 int res; 2247 register char *p; 2248 word l; 2249 word w; 2250 char *pw; 2251 int i; 2252 stream_id nst = get_stream_id(vs, ts, SREAD, &res); 2253 2254 Check_Output_Integer(tag); 2255 if (nst == NO_STREAM) 2256 { 2257 Bip_Error(res) 2258 } 2259 Lock_Stream(nst); 2260 p = ec_getstring(nst, sizeof(word), &l); 2261 Unlock_Stream(nst); 2262 if (p == 0) 2263 { 2264 Bip_Error((int)l) 2265 } 2266 else if (l < sizeof(word)) 2267 { 2268 Bip_Error(PEOF) 2269 } 2270 /* cope with p possibly not aligned */ 2271 pw = (char *) &w; 2272 for (i = 0; i < sizeof(word); i++) 2273 *pw++ = *p++; 2274 Return_Unify_Integer(val, tag, w); 2275} 2276 2277static int 2278p_get1(value val, type tag) 2279{ 2280 int res; 2281 2282 Check_Output_Integer(tag); 2283 Lock_Stream(current_input_); 2284 if (StreamMode(current_input_) & REPROMPT_ONLY) 2285 StreamMode(current_input_) |= DONT_PROMPT; 2286 if ((res = ec_getch(current_input_)) < 0) 2287 { 2288 Unlock_Stream(current_input_); 2289 Bip_Error(res) 2290 } 2291 Unlock_Stream(current_input_); 2292 Return_Unify_Integer(val, tag, res); 2293} 2294 2295 2296/* 2297 * p_put() put/2 2298 * similar to put_char/2, 2299 * but takes a number. 2300 */ 2301static int 2302p_put(value vstr, type tstr, value v, type t) 2303{ 2304 int res; 2305 stream_id nst = get_stream_id(vstr, tstr, SWRITE, &res); 2306 2307 if (nst == NO_STREAM) 2308 { 2309 Bip_Error(res) 2310 } 2311 2312 Check_Integer(t); 2313 Lock_Stream(nst); 2314 if ((res = ec_outfc(nst, (char) v.nint)) < 0) 2315 { 2316 Unlock_Stream(nst); 2317 Bip_Error(res); 2318 } 2319 Unlock_Stream(nst); 2320 Succeed_; 2321} 2322 2323/* 2324 * p_put1() put/1 2325 */ 2326static int 2327p_put1(value v, type t) 2328{ 2329 int res; 2330 2331 Check_Integer(t); 2332 Lock_Stream(current_output_); 2333 if ((res = ec_outfc(current_output_, (char) v.nint)) < 0) 2334 { 2335 Unlock_Stream(current_output_); 2336 Bip_Error(res); 2337 } 2338 Unlock_Stream(current_output_); 2339 Succeed_; 2340} 2341 2342static int 2343p_at_eof(value vs, type ts) 2344{ 2345 int res; 2346 stream_id nst = get_stream_id(vs, ts, 0, &res); 2347 2348 if (nst == NO_STREAM) 2349 { 2350 Bip_Error(res); 2351 } 2352 /* SoftEofStream can recover from being "past" eof, and needs extra check */ 2353 Succeed_If((StreamPastEof(nst) && !IsSoftEofStream(nst)) 2354 || (StreamMethods(nst).at_eof(nst) == PSUCCEED)); 2355} 2356 2357 2358/* 2359 * Flush the specified (output) stream. 2360 */ 2361static int 2362p_flush(value sv, type st) 2363{ 2364 int res; 2365 stream_id nst; 2366 2367 if ((nst = get_stream_id(sv, st, SWRITE, &res)) == NO_STREAM) 2368 { 2369 Bip_Error(res) 2370 } 2371 Lock_Stream(nst); 2372 res = ec_flush(nst); 2373 Unlock_Stream(nst); 2374 return res; 2375} 2376 2377static int 2378p_stream_number(value val1, type tag1) 2379{ 2380 Check_Output_Integer(tag1); 2381 Return_Unify_Integer(val1, tag1, NbStreams - 1); 2382} 2383 2384static int 2385p_pipe(value valr, type tagr, value valw, type tagw) 2386{ 2387#if defined(HAVE_PIPE) 2388 int pd[2]; 2389 stream_id nr, nw; 2390 int res; 2391 int sigio = 0; 2392 pword in_s; 2393 pword out_s; 2394 2395 res = _check_stream(valr, tagr, &in_s, 0); 2396 if (res < 0) { 2397 Bip_Error(res) 2398 } 2399 else if (res & EXEC_PIPE_SIG) 2400 sigio = 1; 2401 res = _check_stream(valw, tagw, &out_s, 0); 2402 if (res < 0) { 2403 Bip_Error(res) 2404 } 2405 else if (res & EXEC_PIPE_SIG) 2406 sigio = 1; 2407 if (in_s.val.did == out_s.val.did) { 2408 Bip_Error(STREAM_SPEC) 2409 } 2410 2411 if (pipe(pd) == -1) 2412 { 2413 Set_Errno; 2414 Bip_Error(SYS_ERROR); 2415 } 2416 nr = find_free_stream(); 2417 init_stream(nr, pd[0], SREAD | SPIPE, d_pipe, NO_PROMPT, NO_STREAM, 0); 2418 nw = find_free_stream(); 2419 init_stream(nw, pd[1], SWRITE | SPIPE, d_pipe, NO_PROMPT, NO_STREAM, 0); 2420 if (sigio) { 2421 if ((res = ec_stream_set_sigio(nr, SREAD)) < 0) { 2422 Bip_Error(res) 2423 } 2424 } 2425 Bind_Stream(in_s.val, in_s.tag, nr); 2426 Bind_Stream(out_s.val, out_s.tag, nw); 2427 Succeed_; 2428#else 2429 Bip_Error(NOT_AVAILABLE); 2430#endif 2431} 2432 2433 2434 2435/* 2436 p_read_string() read_string/4 2437*/ 2438static int 2439p_read_string(value vs, type ts, value vdel, type tdel, value vl, type tl, value val, type tag) 2440{ 2441 stream_id nst; 2442 int isref, status; 2443 int res; 2444 char *c, *d, *delim; 2445 long ndelim, dellength, length = 0; 2446 pword *pw; 2447 static char * nl = "\n"; 2448 Prepare_Requests 2449 2450 if (IsRef(tdel)) 2451 { Bip_Error(INSTANTIATION_FAULT); } 2452 else if (IsString(tdel)) 2453 { 2454 ndelim = StringLength(vdel); 2455 delim = StringStart(vdel); 2456 } 2457 else if (IsAtom(tdel)) 2458 { 2459 if (vdel.did == d_end_of_line) 2460 { 2461 ndelim = 1; delim = nl; 2462 } 2463 else if (vdel.did == d_.eof) 2464 { 2465 ndelim = 0; delim = ""; 2466 } 2467 else { Bip_Error(RANGE_ERROR); } 2468 } 2469 else { Bip_Error(TYPE_ERROR); } 2470 2471 Check_Output_Integer(tl); 2472 Check_Output_String(tag); 2473 isref = IsRef(tl); 2474 nst = get_stream_id(vs, ts, SREAD, &status); 2475 if (nst == NO_STREAM) 2476 { 2477 Bip_Error(status) 2478 } 2479 Lock_Stream(nst); 2480 if (StreamMode(nst) & REPROMPT_ONLY) 2481 StreamMode(nst) |= DONT_PROMPT; 2482 pw = TG; 2483 Push_Buffer(1); /* first make a minimal buffer */ 2484 c = (char *) BufferStart(pw); 2485 while(isref || length < vl.nint) 2486 { 2487 if ((res = ec_getch(nst)) == PEOF) /* ec_getch checks for end of file */ 2488 { 2489 if (!length) { 2490 Unlock_Stream(nst); 2491 TG = pw; /* pop the unfinished string */ 2492 Bip_Error(PEOF) 2493 } else { /* consider EOF as delimiter */ 2494 /* clear the mark, because PEOF is not raised */ 2495 StreamMode(nst) &= ~MEOF; 2496 break; 2497 } 2498 } 2499 if (res < 0) /* checks for mode errors */ 2500 { 2501 Unlock_Stream(nst); 2502 TG = pw; /* pop the unfinished string */ 2503 Bip_Error(res) 2504 } 2505 dellength = ndelim; /* check if we have hit a delimiter */ 2506 d = delim; 2507 while(dellength--) 2508 { 2509 if (res == *d++) 2510 { 2511 dellength = 0; 2512 break; 2513 } 2514 } 2515 if (!dellength) 2516 break; 2517 length++; /* add the character to the string */ 2518 *c++ = res; 2519 if (c == (char *) TG) /* get a new memory word, if needed */ 2520 { 2521 TG += 1; 2522 Check_Gc; 2523 } 2524 } 2525 Unlock_Stream(nst); 2526 /* remove CR if we had a CR-LF end-of-line sequence */ 2527 if (delim == nl && length > 0 && *(c-1) == '\r') 2528 { 2529 --length; 2530 --c; 2531 } 2532 *c = 0; 2533 Trim_Buffer(pw, length+1); 2534 Request_Unify_String(val, tag, pw); 2535 if (isref) 2536 { 2537 Request_Unify_Integer(vl, tl, length); 2538 } 2539 Return_Unify; 2540} 2541 2542 2543/* 2544 * read_string(+Stream, +SepChars, +PadChars, -ActualSep, -String) 2545 * 2546 * SepChars and PadChars are strings. 2547 * SepChars can also be atom 'end_of_line' (meaning "\n or \r\n"), 2548 * or 'end_of_file' (equivalent to ""). 2549 * ActualSep is the delimiter that actually occurred, or -1 for EOF. 2550 * String is the read string with padding removed. 2551 * Once ActualSep=-1 has been returned, the next call gives READ_PAST_EOF. 2552 * The "multi-separator" functionality of split_string/4 is not supported, 2553 * as this could require blocking reads. 2554 */ 2555 2556#define CheckSetMember(ch,nset,pset,match) \ 2557 for(match=nset;match;--match) { \ 2558 if ((ch) == pset[match-1]) \ 2559 break; \ 2560 } 2561 2562static int 2563p_read_string5(value vs, type ts, value vdel, type tdel, 2564 value vpad, type tpad, value vsep, type tsep, value val, type tag) 2565{ 2566 stream_id nst; 2567 int res; 2568 char *c, *start, *ipad; 2569 char *delim, *pad; 2570 long ndelim, npad, match; 2571 pword *pw; 2572 static char * nl = "\n"; 2573 Prepare_Requests 2574 2575 if (IsString(tdel)) { 2576 ndelim = StringLength(vdel); 2577 delim = StringStart(vdel); 2578 } else { 2579 Check_Atom_Or_Nil(vdel, tdel); 2580 if (vdel.did == d_end_of_line) { 2581 ndelim = 1; delim = nl; 2582 } else if (vdel.did == d_.eof) { 2583 ndelim = 0; delim = ""; 2584 } else { 2585 Bip_Error(RANGE_ERROR); 2586 } 2587 } 2588 if (IsString(tpad)) { 2589 npad = StringLength(vpad); 2590 pad = StringStart(vpad); 2591 } else { 2592 Check_Atom_Or_Nil(vpad, tpad); 2593 /* no padding symbols yet */ 2594 Bip_Error(RANGE_ERROR); 2595 } 2596 /* Check_Output_Integer(tl); */ 2597 /* Check_Output_String(tag); */ 2598 2599 nst = get_stream_id(vs, ts, SREAD, &res); 2600 if (nst == NO_STREAM) { 2601 Bip_Error(res) 2602 } 2603 Lock_Stream(nst); 2604 if (StreamMode(nst) & REPROMPT_ONLY) 2605 StreamMode(nst) |= DONT_PROMPT; 2606 pw = TG; 2607 Push_Buffer(1); /* first make a minimal buffer */ 2608 start = c = (char *) BufferStart(pw); 2609 2610_before_: 2611 res = ec_getch(nst); 2612 if (res < 0) goto _eof_err_; 2613 CheckSetMember(res,npad,pad,match); 2614 if (match) goto _before_; 2615 CheckSetMember(res,ndelim,delim,match); 2616 if (match) goto _end_; 2617 2618_within_: 2619 *c++ = res; 2620 if (c == (char *) TG) { /* get a new memory word, if needed */ 2621 TG += 1; 2622 Check_Gc; 2623 } 2624 res = ec_getch(nst); 2625 if (res < 0) goto _eof_err_; 2626 CheckSetMember(res,ndelim,delim,match); 2627 if (match) { 2628 if (delim==nl && *(c-1)=='\r') 2629 --c; /* forget CR (delimiter was end_of_line) */ 2630 goto _end_; 2631 } 2632 CheckSetMember(res,npad,pad,match); 2633 if (!match) goto _within_; 2634 ipad = c; 2635 2636_after_: 2637 *c++ = res; 2638 if (c == (char *) TG) { /* get a new memory word, if needed */ 2639 TG += 1; 2640 Check_Gc; 2641 } 2642 res = ec_getch(nst); 2643 if (res < 0) { 2644 c = ipad; /* forget trailing padding */ 2645 goto _eof_err_; 2646 } 2647 CheckSetMember(res,npad,pad,match); 2648 if (match) { 2649 if (delim==nl && *(c-1)=='\r') 2650 ipad = c; 2651 goto _after_; 2652 } 2653 CheckSetMember(res,ndelim,delim,match); 2654 if (match) { 2655 c = ipad; 2656 goto _end_; 2657 } 2658 if (res != '\r') 2659 goto _within_; 2660 2661_after_cr_: 2662 *c++ = res; 2663 if (c == (char *) TG) { /* get a new memory word, if needed */ 2664 TG += 1; 2665 Check_Gc; 2666 } 2667 res = ec_getch(nst); 2668 if (res < 0) { 2669 goto _eof_err_; /* end after lone CR */ 2670 } 2671 CheckSetMember(res,npad,pad,match); 2672 if (match) { 2673 ipad = c; /* restart padding */ 2674 goto _after_; 2675 } 2676 CheckSetMember(res,ndelim,delim,match); 2677 if (!match) goto _within_; 2678 if (delim==nl) 2679 c = ipad; /* Pad+CR+LF forget all */ 2680 2681_end_: /* here: res == delimiter char */ 2682 Unlock_Stream(nst); 2683 *c++ = 0; 2684 Trim_Buffer(pw, c-start); 2685 Request_Unify_String(val, tag, pw); 2686 Request_Unify_Integer(vsep, tsep, res); 2687 Return_Unify; 2688 2689_eof_err_: 2690 if (res == PEOF) { 2691 res = -1; 2692 goto _end_; 2693 } 2694 Unlock_Stream(nst); 2695 TG = pw; /* pop the unfinished string */ 2696 Bip_Error(res) 2697} 2698 2699 2700/* 2701 * read_directory(+Directory, +Pattern, ?FileList, ?DirList) 2702 */ 2703 2704#ifdef _WIN32 2705 2706static int 2707p_read_dir(value vdir, type tdir, value vpat, type tpat, value vsubdirs, type tsubdirs, value vfiles, type tfiles) 2708{ 2709 char *name, *pattern; 2710 char exp_name[MAX_PATH_LEN]; 2711 char full_name[MAX_PATH_LEN]; 2712 HANDLE dirp; 2713 WIN32_FIND_DATA dent; 2714 DWORD err; 2715 pword file_list, dir_list; 2716 register pword *file_last = &file_list; 2717 register pword *dir_last = &dir_list; 2718 Prepare_Requests; 2719 2720 Get_Name(vdir, tdir, name); /* check arguments */ 2721 Get_Name(vpat, tpat, pattern); 2722 Check_Output_List(tsubdirs); 2723 Check_Output_List(tfiles); 2724 2725 name = expand_filename(name, exp_name, EXPAND_STANDARD); 2726 name = strcat(os_filename(name, full_name), "/*.*"); 2727 2728 dirp = FindFirstFile(name, &dent); 2729 if (dirp == INVALID_HANDLE_VALUE) 2730 { 2731 Set_Sys_Errno(GetLastError(),ERRNO_WIN32); 2732 Bip_Error(SYS_ERROR); 2733 } 2734 2735 do 2736 { 2737 pword *elem = TG; 2738 2739 if (dent.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY) 2740 { 2741 if (!strcmp(dent.cFileName, ".") || !strcmp(dent.cFileName, "..")) 2742 continue; 2743 Make_List(dir_last, elem); /* append the new element */ 2744 dir_last = elem + 1; 2745 } 2746 else /* it's a simple file */ 2747 { 2748 if (!_match(pattern, dent.cFileName)) 2749 continue; 2750 Make_List(file_last, elem); /* append the new element */ 2751 file_last = elem + 1; 2752 } 2753 2754 Push_List_Frame(); /* make a list element */ 2755 Make_String(elem, dent.cFileName); /* value is the name string */ 2756 2757 } while (FindNextFile(dirp, &dent)); 2758 2759 if ((err = GetLastError()) != ERROR_NO_MORE_FILES) 2760 { 2761 Set_Sys_Errno(err,ERRNO_WIN32); 2762 Bip_Error(SYS_ERROR); 2763 } 2764 2765 if (!FindClose(dirp)) 2766 { 2767 Set_Sys_Errno(GetLastError(),ERRNO_WIN32); 2768 Bip_Error(SYS_ERROR); 2769 } 2770 2771 Make_Nil(file_last); /* terminate the lists */ 2772 Make_Nil(dir_last); 2773 2774 Request_Unify_Pw(vfiles, tfiles, file_list.val, file_list.tag); 2775 Request_Unify_Pw(vsubdirs, tsubdirs, dir_list.val, dir_list.tag); 2776 Return_Unify; 2777} 2778 2779#else 2780#if defined(HAVE_READDIR) 2781 2782static int 2783p_read_dir(value vdir, type tdir, value vpat, type tpat, value vsubdirs, type tsubdirs, value vfiles, type tfiles) 2784{ 2785 char *name, *pattern; 2786 char exp_name[MAX_PATH_LEN]; 2787 char full_name[MAXNAMLEN]; /* for stat() */ 2788 DIR *dirp; 2789 struct dirent *dent; 2790 pword file_list, dir_list; 2791 register pword *file_last = &file_list; 2792 register pword *dir_last = &dir_list; 2793 struct_stat file_stat; 2794 Prepare_Requests; 2795 2796 Get_Name(vdir, tdir, name); /* check arguments */ 2797 Get_Name(vpat, tpat, pattern); 2798 Check_Output_List(tsubdirs); 2799 Check_Output_List(tfiles); 2800 2801 name = expand_filename(name, exp_name, EXPAND_STANDARD); 2802 name = os_filename(name, full_name); 2803 if ((dirp = opendir(name)) == NULL) /* try to open the directory */ 2804 { 2805 Set_Errno; 2806 Bip_Error(SYS_ERROR); 2807 } 2808 2809 for (name = full_name; *name; name++) /* prepare the name buffer */ 2810 ; 2811 *name++ = '/'; 2812 2813 while ((dent = readdir(dirp))) /* loop through the entries */ 2814 { 2815 register pword *elem = Gbl_Tg; 2816 2817 (void) strcpy(name, dent->d_name); /* get the file's status */ 2818 if (ec_stat(full_name, &file_stat)) 2819 { 2820 errno = 0; /* just ignore the file */ 2821 continue; 2822 } 2823 2824 if ((file_stat.st_mode & S_IFMT) == S_IFDIR) /* it's a directory */ 2825 { 2826 if (!strcmp(dent->d_name, ".") || !strcmp(dent->d_name, "..")) 2827 continue; 2828 dir_last->tag.kernel = TLIST; /* append the new element */ 2829 dir_last->val.ptr = elem; 2830 dir_last = elem + 1; 2831 } 2832 else /* it's a simple file */ 2833 { 2834 if (!_match(pattern, name)) 2835 continue; 2836 file_last->tag.kernel = TLIST; /* append the new element */ 2837 file_last->val.ptr = elem; 2838 file_last = elem + 1; 2839 } 2840 2841 Gbl_Tg += 2; /* make a list element */ 2842 elem->tag.kernel = TSTRG; /* value is the name string */ 2843 Cstring_To_Prolog(dent->d_name, elem->val); 2844 } 2845 2846 (void) closedir(dirp); 2847 file_last->tag.kernel = TNIL; /* terminate the lists */ 2848 dir_last->tag.kernel = TNIL; 2849 errno = 0; /* just to be sure .. */ 2850 2851 Request_Unify_Pw(vfiles, tfiles, file_list.val, file_list.tag); 2852 Request_Unify_Pw(vsubdirs, tsubdirs, dir_list.val, dir_list.tag); 2853 Return_Unify; 2854} 2855 2856#else 2857 2858static int 2859p_read_dir(value vdir, type tdir, value vpat, type tpat, value vsubdirs, type tsubdirs, value vfiles, type tfiles) { 2860 USER_PANIC("Not available\n"); 2861 Bip_Error(NOT_AVAILABLE); 2862} 2863 2864#endif 2865#endif 2866 2867#ifdef SOCKETS 2868 2869static int 2870p_socket(value vdom, type tdom, value vtp, type ttp, value vs, type ts) 2871{ 2872 int sdomain; 2873 int stype; 2874 socket_t s; 2875 stream_id onst, inst; 2876 int res; 2877 int sigio = 0; 2878 pword p; 2879 2880 Check_Atom(tdom); 2881 Check_Atom(ttp); 2882 res = _check_stream(vs, ts, &p, 0); 2883 if (res < 0) { 2884 Bip_Error(res) 2885 } 2886 else if (res & EXEC_PIPE_SIG) 2887 sigio = 1; 2888 if (vdom.did == d_unix) 2889 sdomain = AF_UNIX; 2890 else if (vdom.did == d_internet) 2891 sdomain = AF_INET; 2892 else { 2893 Bip_Error(RANGE_ERROR); 2894 } 2895 if (vtp.did == d_stream) 2896 stype = SOCK_STREAM; 2897 else if (vtp.did == d_datagram) 2898 stype = SOCK_DGRAM; 2899 else { 2900 Bip_Error(RANGE_ERROR); 2901 } 2902 s = socket(sdomain, stype, 0); 2903 if (s == INVALID_SOCKET) { 2904 Set_Socket_Errno(); 2905 Bip_Error(SYS_ERROR); 2906 } 2907 inst = find_free_stream(); 2908 init_stream(inst, s, SREAD | SSOCKET, d_socket, NO_PROMPT, NO_STREAM, 0); 2909 onst = find_free_stream(); 2910 init_stream(onst, s, SWRITE | SSOCKET, d_socket, NO_PROMPT, _copy_stream(inst), 0); 2911 if (sdomain == AF_UNIX) 2912 SocketUnix(onst) = in_dict("",0); /* to mark AF_UNIX */ 2913 SocketConnection(onst) = 0; 2914 if (sigio) { 2915 if ((res = ec_stream_set_sigio(onst, SWRITE)) < 0) { 2916 Bip_Error(res) 2917 } 2918 } 2919 SocketType(onst) = stype; 2920 Bind_Stream(p.val, p.tag, onst); 2921 Succeed_; 2922} 2923 2924static int 2925socket_bind(stream_id nst, value vaddr, type taddr) 2926{ 2927 if (SocketUnix(nst)) 2928 { 2929#ifdef HAVE_AF_UNIX 2930 struct sockaddr_un name; 2931 2932 Check_Atom_Or_Nil(vaddr, taddr); 2933 name.sun_family = AF_UNIX; 2934 (void) strcpy(name.sun_path, DidName(vaddr.did)); 2935 if (bind(StreamUnit(nst), (struct sockaddr *) &name, 2936 strlen(name.sun_path) + sizeof(name.sun_family)) < 0) { 2937 Set_Errno; 2938 Bip_Error(SYS_ERROR); 2939 } 2940 StreamName(nst) = vaddr.did; 2941 SocketUnix(nst) = vaddr.did; 2942 Succeed_; 2943#else 2944 Bip_Error(SYS_ERROR); 2945#endif 2946 } 2947 else 2948 { 2949 struct sockaddr_in name; 2950 struct hostent *host; 2951 pword *addr; 2952 pword *port; 2953 int length = sizeof(name); 2954 dident hdid; 2955 Prepare_Requests; 2956 2957 memset(&name, 0, length); 2958 2959 if (IsStructure(taddr) && vaddr.ptr->val.did == d_.quotient) 2960 { 2961 addr = vaddr.ptr + 1; 2962 Dereference_(addr); 2963 Check_Output_Atom_Or_Nil(addr->val, addr->tag); 2964 port = vaddr.ptr + 2; 2965 Dereference_(port); 2966 Check_Output_Integer(port->tag); 2967 } 2968 else if (!IsRef(taddr)) 2969 { Bip_Error(TYPE_ERROR); } 2970 name.sin_family = AF_INET; 2971 if (IsRef(taddr) || IsRef(addr->tag)) 2972 { 2973 int hlen; 2974 char buf[257]; 2975 2976 name.sin_addr.s_addr = htonl(INADDR_ANY); 2977 2978 hlen = ec_gethostname(buf, 257); 2979 if (hlen < 0) { 2980 Bip_Error(SYS_ERROR); 2981 } 2982 hdid = enter_dict_n(buf, hlen, 0); 2983 } 2984 else 2985 { 2986 host = gethostbyname(DidName(addr->val.did)); 2987 if (!host) { 2988 Fail_; 2989 } 2990 hdid = addr->val.did; 2991 bcopy((char *) host->h_addr, (char *) &name.sin_addr, host->h_length); 2992 } 2993 if (!IsRef(taddr) && IsInteger(port->tag)) 2994 name.sin_port = htons((short) port->val.nint); 2995 else 2996 name.sin_port = htons(0); 2997 if (bind((socket_t) StreamUnit(nst), (struct sockaddr *) &name, sizeof(name)) != 0) { 2998 Set_Socket_Errno(); 2999 Bip_Error(SYS_ERROR); 3000 } 3001 StreamName(nst) = hdid; 3002 if (getsockname((socket_t) StreamUnit(nst), (struct sockaddr *) &name, &length) != 0) { 3003 Set_Socket_Errno(); 3004 Bip_Error(SYS_ERROR); 3005 } 3006 if (IsRef(taddr)) 3007 { 3008 pword *pw = Gbl_Tg; 3009 3010 Gbl_Tg += 3; 3011 pw[0].tag.kernel = TDICT; 3012 pw[0].val.did = d_.quotient; 3013 pw[1].val.did = hdid; 3014 pw[1].tag.kernel = TDICT; 3015 pw[2].val.nint = ntohs(name.sin_port); 3016 pw[2].tag.kernel = TINT; 3017 Return_Unify_Structure(vaddr, taddr, pw); 3018 } 3019 if (IsRef(port->tag)) { 3020 Request_Unify_Integer(port->val, port->tag, ntohs(name.sin_port)); 3021 } 3022 if (IsRef(addr->tag)) { 3023 Request_Unify_Atom(addr->val, addr->tag, hdid); 3024 } 3025 Return_Unify; 3026 } 3027} 3028 3029static int 3030p_bind(value v, type t, value vaddr, type taddr) 3031{ 3032 int res; 3033 stream_id nst = get_stream_id(v, t, 0, &res); 3034 3035 if (nst == NO_STREAM) 3036 { Bip_Error(res); } 3037 3038 if (IsOpened(nst)) { 3039 return RemoteStream(nst) ? io_rpc(nst, IO_BIND): 3040 socket_bind(nst, vaddr, taddr); 3041 } else 3042 { Bip_Error(STREAM_SPEC); } 3043 3044} 3045 3046static int 3047socket_connect(stream_id nst, value vaddr, type taddr) 3048{ 3049 if (SocketUnix(nst)) 3050 { 3051#ifdef HAVE_AF_UNIX 3052 char *file; 3053 struct sockaddr_un name; 3054 3055 if (IsInteger(taddr)) 3056 { 3057 if (vaddr.nint == 0) 3058 /* null address does not work everywhere, so take a non-socket 3059 file */ 3060 (void) strcpy(name.sun_path, "/"); 3061 else 3062 { Bip_Error(RANGE_ERROR); } 3063 } 3064 else { 3065 Get_Name(vaddr, taddr, file); 3066 (void) strcpy(name.sun_path, file); 3067 } 3068 name.sun_family = AF_UNIX; 3069 if (connect(StreamUnit(nst), (struct sockaddr *) &name, 3070 strlen(name.sun_path) + sizeof(name.sun_family)) < 0 3071 && !(IsInteger(taddr) && errno == ENOTSOCK)) 3072 { 3073 Set_Errno; 3074 Bip_Error(SYS_ERROR); 3075 } 3076 if (IsInteger(taddr)) 3077 SocketConnection(nst) = 0; 3078 else 3079 SocketConnection(nst) = (unsigned char *) (vaddr.did); 3080 Succeed_; 3081#else 3082 Bip_Error(SYS_ERROR); 3083#endif 3084 } 3085 else 3086 { 3087 struct sockaddr_in name; 3088 struct hostent *host; 3089 long haddr = 0; 3090 pword *addr; 3091 pword *port; 3092 dident hostname_did; 3093 3094 memset(&name, 0, sizeof(name)); 3095 3096 Error_If_Ref(taddr); 3097 if (!IsStructure(taddr) || vaddr.ptr->val.did != d_.quotient) 3098 { Bip_Error(TYPE_ERROR); } 3099 3100 addr = vaddr.ptr + 1; 3101 Dereference_(addr); 3102 Error_If_Ref(addr->tag); 3103 if (IsInteger(addr->tag)) { 3104 if (addr->val.nint != 0) 3105 { Bip_Error(RANGE_ERROR); } 3106 host = 0; 3107 haddr = addr->val.nint; 3108 hostname_did = (dident) 0; 3109 } 3110 else 3111 { 3112 if (IsString(addr->tag)) { 3113 hostname_did = Did(StringStart(addr->val),0); 3114 } else if (IsAtom(addr->tag)) { 3115 hostname_did = addr->val.did; 3116 } else if (IsNil(addr->tag)) { 3117 hostname_did = d_.nil; 3118 } else { 3119 Bip_Error(TYPE_ERROR); 3120 } 3121 host = gethostbyname(DidName(hostname_did)); 3122 } 3123 port = vaddr.ptr + 2; 3124 Dereference_(port); 3125 Check_Integer(port->tag); 3126 name.sin_port = htons((short) port->val.nint); 3127 if (!host) 3128 name.sin_addr.s_addr = htonl(haddr); 3129 else 3130 bcopy((char *) host->h_addr, (char *) &name.sin_addr, host->h_length); 3131 name.sin_family = AF_INET; 3132 if (connect((socket_t) StreamUnit(nst), (struct sockaddr *) &name, sizeof(name)) != 0) 3133 { 3134 Set_Socket_Errno(); 3135#ifdef EADDRNOTAVAIL 3136 if (!(host == 0 && haddr == 0 && ec_os_errno_ == EADDRNOTAVAIL)) 3137#endif 3138 { 3139 /* if connect returns with error, then the socket is closed 3140 (some OSs can leave the socket in a funny state if 3141 connection refused) 3142 */ 3143 Lock_Stream(nst); 3144 ec_close_stream(nst, CLOSE_FORCE); 3145 Unlock_Stream(nst); 3146 Bip_Error(SYS_ERROR); 3147 } 3148 } 3149 if (!host) 3150 SocketConnection(nst) = 0; 3151 else 3152 SocketConnection(nst) = (unsigned char *) hostname_did; 3153 Succeed_; 3154 } 3155} 3156 3157static int 3158p_connect(value v, type t, value vaddr, type taddr) 3159{ 3160 int res; 3161 stream_id nst = get_stream_id(v, t, 0, &res); 3162 3163 if (nst == NO_STREAM) 3164 { Bip_Error(res); } 3165 if (IsOpened(nst)) 3166 { 3167 return RemoteStream(nst) ? io_rpc(nst, IO_CONNECT): 3168 socket_connect(nst, vaddr, taddr); 3169 } else 3170 { Bip_Error(STREAM_SPEC); } 3171 3172} 3173 3174static int 3175socket_listen(stream_id nst, value vn, type tn) 3176{ 3177 Check_Integer(tn); 3178 if (listen((socket_t) StreamUnit(nst), (int) vn.nint) != 0) { 3179 Set_Socket_Errno(); 3180 Bip_Error(SYS_ERROR); 3181 } 3182 Succeed_; 3183} 3184 3185static int 3186p_listen(value v, type t, value vn, type tn) 3187{ 3188 int res; 3189 stream_id nst = get_stream_id(v, t, 0, &res); 3190 3191 if (nst == NO_STREAM) 3192 { Bip_Error(res); } 3193 if (IsOpened(nst)) { 3194 return RemoteStream(nst) ? io_rpc(nst, IO_LISTEN): 3195 socket_listen(nst, vn, tn); 3196 } else 3197 { Bip_Error(STREAM_SPEC); } 3198 3199 3200} 3201 3202static int 3203socket_accept(stream_id nst, value vaddr, type taddr, pword p, int sigio) 3204{ 3205 socket_t res; 3206 stream_id inst, onst; 3207 int stype; 3208 int length, err; 3209 dident wn; 3210 Prepare_Requests; 3211 3212 if (SocketUnix(nst)) 3213 { 3214#ifdef HAVE_AF_UNIX 3215 struct sockaddr_un name; 3216 3217 Check_Output_Atom_Or_Nil(vaddr, taddr); 3218 length = sizeof(name); 3219 res = accept(StreamUnit(nst), (struct sockaddr *) &name, &length); 3220 if (res == INVALID_SOCKET) { 3221 Set_Socket_Errno(); 3222 Bip_Error(SYS_ERROR); 3223 } 3224 wn = enter_dict_n(name.sun_path, length-sizeof(name.sun_family), 0); 3225 Request_Unify_Atom(vaddr, taddr, wn); 3226#else 3227 Bip_Error(SYS_ERROR); 3228#endif 3229 } 3230 else 3231 { 3232 struct sockaddr_in name; 3233 struct hostent *host; 3234 pword *pw = Gbl_Tg; 3235 3236 Check_Output_Structure(taddr); 3237 3238 length = sizeof(name); 3239 memset(&name, 0, length); 3240 3241 res = accept((socket_t) StreamUnit(nst), (struct sockaddr *) &name, &length); 3242 if (res == INVALID_SOCKET) { 3243 Set_Socket_Errno(); 3244 Bip_Error(SYS_ERROR); 3245 } 3246 host = gethostbyaddr ((char *) &name.sin_addr, sizeof(name.sin_addr), AF_INET); 3247 Gbl_Tg += 3; 3248 pw[0].tag.kernel = TDICT; 3249 pw[0].val.did = d_.quotient; 3250 if (host) { 3251 pw[1].val.did = wn = enter_dict(host->h_name, 0); 3252 pw[1].tag.kernel = TDICT; 3253 } 3254 else { 3255 pw[1].val.ptr = pw + 1; 3256 pw[1].tag.kernel = TREF; 3257 wn = d_socket; 3258 } 3259 pw[2].val.nint = ntohs(name.sin_port); 3260 pw[2].tag.kernel = TINT; 3261 Request_Unify_Structure(vaddr, taddr, pw); 3262 } 3263 inst = find_free_stream(); 3264 init_stream(inst, (uword) res, SREAD | SSOCKET, wn, NO_PROMPT, NO_STREAM, 0); 3265 onst = find_free_stream(); 3266 init_stream(onst, (uword) res, SWRITE | SSOCKET, wn, NO_PROMPT, _copy_stream(inst), 0); 3267 if (SocketUnix(nst)) 3268 SocketUnix(onst) = in_dict("",0); 3269 if (sigio) { 3270 if ((err = ec_stream_set_sigio(onst, SWRITE)) < 0) { 3271 Bip_Error(err) 3272 } 3273 } 3274#ifdef SO_TYPE 3275 length = sizeof(stype); 3276 (void) getsockopt(res, SOL_SOCKET, SO_TYPE, &stype, &length); 3277 SocketType(onst) = stype; 3278#else 3279 /* copy the socket type from that of the accept socket */ 3280 SocketType(onst) = SocketType(nst); 3281 SocketType(inst) = SocketType(nst); 3282#endif 3283 Bind_Stream(p.val, p.tag, onst); 3284 Return_Unify; 3285} 3286 3287static int 3288p_accept(value v, type t, value vaddr, type taddr, value vs, type ts) 3289{ 3290 int res; 3291 stream_id nst = get_stream_id(v, t, 0, &res); 3292 pword p; 3293 int sigio = 0; 3294 3295 if (nst == NO_STREAM) 3296 { Bip_Error(res); } 3297 res = _check_stream(vs, ts, &p, 0); 3298 if (res < 0) { 3299 Bip_Error(res) 3300 } 3301 else if (res & EXEC_PIPE_SIG) 3302 sigio = 1; 3303 if (IsOpened(nst)) { 3304 return RemoteStream(nst) ? io_rpc(nst, IO_ACCEPT): 3305 socket_accept(nst, vaddr, taddr, p, sigio); 3306 } else 3307 { Bip_Error(STREAM_SPEC); } 3308 3309} 3310 3311int 3312ec_write_socket(uword fd, char *buf, int n) /* returns eclipse status */ 3313{ 3314 int cnt = 0; 3315 3316 for (;;) 3317 { 3318 cnt = send((int) fd, buf, n, 0); 3319 if (cnt == n) 3320 return PSUCCEED; 3321 else if (cnt < 0 ) 3322 { 3323 Set_Socket_Errno(); 3324#ifdef EINTR 3325 if (ec_os_errno_ == EINTR) 3326 continue; /* an interrupted call, try again */ 3327#endif 3328#ifdef _WIN32 3329 if (ec_os_errno_ == WSAEINTR) 3330 continue; /* an interrupted call, try again */ 3331#endif 3332 return OUT_ERROR; 3333 } 3334 else 3335 { 3336 n -= cnt; 3337 buf += cnt; 3338 } 3339 } 3340} 3341 3342int 3343ec_read_socket(uword fd, char *buf, int n) /* returns count, sets ec_os_errno_ if -1 */ 3344{ 3345 int count; 3346 3347 for (;;) 3348 { 3349 count = recv((int) fd, buf, n, 0); 3350 if (count < 0) 3351 { 3352 Set_Socket_Errno(); 3353#ifdef EINTR 3354 if (ec_os_errno_ == EINTR) 3355 continue; /* an interrupted call, try again */ 3356#endif 3357#ifdef _WIN32 3358 if (ec_os_errno_ == WSAEINTR) 3359 continue; /* an interrupted call, try again */ 3360#endif 3361 } 3362 return count; 3363 } 3364} 3365 3366int 3367ec_close_socket(uword fd) /* returns eclipse status */ 3368{ 3369#ifdef _WIN32 3370 if (closesocket(fd) != 0) 3371#else 3372 if (close(fd) != 0) 3373#endif 3374 { 3375 Set_Socket_Errno(); 3376 return SYS_ERROR; 3377 } 3378 return PSUCCEED; 3379} 3380 3381 3382#ifdef _WIN32 3383 3384/*********************************************************************** 3385 * Signalling streams (like SIGIO on Unix) 3386 * 3387 * Mechanism for faking SIGIO signals, mainly intended for Windows: 3388 * When signaling is requested for a stream (which must support 3389 * select()), we associate with it a thread, and let the thread 3390 * post a pseudo-SIGIO integer event whenever data arrives on the 3391 * empty stream. After posting, the thread is stopped. It is reenabled 3392 * when a read operation finds that there is no more data available. 3393 ***********************************************************************/ 3394 3395/* 3396 * Event-posting thread: do a blocking select on the given socket, 3397 * when data is available, post a pseudo-sigio integer event. 3398 */ 3399 3400static int 3401_sigio_thread_function(stream_id nst) 3402{ 3403 fd_set dread; 3404 int res; 3405 socket_t sock = StreamUnit(nst); 3406 3407 for(;;) 3408 { 3409 if (!(StreamMode(nst) & SSIGIO)) 3410 return 1; /* stop thread, ok */ 3411 3412 FD_ZERO(&dread); 3413 FD_SET(sock, &dread); 3414 res = select(sock + 1, &dread, NULL, NULL, NULL); /* block */ 3415 3416 if (res > 0) 3417 { 3418 if (StreamMode(nst) & SSIGIO) /* still enabled? */ 3419 ec_post_event_int(ec_sigio); 3420 return 1; /* stop thread, ok */ 3421 } 3422 else if (res < 0) 3423 { 3424 Set_Socket_Errno(); 3425 switch (ec_os_errno_) { 3426 case WSAEINTR: 3427 case WSAEINPROGRESS: /* ? */ 3428 case WSAENETDOWN: /* ? */ 3429 continue; /* ignore and select again */ 3430 3431 default: 3432 return 0; /* stop thread, error */ 3433 } 3434 } 3435 } 3436} 3437 3438 3439/* Initial setup of the signaling mechanism for the stream */ 3440 3441int 3442ec_setup_stream_sigio_thread(stream_id nst) 3443{ 3444 int res; 3445 3446 /* setup a thread for this socket */ 3447 if (!nst->signal_thread) 3448 { 3449 nst->signal_thread = ec_make_thread(); 3450 if (!nst->signal_thread) 3451 return SYS_ERROR; 3452 } 3453 else if (!ec_thread_stopped(nst->signal_thread, &res)) 3454 { 3455 return RANGE_ERROR; 3456 } 3457 if (!ec_start_thread(nst->signal_thread, (int(*) ARGS((void*)))_sigio_thread_function, nst)) 3458 return SYS_ERROR; 3459 return PSUCCEED; 3460} 3461 3462 3463int 3464ec_reenable_sigio(stream_id nst, int bytes_wanted, int bytes_read) 3465{ 3466 int res; 3467 3468 /* If we just read less than we asked for, we know the stream is empty. 3469 * Otherwise, do a select to find out if there is more data waiting. 3470 */ 3471 if (bytes_read >= bytes_wanted) 3472 { 3473 struct timeval to; 3474 fd_set dread; 3475 to.tv_sec = 0; 3476 to.tv_usec = 0; 3477 FD_ZERO(&dread); 3478 FD_SET(StreamUnit(nst), &dread); 3479 res = select(StreamUnit(nst) + 1, &dread, NULL, NULL, &to); 3480 if (res > 0) { 3481 return PSUCCEED; /* there is more data */ 3482 } else if (res < 0) { 3483 Set_Socket_Errno(); 3484 return SYS_ERROR; 3485 } 3486 } 3487 3488 /* nothing to read, reenable SIGIO thread */ 3489 if (ec_thread_stopped(nst->signal_thread, &res)) 3490 { 3491 if (!ec_start_thread(nst->signal_thread, (int(*) ARGS((void*)))_sigio_thread_function, nst)) 3492 return SYS_ERROR; 3493 } 3494 return PSUCCEED; 3495} 3496 3497#else 3498 3499int 3500ec_setup_stream_sigio_thread(stream_id nst) 3501{} 3502 3503int 3504ec_reenable_sigio(stream_id nst, int bytes_wanted, int bytes_read) 3505{} 3506 3507#endif 3508 3509#else 3510static int p_socket(value vdom, type tdom, value vtp, type ttp, value vs, type ts) 3511{ 3512 USER_PANIC("\nNOT available\n"); 3513 Bip_Error(NOT_AVAILABLE); 3514} 3515static int p_bind(value v, type t, value vaddr, type taddr) 3516{ 3517 USER_PANIC("\nNOT available\n"); 3518 Bip_Error(NOT_AVAILABLE); 3519} 3520static int p_connect(value v, type t, value vaddr, type taddr) 3521{ 3522 USER_PANIC("\nNOT available\n"); 3523 Bip_Error(NOT_AVAILABLE); 3524} 3525static int p_accept(value v, type t, value vaddr, type taddr, value vs, type ts) 3526{ 3527 USER_PANIC("\nNOT available\n"); 3528 Bip_Error(NOT_AVAILABLE); 3529} 3530static int p_listen(value v, type t, value vn, type tn) 3531{ 3532 USER_PANIC("\nNOT available\n"); 3533 Bip_Error(NOT_AVAILABLE); 3534} 3535 3536int 3537ec_setup_stream_sigio_thread(stream_id nst) 3538{ 3539 USER_PANIC("\nNOT available\n"); 3540 Bip_Error(NOT_AVAILABLE); 3541} 3542 3543int 3544ec_reenable_sigio(stream_id nst, int bytes_wanted, int bytes_read) 3545{ 3546 USER_PANIC("\nNOT available\n"); 3547 Bip_Error(NOT_AVAILABLE); 3548} 3549 3550int 3551ec_close_socket(uword fd) /* returns eclipse status */ 3552{ 3553 USER_PANIC("\nNOT available\n"); 3554 Bip_Error(NOT_AVAILABLE); 3555} 3556 3557int 3558ec_read_socket(uword fd, char *buf, int n) /* returns count, sets ec_os_errno_ if -1 */ 3559{ 3560 USER_PANIC("\nNOT available\n"); 3561 Bip_Error(NOT_AVAILABLE); 3562} 3563 3564int 3565ec_write_socket(uword fd, char *buf, int n) /* returns eclipse status */ 3566{ 3567 USER_PANIC("\nNOT available\n"); 3568 Bip_Error(NOT_AVAILABLE); 3569} 3570 3571#endif /* SOCKETS */ 3572 3573#if defined(HAVE_SELECT) 3574 3575 3576/* 3577 * select/3 succeeds if 3578 * 3579 * null r(w) never 3580 * string r(w) something in buffer 3581 * queue r(w) something in buffer 3582 * pipe r something in buffer, or select(fd) 3583 * pipe w select(fd) 3584 * file r something in buffer, or select(fd) 3585 * file w select(fd) 3586 * socket r something in buffer, or select(fd) 3587 * socket w 3588 * tty rw something in buffer, or select(fd) 3589 */ 3590 3591 3592static int 3593p_select(value vin, type tin, value vtime, type ttime, value vout, type tout) 3594{ 3595 fd_set dread; 3596 fd_set dwrite; 3597 pword *list; 3598 pword *pw; 3599 pword *pl; 3600 pword *p; 3601 int res; 3602 int buffer_input = 0; 3603 int need_select = 0; 3604#ifdef _WIN32 3605 int need_kbhit = 0; 3606 int need_peek = 0; 3607#endif 3608 stream_id nst; 3609 struct timeval to; 3610 struct timeval *pto = &to; 3611 uword max = 0; 3612 double dtime; 3613 3614 if (IsNil(tin)) 3615 list = 0; 3616 else 3617 { 3618 Check_List(tin); 3619 list = vin.ptr; 3620 } 3621 Error_If_Ref(ttime); 3622 if (IsInteger(ttime)) 3623 { 3624 if ((int) vtime.nint < 0 || (int) vtime.nint > 100000000) 3625 { Bip_Error(RANGE_ERROR); } 3626 to.tv_sec = vtime.nint; 3627 to.tv_usec = 0; 3628 } 3629 else if (IsDouble(ttime)) 3630 { 3631 dtime = Dbl(vtime); 3632 if (dtime < 0.0 || dtime > 1e8) 3633 { Bip_Error(RANGE_ERROR); } 3634 to.tv_sec = (int) dtime; 3635 to.tv_usec = (int) ((dtime - (int) dtime) * 1000000.0); 3636 } 3637 else 3638 { 3639 if (!IsAtom(ttime)) 3640 { Bip_Error(TYPE_ERROR); } 3641 else if (vtime.did != d_block) 3642 { Bip_Error(RANGE_ERROR); } 3643 pto = (struct timeval *) 0; 3644 } 3645 if (!IsNil(tout)) { 3646 Check_Output_List(tout) 3647 } 3648 if (!list) 3649 { 3650 Return_Unify_Nil(vout, tout); 3651 } 3652 3653 FD_ZERO(&dread); 3654 FD_ZERO(&dwrite); 3655 pl = list; 3656 while (pl) 3657 { 3658 pw = pl++; 3659 Dereference_(pw); /* get the list element */ 3660 nst = get_stream_id(pw->val, pw->tag, 0, &res); 3661 if (nst == NO_STREAM) 3662 { Bip_Error(res); } 3663 if (!IsOpened(nst)) 3664 { Bip_Error(STREAM_SPEC); } 3665 if (IsSocket(nst)) /* We don't wait for writes in sockets... */ 3666 nst = SocketInputStream(nst); 3667 3668 if (StreamMode(nst) & SSELECTABLE) 3669 { 3670 if (IsReadStream(nst) && StreamMethods(nst).buffer_nonempty(nst)) 3671 { 3672 buffer_input = 1; /* we can read from buffer */ 3673 } 3674 else if (StreamUnit(nst) != NO_UNIT) 3675 { 3676 need_select = 1; 3677 if (IsReadStream(nst)) 3678 { 3679 FD_SET((socket_t) StreamUnit(nst), &dread); 3680 } 3681 else if (IsWriteStream(nst)) 3682 { 3683 FD_SET((socket_t) StreamUnit(nst), &dwrite); 3684 } 3685 if ((socket_t) StreamUnit(nst) > max) 3686 max = StreamUnit(nst); 3687 } 3688 /* else: stream definitely not ready */ 3689 } 3690#ifdef _WIN32 3691 else if (IsTty(nst) && IsReadStream(nst) && pto && pto->tv_sec==0 && pto->tv_usec==0) 3692 { 3693 /* allow pseudo-select on Windows console with zero timeout */ 3694 need_kbhit = 1; 3695 } 3696 else if (IsPipeStream(nst) && IsReadStream(nst) && pto && pto->tv_sec==0 && pto->tv_usec==0) 3697 { 3698 /* allow pseudo-select on Windows pipe with zero timeout */ 3699 need_peek = 1; 3700 } 3701#endif 3702 else 3703 { 3704 Bip_Error(UNIMPLEMENTED); 3705 } 3706 3707 Dereference_(pl); /* get the list tail */ 3708 if (IsRef(pl->tag)) 3709 { Bip_Error(INSTANTIATION_FAULT); } 3710 else if (IsList(pl->tag)) 3711 pl = pl->val.ptr; 3712 else if (IsNil(pl->tag)) 3713 pl = 0; 3714 else 3715 { Bip_Error(TYPE_ERROR); } 3716 } 3717 3718 if (need_select) 3719 { 3720 if (buffer_input) /* we don't need to wait, there is something */ 3721 { 3722 to.tv_sec = 0; 3723 to.tv_usec = 0; 3724 pto = &to; 3725 } 3726 if (select(max + 1, &dread, &dwrite, (fd_set *) 0, pto) < 0) 3727 { 3728 Set_Socket_Errno(); 3729 Bip_Error(SYS_ERROR); 3730 } 3731 } 3732#ifdef _WIN32 3733 if (need_kbhit && _kbhit()) 3734 { 3735 FD_SET(StreamUnit(nst), &dread); 3736 } 3737 if (need_peek) 3738 { 3739 DWORD avail; 3740 if (!PeekNamedPipe((HANDLE)_get_osfhandle(StreamUnit(nst)), 3741 NULL, 0, NULL, &avail, NULL)) 3742 { 3743 Set_Sys_Errno(GetLastError(),ERRNO_WIN32); 3744 Bip_Error(SYS_ERROR); 3745 } 3746 if (avail > 0) 3747 { 3748 FD_SET(StreamUnit(nst), &dread); 3749 } 3750 } 3751#endif 3752 3753 pl = list; 3754 list = p = Gbl_Tg; 3755 while (pl) 3756 { 3757 pw = pl++; 3758 Dereference_(pw); /* get the list element */ 3759 nst = get_stream_id(pw->val, pw->tag, 0, &res); 3760 if (IsSocket(nst)) 3761 nst = SocketInputStream(nst); 3762 3763 if ((IsReadStream(nst) && StreamMethods(nst).buffer_nonempty(nst)) 3764 || ((StreamUnit(nst) != NO_UNIT) && 3765 ( FD_ISSET((socket_t) StreamUnit(nst), &dread) 3766 || FD_ISSET((socket_t) StreamUnit(nst), &dwrite)))) 3767 { 3768 Gbl_Tg += 2; 3769 Check_Gc; 3770 *p++ = *pw; 3771 p->val.ptr = p + 1; 3772 p++->tag.kernel = TLIST; 3773 } 3774 3775 Dereference_(pl); /* get the list tail */ 3776 if (IsList(pl->tag)) 3777 pl = pl->val.ptr; 3778 else 3779 pl = 0; 3780 } 3781 if (list == p) { 3782 Return_Unify_Nil(vout, tout); 3783 } 3784 else 3785 { 3786 (p - 1)->tag.kernel = TNIL; 3787 Return_Unify_List(vout, tout, list); 3788 } 3789} 3790#else 3791static int p_select(value vin, type tin, value vtime, type ttime, value vout, type tout) 3792{ 3793 USER_PANIC("\nNOT available\n"); 3794 Bip_Error(NOT_AVAILABLE); 3795} 3796#endif /* SELECT */ 3797 3798 3799/* shell-like filename matching routine 3800 */ 3801static int 3802_match(register char *pattern, register char *name) 3803{ 3804 register int pc, nc; 3805 int flag, found; 3806 3807 do 3808 { 3809 nc = *name++; 3810 switch (pc = *pattern++) 3811 { 3812 case '[': 3813 if (!nc) return 0; 3814 found = flag = 0; 3815 if (*pattern == '^') 3816 { 3817 pattern++; 3818 flag = 1; 3819 } 3820 for(;;) 3821 { 3822 switch (pc = *pattern++) 3823 { 3824 case '-': if (nc >= *(pattern-2) && nc <= *pattern) 3825 found = 1; 3826 continue; 3827 default: if (pc == nc) 3828 found = 1; 3829 continue; 3830 case 0: 3831 case ']': break; 3832 } 3833 break; 3834 } 3835 if (found == flag) return 0; 3836 break; 3837 3838 case '*': 3839 name -= 1; 3840 do 3841 if (_match(pattern, name)) 3842 return 1; 3843 while (*name++); 3844 return 0; 3845 3846 case '?': 3847 if (!nc) return 0; 3848 break; 3849 3850 default: 3851 if (pc != nc) return 0; 3852 break; 3853 } 3854 } 3855 while (nc); 3856 return 1; 3857} 3858 3859 3860#if defined(HAVE_READLINE) 3861static int 3862p_readline(value v, type t) 3863{ 3864 int res; 3865 stream_id nst = get_stream_id(v, t, SREAD, &res); 3866 3867 if (nst == NO_STREAM) 3868 { Bip_Error(res); } 3869 if (!IsTty(nst)) { 3870 Bip_Error(STREAM_MODE) 3871 } 3872 res = set_readline(nst); 3873 if (res != PSUCCEED) { 3874 Set_Errno; 3875 Bip_Error(SYS_ERROR); 3876 } 3877 Succeed_; 3878} 3879#endif 3880 3881 3882#ifdef _WIN32 3883/* 3884 * Surround a string with double quotes and double internal quotes. 3885 * This is the best method I have found for Windows to pass the string as 3886 * precisely as possible. Experiments with backslash-escaping were unsuccessful 3887 * since windows sometimes doubles them internally, probably assuming they are 3888 * path separators. 3889 * The only character that cannot be passed with this method is \n because 3890 * Windows insists in converting it to \r\n... 3891 * 3892 * The result string is allocated on the global stack. 3893 */ 3894char * 3895_quoted_string(char *s, int len) 3896{ 3897 pword *pw = TG; 3898 char *buf; 3899 int i; 3900 Push_Buffer(2*len+3); /* worst case: N chars, N escapes, 2 quotes, 1 nul */ 3901 buf = (char *) BufferStart(pw); 3902 *buf++ = '"'; 3903 for(i=0; i<len; i++) 3904 { 3905 int c = s[i]; 3906 if (c == '"') /* escape quotes by doubling */ 3907 *buf++ = '"'; 3908 *buf++ = c; 3909 } 3910 *buf++ = '"'; 3911 *buf++ = 0; 3912 Trim_Buffer(pw, buf - ((char *) BufferStart(pw))); /* adjust length */ 3913 return (char *) BufferStart(pw); 3914} 3915 3916char * 3917_new_os_filename(char *s) 3918{ 3919 pword *pw = TG; 3920 Push_Buffer(MAX_PATH_LEN); 3921 s = os_filename(s, (char *) BufferStart(pw)); 3922 Trim_Buffer(pw, strlen(s)+1); 3923 return (char *) BufferStart(pw); 3924} 3925#endif 3926 3927 3928/* 3929 * set up an argv[] array from a string or lists of strings/atoms 3930 */ 3931 3932static int 3933_build_argv(value vc, 3934 type tc, 3935 char **argv, /* the constructed argument vector */ 3936 char **cmd) /* usually the same as argv[0], but not on Windows */ 3937{ 3938 if (IsList(tc)) 3939 { 3940 pword *cdr = vc.ptr; 3941 int i = 0; 3942 3943 while (i < MAX_ARGS) 3944 { 3945 pword *car = cdr++; 3946 Dereference_(car); 3947 if (IsNumber(car->tag)) 3948 { 3949 pword auxpw; 3950 int len; 3951 len = tag_desc[TagType(car->tag)].string_size(car->val, car->tag, 0); 3952 Make_Stack_String(len, auxpw.val, argv[i]); /* maybe too long */ 3953 len = tag_desc[TagType(car->tag)].to_string(car->val, car->tag, argv[i], 0); 3954 Trim_Buffer(auxpw.val.ptr, len+1); /* adjust length */ 3955 } 3956 else 3957 { 3958#ifdef _WIN32 3959 char *s; 3960 int len; 3961 3962 if (IsAtom(car->tag)) { 3963 s = DidName(car->val.did); 3964 len = DidLength(car->val.did); 3965 } else if (IsString(car->tag)) { 3966 s = StringStart(car->val); 3967 len = StringLength(car->val); 3968 } else if (IsNil(car->tag)) { 3969 s = DidName(d_.nil); 3970 len = DidLength(d_.nil); 3971 } else if (IsRef(car->tag)) { 3972 Bip_Error(INSTANTIATION_FAULT); 3973 } else { 3974 Bip_Error(TYPE_ERROR); 3975 } 3976 3977 /* apply filename conversion to the command name only */ 3978 if (i == 0) 3979 { 3980 *cmd = s = _new_os_filename(s); 3981 len = strlen(s); 3982 } 3983 3984 /* quote the arguments argv[], but not cmd! */ 3985 argv[i] = _quoted_string(s, len); 3986 3987#else 3988 Get_Name(car->val, car->tag, argv[i]); 3989 if (i == 0) 3990 *cmd = argv[0]; 3991#endif 3992 } 3993 Dereference_(cdr); 3994 ++i; 3995 if (IsNil(cdr->tag)) { 3996 break; 3997 } else if (!IsList(cdr->tag)) { 3998 Bip_Error(TYPE_ERROR); 3999 } 4000 if (i >= MAX_ARGS) { 4001 Set_Sys_Errno(E2BIG, ERRNO_UNIX); 4002 Bip_Error(SYS_ERROR); 4003 } 4004 cdr = cdr->val.ptr; 4005 } 4006 argv[i] = 0; 4007 } 4008 else /* atoms and strings (backward compatibility) */ 4009 { 4010 char *command; 4011 pword copy; 4012 Get_Name(vc, tc, command); 4013 Make_String(©, command); 4014 _get_args(StringStart(copy.val), argv); /* parse the string */ 4015 *cmd = argv[0]; 4016 } 4017 Succeed_; 4018} 4019 4020 4021#undef Bip_Error 4022#define Bip_Error(N) Bip_Error_Fail(N) 4023 4024static int 4025p_check_valid_stream(value v, type t) 4026{ 4027 int res; 4028 stream_id nst = get_stream_id(v, t, 0, &res); 4029 4030 if (nst == NO_STREAM) 4031 { Bip_Error(res); } 4032 if (!IsOpened(nst)) 4033 { Bip_Error(STREAM_SPEC); } 4034 Succeed_; 4035} 4036 4037static int 4038p_check_stream_spec(value v, type t) 4039{ 4040 if (IsRef(t)) { 4041 Bip_Error(INSTANTIATION_FAULT); 4042 } 4043 switch(TagType(t)) 4044 { 4045 case TNIL: 4046 case TDICT: 4047 break; 4048 4049 case TINT: 4050 case TBIG: 4051 /* backward compatibility: allow number iff it was obtained previously */ 4052 break; 4053 4054 case THANDLE: 4055 Check_Typed_Object_Handle(v, t, &stream_tid); 4056 break; 4057 4058 default: 4059 Bip_Error(TYPE_ERROR); 4060 } 4061 Succeed_; 4062} 4063 4064 4065#ifdef _WIN32 4066 4067/* The CreateProcess() doc says the command line can be 32k, 4068 * except for Win2000, where it's limited to MAX_PATH */ 4069#define MAX_WIN_CMD_LINE (32*1024) 4070 4071static int 4072p_exec(value vc, type tc, value vstr, type tstr, value vp, type tp, value vpr, type tpr) 4073{ 4074 char *argv[MAX_ARGS+1]; 4075 struct pipe_desc pipes[MAX_PIPES + 1]; 4076 struct pipe_desc *p; 4077 int pid; 4078 stream_id id; 4079 int i, err; 4080 char *cmd; 4081 pword *old_tg = TG; 4082 STARTUPINFO si; 4083 PROCESS_INFORMATION pi; 4084 DWORD dwInfo, dwCreationFlags; 4085 4086 4087 Check_Ref(tp); 4088 Check_Integer(tpr); 4089 4090 err = _build_argv(vc, tc, argv, &cmd); 4091 if (err < 0) { 4092 Bip_Error(err) 4093 } 4094 4095 err = _check_streams(vstr, tstr, pipes); 4096 if (err < 0) { 4097 Bip_Error(err) 4098 } 4099 4100 err = _open_pipes(pipes); 4101 if (err < 0) { 4102 Bip_Error(err) 4103 } 4104 4105 /* Prepare arguments for CreateProcess() */ 4106 dwCreationFlags = (vpr.nint==1 ? CREATE_NEW_PROCESS_GROUP : 0); 4107 4108 ZeroMemory( &pi, sizeof(pi) ); 4109 ZeroMemory( &si, sizeof(si) ); 4110 si.cb = sizeof(si); 4111 4112 /* By default, inherit the parent's standard I/O */ 4113 si.dwFlags |= STARTF_USESTDHANDLES; 4114 si.hStdInput = GetStdHandle(STD_INPUT_HANDLE); 4115 si.hStdOutput = GetStdHandle(STD_OUTPUT_HANDLE); 4116 si.hStdError = GetStdHandle(STD_ERROR_HANDLE); 4117 4118 /* If there are pipes, make sure the correct end gets inherited 4119 * by the child, and the other does not. 4120 */ 4121 for(i=0; !(pipes[i].flags & EXEC_PIPE_LAST); ++i) 4122 { 4123 HANDLE hParent, hChild; 4124 if (!pipes[i].flags) 4125 continue; 4126 4127 /* don't create a window if there is any I/O redirection */ 4128 dwCreationFlags |= CREATE_NO_WINDOW; 4129 4130 switch(i) { 4131 case 0: 4132 hParent = (HANDLE) _get_osfhandle(pipes[i].fd[1]); 4133 hChild = (HANDLE) _get_osfhandle(pipes[i].fd[0]); 4134 si.hStdInput = hChild; 4135 break; 4136 case 1: 4137 hParent = (HANDLE) _get_osfhandle(pipes[i].fd[0]); 4138 hChild = (HANDLE) _get_osfhandle(pipes[i].fd[1]); 4139 si.hStdOutput = hChild; 4140 break; 4141 case 2: 4142 hParent = (HANDLE) _get_osfhandle(pipes[i].fd[0]); 4143 hChild = (HANDLE) _get_osfhandle(pipes[i].fd[1]); 4144 si.hStdError = hChild; 4145 break; 4146 default: /* TODO: can we inherit the other handles? */ 4147 Bip_Error(UNIMPLEMENTED); 4148 } 4149 if (hParent == INVALID_HANDLE_VALUE || hChild == INVALID_HANDLE_VALUE) 4150 { 4151 Set_Errno; 4152 Bip_Error(SYS_ERROR); 4153 } 4154 if (!SetHandleInformation(hChild, HANDLE_FLAG_INHERIT, HANDLE_FLAG_INHERIT) 4155 || !SetHandleInformation(hParent, HANDLE_FLAG_INHERIT, 0)) 4156 { 4157 Set_Sys_Errno(GetLastError(),ERRNO_WIN32); 4158 Bip_Error(SYS_ERROR); 4159 } 4160 } 4161 4162 /* Concat the arguments into a command line again. Thanks, Microsoft! */ 4163 { 4164 char *s; 4165 int len = 0; 4166 pword *pw_s = TG; 4167 for (i=0; argv[i]; ++i) 4168 { 4169 len += strlen(argv[i]) + 1; 4170 } 4171 if (len > MAX_WIN_CMD_LINE) 4172 { 4173 Set_Sys_Errno(E2BIG, ERRNO_UNIX); 4174 Bip_Error(SYS_ERROR); 4175 } 4176 Push_Buffer(len); 4177 cmd = s = (char *) BufferStart(pw_s); 4178 for (i=0; argv[i]; ++i) 4179 { 4180 char *t = argv[i]; 4181 while((*s++ = *t++)) 4182 ; 4183 *(s-1) = ' '; 4184 } 4185 *(s-1) = 0; 4186 } 4187 4188 /* Start the child process */ 4189 if (!CreateProcess( 4190 NULL, /* If we specify this, PATH won't be searched */ 4191 (LPTSTR) cmd, /* Command line as string */ 4192 NULL, /* Process handle not inheritable */ 4193 NULL, /* Thread handle not inheritable */ 4194 TRUE, /* inherit handles */ 4195 dwCreationFlags, /* process group, window, ... */ 4196 NULL, /* Use parent's environment block */ 4197 NULL, /* Use parent's starting directory */ 4198 &si, /* Pointer to STARTUPINFO structure */ 4199 &pi)) /* Pointer to PROCESS_INFORMATION structure */ 4200 { 4201 Set_Sys_Errno(GetLastError(),ERRNO_WIN32); 4202 Bip_Error(SYS_ERROR); 4203 _close_pipes(pipes); 4204 Bip_Error(SYS_ERROR); 4205 } 4206 4207 /* Pop all the temporary strings */ 4208 TG = old_tg; 4209 4210 /* Close the (now inherited) child ends of the pipes in the parent */ 4211 for(i=0; !(pipes[i].flags & EXEC_PIPE_LAST); ++i) 4212 { 4213 if (pipes[i].flags) { 4214 switch(i) { 4215 case 0: 4216 close(pipes[i].fd[0]); 4217 break; 4218 case 1: 4219 case 2: 4220 close(pipes[i].fd[1]); 4221 break; 4222 default: /* TODO: can we inherit the other handles? */ 4223 Bip_Error(UNIMPLEMENTED); 4224 } 4225 } 4226 } 4227 pid = pi.dwProcessId; 4228 CloseHandle(pi.hThread); 4229 4230 /* Remember the process handle in a list which is used by p_wait(). 4231 * Otherwise the process can disappear before they have been waited for */ 4232 { 4233 t_child_desc *pd = (t_child_desc *) hp_alloc_size(sizeof(t_child_desc)); 4234 pd->pid = pid; 4235 pd->hProcess = pi.hProcess; 4236 pd->next = child_processes; 4237 pd->prev_next = &child_processes; 4238 child_processes = pd; 4239 } 4240 4241 /* Now create the Eclipse streams for the pipes */ 4242 p = &pipes[0]; 4243 while (!(p->flags & EXEC_PIPE_LAST)) 4244 { 4245 if (p->flags & EXEC_PIPE_IN) { 4246 id = find_free_stream(); 4247 init_stream(id, p->fd[1], SWRITE | SPIPE, d_pipe, NO_PROMPT, 4248 NO_STREAM, 0); 4249 } else if (p->flags & EXEC_PIPE_OUT) { 4250 id = find_free_stream(); 4251 init_stream(id, p->fd[0], SREAD | SPIPE, d_pipe, NO_PROMPT, 4252 NO_STREAM, 0); 4253 if (p->flags & EXEC_PIPE_SIG) { 4254 if ((err = ec_stream_set_sigio(id, SREAD)) < 0) { 4255 Bip_Error(err); 4256 } 4257 } 4258 } 4259 if (p->flags & (EXEC_PIPE_IN|EXEC_PIPE_OUT)) { 4260 Bind_Stream(p->pw.val, p->pw.tag, id); 4261 } 4262 p++; 4263 } 4264 4265 Return_Unify_Integer(vp, tp, pid); 4266} 4267 4268#elif defined(BARRELFISH) 4269static int 4270p_exec(value vc, type tc, value vstr, type tstr, value vp, type tp, value vpr, type tpr) 4271{ 4272 USER_PANIC("\nNOT available\n"); 4273 Bip_Error(NOT_AVAILABLE); 4274} 4275#else 4276 4277static int 4278p_exec(value vc, type tc, value vstr, type tstr, value vp, type tp, value vpr, type tpr) 4279{ 4280 char *argv[MAX_ARGS+1]; 4281 struct pipe_desc pipes[MAX_PIPES + 1]; 4282 struct pipe_desc *p; 4283 int pid; 4284 stream_id id; 4285 int err; 4286 char *cmd; 4287 4288 Check_Ref(tp); 4289 Check_Integer(tpr); 4290 4291 err = _build_argv(vc, tc, argv, &cmd); 4292 if (err < 0) { 4293 Bip_Error(err) 4294 } 4295 4296 err = _check_streams(vstr, tstr, pipes); 4297 if (err < 0) { 4298 Bip_Error(err) 4299 } 4300 4301 err = _open_pipes(pipes); 4302 if (err < 0) { 4303 Bip_Error(err) 4304 } 4305 4306 switch (pid = vfork()) 4307 { 4308 case -1: 4309 _close_pipes(pipes); 4310 Set_Errno; 4311 Bip_Error(SYS_ERROR); 4312 4313 case 0: /* child */ 4314 _connect_pipes(pipes); 4315 if (vpr.nint == 1) /* wants to set process group ID */ 4316#ifdef HAVE_SETSID 4317 (void) setsid(); 4318#else 4319 (void) setpgrp(0, getpid()); 4320#endif 4321 errno = 0; 4322 (void) execvp(cmd, argv); 4323 { 4324 /* Explicitly send error to child's error stream. If 4325 * we send to current_err_ on most architectures the 4326 * error goes to the parent's error stream. On alpha Linux 4327 * current_err_ is attached to the ether so the error isn't 4328 * seen at all. This has the benefit that the error can now be read 4329 * correctly from the child's stream, but in tkeclipse it no 4330 * longer appears as an error in the output window. 4331 * This would appear to be determined by the architecture's 4332 * vfork() implementation. 4333 */ 4334 if (vpr.nint < 2 && strerror(errno)) { 4335 fprintf(stderr, "system interface error: %s in exec(%s, ..., ...)\n", 4336 strerror(errno), cmd); 4337 fflush(stderr); 4338 } 4339 /* buggy behaviour in some cases mean errno may not be set with 4340 an error, reutrn a fake errno 4341 */ 4342 if (errno == 0) errno = ENOEXEC; 4343 _exit(errno + 128); /* not exit() inside vfork, as per man page */ 4344 } 4345 4346 default: /* parent */ 4347 p = &pipes[0]; 4348 while (!(p->flags & EXEC_PIPE_LAST)) 4349 { 4350 if (p->flags & EXEC_PIPE_IN) { 4351 (void) close(p->fd[0]); 4352 id = find_free_stream(); 4353 init_stream(id, p->fd[1], SWRITE | SPIPE, d_pipe, NO_PROMPT, 4354 NO_STREAM, 0); 4355 } else if (p->flags & EXEC_PIPE_OUT) { 4356 (void) close(p->fd[1]); 4357 id = find_free_stream(); 4358 init_stream(id, p->fd[0], SREAD | SPIPE, d_pipe, NO_PROMPT, 4359 NO_STREAM, 0); 4360 if (p->flags & EXEC_PIPE_SIG) { 4361 if ((err = ec_stream_set_sigio(id, SREAD)) < 0) { 4362 Bip_Error(err); 4363 } 4364 } 4365 } 4366 if (p->flags & (EXEC_PIPE_IN|EXEC_PIPE_OUT)) { 4367 Bind_Stream(p->pw.val, p->pw.tag, id); 4368 } 4369 p++; 4370 } 4371 Return_Unify_Integer(vp, tp, pid); 4372 } 4373} 4374#endif 4375 4376#undef Bip_Error 4377#define Bip_Error(N) return(N); 4378 4379/* 4380 * Break up a string into an array of tokens which can be used for 4381 * an execv call. 4382 */ 4383static void 4384_get_args(char *command, char **argv) 4385{ 4386 int i; 4387 register int c; 4388 register int sep; 4389 char *cp; 4390 4391 for (i = 0; i < MAX_ARGS; ) 4392 { 4393 if (!command) 4394 break; 4395 4396 while ((c = *command)) 4397 { 4398 if (c != ' ' && c != '\t') 4399 break; 4400 command++; 4401 } 4402 4403 if (c == '\0') 4404 break; 4405 4406 switch (*command) 4407 { 4408 case '\'': 4409 sep = '\''; 4410 command++; 4411 break; 4412 4413 case '"': 4414 sep = '"'; 4415 command++; 4416 break; 4417 4418#ifndef _WIN32 4419 case '\\': 4420 command++; 4421 /* fall into */ 4422#endif 4423 default: 4424 sep = 0; 4425 } 4426 argv[i++] = command; 4427 cp = command + 1; 4428 while ((c = *++command)) 4429 if (sep) 4430 { 4431 if (c == sep) 4432 break; 4433 *cp++ = c; 4434 } 4435#ifndef _WIN32 4436 /* take care of escaped chars */ 4437 else if (c == '\\') 4438 { 4439 if ((c = *++command) == '\0') 4440 break; 4441 else 4442 *cp++ = c; 4443 } 4444#endif 4445 else if (c == ' ' || c == '\t') 4446 break; 4447 else 4448 *cp++ = c; 4449 4450 *cp++ = '\0'; 4451 if (c == '\0') 4452 break; 4453 else 4454 command = cp; 4455 } 4456 argv[i] = 0; 4457} 4458 4459static int 4460_check_streams(value vstr, type tstr, struct pipe_desc *pipes) 4461{ 4462 int i = 0; 4463 int res; 4464 int io; 4465 pword *p; 4466 pword *l; 4467 4468 if (IsList(tstr)) 4469 { 4470 l = vstr.ptr; 4471 for (;;) 4472 { 4473 p = l; 4474 Dereference_(p); 4475 switch (i) { 4476 case 0: 4477 io = EXEC_PIPE_IN; 4478 break; 4479 4480 case 1: 4481 case 2: 4482 io = EXEC_PIPE_OUT; 4483 break; 4484 4485 default: 4486 io = EXEC_PIPE_IN | EXEC_PIPE_OUT; 4487 } 4488 res = _check_stream(p->val, p->tag, &pipes[i].pw, io); 4489 if (res < 0) 4490 return res; 4491 if (i <= 2 && res) /* we know if input or output */ 4492 res |= io; 4493 else if (res && !(res & io)) /* must be specified */ 4494 return STREAM_MODE; 4495 pipes[i].flags = res; 4496 l++; 4497 i++; 4498 Dereference_(l); 4499 if (IsNil(l->tag)) 4500 break; 4501 if (!IsList(l->tag)) 4502 return IsRef(l->tag) ? INSTANTIATION_FAULT : TYPE_ERROR; 4503 l = l->val.ptr; 4504 if (i >= MAX_PIPES) 4505 return RANGE_ERROR; 4506 } 4507 } 4508 else if (!IsNil(tstr)) 4509 { 4510 return IsRef(tstr) ? INSTANTIATION_FAULT : TYPE_ERROR; 4511 } 4512 pipes[i].flags |= EXEC_PIPE_LAST; 4513 return 0; 4514} 4515 4516 4517/* 4518 * Check the stream argument for exec/3. 4519 * For error, return negative error code 4520 * 4521 * For null return 0 4522 * if atom or variable set EXEC_PIPE_CON 4523 * if sigio(Atom_Or_Var) also set EXEC_PIPE_SIG 4524 * Also set s to the proper stream argument. 4525 * 4526 * If io is nonzero, allow in(S), out(S), or either, depending on io. 4527 * if in(Atom_Or_Var) also set EXEC_PIPE_IN in return code 4528 * if out(Atom_Or_Var) also set EXEC_PIPE_OUT in return code 4529 */ 4530static int 4531_check_stream(value v, type t, pword *s, int io) 4532{ 4533 int res = EXEC_PIPE_CON; 4534 int where; 4535 4536 if (IsAtom(t)) 4537 { 4538 if (v.did == d_.null) 4539 res = 0; 4540 } 4541#if defined(SIGIO_FASYNC) || defined(SIGIO_SETSIG) || defined(SIGIO_FIOASYNC) 4542 else if (IsStructure(t) && v.ptr->val.did == d_sigio) 4543 { 4544 (v.ptr)++; 4545 Dereference_(v.ptr); 4546 if ((res = _check_stream(v.ptr->val, v.ptr->tag, s, io)) < 0) 4547 return res; 4548 return res | EXEC_PIPE_SIG; 4549 } 4550#endif 4551 else if (IsStructure(t) && 4552 ((v.ptr->val.did == d_in && (where = EXEC_PIPE_IN)) || 4553 (v.ptr->val.did == d_out && (where = EXEC_PIPE_OUT)))) 4554 { 4555 if (!(io & where)) 4556 return STREAM_MODE; 4557 (v.ptr)++; 4558 Dereference_(v.ptr); 4559 if ((res = _check_stream(v.ptr->val, v.ptr->tag, s, 0)) < 0) 4560 return res; 4561 return res | where; 4562 } 4563 else if (IsNil(t)) 4564 v.did = d_.nil; 4565 else if (!IsRef(t)) 4566 return TYPE_ERROR; 4567 s->val = v; 4568 s->tag = t; 4569 return res; 4570} 4571 4572 4573static void 4574_close_pipes(struct pipe_desc *pipes) 4575{ 4576 while (!(pipes->flags & EXEC_PIPE_LAST)) { 4577 if (pipes->flags) { 4578 (void) close(pipes->fd[0]); 4579 (void) close(pipes->fd[1]); 4580 } 4581 pipes++; 4582 } 4583} 4584 4585#ifndef _WIN32 4586 4587static void 4588_connect_pipes(struct pipe_desc *pipes) 4589{ 4590 int i = 0; 4591 4592 while (!(pipes->flags & EXEC_PIPE_LAST)) { 4593 if (pipes->flags & EXEC_PIPE_IN) { 4594 if (dup2(pipes->fd[0], i) == -1 || 4595 close(pipes->fd[1]) == -1 || 4596 close(pipes->fd[0]) == -1) 4597 { 4598 ec_bad_exit(strerror(errno)); 4599 } 4600 if ((pipes->flags & EXEC_PIPE_SIG) && set_sigio(i) < 0) { 4601 ec_bad_exit(strerror(errno)); 4602 } 4603 } else if (pipes->flags & EXEC_PIPE_OUT) { 4604 if (dup2(pipes->fd[1], i) == -1) { 4605 ec_bad_exit(strerror(errno)); 4606 } 4607 (void) close(pipes->fd[0]); 4608 (void) close(pipes->fd[1]); 4609 } 4610 pipes++; 4611 i++; 4612 } 4613} 4614 4615#endif 4616 4617static int 4618_open_pipes(struct pipe_desc *allpipes) 4619{ 4620 struct pipe_desc *pipes = allpipes; 4621 while (!(pipes->flags & EXEC_PIPE_LAST)) { 4622 if (pipes->flags) { 4623 if (pipe(pipes->fd) == -1) { 4624 Set_Errno; 4625 pipes->flags |= EXEC_PIPE_LAST; 4626 _close_pipes(allpipes); 4627 return SYS_ERROR; 4628 } 4629 } 4630 pipes++; 4631 } 4632 return 0; 4633} 4634 4635 4636static int 4637p_wait(value pv, type pt, value sv, type st, value vmode, type tmode) 4638{ 4639 int statusp; 4640 int pid, res; 4641 Prepare_Requests; 4642 4643 Check_Atom(tmode) 4644 Check_Output_Integer(st); 4645 if (IsInteger(pt)) 4646 { 4647#ifdef _WIN32 4648 HANDLE phandle; 4649 DWORD dwstatus; 4650 t_child_desc *pd; 4651 4652 Cut_External; 4653 4654 /* First try to find the PID in our list of children */ 4655 for(pd = child_processes; pd; pd = pd->next) 4656 { 4657 if (pv.nint == pd->pid) 4658 break; 4659 } 4660 if (pd) /* We know the process and still have a handle */ 4661 { 4662 phandle = pd->hProcess; 4663 } 4664 else /* Unknown process, try to open a temporary handle */ 4665 { 4666 phandle = OpenProcess(SYNCHRONIZE|PROCESS_QUERY_INFORMATION, FALSE, pv.nint); 4667 if (!phandle) 4668 { 4669 if (GetLastError() == ERROR_INVALID_PARAMETER) 4670 { 4671 Fail_; 4672 } 4673 Set_Sys_Errno(GetLastError(),ERRNO_WIN32); 4674 Bip_Error(SYS_ERROR); 4675 } 4676 } 4677 4678 if (vmode.did == d_.hang) { 4679 res = WaitForSingleObject(phandle, INFINITE); 4680 } else if(vmode.did == d_.nohang) { 4681 res = WaitForSingleObject(phandle, 0); 4682 } else { 4683 Bip_Error(RANGE_ERROR); 4684 } 4685 if (res == WAIT_OBJECT_0) 4686 { 4687 /* handle is signaled, i.e. process terminated */ 4688 if (!GetExitCodeProcess(phandle, &dwstatus)) 4689 goto _wait_cleanup_error_; 4690 pid = pv.nint; 4691 statusp = dwstatus; 4692 Child_Unlink(pd); 4693 CloseHandle(phandle); 4694 } 4695 else if (res == WAIT_TIMEOUT) 4696 { 4697 /* make it fail, but keep the handle if was in the list */ 4698 if (!pd) 4699 { 4700 CloseHandle(phandle); 4701 } 4702 Fail_; 4703 } 4704 else /* WAIT_FAILED */ 4705 { 4706_wait_cleanup_error_: 4707 Child_Unlink(pd); 4708 CloseHandle(phandle); 4709 Set_Sys_Errno(GetLastError(),ERRNO_WIN32); 4710 Bip_Error(SYS_ERROR); 4711 } 4712#else 4713 Cut_External; 4714 if (vmode.did == d_.hang) { 4715 pid = waitpid((pid_t) pv.nint, &statusp, 0); 4716 } else if(vmode.did == d_.nohang) { 4717 pid = waitpid((pid_t) pv.nint, &statusp, WNOHANG); 4718 if (pid == 0) { /* Child not yet exited */ 4719 Fail_; 4720 } 4721 } else { 4722 Bip_Error(RANGE_ERROR); 4723 } 4724#endif 4725 } 4726 else if (IsRef(pt)) 4727 { 4728#ifdef _WIN32 4729 Bip_Error(UNIMPLEMENTED); 4730#else 4731 pid = waitpid((pid_t) (-1), &statusp, 0); 4732 if (pid >= 0) { 4733 Request_Unify_Integer(pv, pt, pid); 4734 } 4735#endif 4736 } 4737 else 4738 { 4739 Bip_Error(TYPE_ERROR); 4740 } 4741 if (pid == -1) { 4742 Cut_External; 4743 if (errno == ECHILD) { 4744 Fail_; 4745 } 4746 Set_Errno; 4747 Bip_Error(SYS_ERROR) 4748 } 4749 Request_Unify_Integer(sv, st, statusp); 4750 Return_Unify; 4751} 4752