## socket.pkg
# Compiled by:
# src/lib/std/standard.libstipulate
package ps = proto_socket; # proto_socket is from src/lib/std/src/socket/proto-socket.pkg package md = maildrop; # maildrop is from src/lib/src/lib/thread-kit/src/core-thread-kit/maildrop.pkg package sok = socket__premicrothread; # socket__premicrothread is from src/lib/std/socket--premicrothread.pkg package tk = threadkit; # threadkit is from src/lib/src/lib/thread-kit/src/core-thread-kit/threadkit.pkg package ci = mythryl_callable_c_library_interface; # mythryl_callable_c_library_interface is from src/lib/std/src/unsafe/mythryl-callable-c-library-interface.pkg package w8v = vector_of_one_byte_unts; # vector_of_one_byte_unts is from src/lib/std/src/vector-of-one-byte-unts.pkg package w8a = rw_vector_of_one_byte_unts; # rw_vector_of_one_byte_unts is from src/lib/std/src/rw-vector-of-one-byte-unts.pkg #
Wy8Vector = w8v::Vector;
Wy8Array = w8a::Rw_Vector;
fun cfun fun_name
=
ci::find_c_function'' { lib_name => "socket", fun_name }; # socket is in src/c/lib/socket/cfun-list.h
fun cfun''' fun_name
=
ci::find_c_function''' { lib_name => "socket", fun_name }; # socket is in src/c/lib/socket/cfun-list.h
herein
package socket
: (weak) Socket # Socket is from src/lib/std/src/socket/socket.api {
include package threadkit; # threadkit is from src/lib/src/lib/thread-kit/src/core-thread-kit/threadkit.pkg #
# 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 )
=
sok::Socket_Address( A_af );
Datagram = sok::Datagram; # Witness types for the socket parameter.
Stream(X) = sok::Stream(X);
Passive = sok::Passive;
Active = sok::Active;
package af= sok::af; # Address families.
package typ = sok::typ; # Socket types.
# Socket control operations:
#
package ctl {
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 sok::ctl::get_debug arg;
fun set_debug arg = wrap_set sok::ctl::set_debug arg;
#
fun get_reuseaddr arg = wrap_get sok::ctl::get_reuseaddr arg;
fun set_reuseaddr arg = wrap_set sok::ctl::set_reuseaddr arg;
fun get_keepalive arg = wrap_get sok::ctl::get_keepalive arg;
fun set_keepalive arg = wrap_set sok::ctl::set_keepalive arg;
fun get_dontroute arg = wrap_get sok::ctl::get_dontroute arg;
fun set_dontroute arg = wrap_set sok::ctl::set_dontroute arg;
#
fun get_linger arg = wrap_get sok::ctl::get_linger arg;
fun set_linger arg = wrap_set sok::ctl::set_linger arg;
#
fun get_broadcast arg = wrap_get sok::ctl::get_broadcast arg;
fun set_broadcast arg = wrap_set sok::ctl::set_broadcast arg;
fun get_oobinline arg = wrap_get sok::ctl::get_oobinline arg;
fun set_oobinline arg = wrap_set sok::ctl::set_oobinline arg;
#
fun get_sndbuf arg = wrap_get sok::ctl::get_sndbuf arg;
fun set_sndbuf arg = wrap_set sok::ctl::set_sndbuf arg;
fun get_rcvbuf arg = wrap_get sok::ctl::get_rcvbuf arg;
fun set_rcvbuf arg = wrap_set sok::ctl::set_rcvbuf arg;
#
fun get_type arg = wrap_get sok::ctl::get_type arg;
fun get_error arg = wrap_get sok::ctl::get_error arg;
#
fun get_peer_name arg = wrap_get sok::ctl::get_peer_name arg;
fun get_sock_name arg = wrap_get sok::ctl::get_sock_name arg;
#
fun get_nread arg = wrap_get sok::ctl::get_nread arg;
fun get_atmark arg = wrap_get sok::ctl::get_atmark arg;
};
# Socket address operations
#
same_address = sok::same_address;
family_of_address = sok::family_of_address;
# Socket management
#
stipulate
#
include package threadkit; # threadkit is from src/lib/src/lib/thread-kit/src/core-thread-kit/threadkit.pkg # The commented-out code here is what Reppy had.
# Commented out 2012-12-23 CrT as part of eliminating
# all the nonblocking socket stuff.
# fun accept_nonblocking' socket
# =
# case (sok::accept_nonblocking socket)
# #
# THE (socket', address)
# =>
# THE (ps::make_socket socket', address);
#
# NULL => NULL;
# esac;
#
# fun accept' socket
# =
# { (sok::accept socket)
# ->
# (socket', address);
#
# (ps::make_socket socket', address);
# };
#
herein
fun accept (sock as ps::THREADKIT_SOCKET { socket, ... } )
=
{ (sok::accept socket)
->
(socket', address);
(ps::make_socket socket', address);
};
# fun accept_mailop (sock as ps::THREADKIT_SOCKET { socket, ... } )
# =
# tk::dynamic_mailop {.
# #
# case (accept_nonblocking' socket)
# #
# THE result => always' result;
#
# NULL => ps::socket_read_now_possible_on' sock
# ==>
# (\\ _ = accept' socket);
# esac;
# };
#
# fun accept (sock as ps::THREADKIT_SOCKET { socket, ... } )
# =
# case (accept_nonblocking' socket)
# #
# THE result => result;
#
# NULL => { block_until_mailop_fires (ps::socket_read_now_possible_on' sock);
# #
# accept' socket;
# };
# esac;
end;
fun bind (ps::THREADKIT_SOCKET { socket, ... }, address)
=
sok::bind (socket, address);
# fun connect_mailop (skt as ps::THREADKIT_SOCKET { socket, ... }, address)
# =
# tk::dynamic_mailop {.
# #
# if (sok::connect_nonblocking (socket, address)) always' ();
# else ps::socket_write_now_possible_on' skt;
# fi;
# };
fun connect (skt as ps::THREADKIT_SOCKET { socket, ... }, address)
=
sok::connect (socket, address);
# if (not (sok::connect_nonblocking (socket, address)))
# #
# block_until_mailop_fires (ps::socket_write_now_possible_on' skt);
# fi;
fun listen (ps::THREADKIT_SOCKET { socket, ... }, n)
=
sok::listen (socket, n);
fun close (ps::THREADKIT_SOCKET { socket, state } )
=
{
case (md::take_from_maildrop state)
#
ps::CLOSED => ();
_ => sok::close socket;
esac;
md::put_in_maildrop (state, ps::CLOSED);
};
stipulate
package s' : (weak) api { Shutdown_Mode = NO_RECVS | NO_SENDS | NO_RECVS_OR_SENDS; }
=
sok;
herein
include package s';
end;
fun shutdown (ps::THREADKIT_SOCKET { socket, ... }, how)
=
sok::shutdown (socket, how);
Socket_Descriptor
=
sok::Socket_Descriptor;
fun io_descriptor (ps::THREADKIT_SOCKET { socket, ... } )
=
sok::io_descriptor socket;
fun socket_descriptor (ps::THREADKIT_SOCKET { socket, ... } )
=
sok::socket_descriptor socket;
same_descriptor = sok::same_descriptor;
select = sok::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 (sock as ps::THREADKIT_SOCKET { socket, ... }, buf)
=
sok::send_vector (socket, buf);
# case (sok::send_vector_nonblocking (socket, buf))
# #
# THE result => result;
# #
# NULL => { block_until_mailop_fires (ps::socket_write_now_possible_on' sock);
# #
# sok::send_vector (socket, buf);
# };
# esac;
fun send_rw_vector (skt as ps::THREADKIT_SOCKET { socket, ... }, buf)
=
sok::send_rw_vector (socket, buf);
# case (sok::send_rw_vector_nonblocking (socket, buf))
# #
# THE result => result;
#
# NULL => { block_until_mailop_fires (ps::socket_write_now_possible_on' skt);
# #
# sok::send_rw_vector (socket, buf);
# };
# esac;
fun send_vector' (skt as ps::THREADKIT_SOCKET { socket, ... }, buf, flgs)
=
sok::send_vector' (socket, buf, flgs);
# case (sok::send_vector_nonblocking' (socket, buf, flgs))
# #
# THE result => result;
#
# NULL => { block_until_mailop_fires (ps::socket_write_now_possible_on' skt);
# #
# sok::send_vector' (socket, buf, flgs);
# };
# esac;
fun send_rw_vector' (skt as ps::THREADKIT_SOCKET { socket, ... }, buf, flgs)
=
sok::send_rw_vector' (socket, buf, flgs);
# case (sok::send_rw_vector_nonblocking' (socket, buf, flgs))
# #
# THE result => result;
#
# NULL => { block_until_mailop_fires (ps::socket_write_now_possible_on' skt);
# #
# sok::send_rw_vector' (socket, buf, flgs);
# };
# esac;
fun send_vector_to (skt as ps::THREADKIT_SOCKET { socket, ... }, address, buf)
=
sok::send_vector_to (socket, address, buf);
# if (not (sok::send_vector_to_nonblocking (socket, address, buf)))
# #
# block_until_mailop_fires (ps::socket_write_now_possible_on' skt);
# #
# sok::send_vector_to (socket, address, buf);
# fi;
fun send_rw_vector_to (skt as ps::THREADKIT_SOCKET { socket, ... }, address, buf)
=
sok::send_rw_vector_to (socket, address, buf);
# if (not (sok::send_rw_vector_to_nonblocking (socket, address, buf)))
# #
# block_until_mailop_fires (ps::socket_write_now_possible_on' skt);
# #
# sok::send_rw_vector_to (socket, address, buf);
# fi;
fun send_vector_to' (skt as ps::THREADKIT_SOCKET { socket, ... }, address, buf, flgs)
=
sok::send_vector_to' (socket, address, buf, flgs);
# if (not (sok::send_vector_to_nonblocking' (socket, address, buf, flgs)))
# #
# block_until_mailop_fires (ps::socket_write_now_possible_on' skt);
# #
# sok::send_vector_to' (socket, address, buf, flgs);
# fi;
fun send_rw_vector_to' (sock as ps::THREADKIT_SOCKET { socket, ... }, address, buf, flgs)
=
sok::send_rw_vector_to' (socket, address, buf, flgs);
# if (not (sok::send_rw_vector_to_nonblocking' (socket, address, buf, flgs)))
# #
# block_until_mailop_fires (ps::socket_write_now_possible_on' sock);
# #
# sok::send_rw_vector_to' (socket, address, buf, flgs);
# fi;
# This is the call which we'd like
# to have available as a mailop also
# for the benefit of inbuf-ximp.pkg.
# inbuf-ximp.pkg calls
# socket__premicrothread::receive_vector ()
# which is receive_vector() below, which calls
# *recv_v__ref.
(cfun''' "recv") # recv def in src/c/lib/socket/recv.c
->
( recv_v__syscall: (Int, Int, Bool, Bool) -> w8v::Vector,
recv_v__ref,
set__recv_v__ref,
recv_v_mailop__syscall: (Int, Int, Bool, Bool) -> Mailop(w8v::Vector),
recv_v_mailop__ref,
set__recv_v_mailop__ref
);
# Socket input operations
#
stipulate
# Default flags
#
default_don't_route = FALSE;
default_oob = FALSE;
default_peek = FALSE;
fun recv_v (_, 0, _, _)
=>
w8v::from_list [];
recv_v (socket_fd, nbytes, peek, oob)
=>
{ if (nbytes < 0) raise exception SIZE; fi;
#
*recv_v__ref (socket_fd, nbytes, peek, oob);
};
end;
fun recv_v' (socket_fd, nbytes, peek, oob)
=
{ if (nbytes <= 0) raise exception SIZE; fi;
#
*recv_v_mailop__ref (socket_fd, nbytes, peek, oob);
};
herein
# Set socket to blocking if not already blocking
# and read given number of bytes from given socket.
#
# Return resulting bytevector.
#
fun receive_vektor (socket, size)
=
recv_v (socket, size, default_peek, default_oob);
# Set socket to blocking if not already blocking
# and read given number of bytes from given socket.
#
# Return resulting bytevector.
#
fun receive_vektor' (socket, size)
=
recv_v' (socket, size, default_peek, default_oob);
end;
# Socket input operations
#
fun receive_vector (skt as ps::THREADKIT_SOCKET { socket, ... }, n)
=
sok::receive_vector (socket, n);
# case (sok::receive_vector_nonblocking (socket, n))
# #
# THE result => result;
#
# NULL => { block_until_mailop_fires (ps::socket_read_now_possible_on' skt);
# #
# sok::receive_vector (socket, n);
# };
# esac;
fun receive_rw_vector (skt as ps::THREADKIT_SOCKET { socket, ... }, buf)
=
sok::receive_rw_vector (socket, buf);
# case (sok::receive_rw_vector_nonblocking (socket, buf))
# #
# THE result => result;
#
# NULL => { block_until_mailop_fires (ps::socket_read_now_possible_on' skt);
# #
# sok::receive_rw_vector (socket, buf);
# };
# esac;
fun receive_vector' (skt as ps::THREADKIT_SOCKET { socket, ... }, n, flgs)
=
sok::receive_vector' (socket, n, flgs);
# case (sok::receive_vector_nonblocking' (socket, n, flgs))
# #
# THE result => result;
#
# NULL => { block_until_mailop_fires (ps::socket_read_now_possible_on' skt);
# #
# sok::receive_vector' (socket, n, flgs);
# };
# esac;
fun receive_rw_vector' (skt as ps::THREADKIT_SOCKET { socket, ... }, buf, flgs)
=
sok::receive_rw_vector' (socket, buf, flgs);
# case (sok::receive_rw_vector_nonblocking' (socket, buf, flgs))
# #
# THE result => result;
#
# NULL => { block_until_mailop_fires (ps::socket_read_now_possible_on' skt);
# #
# sok::receive_rw_vector' (socket, buf, flgs);
# };
# esac;
fun receive_vector_from (skt as ps::THREADKIT_SOCKET { socket, ... }, n)
=
sok::receive_vector_from (socket, n);
# case (sok::receive_vector_from_nonblocking (socket, n))
# #
# THE result => result;
#
# NULL => { block_until_mailop_fires (ps::socket_read_now_possible_on' skt);
# #
# sok::receive_vector_from (socket, n);
# };
# esac;
fun receive_rw_vector_from (skt as ps::THREADKIT_SOCKET { socket, ... }, buf)
=
sok::receive_rw_vector_from (socket, buf);
# case (sok::receive_rw_vector_from_nonblocking (socket, buf))
# #
# THE result => result;
#
# NULL => { block_until_mailop_fires (ps::socket_read_now_possible_on' skt);
# #
# sok::receive_rw_vector_from (socket, buf);
# };
# esac;
fun receive_vector_from' (skt as ps::THREADKIT_SOCKET { socket, ... }, n, flgs)
=
sok::receive_vector_from' (socket, n, flgs);
# case (sok::receive_vector_from_nonblocking' (socket, n, flgs))
# #
# THE result => result;
#
# NULL => { block_until_mailop_fires (ps::socket_read_now_possible_on' skt);
# #
# sok::receive_vector_from' (socket, n, flgs);
# };
# esac;
fun receive_rw_vector_from' (skt as ps::THREADKIT_SOCKET { socket, ... }, buf, flgs)
=
sok::receive_rw_vector_from' (socket, buf, flgs);
# case (sok::receive_rw_vector_from_nonblocking' (socket, buf, flgs))
# #
# THE result => result;
#
# NULL => { block_until_mailop_fires (ps::socket_read_now_possible_on' skt);
# #
# sok::receive_rw_vector_from' (socket, buf, flgs);
# };
# esac;
# Socket input mailop constructors
#
# fun receive_vector_mailop (skt as ps::THREADKIT_SOCKET { socket, ... }, n)
# =
# tk::dynamic_mailop {.
# #
# case (sok::receive_vector_nonblocking (socket, n))
# #
# THE result => always' result;
#
# NULL => ps::socket_read_now_possible_on' skt
# ==>
# (\\ _ = sok::receive_vector (socket, n));
# esac;
# };
#
# fun receive_rw_vector_mailop (skt as ps::THREADKIT_SOCKET { socket, ... }, buf)
# =
# tk::dynamic_mailop {.
# #
# case (sok::receive_rw_vector_nonblocking (socket, buf))
# #
# THE result => always' result;
#
# NULL => ps::socket_read_now_possible_on' skt
# ==>
# (\\ _ = sok::receive_rw_vector (socket, buf));
# esac;
# };
#
# fun receive_vector_mailop' (skt as ps::THREADKIT_SOCKET { socket, ... }, n, flgs)
# =
# tk::dynamic_mailop {.
# #
# case (sok::receive_vector_nonblocking' (socket, n, flgs))
# #
# THE result => always' result;
#
# NULL => ps::socket_read_now_possible_on' skt
# ==>
# (\\ _ = sok::receive_vector' (socket, n, flgs));
# esac;
# };
#
# fun receive_rw_vector_mailop' (skt as ps::THREADKIT_SOCKET { socket, ... }, buf, flgs)
# =
# tk::dynamic_mailop {.
# #
# case (sok::receive_rw_vector_nonblocking' (socket, buf, flgs))
# #
# THE result => always' result;
#
# NULL => ps::socket_read_now_possible_on' skt
# ==>
# (\\ _ = sok::receive_rw_vector' (socket, buf, flgs));
# esac;
# };
#
# fun receive_vector_from_mailop (skt as ps::THREADKIT_SOCKET { socket, ... }, n)
# =
# tk::dynamic_mailop {.
# #
# case (sok::receive_vector_from_nonblocking (socket, n))
# #
# THE result => always' result;
#
# NULL => ps::socket_read_now_possible_on' skt
# ==>
# (\\ _ = sok::receive_vector_from (socket, n));
# esac;
# };
#
# fun receive_rw_vector_from_mailop (skt as ps::THREADKIT_SOCKET { socket, ... }, buf)
# =
# tk::dynamic_mailop {.
# #
# case (sok::receive_rw_vector_from_nonblocking (socket, buf))
# #
# THE result => always' result;
#
# NULL => ps::socket_read_now_possible_on' skt
# ==>
# (\\ _ = sok::receive_rw_vector_from (socket, buf));
# esac;
# };
#
# fun receive_vector_from_mailop' (skt as ps::THREADKIT_SOCKET { socket, ... }, n, flgs)
# =
# tk::dynamic_mailop {.
# #
# case (sok::receive_vector_from_nonblocking' (socket, n, flgs))
# #
# THE result => always' result;
#
# NULL => ps::socket_read_now_possible_on' skt
# ==>
# (\\ _ = sok::receive_vector_from' (socket, n, flgs));
# esac;
# };
#
# fun receive_rw_vector_from_mailop' (skt as ps::THREADKIT_SOCKET { socket, ... }, buf, flgs)
# =
# tk::dynamic_mailop {.
# #
# case (sok::receive_rw_vector_from_nonblocking' (socket, buf, flgs))
# #
# THE result => always' result;
#
# NULL => ps::socket_read_now_possible_on' skt
# ==>
# (\\ _ = sok::receive_rw_vector_from' (socket, buf, flgs));
# esac;
# };
};
end;