## threadkit-socket.pkg
# Compiled by:
# src/lib/std/standard.libpackage threadkit_socket
: (weak) Threadkit_Socket # Threadkit_Socket is from src/lib/std/src/socket/threadkit-socket.api{
include threadkit; # threadkit is from src/lib/src/lib/thread-kit/src/core-thread-kit/threadkit.pkg package ps = threadkit_pre_socket; # threadkit_pre_socket is from src/lib/std/src/socket/threadkit-pre-socket.pkg package md = maildrop; # maildrop is from src/lib/src/lib/thread-kit/src/core-thread-kit/maildrop.pkg package sock = socket;
# Sockets are typeagnostic.
# The instantiation of the type variables
# provides a way to distinguish between
# different kinds of sockets.
#
Threadkit_Socket( A_af, A_sock )
=
ps::Threadkit_Socket( A_af, A_sock );
Socket_Address( A_af )
=
socket::Socket_Address( A_af );
# Witness types for the socket parameter:
#
Datagram = socket::Datagram;
Stream(X) = socket::Stream(X);
Passive = socket::Passive;
Active = socket::Active;
# socket is from src/lib/std/socket.pkg # Address families
#
package af= socket::af;
# Socket types:
#
package socket = socket::socket;
# Socket control operations:
#
package control {
fun wrap_set f (ps::THREADKIT_SOCKET { socket, ... }, v) = f (socket, v);
fun wrap_get f (ps::THREADKIT_SOCKET { socket, ... } ) = f socket;
# Get/set socket options:
#
fun get_debug arg = wrap_get sock::control::get_debug arg;
fun set_debug arg = wrap_set sock::control::set_debug arg;
#
fun get_reuseaddr arg = wrap_get sock::control::get_reuseaddr arg;
fun set_reuseaddr arg = wrap_set sock::control::set_reuseaddr arg;
fun get_keepalive arg = wrap_get sock::control::get_keepalive arg;
fun set_keepalive arg = wrap_set sock::control::set_keepalive arg;
fun get_dontroute arg = wrap_get sock::control::get_dontroute arg;
fun set_dontroute arg = wrap_set sock::control::set_dontroute arg;
#
fun get_linger arg = wrap_get sock::control::get_linger arg;
fun set_linger arg = wrap_set sock::control::set_linger arg;
#
fun get_broadcast arg = wrap_get sock::control::get_broadcast arg;
fun set_broadcast arg = wrap_set sock::control::set_broadcast arg;
fun get_oobinline arg = wrap_get sock::control::get_oobinline arg;
fun set_oobinline arg = wrap_set sock::control::set_oobinline arg;
#
fun get_sndbuf arg = wrap_get sock::control::get_sndbuf arg;
fun set_sndbuf arg = wrap_set sock::control::set_sndbuf arg;
fun get_rcvbuf arg = wrap_get sock::control::get_rcvbuf arg;
fun set_rcvbuf arg = wrap_set sock::control::set_rcvbuf arg;
#
fun get_type arg = wrap_get sock::control::get_type arg;
fun get_error arg = wrap_get sock::control::get_error arg;
#
fun get_peer_name arg = wrap_get sock::control::get_peer_name arg;
fun get_sock_name arg = wrap_get sock::control::get_sock_name arg;
#
fun get_nread arg = wrap_get sock::control::get_nread arg;
fun get_atmark arg = wrap_get sock::control::get_atmark arg;
}; # package control
# Socket address operations
#
same_address = sock::same_address;
family_of_address = sock::family_of_address;
# Socket management
#
stipulate
include threadkit; # threadkit is from src/lib/src/lib/thread-kit/src/core-thread-kit/threadkit.pkg fun accept_nonblocking' socket
=
case (sock::accept_nonblocking socket)
THE (socket', address)
=>
THE (threadkit_pre_socket::make_socket socket', address);
NULL => NULL;
esac;
fun accept' socket
=
{ my (socket', address)
=
sock::accept socket;
(threadkit_pre_socket::make_socket socket', address);
};
herein
fun accept_mailop (s as ps::THREADKIT_SOCKET { socket, ... } )
=
guard .{
case (accept_nonblocking' socket)
THE result => always_mailop result;
NULL => threadkit_pre_socket::in_mailop s
==>
(fn _ = accept' socket);
esac;
};
fun accept (s as ps::THREADKIT_SOCKET { socket, ... } )
=
case (accept_nonblocking' socket)
THE result => result;
NULL => { do_mailop (threadkit_pre_socket::in_mailop s);
accept' socket;
};
esac;
end;
fun bind (ps::THREADKIT_SOCKET { socket, ... }, address)
=
sock::bind (socket, address);
fun connect_mailop (s as ps::THREADKIT_SOCKET { socket, ... }, address)
=
guard .{
if (sock::connect_nonblocking (socket, address))
#
always_mailop ();
else
threadkit_pre_socket::out_mailop s;
fi;
};
fun connect (s as ps::THREADKIT_SOCKET { socket, ... }, address)
=
if (not (sock::connect_nonblocking (socket, address)))
#
do_mailop (threadkit_pre_socket::out_mailop s);
fi;
fun listen (ps::THREADKIT_SOCKET { socket, ... }, n)
=
sock::listen (socket, n);
fun close (ps::THREADKIT_SOCKET { socket, state } )
=
{ case (md::empty state)
#
ps::CLOSED => ();
_ => sock::close socket;
esac;
md::fill (state, ps::CLOSED);
};
package s' : (weak) api { Shutdown_Mode = NO_RECVS | NO_SENDS | NO_RECVS_OR_SENDS; }
=
sock;
include s';
fun shutdown (ps::THREADKIT_SOCKET { socket, ... }, how)
=
sock::shutdown (socket, how);
Socket_Descriptor
=
sock::Socket_Descriptor;
fun io_descriptor (ps::THREADKIT_SOCKET { socket, ... } )
=
sock::io_descriptor socket;
fun socket_descriptor (ps::THREADKIT_SOCKET { socket, ... } )
=
sock::socket_descriptor socket;
same_descriptor = sock::same_descriptor;
select = sock::select;
# Socket I/O option types
#
Out_Flags = { don't_route: Bool, oob: Bool };
In_Flags = { peek: Bool, oob: Bool };
Buf(X) = { buf: X,
i: Int,
size: Null_Or( Int )
};
# Socket output operations:
#
fun send_vector (s as ps::THREADKIT_SOCKET { socket, ... }, buf)
=
case (sock::send_vector_nonblocking (socket, buf))
THE result => result;
NULL => { do_mailop (ps::out_mailop s);
sock::send_vector (socket, buf);
};
esac;
fun send_rw_vector (s as ps::THREADKIT_SOCKET { socket, ... }, buf)
=
case (sock::send_rw_vector_nonblocking (socket, buf))
THE result => result;
NULL => { do_mailop (ps::out_mailop s);
sock::send_rw_vector (socket, buf);
};
esac;
fun send_vector' (s as ps::THREADKIT_SOCKET { socket, ... }, buf, flgs)
=
case (sock::send_vector_nonblocking' (socket, buf, flgs))
THE result => result;
NULL => { do_mailop (ps::out_mailop s);
sock::send_vector' (socket, buf, flgs);
};
esac;
fun send_rw_vector' (s as ps::THREADKIT_SOCKET { socket, ... }, buf, flgs)
=
case (sock::send_rw_vector_nonblocking' (socket, buf, flgs))
THE result => result;
NULL => { do_mailop (ps::out_mailop s);
sock::send_rw_vector' (socket, buf, flgs);
};
esac;
fun send_vector_to (s as ps::THREADKIT_SOCKET { socket, ... }, address, buf)
=
if (not (sock::send_vector_to_nonblocking (socket, address, buf)))
do_mailop (ps::out_mailop s);
sock::send_vector_to (socket, address, buf);
fi;
fun send_rw_vector_to (s as ps::THREADKIT_SOCKET { socket, ... }, address, buf)
=
if (not (sock::send_rw_vector_to_nonblocking (socket, address, buf)))
do_mailop (ps::out_mailop s);
sock::send_rw_vector_to (socket, address, buf);
fi;
fun send_vector_to' (s as ps::THREADKIT_SOCKET { socket, ... }, address, buf, flgs)
=
if (not (sock::send_vector_to_nonblocking' (socket, address, buf, flgs)))
do_mailop (ps::out_mailop s);
sock::send_vector_to' (socket, address, buf, flgs);
fi;
fun send_rw_vector_to' (s as ps::THREADKIT_SOCKET { socket, ... }, address, buf, flgs)
=
if (not (sock::send_rw_vector_to_nonblocking' (socket, address, buf, flgs)))
do_mailop (ps::out_mailop s); sock::send_rw_vector_to' (socket, address, buf, flgs);
fi;
# Socket input operations
#
fun receive_vector (s as ps::THREADKIT_SOCKET { socket, ... }, n)
=
case (sock::receive_vector_nonblocking (socket, n))
THE result => result;
NULL => { do_mailop (ps::in_mailop s);
sock::receive_vector (socket, n);
};
esac;
fun receive_rw_vector (s as ps::THREADKIT_SOCKET { socket, ... }, buf)
=
case (sock::receive_rw_vector_nonblocking (socket, buf))
THE result => result;
NULL => { do_mailop (ps::in_mailop s);
sock::receive_rw_vector (socket, buf);
};
esac;
fun receive_vector' (s as ps::THREADKIT_SOCKET { socket, ... }, n, flgs)
=
case (sock::receive_vector_nonblocking' (socket, n, flgs))
THE result => result;
NULL => { do_mailop (ps::in_mailop s);
sock::receive_vector' (socket, n, flgs);
};
esac;
fun receive_rw_vector' (s as ps::THREADKIT_SOCKET { socket, ... }, buf, flgs)
=
case (sock::receive_rw_vector_nonblocking' (socket, buf, flgs))
THE result => result;
NULL => { do_mailop (ps::in_mailop s);
sock::receive_rw_vector' (socket, buf, flgs);
};
esac;
fun receive_vector_from (s as ps::THREADKIT_SOCKET { socket, ... }, n)
=
case (sock::receive_vector_from_nonblocking (socket, n))
THE result => result;
NULL => { do_mailop (ps::in_mailop s);
sock::receive_vector_from (socket, n);
};
esac;
fun receive_rw_vector_from (s as ps::THREADKIT_SOCKET { socket, ... }, buf)
=
case (sock::receive_rw_vector_from_nonblocking (socket, buf))
THE result => result;
NULL => { do_mailop (ps::in_mailop s);
sock::receive_rw_vector_from (socket, buf);
};
esac;
fun receive_vector_from' (s as ps::THREADKIT_SOCKET { socket, ... }, n, flgs)
=
case (sock::receive_vector_from_nonblocking' (socket, n, flgs))
THE result => result;
NULL => { do_mailop (ps::in_mailop s);
sock::receive_vector_from' (socket, n, flgs);
};
esac;
fun receive_rw_vector_from' (s as ps::THREADKIT_SOCKET { socket, ... }, buf, flgs)
=
case (sock::receive_rw_vector_from_nonblocking' (socket, buf, flgs))
THE result => result;
NULL => { do_mailop (ps::in_mailop s);
sock::receive_rw_vector_from' (socket, buf, flgs);
};
esac;
# Socket input mailop constructors
#
fun receive_vector_mailop (s as ps::THREADKIT_SOCKET { socket, ... }, n)
=
guard .{
case (sock::receive_vector_nonblocking (socket, n))
THE result => always_mailop result;
NULL => ps::in_mailop s
==>
(fn _ = sock::receive_vector (socket, n));
esac;
};
fun receive_rw_vector_mailop (s as ps::THREADKIT_SOCKET { socket, ... }, buf)
=
guard .{
case (sock::receive_rw_vector_nonblocking (socket, buf))
THE result => always_mailop result;
NULL => ps::in_mailop s
==>
(fn _ = sock::receive_rw_vector (socket, buf));
esac;
};
fun receive_vector_mailop' (s as ps::THREADKIT_SOCKET { socket, ... }, n, flgs)
=
guard .{
case (sock::receive_vector_nonblocking' (socket, n, flgs))
THE result => always_mailop result;
NULL => ps::in_mailop s
==>
(fn _ = sock::receive_vector' (socket, n, flgs));
esac;
};
fun receive_rw_vector_mailop' (s as ps::THREADKIT_SOCKET { socket, ... }, buf, flgs)
=
guard .{
case (sock::receive_rw_vector_nonblocking' (socket, buf, flgs))
THE result => always_mailop result;
NULL => ps::in_mailop s
==>
(fn _ = sock::receive_rw_vector' (socket, buf, flgs));
esac;
};
fun receive_vector_from_mailop (s as ps::THREADKIT_SOCKET { socket, ... }, n)
=
guard .{
case (sock::receive_vector_from_nonblocking (socket, n))
THE result => always_mailop result;
NULL => ps::in_mailop s
==>
(fn _ = sock::receive_vector_from (socket, n));
esac;
};
fun receive_rw_vector_from_mailop (s as ps::THREADKIT_SOCKET { socket, ... }, buf)
=
guard .{
case (sock::receive_rw_vector_from_nonblocking (socket, buf))
THE result => always_mailop result;
NULL => ps::in_mailop s
==>
(fn _ = sock::receive_rw_vector_from (socket, buf));
esac;
};
fun receive_vector_from_mailop' (s as ps::THREADKIT_SOCKET { socket, ... }, n, flgs)
=
guard .{
case (sock::receive_vector_from_nonblocking' (socket, n, flgs))
THE result => always_mailop result;
NULL => ps::in_mailop s
==>
(fn _ = sock::receive_vector_from' (socket, n, flgs));
esac;
};
fun receive_rw_vector_from_mailop' (s as ps::THREADKIT_SOCKET { socket, ... }, buf, flgs)
=
guard .{
case (sock::receive_rw_vector_from_nonblocking' (socket, buf, flgs))
THE result => always_mailop result;
NULL => ps::in_mailop s
==>
(fn _ = sock::receive_rw_vector_from' (socket, buf, flgs));
esac;
};
};