예제 #1
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);
}
예제 #2
0
/* in the form: (1 2 3 4). Repeated slots are NOT returned */
SCM g_get_unique_slots(SCM scm_uref)
{
    NETLIST *nl_current;
    char *uref;
    gchar *slot = NULL;
    char *slot_tmp = NULL;
    SCM slots_list = SCM_EOL;
    SCM slot_number;


    SCM_ASSERT(scm_is_string (scm_uref),
	       scm_uref, SCM_ARG1, "gnetlist:get-unique-slots-used-of-package");

    uref = SCM_STRING_CHARS (scm_uref);
    
    /* here is where you make it multi page aware */
    nl_current = netlist_head;

    /* search for the first instance */
    /* through the entire list */
    while (nl_current != NULL) {

	if (nl_current->component_uref) {
	    if (strcmp(nl_current->component_uref, uref) == 0) {

		/* first search outside the symbol */
		slot_tmp =
		    o_attrib_search_name_single(nl_current->object_ptr,
						"slot", NULL);

		if (!slot_tmp) {
		/* if not found, search inside the symbol */
		slot_tmp =
		    o_attrib_search_name(nl_current->object_ptr->
					 complex->prim_objs, "slot",
					 0);
		}
		/* When a package has no slot attribute, then assume it's slot number 1 */
		if (!slot_tmp) {
		  slot_tmp=g_strdup("1");
		}
		slot = g_strconcat ("#d", slot_tmp, NULL);
		slot_number = scm_string_to_number(scm_makfrom0str (slot),
                                           scm_from_int(10));
		g_free (slot);
		if (slot_number != SCM_BOOL_F) {
		  if (scm_member(slot_number, slots_list) ==  SCM_BOOL_F) {
		    slots_list = scm_cons (slot_number, slots_list);
		  }
		}
		else 
		  fprintf(stderr, "Uref %s: Bad slot number: %s.\n", uref, slot_tmp);
		g_free (slot_tmp);
	    }
	}
	nl_current = nl_current->next;
    }

    slots_list = scm_sort_list_x(slots_list,
                                 SCM_VARIABLE_REF (scm_c_module_lookup (
                                   scm_current_module (), "<")));
    return (slots_list);
}