dhcp-client-guile.c

this is sample about DHCP-agent

        return SCM_BOOL_F;
    }

}

SCM dhcp_scm_client_discover_icmp_latency(SCM scm_dc, SCM scm_address_list)
{
    client_control_smob_t *client_control_smob;
    dhcp_client_control_t *dc;
    list_t *address_list;
    list_t *latency_list;
    SCM scm_latency_list;
    int retries;
    int timeout;
    int arp_retries;
    int arp_timeout;

    /* do assertions */
    SCM_ASSERT(SCM_SMOB_PREDICATE(client_control_tag, scm_dc),
               scm_dc, SCM_ARG1, "client-discover-icmp-latency");

    SCM_ASSERT(SCM_CONSP(scm_address_list), scm_address_list, SCM_ARG2, 
               "client-discover-icmp-latency");

    /* client control. */
    client_control_smob = (client_control_smob_t *)SCM_SMOB_DATA(scm_dc);
    dc = client_control_smob->dc;

    /* get number of retries. */
    retries = client_conf_get_icmp_retries(dc->conf, dhcp_client_get_server_ip_address(dc),
                                           dhcp_client_get_server_hw_address(dc));

    /* get timeout threshold. */
    timeout = client_conf_get_icmp_echo_timeout(dc->conf, dhcp_client_get_server_ip_address(dc),
                                                dhcp_client_get_server_hw_address(dc));

    /* get arp timeout. */
    arp_timeout = client_conf_get_arp_timeout(dc->conf, dhcp_client_get_server_ip_address(dc),
                                              dhcp_client_get_server_hw_address(dc));

    /* get arp retries. */
    arp_retries = client_conf_get_arp_retries(dc->conf, dhcp_client_get_server_ip_address(dc),
                                              dhcp_client_get_server_hw_address(dc));

    address_list = guile_address_list_to_internal_list(scm_address_list);
    latency_list = icmp_rtt_discovery(dc->rawnet, retries, timeout, arp_retries, arp_timeout, address_list);

    scm_latency_list = internal_latency_list_to_guile_latency_list(latency_list);

    list_destroy(address_list, xfree);
    list_destroy(latency_list, xfree);

    return scm_latency_list;
}

/* * * * * * * * * * * * * * * * * * * * * * * * * * * * *  *
 * info message, error message, and fatal message wrappers. *
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * *  */

static SCM dhcp_scm_client_info_message(SCM string)
{
    char *str;

    str = x_scm_string2newstr(string);
    INFO_MESSAGE(str);
    xfree(str);

    return SCM_BOOL_T;
}

static SCM dhcp_scm_client_error_message(SCM string)
{
    char *str;

    str = x_scm_string2newstr(string);
    ERROR_MESSAGE(str);
    xfree(str);

    return SCM_BOOL_T;
}

static SCM dhcp_scm_client_fatal_error_message(SCM string)
{
    char *str;

    str = x_scm_string2newstr(string);
    FATAL_MESSAGE(str);
    xfree(str);

    return SCM_BOOL_T;
}

/* * * * * * * * * * * * * * * * * * * *
 * dhcp client control smob            *
 * * * * * * * * * * * * * * * * * * * */

/* mark a dhcp client control scm: we don't need to do any marking. */
static SCM dhcp_scm_client_control_mark(SCM scm_client_control)
{
    return SCM_BOOL_F;
}

/* free a client control scm. */
static size_t dhcp_scm_client_control_free(SCM scm_client_control)
{
    client_control_smob_t *client_control_smob;

    client_control_smob = (client_control_smob_t *)SCM_SMOB_DATA(scm_client_control);
    xfree(client_control_smob);

    return sizeof(client_control_smob_t);
}

/* print out a client control scm. */
static int dhcp_scm_client_control_print(SCM scm_client_control, SCM port, scm_print_state *pstate)
{
    scm_puts("#<client_control>", port);
    return 1;
}

/* convert a client control handler to SCM. */
static SCM dhcp_scm_make_client_control(dhcp_client_control_t *dc)
{
    client_control_smob_t *client_control_smob;

    client_control_smob = xmalloc(sizeof(client_control_smob_t));
    client_control_smob->dc = dc;

    SCM_RETURN_NEWSMOB(client_control_tag, client_control_smob);
}

/* initialization routines for client_control SMOB. */
static void init_client_control_smob(void)
{
    client_control_tag = scm_make_smob_type("client_control", sizeof(client_control_smob_t));

    /* bind mark, free, and print. */
    scm_set_smob_mark(client_control_tag, dhcp_scm_client_control_mark);
    scm_set_smob_free(client_control_tag, dhcp_scm_client_control_free);
    scm_set_smob_print(client_control_tag, dhcp_scm_client_control_print);

    return;
}

/* * * * * * * * * * * * * * * * * * * * * *
 * guile routines to define dhcp options.  *
 * * * * * * * * * * * * * * * * * * * * * */
 
/* define a dhcp option as a list. */
static void def_guile_option_list(dhcp_opt_t *option)
{
    stringbuffer_t *expr_sb;
    stringbuffer_t *val_sb;

    char *val;

    expr_sb = stringbuffer_create();
    val_sb = stringbuffer_create();

    val = dhcp_opt_get_user_string(option);
    stringbuffer_aprintf(val_sb, "'( \"%s", val);
    xfree(val);

    stringbuffer_replace(val_sb, ",", "\"");
    stringbuffer_aprintf(val_sb, "\")");

    stringbuffer_aprintf(expr_sb, "(define dhcp-%s %s)", 
                         dhcp_option_conf_string_get(dhcp_opt_get_tag(option)),
                         stringbuffer_getstring(val_sb));

    scm_c_eval_string(stringbuffer_getstring(expr_sb));

    stringbuffer_destroy(expr_sb);
    stringbuffer_destroy(val_sb);

    return;
}

/* define a dhcp option as an atom. */
static void def_guile_option_atom(dhcp_opt_t *option)
{
    stringbuffer_t *expr_sb;

    expr_sb = stringbuffer_create();
    stringbuffer_aprintf(expr_sb, "(define dhcp-%s %s)", 
                         dhcp_option_conf_string_get(dhcp_opt_get_tag(option)),
                         dhcp_opt_get_user_string(option));

    scm_c_eval_string(stringbuffer_getstring(expr_sb));
    stringbuffer_destroy(expr_sb);
    return;
}

/* define a dhcp option as string -- this means we have to escape any " and \. */
static void def_guile_option_string(dhcp_opt_t *option)
{
    stringbuffer_t *expr_sb;
    stringbuffer_t *val_sb;

    expr_sb = stringbuffer_create();
    val_sb = stringbuffer_create();

    stringbuffer_append(val_sb, dhcp_opt_get_user_string(option));
    stringbuffer_replace(val_sb, "\\", "\\\\");
    stringbuffer_replace(val_sb, "\"", "\\\"");

    stringbuffer_aprintf(expr_sb, "(define dhcp-%s \"%s\")", 
                         dhcp_option_conf_string_get(dhcp_opt_get_tag(option)),
                         stringbuffer_getstring(val_sb));

    scm_c_eval_string(stringbuffer_getstring(expr_sb));

    stringbuffer_destroy(expr_sb);
    stringbuffer_destroy(val_sb);
    return;
}

/* define a dhcp option at the top level guile environ. */
static void def_guile_option(dhcp_opt_t *option)
{
    switch(dhcp_opt_get_type(option)) {

    case DHCP_OPT_LIST:
        def_guile_option_list(option);
        break;

    case DHCP_OPT_ATOM:
        def_guile_option_atom(option);
        break;

    case DHCP_OPT_STRING:
        def_guile_option_string(option);
        break;

    case DHCP_OPT_ARRAY:        
        def_guile_option_list(option);
        break;

    default:
        FATAL_MESSAGE("illegal dhcp option. i should not get here. this is a bug. report it.");
        exit(1);
    }

    return;

}

/* take a list of options and define them at the top level. */
static void dhcp_def_guile_options(dhcp_client_control_t *dc, list_t *options)
{
    SCM client_control_sym;
    SCM client_control_handle;
    dhcp_opt_t *option;

    client_control_sym = scm_str2symbol("client-control");
    client_control_handle = dhcp_scm_make_client_control(dc);

    scm_define(client_control_sym, client_control_handle);

    /* walk down list and create each option and bind symbols to dhcp options. */

    list_rewind(options);
    while((option = list_next(options)) != NULL) {

        def_guile_option(option);
    }

    return;
}

/* undefine options so we don't see stale ones the next time we do a sysconf. */
static void dhcp_undef_guile_options(dhcp_client_control_t *dc, list_t *options)
{
    dhcp_opt_t *option;
    stringbuffer_t *expr_sb;

    /* walk down list and undef each option by name. */

    expr_sb = stringbuffer_create();

    list_rewind(options);
    while((option = list_next(options)) != NULL) {

        stringbuffer_clear(expr_sb);
        stringbuffer_aprintf(expr_sb, "(undefine dhcp-%s)", 
                             dhcp_option_conf_string_get(dhcp_opt_get_tag(option)));
        scm_c_eval_string(stringbuffer_getstring(expr_sb));
    }

    /* undefine the client control handler too. */
    scm_c_eval_string("(undefine client-control)");

    stringbuffer_destroy(expr_sb);

    return;
}

/* run the applicable guile hook of state. */
static void dhcp_run_guile_sysconf(dhcp_client_control_t *dc, int state)
{
    SCM hook;

    switch(state) {

    case STATE_SETUP:

        hook = scm_c_eval_string("dhcp-bind-hook");
        scm_c_run_hook(hook, SCM_EOL);
        break;

    case STATE_SHUTDOWN:
        hook = scm_c_eval_string("dhcp-release-hook");
        scm_c_run_hook(hook, SCM_EOL);
        break;

    default:
        FATAL_MESSAGE("illegal state value passed.");
    }

    return;
}

/* load the guile dhcp sysconf script. */
static void load_guile_sysconf(dhcp_client_control_t *dc)
{
    stringbuffer_t *sb;

    if(getenv("DEBUG_CLIENT_SCM"))
       scm_shell(0, NULL);

    sb = stringbuffer_create();
    stringbuffer_aprintf(sb, "%s/default.sysconf", DHCPSYSCONF_CLIENTDIR);

    if(file_exists(stringbuffer_getstring(sb))) {

        scm_c_primitive_load(stringbuffer_getstring(sb));
        stringbuffer_destroy(sb);
        return;
        
    } 

    stringbuffer_clear(sb);
    stringbuffer_aprintf(sb, "%s/%s.sysconf", DHCPSYSCONF_CLIENTDIR, dc->interface);

    if(file_exists(stringbuffer_getstring(sb))) {

        scm_c_primitive_load(stringbuffer_getstring(sb));
        stringbuffer_destroy(sb);
        return;
    }
    
    /* otherwise there is no sysconf file and this is
     * bad. signal a fatal error. */

    FATAL_MESSAGE("sysconf file missing -- looked for default.sysconf and <interface>.sysconf. exiting...");
    exit(1); /* get rid of compiler warning. */
}

/* * * * * * * * * * * * * * * *
 * public interface routines.  *
 * * * * * * * * * * * * * * * */

void dhcp_guile_init(dhcp_client_control_t *dc)
{
    SCM hook;

    /* initialize the client control smob */
    init_client_control_smob();

    /* bind subroutines. */

    scm_c_define_gsubr("client-interface-up", 4, 0, 0, dhcp_scm_interface_up);
    scm_c_define_gsubr("client-set-default-route", 2, 0, 0, dhcp_scm_client_set_default_route);
    scm_c_define_gsubr("client-remove-default-route", 2, 0, 0, dhcp_scm_client_remove_default_route);
    scm_c_define_gsubr("client-get-default-mtu", 1, 0, 0, dhcp_scm_get_default_mtu);
    scm_c_define_gsubr("client-get-default-subnet-mask", 1, 0, 0, dhcp_scm_get_default_subnet_mask);
    scm_c_define_gsubr("client-do-discover-icmp-latency?", 1, 0, 0, dhcp_scm_client_do_discover_icmp_latency);
    scm_c_define_gsubr("client-configure?", 2, 0, 0, dhcp_scm_configurep);
    scm_c_define_gsubr("client-info-message", 1, 0, 0, dhcp_scm_client_info_message);
    scm_c_define_gsubr("client-error-message", 1, 0, 0, dhcp_scm_client_error_message);
    scm_c_define_gsubr("client-fatal-error-message", 1, 0, 0, dhcp_scm_client_fatal_error_message);
    scm_c_define_gsubr("client-shutdown", 1, 0, 0, dhcp_scm_client_shutdown);
    scm_c_define_gsubr("client-discover-icmp-latency", 2, 0, 0, dhcp_scm_client_discover_icmp_latency);

    /* create hooks. */

    /* bound hook. */
    hook = scm_make_hook(SCM_MAKINUM(0));
    scm_c_define("dhcp-bind-hook", hook);

    /* release. */
    hook = scm_make_hook(SCM_MAKINUM(0));
    scm_c_define("dhcp-release-hook", hook);

    /* load user definitions. */
    load_guile_sysconf(dc);

    return;
}

void dhcp_sysconf_guile(dhcp_client_control_t *dc, list_t *options, int state)
{
    dhcp_def_guile_options(dc, options);
    dhcp_run_guile_sysconf(dc, state);
    dhcp_undef_guile_options(dc, options);

    return;
}