static void scm_conv_check(void)
{
scm_init_guile();
static struct {
int version;
char const *str;
char const *num;
sa_family_t exp_family;
} tests[] = {
{ 4, "1.0.0.0", "(%d . 16777216)", AF_INET },
{ 4, "127.0.0.1", "(%d . 2130706433)", AF_INET },
{ 4, "128.10.5.255", "(%d . 2148140543)", AF_INET },
{ 6, "ff02::1", "(%d . 338963523518870617245727861364146307073)", AF_INET6 },
{ 6, "1:2:3:4::", "(%d . 5192455318486707403025865779445760)", AF_INET6 },
};
for (unsigned t = 0; t < NB_ELEMS(tests); t++) {
struct ip_addr addr;
ip_addr_ctor_from_str(&addr, tests[t].str, strlen(tests[t].str), tests[t].version);
SCM ip = scm_from_ip_addr(&addr);
SCM str = scm_simple_format(SCM_BOOL_F, scm_from_latin1_string("~a"), scm_cons(ip, SCM_EOL));
char buf[256];
size_t len = scm_to_locale_stringbuf(str, buf, sizeof(buf));
assert(len < sizeof(buf));
buf[len] = '\0';
char expected[256];
snprintf(expected, sizeof(expected), tests[t].num, tests[t].exp_family);
printf("%s -> '%s' (expected '%s')\n", tests[t].str, buf, expected);
assert(0 == strcmp(expected, buf));
}
}
SCM scm_tls_send(SCM tls_smob, SCM msg){
scm_assert_smob_type(tls_tag, tls_smob);
BIO *bio = (BIO*)SCM_SMOB_DATA(tls_smob);
size_t msglen = scm_c_string_length(msg);
char *buf = alloca(msglen+1);
size_t buflen = scm_to_locale_stringbuf(msg, buf, msglen);
buf[buflen] = '\0';
return scm_from_int(BIO_puts(bio, buf));
}
//get scm symbols: scm_from_utf8_symbol(name)
SCM scm_connect_tls(SCM host, SCM port){
char hostbuf[256], portbuf[16];
//Assume the current locale is utf8, as the only function that lets
//use use our own buffers implicitly uses the current locale
if(!scm_is_string(host)){
scm_raise_error("wrong-type-arg", "expected string in position 1");
} else {
size_t len = scm_to_locale_stringbuf(host, hostbuf, 256);
if(len >= 256){
scm_raise_error("too-long", "hostname too long");
} else {
hostbuf[len] = '\0';
}
}
if(scm_is_string(port)){
//make sure port looks like a number
if(scm_is_false(scm_string_to_number(port, scm_from_int(10)))){
scm_raise_error("wrong-type-arg",
"expected number or number as string in position 2");
}
size_t len = scm_to_locale_stringbuf(port, portbuf, 32);
if(len >= 16){
scm_raise_error("out-of-range", "Maximum port number is 65535");
} else {
portbuf[len] = '\0';
}
} else if(scm_is_integer(port)){
uint16_t portno = scm_to_uint16(port);
snprintf(portbuf, 16, "%d", portno);
} else {
scm_raise_error("wrong-type-arg",
"expected number or number as string in position 2");
}
BIO *bio = connect_tls(hostbuf, portbuf);
if(!bio){
scm_raise_error("system-error", "Failed to make tls connection");
}
return scm_new_smob(tls_tag, (scm_t_bits)bio);
}
//
// Set a name on a communicator:
//
SCM
guile_comm_set_name (SCM world, SCM name)
{
// extract MPI_Comm, verifies the type:
MPI_Comm comm = scm_to_comm (world);
// some communicators have names associated with them:
char cname[MPI_MAX_OBJECT_NAME];
// does not null-terninate:
int len = scm_to_locale_stringbuf (name, cname, MPI_MAX_OBJECT_NAME);
if ( len > MPI_MAX_OBJECT_NAME )
len = MPI_MAX_OBJECT_NAME;
cname[len] = '\0';
int ierr = MPI_Comm_set_name (comm, cname);
assert (MPI_SUCCESS==ierr);
return scm_from_int (len);
}
static void
stringbuf_cat_locale_string (struct stringbuf *buf, SCM str)
{
size_t max_len = buf->buf_len - (buf->ptr - buf->buf) - 1;
size_t len = scm_to_locale_stringbuf (str, buf->ptr, max_len);
if (len > max_len)
{
/* buffer is too small, double its size and try again.
*/
stringbuf_grow (buf);
stringbuf_cat_locale_string (buf, str);
}
else
{
/* string fits, terminate it and check for embedded '\0'.
*/
buf->ptr[len] = '\0';
if (strlen (buf->ptr) != len)
scm_misc_error (NULL,
"string contains #\\nul character: ~S",
scm_list_1 (str));
buf->ptr += len;
}
}
