326 lines
8.3 KiB
Text
326 lines
8.3 KiB
Text
(*
|
|
|
|
This program has to be compiled without -std=c99, which patscc will
|
|
insert unless you override the setting.
|
|
|
|
##myatsccdef=\
|
|
patscc \
|
|
-atsccomp gcc \
|
|
-I"${PATSHOME}" \
|
|
-I"${PATSHOME}/ccomp/runtime" \
|
|
-L"${PATSHOME}/ccomp/atslib/lib" \
|
|
-DATS_MEMALLOC_LIBC \
|
|
-o $fname($1) $1
|
|
|
|
*)
|
|
|
|
(* The code below is largely C, but the ATS interface enforces memory
|
|
management. For instance, try removing the call to "addrinfo_free",
|
|
and see what happens. You will get an error message from the
|
|
compiler. *)
|
|
|
|
#include "share/atspre_staload.hats"
|
|
staload UN = "prelude/SATS/unsafe.sats"
|
|
|
|
#define ATS_EXTERN_PREFIX "rosetta_code_"
|
|
|
|
%{^
|
|
|
|
#include <sys/types.h>
|
|
#include <sys/socket.h>
|
|
#include <netdb.h>
|
|
|
|
ATSinline() atstype_int
|
|
rosetta_code__getaddrinfo (atstype_ptr node,
|
|
atstype_ptr service,
|
|
atstype_int ai_flags,
|
|
atstype_int ai_family,
|
|
atstype_int ai_socktype,
|
|
atstype_int ai_protocol,
|
|
atstype_ptr res)
|
|
{
|
|
struct addrinfo hints;
|
|
memset (&hints, 0, sizeof hints);
|
|
hints.ai_flags = ai_flags;
|
|
hints.ai_family = ai_family;
|
|
hints.ai_socktype = ai_socktype;
|
|
hints.ai_protocol = ai_protocol;
|
|
return getaddrinfo ((const char *) node,
|
|
(const char *) service,
|
|
&hints,
|
|
(struct addrinfo **) res);
|
|
}
|
|
|
|
ATSinline() atstype_void
|
|
rosetta_code__freeaddrinfo (atstype_ptr res)
|
|
{
|
|
freeaddrinfo ((struct addrinfo *) res);
|
|
}
|
|
|
|
ATSinline() atstype_string
|
|
rosetta_code__gai_strerror (atstype_int errcode)
|
|
{
|
|
return (atstype_string) gai_strerror (errcode);
|
|
}
|
|
|
|
ATSinline() atstype_ptr
|
|
rosetta_code__ai_next (atstype_ptr p)
|
|
{
|
|
return (atstype_ptr) ((struct addrinfo *) p)->ai_next;
|
|
}
|
|
|
|
ATSinline() void
|
|
rosetta_code__ai_get_numeric_host (atstype_ptr addrinfo,
|
|
atstype_ptr host,
|
|
atstype_ptr errcode)
|
|
{
|
|
struct addrinfo *p_addrinfo = (struct addrinfo *) addrinfo;
|
|
char **p_host = (char **) host;
|
|
int *p_errcode = (int *) errcode;
|
|
|
|
char buf[NI_MAXHOST];
|
|
*p_errcode = getnameinfo (p_addrinfo->ai_addr,
|
|
p_addrinfo->ai_addrlen,
|
|
buf, sizeof buf, NULL, 0,
|
|
NI_NUMERICHOST);
|
|
*p_host = ( *p_errcode == 0 ) ? (strdup (buf)) : NULL;
|
|
}
|
|
|
|
%}
|
|
|
|
#define NIL list_vt_nil ()
|
|
#define :: list_vt_cons
|
|
|
|
implement list_vt_freelin$clear<Strptr1> s = strptr_free s
|
|
|
|
macdef AF_UNSPEC = $extval (int, "AF_UNSPEC")
|
|
macdef SOCK_DGRAM = $extval (int, "SOCK_DGRAM")
|
|
|
|
absview addrinfo_v (p : addr,
|
|
freeable : bool)
|
|
|
|
vtypedef addrinfo (p : addr,
|
|
freeable : bool) =
|
|
[null < p]
|
|
@(addrinfo_v (p, freeable) |
|
|
ptr p)
|
|
|
|
vtypedef addrinfo (p : addr) =
|
|
[freeable : bool]
|
|
addrinfo (p, freeable)
|
|
|
|
vtypedef addrinfo (freeable : bool) =
|
|
[p : addr]
|
|
addrinfo (p, freeable)
|
|
|
|
vtypedef addrinfo =
|
|
[p : addr]
|
|
[freeable : bool]
|
|
addrinfo (p, freeable)
|
|
|
|
vtypedef freeable_addrinfo (p : addr) = addrinfo (p, true)
|
|
vtypedef freeable_addrinfo = addrinfo true
|
|
vtypedef unfreeable_addrinfo (p : addr) = addrinfo (p, false)
|
|
vtypedef unfreeable_addrinfo = addrinfo false
|
|
|
|
fn
|
|
addrinfo_strerror (errcode : int)
|
|
: string =
|
|
let
|
|
extern fn _gai_strerror : int -<> string = "mac#%"
|
|
in
|
|
_gai_strerror errcode
|
|
end
|
|
|
|
fn
|
|
addrinfo_fetch (node : !Strptr0,
|
|
service : !Strptr0,
|
|
ai_flags : int,
|
|
ai_family : int,
|
|
ai_socktype : int,
|
|
ai_protocol : int,
|
|
error : &int? >> int)
|
|
: Option_vt ([p : agz] addrinfo (p, true)) =
|
|
let
|
|
extern fn
|
|
_getaddrinfo (node : !Strptr0,
|
|
service : !Strptr0,
|
|
ai_flags : int,
|
|
ai_family : int,
|
|
ai_socktype : int,
|
|
ai_protocol : int,
|
|
result : &ptr? >> ptr p)
|
|
: #[p : addr]
|
|
int = "mac#%"
|
|
|
|
var p : ptr
|
|
val err = _getaddrinfo (node, service, ai_flags, ai_family,
|
|
ai_socktype, ai_protocol, p)
|
|
prval [p : addr] EQADDR () = eqaddr_make_ptr p
|
|
in
|
|
error := err;
|
|
if (err = 0) * (isneqz p) then
|
|
let
|
|
extern praxi make_view : () -<prf> addrinfo_v (p, true)
|
|
in
|
|
Some_vt @(make_view () | p)
|
|
end
|
|
else
|
|
None_vt ()
|
|
end
|
|
|
|
fn
|
|
addrinfo_free {p : addr}
|
|
(addrinfo : freeable_addrinfo p)
|
|
: void =
|
|
let
|
|
extern fn _freeaddrinfo : ptr -> void = "mac#%"
|
|
extern praxi consume_view : addrinfo_v (p, true) -<prf> void
|
|
|
|
val @(pf | p) = addrinfo
|
|
prval () = consume_view pf
|
|
in
|
|
_freeaddrinfo p
|
|
end
|
|
|
|
prfn
|
|
unfreeable_addrinfo_finalize {p : addr}
|
|
(addrinfo : unfreeable_addrinfo p)
|
|
:<prf> void =
|
|
let
|
|
extern praxi consume_view : addrinfo_v (p, false) -<prf> void
|
|
in
|
|
consume_view (addrinfo.0)
|
|
end
|
|
|
|
fn
|
|
addrinfo_next (addrinfo : !addrinfo)
|
|
:<> Option_vt (addrinfo false) =
|
|
let
|
|
extern fn _ai_next : ptr -<> [q : agez] ptr q = "mac#%"
|
|
val [q : addr] q = _ai_next (addrinfo.1)
|
|
in
|
|
if iseqz q then
|
|
None_vt ()
|
|
else
|
|
let
|
|
extern praxi make_view : () -<prf> addrinfo_v (q, false)
|
|
in
|
|
Some_vt @(make_view () | q)
|
|
end
|
|
end
|
|
|
|
fn
|
|
addrinfo_get_numeric_host (addrinfo : !addrinfo,
|
|
errcode : &int? >> int)
|
|
: Option_vt Strptr1 =
|
|
let
|
|
extern fn
|
|
_ai_get_numeric_host (addrinfo : Ptr,
|
|
host : &ptr? >> Ptr,
|
|
errcode : &int? >> int)
|
|
: void = "mac#%"
|
|
|
|
var host : ptr
|
|
in
|
|
_ai_get_numeric_host (addrinfo.1, host, errcode);
|
|
if (errcode = 0) * (isneqz host) then
|
|
Some_vt ($UN.castvwtp0 host)
|
|
else
|
|
None_vt ()
|
|
end
|
|
|
|
fn
|
|
get_numeric_hosts (addrinfo : !freeable_addrinfo)
|
|
: Option_vt (List1_vt Strptr1) =
|
|
let
|
|
fun
|
|
loop (ainfo : !unfreeable_addrinfo,
|
|
accum : List1_vt Strptr1)
|
|
: Option_vt (List1_vt Strptr1) =
|
|
let
|
|
var errcode : int
|
|
val ai_opt = addrinfo_get_numeric_host (ainfo, errcode)
|
|
in
|
|
case+ ai_opt of
|
|
| ~ None_vt () =>
|
|
begin
|
|
list_vt_freelin<Strptr1> accum;
|
|
fprintln! (stderr_ref, "Error: ",
|
|
addrinfo_strerror errcode);
|
|
None_vt ()
|
|
end
|
|
| ~ Some_vt host =>
|
|
let
|
|
val next_ai_opt = addrinfo_next ainfo
|
|
and accum = host :: accum
|
|
in
|
|
case+ next_ai_opt of
|
|
| ~ None_vt () => Some_vt (list_vt_reverse accum)
|
|
| ~ Some_vt next_ai =>
|
|
let
|
|
val retval = loop (next_ai, accum)
|
|
prval () = unfreeable_addrinfo_finalize next_ai
|
|
in
|
|
retval
|
|
end
|
|
end
|
|
end
|
|
|
|
var errcode : int
|
|
val ai_opt = addrinfo_get_numeric_host (addrinfo, errcode)
|
|
in
|
|
case+ ai_opt of
|
|
| ~ None_vt () =>
|
|
begin
|
|
fprintln! (stderr_ref, "Error: ", addrinfo_strerror errcode);
|
|
None_vt ()
|
|
end
|
|
| ~ Some_vt host =>
|
|
let
|
|
val next_ai_opt = addrinfo_next addrinfo
|
|
and accum = host :: NIL
|
|
in
|
|
case+ next_ai_opt of
|
|
| ~ None_vt () => Some_vt accum
|
|
| ~ Some_vt next_ai =>
|
|
let
|
|
val retval = loop (next_ai, accum)
|
|
prval () = unfreeable_addrinfo_finalize next_ai
|
|
in
|
|
retval
|
|
end
|
|
end
|
|
end
|
|
|
|
implement
|
|
main0 () =
|
|
let
|
|
val hostname = string0_copy "www.kame.net"
|
|
val service = strptr_null ()
|
|
var errcode : int
|
|
val ai_opt = addrinfo_fetch (hostname, service, 0, AF_UNSPEC,
|
|
SOCK_DGRAM, 0, errcode)
|
|
val () = strptr_free hostname
|
|
prval () = strptr_free_null service
|
|
in
|
|
case+ ai_opt of
|
|
| ~ None_vt () =>
|
|
begin
|
|
fprintln! (stderr_ref, "Error: ", addrinfo_strerror errcode);
|
|
exit 1
|
|
end
|
|
| ~ Some_vt addrinfo =>
|
|
let
|
|
val hosts_opt = get_numeric_hosts addrinfo
|
|
in
|
|
addrinfo_free addrinfo;
|
|
case+ hosts_opt of
|
|
| ~ None_vt () => exit 1
|
|
| ~ Some_vt hosts =>
|
|
begin
|
|
println! ($UN.castvwtp1{List1 string} hosts);
|
|
list_vt_freelin hosts
|
|
end
|
|
end
|
|
end
|