示例#1
0
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));
    }
}
示例#2
0
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));
}
示例#3
0
//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);
}
示例#4
0
//
// 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);
}
示例#5
0
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;
    }
}