static s48_ref_t
posix_pipe(s48_call_t call)
{ int fildes[2],
status;
s48_ref_t in_channel, out_channel;
s48_ref_t id = s48_enter_string_latin_1_2 (call, "pipe");
RETRY_OR_RAISE_NEG(status, pipe(fildes));
in_channel = s48_add_channel_2(call, s48_channel_status_input_2(call), id, fildes[0]);
if (!s48_channel_p_2(call, in_channel)) {
ps_close_fd(fildes[0]); /* retries if interrupted */
ps_close_fd(fildes[1]); /* retries if interrupted */
s48_raise_scheme_exception_2(call, s48_extract_long_2(call, in_channel), 0); }
RETRY_OR_RAISE_NEG(status, fcntl(fildes[1], F_SETFL, O_NONBLOCK));
out_channel = s48_add_channel_2(call, s48_channel_status_output_2(call), id, fildes[1]);
if (!s48_channel_p_2(call, out_channel)) {
s48_close_channel(fildes[0]);
ps_close_fd(fildes[1]); /* retries if interrupted */
s48_raise_scheme_exception_2(call, s48_extract_long_2(call, in_channel), 0); }
return s48_cons_2(call, in_channel, out_channel);
}
static s48_value
s48_socket(s48_value server_p)
{
int fd,
mode;
s48_value channel;
fd = socket(AF_INET, SOCK_STREAM, 0);
if (fd < 0)
s48_raise_os_error(errno);
if (-1 == fcntl(fd, F_SETFL, O_NONBLOCK))
s48_raise_os_error(errno);
mode = (server_p == S48_FALSE) ?
S48_CHANNEL_STATUS_SPECIAL_OUTPUT :
S48_CHANNEL_STATUS_SPECIAL_INPUT;
channel = s48_add_channel(mode, s48_enter_string("socket"), fd);
if (!S48_CHANNEL_P(channel)) {
ps_close_fd(fd); /* retries if interrupted */
s48_raise_scheme_exception(s48_extract_fixnum(channel), 0); };
return channel;
}
static s48_ref_t
posix_dup(s48_call_t call, s48_ref_t channel, s48_ref_t new_mode)
{
int new_fd, old_fd, flags;
long status;
s48_ref_t s48_status;
s48_ref_t old_mode;
s48_ref_t new_channel;
if (!s48_channel_p_2(call, channel) ||
s48_eq_p_2(call, s48_channel_status_2(call, channel), s48_channel_status_closed_2(call)))
s48_assertion_violation_2(call, "posix_dup", "not an open channel", 1, channel);
old_fd = s48_unsafe_extract_long_2(call, s48_unsafe_channel_os_index_2(call, channel));
old_mode = s48_unsafe_channel_status_2(call, channel);
RETRY_OR_RAISE_NEG(new_fd, dup(old_fd));
s48_status = s48_set_channel_os_index_2(call, channel, new_fd);
if (!s48_true_p_2(call, s48_status)) {
ps_close_fd(new_fd); /* retries if interrupted */
s48_raise_scheme_exception_2(call, s48_extract_long_2(call, s48_status), 1, channel); }
if (s48_eq_p_2(call, new_mode, s48_channel_status_output_2(call))
&& s48_eq_p_2(call, old_mode, s48_channel_status_input_2(call))) {
RETRY_OR_RAISE_NEG(flags, fcntl(new_fd, F_GETFL));
RETRY_OR_RAISE_NEG(status, fcntl(new_fd, F_SETFL, flags | O_NONBLOCK)); }
new_channel = s48_add_channel_2(call,
s48_false_p_2(call, new_mode) ? old_mode : new_mode,
s48_unsafe_channel_id_2(call, channel),
old_fd);
if (!s48_channel_p_2(call, new_channel)) {
ps_close_fd(old_fd); /* retries if interrupted */
s48_raise_scheme_exception_2(call, s48_extract_long_2(call, new_channel), 1, channel); }
return new_channel;
}
static s48_ref_t
posix_dup2(s48_call_t call, s48_ref_t channel, s48_ref_t new_fd)
{
s48_ref_t new_channel;
s48_ref_t s48_status;
int status;
int new_c_fd, old_c_fd;
if (!s48_channel_p_2(call, channel) ||
s48_eq_p_2(call, s48_channel_status_2(call, channel), s48_channel_status_closed_2(call)))
s48_assertion_violation_2(call, "posix_dup2", "not an open channel", 1, channel);
if (!s48_fixnum_p_2(call, new_fd) || new_fd < 0)
s48_assertion_violation_2(call, "posix_dup2", "fd not a nonnegative fixnum", 1, new_fd);
old_c_fd = s48_extract_long_2(call, s48_unsafe_channel_os_index_2(call, channel));
new_c_fd = s48_extract_long_2(call, new_fd);
s48_close_channel(new_c_fd);
RETRY_OR_RAISE_NEG(status, dup2(old_c_fd, new_c_fd));
s48_status = s48_set_channel_os_index_2(call, channel, new_c_fd);
if (!s48_true_p_2(call, s48_status)) {
ps_close_fd(new_c_fd); /* retries if interrupted */
s48_raise_scheme_exception_2(call, s48_extract_long_2(call, s48_status), 1, channel); }
new_channel = s48_add_channel_2(call,
s48_unsafe_channel_status_2(call, channel),
s48_unsafe_channel_id_2(call, channel),
old_c_fd);
if (!s48_channel_p_2(call, new_channel)) {
ps_close_fd(old_c_fd); /* retries if interrupted */
s48_raise_scheme_exception_2(call, s48_extract_long_2(call, new_channel), 1, channel); }
return new_channel;
}
static s48_value
s48_connect(s48_value channel, s48_value machine, s48_value port)
{
int socket_fd,
output_fd,
port_number;
char *machine_name;
struct hostent *host;
struct sockaddr_in address;
s48_value output_channel;
S48_CHECK_CHANNEL(channel);
socket_fd = S48_UNSAFE_EXTRACT_FIXNUM(S48_UNSAFE_CHANNEL_OS_INDEX(channel));
S48_CHECK_STRING(machine);
machine_name = S48_UNSAFE_EXTRACT_STRING(machine);
S48_CHECK_FIXNUM(port);
port_number = S48_UNSAFE_EXTRACT_FIXNUM(port);
/*
* Get the host and initialize `address'.
*/
host = gethostbyname(machine_name);
if (host == NULL)
s48_raise_os_error(errno);
memset((void *)&address, 0, sizeof(address));
address.sin_family = host->h_addrtype;
if (host->h_length > sizeof(address.sin_addr))
s48_raise_range_error(s48_enter_fixnum(host->h_length),
S48_UNSAFE_ENTER_FIXNUM(0),
s48_enter_fixnum(sizeof(address.sin_addr)));
memcpy((void *)&address.sin_addr, (void *)host->h_addr, host->h_length);
address.sin_port = htons(port_number);
/*
* Try the connection. If it works we make an output channel and return it.
* The original socket channel will be used as the input channel.
*/
if (connect(socket_fd, (struct sockaddr *)&address, sizeof(address)) >= 0) {
S48_STOB_SET(channel, S48_CHANNEL_STATUS_OFFSET, S48_CHANNEL_STATUS_INPUT);
output_fd = dup(socket_fd);
if (output_fd == -1)
s48_raise_os_error(errno);
output_channel = s48_add_channel(S48_CHANNEL_STATUS_OUTPUT,
s48_enter_string("socket connection"),
output_fd);
if (!S48_CHANNEL_P(output_channel)) {
ps_close_fd(output_fd); /* retries if interrupted */
s48_raise_scheme_exception(s48_extract_fixnum(output_channel), 0); };
return output_channel;
}
/*
* Check for errors. If we need to retry we mark the socket as pending
* and return #F to tell the Scheme procedure to wait.
*/
/* already connected, will raise an error from Scheme */
if (errno == EISCONN)
return S48_TRUE;
if (errno != EWOULDBLOCK && errno != EINTR && errno != EALREADY
&& errno != EINPROGRESS && errno != EAGAIN)
s48_raise_os_error(errno);
if (! (s48_add_pending_fd(socket_fd, FALSE)))
s48_raise_out_of_memory_error();
return S48_FALSE;
}
static s48_value
s48_accept(s48_value channel)
{
int socket_fd,
connect_fd,
output_fd,
len;
struct sockaddr_in address;
s48_value input_channel,
output_channel;
S48_CHECK_CHANNEL(channel);
socket_fd = S48_UNSAFE_EXTRACT_FIXNUM(S48_UNSAFE_CHANNEL_OS_INDEX(channel));
len = sizeof(address);
connect_fd = accept(socket_fd, (struct sockaddr *)&address, &len);
/*
* Check for a connection. If we have one we create two channels, one
* input and one, with a dup()'ed fd, output. Lots of error checking
* makes this messy.
*/
if (connect_fd >= 0) {
S48_DECLARE_GC_PROTECT(1);
if (-1 == fcntl(connect_fd, F_SETFL, O_NONBLOCK))
s48_raise_os_error(errno);
input_channel = s48_add_channel(S48_CHANNEL_STATUS_INPUT,
s48_enter_string("socket connection"),
connect_fd);
if (!S48_CHANNEL_P(input_channel)) {
ps_close_fd(connect_fd); /* retries if interrupted */
s48_raise_scheme_exception(s48_extract_fixnum(input_channel), 0); };
output_fd = dup(connect_fd);
if (output_fd == -1)
s48_raise_os_error(errno);
S48_GC_PROTECT_1(input_channel);
output_channel = s48_add_channel(S48_CHANNEL_STATUS_OUTPUT,
s48_enter_string("socket connection"),
output_fd);
if (!S48_CHANNEL_P(output_channel)) {
/* input_channel will eventually be closed by the GC */
ps_close_fd(output_fd); /* retries if interrupted */
s48_raise_scheme_exception(s48_extract_fixnum(output_channel), 0); };
S48_GC_UNPROTECT();
return s48_cons(input_channel, output_channel);
}
/*
* Check for errors. If we need to retry we mark the socket as pending
* and return #F to tell the Scheme procedure to wait.
*/
if ((errno != EWOULDBLOCK) && (errno != EINTR) && (errno != EAGAIN))
s48_raise_os_error(errno);
if (! s48_add_pending_fd(socket_fd, TRUE))
s48_raise_out_of_memory_error();
return S48_FALSE;
}