## socket-guts.pkg
# Compiled by:
# src/lib/std/src/standard-core.sublibstipulate
package int = int_guts; # int_guts is from src/lib/std/src/int-guts.pkg package wg = winix_guts; # winix_guts is from src/lib/std/src/posix/winix-guts.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 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 ps = proto_socket__premicrothread; # proto_socket__premicrothread is from src/lib/std/src/socket/proto-socket--premicrothread.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 #
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_guts # aka src/lib/std/socket--premicrothread.pkg : (weak) Socket__Premicrothread # Socket__Premicrothread is from src/lib/std/src/socket/socket--premicrothread.api {
Wy8Vector = w8v::Vector;
Wy8Array = w8a::Rw_Vector;
Socket_Fd = ps::Socket_Fd; # The system's representation of a socket.
include package proto_socket__premicrothread; # Import the various socket related types.
(cfun "listAddrFamilies") # listAddrFamilies def in src/c/lib/socket/list-addr-families.c
->
( list_addr_families__syscall: Void -> List( ci::System_Constant ),
list_addr_families__ref,
set__list_addr_families__ref
);
package af { # Address families
#
include package af; # af is from src/lib/std/src/socket/proto-socket--premicrothread.pkg # via above 'include proto_socket__premicrothread'.
fun list ()
=
list::map
(\\ arg = (arg.name, ADDRESS_FAMILY arg))
(*list_addr_families__ref ());
fun to_string (ADDRESS_FAMILY { name, ... })
=
name;
fun from_string name
=
case (ci::find_system_constant (name, *list_addr_families__ref ()))
#
THE af => THE (ADDRESS_FAMILY af);
NULL => NULL;
esac;
};
(cfun "listSockTypes") # listSockTypes def in src/c/lib/socket/list-socket-types.c
->
( list_socket_types__syscall: Void -> List( ci::System_Constant ),
list_socket_types__ref,
set__list_socket_types__ref
);
package typ { # Socket types.
#
include package proto_socket__premicrothread;
Socket_Type
=
ps::typ::Socket_Type;
# socket is from src/lib/std/src/socket/proto-socket--premicrothread.pkg stream = typ::SOCKET_TYPE (ci::bind_system_constant ("STREAM", *list_socket_types__ref ()));
datagram = typ::SOCKET_TYPE (ci::bind_system_constant ("DGRAM", *list_socket_types__ref ()));
fun list ()
=
list::map
(\\ arg = (arg.name, typ::SOCKET_TYPE arg))
(*list_socket_types__ref ());
fun to_string (typ::SOCKET_TYPE { name, ... })
=
name;
fun from_string name
=
case (ci::find_system_constant (name, *list_socket_types__ref ()))
#
THE ty => THE (typ::SOCKET_TYPE ty);
NULL => NULL;
esac;
};
(cfun "get_or_set_socket_debug_option") # "get_or_set_socket_debug_option" def in src/c/lib/socket/get-or-set-socket-debug-option.c
->
( ctl_debug__syscall: (Socket_Fd, Null_Or(Bool)) -> Bool,
ctl_debug__ref,
set__ctl_debug__ref
);
(cfun "get_or_set_socket_reuseaddr_option") # "get_or_set_socket_reuseaddr_option" def in src/c/lib/socket/get-or-set-socket-reuseaddr-option.c
->
( ctl_reuseaddr__syscall: (Socket_Fd, Null_Or(Bool)) -> Bool,
ctl_reuseaddr__ref,
set__ctl_reuseaddr__ref
);
(cfun "get_or_set_socket_keepalive_option") # "get_or_set_socket_keepalive_option" def in src/c/lib/socket/get-or-set-socket-keepalive-option.c
->
( ctl_keepalive__syscall: (Socket_Fd, Null_Or(Bool)) -> Bool,
ctl_keepalive__ref,
set__ctl_keepalive__ref
);
(cfun "get_or_set_socket_dontroute_option") # "get_or_set_socket_dontroute_option" def in src/c/lib/socket/get-or-set-socket-dontroute-option.c
->
( ctl_dontroute__syscall: (Socket_Fd, Null_Or(Bool)) -> Bool,
ctl_dontroute__ref,
set__ctl_dontroute__ref
);
(cfun "get_or_set_socket_broadcast_option") # "get_or_set_socket_broadcast_option" def in src/c/lib/socket/get-or-set-socket-broadcast-option.c
->
( ctl_broadcast__syscall: (Socket_Fd, Null_Or(Bool)) -> Bool,
ctl_broadcast__ref,
set__ctl_broadcast__ref
);
(cfun "get_or_set_socket_oobinline_option") # "get_or_set_socket_oobinline_option" def in src/c/lib/socket/get-or-set-socket-oobinline-option.c
->
( ctl_oobinline__syscall: (Socket_Fd, Null_Or(Bool)) -> Bool,
ctl_oobinline__ref,
set__ctl_oobinline__ref
);
(cfun "get_or_set_socket_sndbuf_option") # "get_or_set_socket_sndbuf_option" def in src/c/lib/socket/get-or-set-socket-sndbuf-option.c
->
( ctl_sndbuf__syscall: (Socket_Fd, Null_Or(Int )) -> Int,
ctl_sndbuf__ref,
set__ctl_sndbuf__ref
);
(cfun "get_or_set_socket_rcvbuf_option") # "get_or_set_socket_rcvbuf_option" def in src/c/lib/socket/get-or-set-socket-rcvbuf-option.c
->
( ctl_rcvbuf__syscall: (Socket_Fd, Null_Or(Int )) -> Int,
ctl_rcvbuf__ref,
set__ctl_rcvbuf__ref
);
(cfun "get_or_set_socket_linger_option") # "get_or_set_socket_linger_option" def in src/c/lib/socket/get-or-set-socket-linger-option.c
->
( ctl_linger__syscall: (Socket_Fd, Null_Or( Null_Or(Int) )) -> Null_Or(Int),
ctl_linger__ref,
set__ctl_linger__ref
);
(cfun "getTYPE") # getTYPE def in src/c/lib/socket/getTYPE.c
->
( get_type__syscall: Socket_Fd -> ci::System_Constant,
get_type__ref,
set__get_type__ref
);
(cfun "getERROR") # getERROR def in src/c/lib/socket/getERROR.c
->
( get_error__syscall: Socket_Fd -> Bool,
get_error__ref,
set__get_error__ref
);
(cfun "getPeerName") # getPeerName def in src/c/lib/socket/getpeername.c
->
( get_peer_name__syscall: Socket_Fd -> Internet_Address,
get_peer_name__ref,
set__get_peer_name__ref
);
(cfun "getSockName") # getSockName def in src/c/lib/socket/getsockname.c
->
( get_sock_name__syscall: Socket_Fd -> Internet_Address,
get_sock_name__ref,
set__get_sock_name__ref
);
(cfun "getNREAD") # getNREAD def in src/c/lib/socket/getNREAD.c
->
( get_nread__syscall: Socket_Fd -> Int,
get_nread__ref,
set__get_nread__ref
);
(cfun "getATMARK") # getATMARK def in src/c/lib/socket/getATMARK.c
->
( get_atmark__syscall: Socket_Fd -> Bool,
get_atmark__ref,
set__get_atmark__ref
);
package ctl { # Socket control operations.
#
stipulate
#
fun the_else control_fn socket_fd
=
control_fn( socket_fd, NULL );
fun set_opt control_fn (socket_fd, value)
=
ignore (control_fn (socket_fd, THE value));
herein
# Get/set socket options
fun get_debug x = the_else *ctl_debug__ref x;
fun set_debug x = set_opt *ctl_debug__ref x;
fun get_reuseaddr x = the_else *ctl_reuseaddr__ref x;
fun set_reuseaddr x = set_opt *ctl_reuseaddr__ref x;
fun get_keepalive x = the_else *ctl_keepalive__ref x;
fun set_keepalive x = set_opt *ctl_keepalive__ref x;
fun get_dontroute x = the_else *ctl_dontroute__ref x;
fun set_dontroute x = set_opt *ctl_dontroute__ref x;
fun get_linger socket
=
case (the_else *ctl_linger__ref socket)
#
THE t => THE (time_guts::from_seconds (int::to_multiword_int t));
NULL => NULL;
esac;
# NOTE: Should probably do some
# range checking on the argument: XXX BUGGO FIXME
fun set_linger (socket, THE t)
=>
set_opt *ctl_linger__ref (socket, THE (int::from_multiword_int (time_guts::to_seconds t)));
set_linger (socket, NULL)
=>
set_opt *ctl_linger__ref (socket, NULL);
end;
fun get_broadcast x = the_else *ctl_broadcast__ref x;
fun set_broadcast x = set_opt *ctl_broadcast__ref x;
fun get_oobinline x = the_else *ctl_oobinline__ref x;
fun set_oobinline x = set_opt *ctl_oobinline__ref x;
fun get_sndbuf x = the_else *ctl_sndbuf__ref x;
fun set_sndbuf x = set_opt *ctl_sndbuf__ref x; # NOTE: Should probably do some range checking on the argument: XXX BUGGO FIXME
fun get_rcvbuf x = the_else *ctl_rcvbuf__ref x;
# NOTE: Should probably do some
# range checking on the argument: XXX BUGGO FIXME
fun set_rcvbuf x
=
set_opt *ctl_rcvbuf__ref x;
fun get_type socket_fd
=
ps::typ::SOCKET_TYPE (*get_type__ref socket_fd);
fun get_error socket_fd
=
*get_error__ref socket_fd;
stipulate
fun get_name f socket_fd
=
ADDRESS (f socket_fd);
herein
fun get_peer_name socket = get_name *get_peer_name__ref socket;
fun get_sock_name socket = get_name *get_sock_name__ref socket;
end;
fun get_nread socket_fd = *get_nread__ref socket_fd;
fun get_atmark socket_fd = *get_atmark__ref socket_fd;
end; # stipulate
}; # package control
(cfun "setNBIO") # setNBIO def in src/c/lib/socket/setNBIO.c
->
( set_nonblockingio__syscall: (Socket_Fd, Bool) -> Void, # "NBIO" == "non-blocking I/O"
set_nonblockingio__ref,
set__set_nonblockingio__ref
);
# Socket address operations:
#
fun same_address (ADDRESS a1, ADDRESS a2)
=
(a1 == a2);
(cfun "getAddrFamily") # getAddrFamily def in src/c/lib/socket/getaddrfamily.c
->
( get_address_family__syscall: Internet_Address -> Raw_Address_Family,
get_address_family__ref,
set__get_address_family__ref
);
fun family_of_address (ADDRESS a)
=
af::ADDRESS_FAMILY (*get_address_family__ref a);
(cfun "accept") # accept def in src/c/lib/socket/accept.c
->
( accept__syscall: Int -> (Int, Internet_Address),
accept__ref,
set__accept__ref
);
(cfun "bind") # bind def in src/c/lib/socket/bind.c
->
( bind__syscall: (Int, Internet_Address) -> Void,
bind__ref,
set__bind__ref
);
(cfun "connect") # connect def in src/c/lib/socket/connect.c
->
( connect__syscall: (Int, Internet_Address) -> Void,
connect__ref,
set__connect__ref
);
(cfun "listen") # listen def in src/c/lib/socket/listen.c
->
( listen__syscall: (Int, Int) -> Void,
listen__ref,
set__listen__ref
);
(cfun "close") # close def in src/c/lib/socket/close.c
->
( close__syscall: Int -> Void,
close__ref,
set__close__ref
);
# Socket management:
#
fun bind (socket_fd, ADDRESS address)
=
*bind__ref (socket_fd, address);
fun listen (socket_fd, back_log)
=
*listen__ref (socket_fd, back_log); # Should do some range checking on back_log XXX BUGGO FIXME
fun accept socket_fd
=
{ (*accept__ref socket_fd)
->
(socket_fd, address);
( socket_fd,
ADDRESS address
);
};
fun connect (socket_fd, ADDRESS address)
=
*connect__ref (socket_fd, address);
fun close socket_fd
=
*close__ref socket_fd;
(cfun "shutdown") # shutdown def in src/c/lib/socket/shutdown.c
->
( shutdown__syscall: (Int, Int) -> Void,
shutdown__ref,
set__shutdown__ref
);
stipulate
fun how NO_RECVS => 0;
how NO_SENDS => 1;
how NO_RECVS_OR_SENDS => 2;
end;
herein
fun shutdown (socket_fd, mode)
=
*shutdown__ref (socket_fd, how mode);
end;
make_io_descriptor = pre_os::io::int_to_iod;
fun io_descriptor socket_fd
=
make_io_descriptor socket_fd;
fun make_wait_request { socket, readable, writable, oobdable }
=
{ io_descriptor => io_descriptor socket, readable, writable, oobdable };
# For now we implement 'wait_for_io_opportunity' in terms of 'poll':
#
# The C side of 'poll' is in
# src/c/lib/posix-os/select.c
# The Mythryl side is in
# src/lib/std/src/winix/winix-io--premicrothread.api # src/lib/std/src/posix/winix-io--premicrothread.pkg #
# For an alternate convenience wrapper see:
# src/lib/src/when.api # src/lib/src/when.pkg #
socket_descriptor
=
io_descriptor;
fun same_descriptor (d1, d2)
=
wg::io::compare (d1, d2) == EQUAL;
fun wait_for_io_opportunity { readable, writable, oobdable, timeout }
=
split3 (reverse result_list, [], [], [])
where
fun is_readable d
=
{ io_descriptor => d,
readable => TRUE,
writable => FALSE,
oobdable => FALSE
};
fun is_writable d
=
{ io_descriptor => d,
readable => FALSE,
writable => TRUE,
oobdable => FALSE
};
fun is_oobdable d
=
{ io_descriptor => d,
readable => FALSE,
writable => TRUE,
oobdable => FALSE
};
wait_requests
=
map is_readable readable
@
map is_writable writable
@
map is_oobdable oobdable;
result_list
=
wg::io::wait_for_io_opportunity { wait_requests, timeout };
fun split3 ([], readable, writable, oobdable)
=>
{ readable, writable, oobdable };
split3 ((i: wg::io::Ioplea_Result) ! is, readable, writable, oobdable)
=>
{ readable = i.readable ?? i.io_descriptor ! readable :: readable;
writable = i.writable ?? i.io_descriptor ! writable :: writable;
oobdable = i.oobdable ?? i.io_descriptor ! oobdable :: oobdable;
split3 (is, readable, writable, oobdable);
};
end;
end;
select = wait_for_io_opportunity;
#
# Deprecated synonym, mainly so that unix folks
# looking for 'select' in the function index
# will be led here.
vbuf = vector_slice_of_one_byte_unts::burst_slice;
abuf = rw_vector_slice_of_one_byte_unts::burst_slice;
# Default flags
#
default_don't_route = FALSE;
default_oob = FALSE;
default_peek = FALSE;
# Socket output operations
#
(cfun "sendBuf") # "sendBuf" is in src/c/lib/socket/sendbuf.c
->
( send_v__syscall: (Int, Wy8Vector, Int, Int, Bool, Bool) -> Int,
send_v__ref,
set__send_v__ref
);
(cfun "sendBuf") # "sendBuf" is in src/c/lib/socket/sendbuf.c
->
( send_a__syscall: (Int, Wy8Array, Int, Int, Bool, Bool) -> Int,
send_a__ref,
set__send_a__ref
);
fun send_vector (socket_fd, buffer)
=
{
(vbuf buffer)
->
(vec, i, len);
if (len > 0)
#
*send_v__ref
( socket_fd,
vec,
i,
len,
default_don't_route,
default_oob
);
else
0;
fi;
};
fun send_vector' (socket_fd, buffer, { don't_route, oob } )
=
{ (vbuf buffer)
->
(vec, i, len);
if (len > 0) *send_v__ref (socket_fd, vec, i, len, don't_route, oob);
else 0;
fi;
};
fun send_rw_vector (socket_fd, buffer)
=
{ (abuf buffer)
->
(arr, i, len);
if (len > 0) *send_a__ref (socket_fd, arr, i, len, default_don't_route, default_oob);
else 0;
fi;
};
fun send_rw_vector' (socket_fd, buffer, { don't_route, oob } )
=
{ (abuf buffer)
->
(arr, i, len);
if (len > 0) *send_a__ref (socket_fd, arr, i, len, don't_route, oob);
else 0;
fi;
};
(cfun "sendBufTo") # sendBufTo is in src/c/lib/socket/sendbufto.c
->
( send_to_v__syscall: (Int, Wy8Vector, Int, Int, Bool, Bool, Internet_Address) -> Int,
send_to_v__ref,
set__send_to_v__ref
);
(cfun "sendBufTo") # sendBufTo is in src/c/lib/socket/sendbufto.c
->
( send_to_a__syscall: (Int, Wy8Array, Int, Int, Bool, Bool, Internet_Address) -> Int,
send_to_a__ref,
set__send_to_a__ref
);
fun send_vector_to (socket_fd, ADDRESS address, buffer)
=
{ (vbuf buffer) -> (vec, i, len);
#
if (len > 0) *send_to_v__ref (socket_fd, vec, i, len, default_don't_route, default_oob, address);
else 0;
fi;
();
};
fun send_vector_to' (socket_fd, ADDRESS address, buffer, { don't_route, oob } )
=
{ (vbuf buffer) -> (vec, i, len);
#
if (len > 0) *send_to_v__ref (socket_fd, vec, i, len, don't_route, oob, address);
else 0;
fi;
();
};
fun send_rw_vector_to (socket_fd, ADDRESS address, buffer)
=
{ (abuf buffer) -> (arr, i, len);
#
if (len > 0) *send_to_a__ref (socket_fd, arr, i, len, default_don't_route, default_oob, address);
else 0;
fi;
();
};
fun send_rw_vector_to' (socket_fd, ADDRESS address, buffer, { don't_route, oob } )
=
{ (abuf buffer) -> (arr, i, len);
#
if (len > 0) *send_to_a__ref (socket_fd, arr, i, len, don't_route, oob, address);
else 0;
fi;
();
};
(cfun "recv") # recv def in src/c/lib/socket/recv.c
->
( recv_v__syscall: (Int, Int, Bool, Bool) -> Wy8Vector,
recv_v__ref,
set__recv_v__ref
);
(cfun "recvBuf") # recvBuf def in src/c/lib/socket/recvbuf.c
->
( recv_a__syscall: (Int, Wy8Array, Int, Int, Bool, Bool) -> Int,
recv_a__ref,
set__recv_a__ref
);
# Socket input operations
#
stipulate
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;
herein
# Set socket to blocking if not already blocking
# and read given number of bytes from given socket.
#
# Return resulting bytevector.
#
fun receive_vector (socket, size)
=
recv_v (socket, size, default_peek, default_oob);
# Same as receive_vector above,
# but with explicit PEEK and OOB flags:
#
fun receive_vector' (socket, size, { peek, oob } )
=
recv_v (socket, size, peek, oob);
fun receive_rw_vector (socket_fd, buffer)
=
{ (abuf buffer) -> (buf, i, size);
#
if (size > 0) *recv_a__ref (socket_fd, buf, i, size, default_peek, default_oob);
else 0;
fi;
};
fun receive_rw_vector' (socket_fd, buffer, { peek, oob } )
=
{ (abuf buffer) -> (buf, i, size);
#
if (size > 0) *recv_a__ref (socket_fd, buf, i, size, peek, oob);
else 0;
fi;
};
end; # stipulate
(cfun "recvFrom") # recvFrom def in src/c/lib/socket/recvfrom.c
->
( recv_from_v__syscall: (Int, Int, Bool, Bool) -> (Wy8Vector, Internet_Address),
recv_from_v__ref,
set__recv_from_v__ref
);
(cfun "recvBufFrom") # "recvBufFrom" def in src/c/lib/socket/recvbuffrom.c
->
( recv_from_a__syscall: (Int, Wy8Array, Int, Int, Bool, Bool) -> (Int, Internet_Address),
recv_from_a__ref,
set__recv_from_a__ref
);
stipulate
fun recv_from_v (_, 0, _, _)
=>
(w8v::from_list [], (ADDRESS (w8v::from_list [])));
recv_from_v (socket_fd, size, peek, oob)
=>
{ if (size < 0) raise exception SIZE; fi;
#
(*recv_from_v__ref (socket_fd, size, peek, oob))
->
(data, address);
(data, ADDRESS address);
};
end;
herein
fun receive_vector_from (socket, size)
=
recv_from_v (socket, size, default_peek, default_oob);
fun receive_vector_from' (socket, size, { peek, oob } )
=
recv_from_v (socket, size, peek, oob);
fun receive_rw_vector_from (socket_fd, asl)
=
{ (abuf asl) -> (buf, i, size);
if (size > 0)
#
(*recv_from_a__ref (socket_fd, buf, i, size, default_peek, default_oob))
->
(n, address);
(n, ADDRESS address);
else
(0, ADDRESS (w8v::from_list [] ));
fi;
};
fun receive_rw_vector_from' (socket_fd, asl, { peek, oob } )
=
{ (abuf asl) -> (buf, i, size);
if (size > 0)
#
(*recv_from_a__ref (socket_fd, buf, i, size, peek, oob))
->
(n, address);
(n, ADDRESS address);
else
(0, (ADDRESS (w8v::from_list [])));
fi;
};
end; # stipulate
}; # package socket
end; # stipulate