static foreign_t
pl_win_open_console(term_t title, term_t input, term_t output, term_t error,
term_t options)
{ rlc_console_attr attr;
rlc_console c;
IOSTREAM *in, *out, *err;
TCHAR *s;
size_t len;
memset(&attr, 0, sizeof(attr));
if ( !PL_get_wchars(title, &len, &s, CVT_ALL|BUF_RING) )
return type_error(title, "text");
attr.title = (const TCHAR*) s;
if ( !process_console_options(&attr, options) )
return FALSE;
c = rlc_create_console(&attr);
create_prolog_hidden_window(c); /* for sending messages */
registerConsole(c);
#define STREAM_COMMON (SIO_TEXT| /* text-stream */ \
SIO_NOCLOSE| /* do no close on abort */ \
SIO_ISATTY| /* terminal */ \
SIO_NOFEOF) /* reset on end-of-file */
in = Snew(c, SIO_INPUT|SIO_LBUF|STREAM_COMMON, &rlc_functions);
out = Snew(c, SIO_OUTPUT|SIO_LBUF|STREAM_COMMON, &rlc_functions);
err = Snew(c, SIO_OUTPUT|SIO_NBUF|STREAM_COMMON, &rlc_functions);
in->position = &in->posbuf; /* record position on same stream */
out->position = &in->posbuf;
err->position = &in->posbuf;
in->encoding = ENC_WCHAR;
out->encoding = ENC_WCHAR;
err->encoding = ENC_WCHAR;
if ( !PL_unify_stream(input, in) ||
!PL_unify_stream(output, out) ||
!PL_unify_stream(error, err) )
{ Sclose(in);
Sclose(out);
Sclose(err);
rlc_close(c);
return FALSE;
}
rlc_set(c, RLC_PROLOG_INPUT, (uintptr_t)in, NULL);
rlc_set(c, RLC_PROLOG_OUTPUT, (uintptr_t)out, NULL);
rlc_set(c, RLC_PROLOG_ERROR, (uintptr_t)err, free_stream);
return TRUE;
}
static int
syntax_error(const char *culprit, IOSTREAM *in)
{ term_t ex;
term_t loc, sterm;
if ( in->position &&
(loc=PL_new_term_ref()) &&
(sterm = PL_new_term_ref()) &&
PL_unify_stream(sterm, in) &&
PL_unify_term(loc,
PL_FUNCTOR, FUNCTOR_stream4,
PL_TERM, sterm,
PL_INT, in->position->lineno,
PL_INT, in->position->linepos,
PL_INT64, in->position->charno) &&
(ex = PL_new_term_ref()) &&
PL_unify_term(ex,
PL_FUNCTOR, FUNCTOR_error2,
PL_FUNCTOR, FUNCTOR_syntax_error1,
PL_CHARS, culprit,
PL_TERM, loc) )
return PL_raise_exception(ex);
return FALSE;
}
static int
syntax_error(IOSTREAM *in, const char *msg)
{ term_t ex = PL_new_term_refs(2);
IOPOS *pos;
if ( !PL_unify_term(ex+0, PL_FUNCTOR, FUNCTOR_syntax_error1,
PL_CHARS, msg) )
return FALSE;
if ( (pos=in->position) )
{ term_t stream;
if ( !(stream = PL_new_term_ref()) ||
!PL_unify_stream(stream, in) ||
!PL_unify_term(ex+1,
PL_FUNCTOR, FUNCTOR_stream4,
PL_TERM, stream,
PL_INT, (int)pos->lineno,
PL_INT, (int)(pos->linepos-1), /* one too late */
PL_INT64, (int64_t)(pos->charno-1)) )
return FALSE;
}
if ( PL_cons_functor_v(ex, FUNCTOR_error2, ex) )
{ int c;
do
{ c = Sgetcode(in);
} while(c != '\n' && c != -1);
return PL_raise_exception(ex);
}
return FALSE;
}
static foreign_t
archive_open_entry(term_t archive, term_t stream)
{ archive_wrapper *ar;
IOSTREAM *s;
if ( !get_archive(archive, &ar) )
return FALSE;
if ( (s=Snew(ar, SIO_INPUT|SIO_RECORDPOS, &ar_entry_functions)) )
{ ar->status = AR_OPENED_ENTRY;
if ( PL_unify_stream(stream, s) )
{ PL_register_atom(ar->symbol); /* We may no longer reference the */
return TRUE; /* archive itself */
}
Sclose(s);
return FALSE;
}
return PL_resource_error("memory");
}
static int
do_create_process(p_options *info)
{ int pid;
if ( !(pid=vfork()) ) /* child */
{ int fd;
PL_cleanup_fork();
if ( info->detached )
setsid();
if ( info->cwd )
{ if ( chdir(info->cwd) )
{ perror(info->cwd);
exit(1);
}
}
/* stdin */
switch( info->streams[0].type )
{ case std_pipe:
dup2(info->streams[0].fd[0], 0);
close(info->streams[0].fd[1]);
break;
case std_null:
if ( (fd = open("/dev/null", O_RDONLY)) >= 0 )
dup2(fd, 0);
break;
case std_std:
break;
}
/* stdout */
switch( info->streams[1].type )
{ case std_pipe:
dup2(info->streams[1].fd[1], 1);
close(info->streams[1].fd[0]);
break;
case std_null:
if ( (fd = open("/dev/null", O_WRONLY)) >= 0 )
dup2(fd, 1);
break;
case std_std:
break;
}
/* stderr */
switch( info->streams[2].type )
{ case std_pipe:
dup2(info->streams[2].fd[1], 2);
close(info->streams[2].fd[0]);
break;
case std_null:
if ( (fd = open("/dev/null", O_WRONLY)) >= 0 )
dup2(fd, 2);
break;
case std_std:
break;
}
if ( info->envp )
execve(info->exe, info->argv, info->envp);
else
execv(info->exe, info->argv);
perror(info->exe);
exit(1);
} else if ( pid < 0 ) /* parent */
{ term_t exe = PL_new_term_ref();
PL_put_atom_chars(exe, info->exe);
return pl_error(NULL, 0, "fork", ERR_ERRNO, errno, "fork", "process", exe);
} else
{ if ( info->pipes > 0 && info->pid == 0 )
{ IOSTREAM *s;
process_context *pc = PL_malloc(sizeof(*pc));
DEBUG(Sdprintf("Wait on pipes\n"));
memset(pc, 0, sizeof(*pc));
pc->magic = PROCESS_MAGIC;
pc->pid = pid;
if ( info->streams[0].type == std_pipe )
{ close(info->streams[0].fd[0]);
s = open_process_pipe(pc, 0, info->streams[0].fd[1]);
PL_unify_stream(info->streams[0].term, s);
}
if ( info->streams[1].type == std_pipe )
{ close(info->streams[1].fd[1]);
s = open_process_pipe(pc, 1, info->streams[1].fd[0]);
PL_unify_stream(info->streams[1].term, s);
}
if ( info->streams[2].type == std_pipe )
{ close(info->streams[2].fd[1]);
s = open_process_pipe(pc, 2, info->streams[2].fd[0]);
PL_unify_stream(info->streams[2].term, s);
}
return TRUE;
} else if ( info->pipes > 0 )
{ IOSTREAM *s;
if ( info->streams[0].type == std_pipe )
{ close(info->streams[0].fd[0]);
s = Sfdopen(info->streams[0].fd[1], "w");
PL_unify_stream(info->streams[0].term, s);
}
if ( info->streams[1].type == std_pipe )
{ close(info->streams[1].fd[1]);
s = Sfdopen(info->streams[1].fd[0], "r");
PL_unify_stream(info->streams[1].term, s);
}
if ( info->streams[2].type == std_pipe )
{ close(info->streams[2].fd[1]);
s = Sfdopen(info->streams[2].fd[0], "r");
PL_unify_stream(info->streams[2].term, s);
}
}
if ( info->pid )
return PL_unify_integer(info->pid, pid);
return wait_success(info->exe_name, pid);
}
}
static int
do_create_process(p_options *info)
{ int flags = 0;
PROCESS_INFORMATION pi;
STARTUPINFOW si;
switch(info->window)
{ case MAYBE:
if ( !console_app() )
flags |= CREATE_NO_WINDOW;
break;
case TRUE:
break;
case FALSE:
flags |= CREATE_NO_WINDOW;
break;
}
if ( info->detached )
flags |= CREATE_BREAKAWAY_FROM_JOB;
memset(&si, 0, sizeof(si));
si.cb = sizeof(si);
si.dwFlags = STARTF_USESTDHANDLES;
/* stdin */
switch( info->streams[0].type )
{ case std_pipe:
si.hStdInput = info->streams[0].fd[0];
SetHandleInformation(info->streams[0].fd[1],
HANDLE_FLAG_INHERIT, FALSE);
break;
case std_null:
si.hStdInput = open_null_stream(GENERIC_READ);
break;
case std_std:
si.hStdInput = GetStdHandle(STD_INPUT_HANDLE);
break;
}
/* stdout */
switch( info->streams[1].type )
{ case std_pipe:
si.hStdOutput = info->streams[1].fd[1];
SetHandleInformation(info->streams[1].fd[0],
HANDLE_FLAG_INHERIT, FALSE);
break;
case std_null:
si.hStdOutput = open_null_stream(GENERIC_WRITE);
break;
case std_std:
si.hStdOutput = GetStdHandle(STD_OUTPUT_HANDLE);
break;
}
/* stderr */
switch( info->streams[2].type )
{ case std_pipe:
si.hStdError = info->streams[2].fd[1];
SetHandleInformation(info->streams[2].fd[0],
HANDLE_FLAG_INHERIT, FALSE);
break;
case std_null:
si.hStdError = open_null_stream(GENERIC_WRITE);
break;
case std_std:
si.hStdError = GetStdHandle(STD_ERROR_HANDLE);
break;
}
if ( CreateProcessW(info->exe,
info->cmdline,
NULL, /* Process security */
NULL, /* Thread security */
TRUE, /* Inherit handles */
flags, /* Creation flags */
info->envbuf.buffer, /* Environment */
info->cwd, /* Directory */
&si, /* Startup info */
&pi) ) /* Process information */
{ CloseHandle(pi.hThread);
if ( info->pipes > 0 && info->pid == 0 )
{ IOSTREAM *s;
process_context *pc = PL_malloc(sizeof(*pc));
DEBUG(Sdprintf("Wait on pipes\n"));
memset(pc, 0, sizeof(*pc));
pc->magic = PROCESS_MAGIC;
pc->handle = pi.hProcess;
if ( info->streams[0].type == std_pipe )
{ CloseHandle(info->streams[0].fd[0]);
s = open_process_pipe(pc, 0, info->streams[0].fd[1]);
PL_unify_stream(info->streams[0].term, s);
}
if ( info->streams[1].type == std_pipe )
{ CloseHandle(info->streams[1].fd[1]);
s = open_process_pipe(pc, 1, info->streams[1].fd[0]);
PL_unify_stream(info->streams[1].term, s);
}
if ( info->streams[2].type == std_pipe )
{ CloseHandle(info->streams[2].fd[1]);
s = open_process_pipe(pc, 2, info->streams[2].fd[0]);
PL_unify_stream(info->streams[2].term, s);
}
return TRUE;
} else if ( info->pipes > 0 )
{ IOSTREAM *s;
if ( info->streams[0].type == std_pipe )
{ CloseHandle(info->streams[0].fd[0]);
s = Sopen_handle(info->streams[0].fd[1], "w");
PL_unify_stream(info->streams[0].term, s);
}
if ( info->streams[1].type == std_pipe )
{ CloseHandle(info->streams[1].fd[1]);
s = Sopen_handle(info->streams[1].fd[0], "r");
PL_unify_stream(info->streams[1].term, s);
}
if ( info->streams[2].type == std_pipe )
{ CloseHandle(info->streams[2].fd[1]);
s = Sopen_handle(info->streams[2].fd[0], "r");
PL_unify_stream(info->streams[2].term, s);
}
}
if ( info->pid )
{ register_process(pi.dwProcessId, pi.hProcess);
return PL_unify_integer(info->pid, pi.dwProcessId);
}
return win_wait_success(info->exe_name, pi.hProcess);
} else
{ return win_error("CreateProcess");
}
}
static foreign_t
cgi_property(term_t cgi, term_t prop)
{ IOSTREAM *s;
cgi_context *ctx;
term_t arg = PL_new_term_ref();
atom_t name;
int arity;
int rc = TRUE;
if ( !get_cgi_stream(cgi, &s, &ctx) )
return FALSE;
if ( !PL_get_name_arity(prop, &name, &arity) || arity != 1 )
{ rc = type_error(prop, "cgi_property");
goto out;
}
_PL_get_arg(1, prop, arg);
if ( name == ATOM_request )
{ if ( ctx->request )
rc = unify_record(arg, ctx->request);
else
rc = PL_unify_nil(arg);
} else if ( name == ATOM_header )
{ if ( ctx->header )
rc = unify_record(arg, ctx->header);
else
rc = PL_unify_nil(arg);
} else if ( name == ATOM_id )
{ rc = PL_unify_int64(arg, ctx->id);
} else if ( name == ATOM_client )
{ rc = PL_unify_stream(arg, ctx->stream);
} else if ( name == ATOM_transfer_encoding )
{ rc = PL_unify_atom(arg, ctx->transfer_encoding);
} else if ( name == ATOM_connection )
{ rc = PL_unify_atom(arg, ctx->connection ? ctx->connection : ATOM_close);
} else if ( name == ATOM_content_length )
{ if ( ctx->transfer_encoding == ATOM_chunked )
rc = PL_unify_int64(arg, ctx->chunked_written);
else
rc = PL_unify_int64(arg, ctx->datasize - ctx->data_offset);
} else if ( name == ATOM_header_codes )
{ if ( ctx->data_offset > 0 )
rc = PL_unify_chars(arg, PL_CODE_LIST, ctx->data_offset, ctx->data);
else /* incomplete header */
rc = PL_unify_chars(arg, PL_CODE_LIST, ctx->datasize, ctx->data);
} else if ( name == ATOM_state )
{ atom_t state;
switch(ctx->state)
{ case CGI_HDR: state = ATOM_header; break;
case CGI_DATA: state = ATOM_data; break;
case CGI_DISCARDED: state = ATOM_discarded; break;
default:
assert(0);
}
rc = PL_unify_atom(arg, state);
} else
{ rc = existence_error(prop, "cgi_property");
}
out:
if ( !PL_release_stream(s) )
{ if ( PL_exception(0) )
PL_clear_exception();
}
return rc;
}