sexpr on_event (sexpr arguments, struct machine_state *state) { if (eolp (state->stack)) { sexpr tstate = car (arguments); if (truep(equalp(tstate, sym_always)) || ((init_state == gs_power_on) && truep(equalp(tstate, sym_power_on))) || ((init_state == gs_power_down) && truep(equalp(tstate, sym_power_down))) || ((init_state == gs_power_reset) && truep(equalp(tstate, sym_power_reset))) || ((init_state == gs_ctrl_alt_del) && truep(equalp(tstate, sym_ctrl_alt_del)))) { state->code = cdr (state->code); return sx_nonexistent; /* makes the seteh code execute the remainder of the script */ } else { return sx_false; // wrong state } } else { return sx_true; } }
static void handle_external_mod_update (struct kyu_module *newdef, struct kyu_module *mydef) { sexpr c, a, module, rv = sx_nil, flags = newdef->schedulerflags; c = sx_set_difference (mydef->schedulerflags, newdef->schedulerflags); if (eolp (c)) { return; } while (consp (c) && nilp (rv)) { a = car (c); if (truep (equalp (a, sym_enabling))) { if (falsep (sx_set_memberp (mydef->schedulerflags, sym_enabling))) { rv = handle_enable_request (mydef); if (falsep (rv)) { flags = sx_set_add (mydef->schedulerflags, sym_blocked); } } } else if (truep (equalp (a, sym_disabling))) { if (falsep (sx_set_memberp (mydef->schedulerflags, sym_disabling))) { rv = handle_disable_request (mydef); } } else if (consp (a) && falsep (sx_set_memberp (mydef->schedulerflags, a))) { rv = handle_action (mydef, cdr (a)); } c = cdr (c); } module = kyu_make_module (mydef->name, mydef->description, mydef->provides, mydef->requires, mydef->before, mydef->after, mydef->conflicts, flags, mydef->functions); my_modules = lx_environment_unbind (my_modules, mydef->name); my_modules = lx_environment_bind (my_modules, mydef->name, module); kyu_command (cons (sym_update, cons (native_system, cons (module, sx_end_of_list)))); }
static sexpr get_acceptable_type (sexpr lq) { sexpr types = get_acceptable_types (lq), ta, mape = lx_environment_alist (mime_map), n; while (consp (types)) { ta = car (types); n = mape; while (consp (n)) { if (truep (equalp (ta, cdr (car (n))))) { return ta; } n = cdr (n); } types = cdr (types); } return default_type; }
static void configure_callback (sexpr sx) { sexpr a = car (sx); if (truep (equalp (a, sym_root))) { webroot = car (cdr (sx)); } else if (truep (equalp (a, sym_map_extension))) { a = cdr (sx); mime_map = lx_environment_bind (mime_map, car (a), car (cdr (a))); } else if (truep (equalp (a, sym_default_type))) { default_type = car (cdr (sx)); } }
int retool_dfa( int argc, char* argv[] ) { atom_t dv = nil; atom_t iv; atom_t d; int i, p; if( argc < 3 ) { (void)fprintf( stderr, "usage: dfa regex alphabet\n" ); return 1; } atom_t atom = re_posix_parse( argv[1] ); char *x = argv[2]; (void)printf( "\n" ); (void)printf( " " ); while( *x ) { (void)printf( " %c", *x ); ++x; } (void)printf( "\n\n" ); dv = list2( nil, atom ); iv = cdr(dv); for( i = 1 ; iv ; ++i ) { (void)printf( "% 4d: ", i ); x = argv[2]; while( *x ) { d = brz_deriv( atom, *x ); p = position( d, dv ); if( p < 0 ) dv = append( dv, d ); p = position( d, dv ); if( p ) { (void)printf( "% 4d", p ); } else { (void)printf( " ." ); } ++x; } (void)printf( " " ); re_posix_dump( atom ); iv = cdr(iv); if( !iv ) break; atom = car(iv); } (void)printf( "\n" ); return !truep( atom ); }
struct graph_edge *graph_node_search_edge (struct graph_node *node, sexpr label) { int i; for(i = 0; i < node->edge_count; i++) { if(truep(equalp(node->edges[i]->label, label))) return node->edges[i]; } return (struct graph_edge *)0; }
static void mx_sx_ctl_queue_read (sexpr sx, struct sexpr_io *io, void *aux) { if (consp(sx)) { sexpr sxcar = car (sx); if (truep(equalp(sxcar, sym_disable))) { cexit (0); } } }
sexpr equalp (sexpr a, sexpr b) { if (a == b) return sx_true; if (!pointerp(a) || !pointerp(b)) return sx_false; if ((stringp(a) && stringp(b)) || (symbolp(a) && symbolp(b))) { struct sexpr_string_or_symbol *sa = (struct sexpr_string_or_symbol *)sx_pointer(a), *sb = (struct sexpr_string_or_symbol *)sx_pointer(b); unsigned long i; return (str_hash(sa->character_data, &i) == str_hash(sb->character_data, &i)) ? sx_true : sx_false; } else if (consp(a) && consp(b)) { return ((truep(equalp(car(a), car(b))) && truep(equalp(cdr(a), cdr(b))))) ? sx_true : sx_false; } else if (customp(a) && customp(b)) { int type = sx_type (a); if (type == sx_type (b)) { struct sexpr_type_descriptor *d = sx_get_descriptor (type); if ((d != (struct sexpr_type_descriptor *)0) && (d->equalp != (void *)0)) { return d->equalp (a, b); } } } return sx_false; }
struct graph_node *graph_search_node (sexpr sx, sexpr label) { struct graph *gr = (struct graph *)sx_pointer(sx); int i; for(i = 0; i < gr->node_count; i++) { if(truep(equalp(gr->nodes[i]->label, label))) return gr->nodes[i]; } return (struct graph_node *)0; }
int str_set_rx_memberp (char **set, const char *regex) { if (set != (char **)0) { sexpr rx = rx_compile (regex); while (*set != (char *)0) { if (truep (rx_match (rx, *set))) { return ~0; } set++; } } return 0; }
int retool_deriv( int argc, char* argv[] ) { if( argc < 3 ) { (void)fprintf( stderr, "deriv expects 2 arguments\n" ); return 1; } atom_t atom = re_posix_parse( argv[1] ); char *x = argv[2]; while( *x ) { (void)printf( "'%c': ", *x ); atom = brz_deriv( atom, *x ); re_posix_dump( atom ); if( !atom || truep( atom )) break; ++x; } return 0; }
sexpr lx_environment_lookup (sexpr env, sexpr key) { if (environmentp (env)) { struct environment *t = (struct environment *)env; sexpr sx = t->environment; while (consp (sx)) { sexpr sxt = car (sx); if (truep (equalp (car (sxt), key))) { return cdr (sxt); } sx = cdr (sx); } } return sx_nonexistent; }
static sexpr handle_action (struct kyu_module *mod, sexpr action) { sexpr act = lx_environment_lookup (mod_functions, mod->name), c, a, e; if (nexp (act)) { kyu_command (cons (sym_warning, cons (sym_module_has_no_functions, cons (mod->name, sx_end_of_list)))); return sx_false; } for (c = act; consp (c); c = cdr (c)) { a = car (c); if (truep (equalp (car (a), action))) { e = lx_environment_unbind (global_environment, sym_source); e = lx_environment_bind (e, sym_source, (sexpr)mod); lx_eval (cons (cons (sym_action_dispatch, cons (cons (mod->name, action), cons (cdr (a), cons (cons (sym_get_configuration, cons (mod->name, sx_end_of_list)), sx_end_of_list)))), sx_end_of_list), e); return sx_true; } } kyu_command (cons (sym_warning, cons (sym_module_action_not_available, cons (mod->name, sx_end_of_list)))); return sx_false; }
static void include_on_read (sexpr sx, struct sexpr_io *io, void *aux) { struct transdata *td = (struct transdata *)aux; if (eofp (sx)) { td->done = 1; } else if (consp (sx)) { sexpr n = car (sx); if (truep (equalp (sym_object, n))) { (*(td->data)) = cons (lx_eval (sx, (td->environment)), (*(td->data))); } else { (*(td->data)) = cons (sx, (*(td->data))); } } }
static void on_script_file_read (sexpr sx, struct sexpr_io *io, void *p) { if (consp (sx)) { sexpr a = car (sx), mt, b, c; struct kyu_module *mo; char daemon = 0; if (truep (equalp (sym_init_script, a)) || (daemon = truep (equalp (sym_daemon, a)))) { sexpr name = sx_nonexistent, description = sx_nonexistent, provides = sx_end_of_list, requires = sx_end_of_list, before = sx_end_of_list, after = sx_end_of_list, conflicts = sx_end_of_list, schedulerflags = sx_end_of_list, functions = sx_end_of_list, functiondata = sx_end_of_list, binary = sx_end_of_list, pidfile = sx_end_of_list, startcommand = sx_end_of_list, stopcommand = sx_true, parameters = sx_end_of_list, module; if (daemon) { functions = cons (sym_stop, cons (sym_start, functions)); } a = cdr (sx); name = car (a); a = cdr (a); description = car (a); a = cdr (a); while (consp (a)) { sexpr v = car (a); sexpr va = car (v); if (truep (equalp (sym_provides, va))) { provides = sx_set_merge (provides, cdr (v)); } else if (truep (equalp (sym_requires, va))) { requires = sx_set_merge (requires, cdr (v)); } else if (truep (equalp (sym_conflicts_with, va))) { conflicts = sx_set_merge (conflicts, cdr (v)); } else if (truep (equalp (sym_before, va))) { before = sx_set_merge (before, cdr (v)); } else if (truep (equalp (sym_after, va))) { after = sx_set_merge (after, cdr (v)); } else if (truep (equalp (sym_schedule_limitations, va))) { schedulerflags = sx_set_merge (schedulerflags, cdr (v)); } else if (truep (equalp (sym_functions, va))) { functiondata = sx_set_merge (functiondata, cdr (v)); } else if (truep (equalp (sym_pid_file, va))) { pidfile = sx_set_merge (pidfile, cdr (v)); } else if (truep (equalp (sym_binary, va))) { binary = sx_set_merge (binary, cdr (v)); } else if (truep (equalp (sym_parameters, va))) { parameters = sx_set_merge (parameters, cdr (c)); } a = cdr (a); } if (!eolp (binary)) { for (a = binary; consp (a); a = cdr (a)) { b = car (a); if (falsep ((c = which (b)))) { kyu_command (cons (sym_warning, cons (sym_binary_not_found, cons (native_system, cons (name, cons (b, sx_end_of_list)))))); return; } if (daemon) { startcommand = cons (cons (sym_run, cons (c, parameters)), startcommand); if (!eolp(pidfile) && truep(stopcommand)) { stopcommand = sx_list1 (sx_list2(sym_kill_via_pid_file, pidfile)); } } } } if (daemon) { functiondata = cons (cons (sym_start, startcommand), cons (cons (sym_stop, stopcommand), functiondata)); } mt = lx_environment_lookup (my_modules, name); if (!nexp (mt)) { mo = (struct kyu_module *)mt; schedulerflags = sx_set_merge (schedulerflags, mo->schedulerflags); } module = kyu_make_module (name, description, provides, requires, before, after, conflicts, schedulerflags, functions); my_modules = lx_environment_unbind (my_modules, name); my_modules = lx_environment_bind (my_modules, name, module); mod_functions = lx_environment_unbind (mod_functions, name); mod_functions = lx_environment_bind (mod_functions, name, functiondata); mod_metadata = lx_environment_unbind (mod_metadata, name); mod_metadata = lx_environment_bind (mod_metadata, name, cons (binary, pidfile)); kyu_command (cons (sym_update, cons (native_system, cons (module, sx_end_of_list)))); } } else if (eofp (sx)) { open_config_files--; if (open_config_files == 0) { update_status_from_pid_files (); kyu_command (cons (sym_initialised, cons (sym_server_seteh, sx_end_of_list))); } } }
static sexpr include (sexpr arguments, struct machine_state *st) { sexpr env = st->environment; define_string (str_slash, "/"); sexpr e = env, to = car (arguments), t = sx_join (webroot, str_slash, to), data = sx_end_of_list, lang, lcodes, te, tf, type = sx_nonexistent, lcc; struct sexpr_io *io; int len = 0, i = 0; const char *ts = sx_string (to); char *tmp; if (nexp (lx_environment_lookup (e, sym_original_name))) { e = lx_environment_bind (e, sym_original_name, car (arguments)); } if (truep (filep (t))) { return cons (e, cons (cons (sym_verbatim, cons (t, sx_end_of_list)), sx_end_of_list)); } te = sx_join (to, str_dot_ksu, str_nil); lcodes = (lx_environment_lookup (e, sym_language)); lcodes = sx_reverse (lcodes); lcodes = cons (str_dot, lcodes); lcodes = sx_reverse (lcodes); lcc = lcodes; while (consp (lcc)) { lang = car (lcc); t = sx_join (webroot, str_slash, sx_join (lang, str_slash, te)); if (truep (filep (t))) { sexpr v = lx_environment_lookup (e, sym_Vary); tf = lx_environment_lookup (e, sym_accept); e = lx_environment_bind (e, sym_base_name, to); if (!nexp (v)) { e = lx_environment_unbind (e, sym_Vary); e = lx_environment_bind (e, sym_Vary, sx_join (v, str_cAccept, sx_end_of_list)); } else { e = lx_environment_bind (e, sym_Vary, str_Accept); } if (!nexp (tf)) { tf = get_acceptable_type (tf); } else { tf = default_type; } goto include; } lcc = cdr (lcc); } while (ts[len] != (char)0) { if (ts[len] == '.') i = len; len++; } if (i > 0) { len = i; tmp = aalloc (len + 1); for (i = 0; i < len; i++) { tmp[i] = ts[i]; } tmp[i] = 0; i++; te = make_string (tmp); type = make_string (ts + i); afree (i, tmp); e = lx_environment_bind (e, sym_base_name, te); e = lx_environment_bind (e, sym_extension, type); te = sx_join (te, str_dot_ksu, str_nil); while (consp (lcodes)) { lang = car (lcodes); t = sx_join (webroot, str_slash, sx_join (lang, str_slash, te)); if (truep (filep (t))) { tf = lx_environment_lookup(mime_map, type); include: if (!nexp (tf)) { struct transdata td = { lx_environment_join (lx_environment_join (kho_environment, env), e), &data, 0 }; e = lx_environment_bind (e, sym_format, tf); io = sx_open_i (io_open_read (sx_string (t))); multiplex_add_sexpr (io, include_on_read, &td); do { multiplex (); } while (td.done == 0); return cons (e, sx_reverse (data)); } else { return cons (e, cons (cons (sym_object, cons (sym_verbatim, cons (t, sx_end_of_list))), sx_end_of_list)); } } lcodes = cdr (lcodes); } } if (!nexp (lx_environment_lookup (e, sym_error))) { return cons (sym_object, cons (cons (sym_error, cons (sym_file_not_found, sx_end_of_list)), sx_end_of_list)); } else { return sx_nonexistent; } }
int cmain () { define_symbol (sym_monitor, "monitor"); int i; programme_identification = cons (sym_monitor, make_integer (2)); #if defined(have_sys_setsid) sys_setsid(); #endif initialise_kyu_script_commands (); multiplex_add_kyu_callback (on_ipc_read, (void *)0); global_environment = kyu_sx_default_environment (); global_environment = lx_environment_bind (global_environment, sym_on_event, lx_foreign_mu (sym_on_event, on_event)); global_environment = lx_environment_bind (global_environment, sym_power_on, lx_foreign_mu (sym_power_on, power_on)); global_environment = lx_environment_bind (global_environment, sym_power_down, lx_foreign_mu (sym_power_down, power_down)); global_environment = lx_environment_bind (global_environment, sym_power_reset, lx_foreign_mu (sym_power_reset, power_reset)); global_environment = lx_environment_bind (global_environment, sym_ctrl_alt_del, lx_foreign_mu (sym_ctrl_alt_del, ctrl_alt_del)); for (i = 1; curie_argv[i] != (char *)0; i++) { sexpr n = make_string (curie_argv[i]); if (truep(filep(n))) { open_script_files++; multiplex_add_sexpr (sx_open_i (io_open_read (curie_argv[i])), on_script_read, (void *)0); } else { native_system = make_symbol (curie_argv[i]); } } kyu_sd_add_listener_stdio (); while (multiplex() == mx_ok); return 21; }
static void event_add (sexpr sx) { struct event *ev; if (consp (sx)) { sexpr a = car (sx); sexpr c = cdr (sx); int repeat = 1; int stat = 0; if (truep (equalp (a, sym_quit))) { cexit (0); } if (truep (equalp (a, sym_repeat))) { a = car (c); c = cdr (c); repeat = -1; stat |= STAT_HAD_REPEAT; if (integerp (a)) { repeat = sx_integer (a); a = car (c); c = cdr (c); } else if (truep (equalp (a, sym_indefinitely))) { repeat = -1; a = car (c); c = cdr (c); } else { stat |= STAT_SKIP_IN_POP; } } if (truep (equalp (a, sym_every))) { a = car (c); c = cdr (c); if (!(stat & STAT_HAD_REPEAT)) { repeat = -1; } stat |= STAT_PROCESS_IN; stat |= STAT_SKIP_IN_POP; } if (truep (equalp (a, sym_in)) || (stat & STAT_PROCESS_IN)) { if (!(stat & STAT_SKIP_IN_POP)) { a = car (c); c = cdr (c); } if (integerp (a)) { ev = get_event (); ev->repeat = repeat; ev->model_data.seconds = sx_integer (a); a = car (c); c = cdr (c); if (truep (equalp (a, sym_seconds)) || truep (equalp (a, sym_second)) || truep (equalp (a, sym_s))) { a = car (c); c = cdr (c); /* nothing to do*/ } if (!nexp (a) && falsep (equalp (a, sym_then))) { ev->output = a; a = car (c); c = cdr (c); } if (truep (equalp (a, sym_then))) { ev->then = c; } } } } }
sexpr read_directory_w (const char *p, char **map, char *mapd) { sexpr r = sx_end_of_list; unsigned int l = 0, s = 0, c = 0; map[0] = mapd; while (p[l]) { if (p[l] == '/') { mapd[l] = 0; map[s] = (mapd + c); s++; c = l+1; } else { mapd[l] = p[l]; } l++; } mapd[l] = 0; map[s] = (mapd + c); s++; if (map[0][0] == 0) { r = cons (str_slashdot, r); } else { r = cons (str_dot, r); } for (c = 0; c < s; c++) { char regex = 0; char *t = map[c]; sexpr nr = sx_end_of_list; if (map[c][0] == 0) continue; if (!((t[0] == '.') && ((t[1] == 0) || ((t[1] == '.') && (t[2] == 0))))) { unsigned int cx; for (cx = 0; (regex == 0) && t[cx]; cx++) { switch (t[cx]) { case '\\': case '?': case '*': case '+': case '(': case ')': case '|': case '[': case '.': regex = 1; break; default: break; } } } if (regex) { sexpr g = rx_compile (map[c]); sexpr c; for (c = r; consp(c); c = cdr(c)) { sexpr ca = car (c); sexpr n = read_directory_rx (sx_string (ca), g); sexpr e; for (e = n; consp (e); e = cdr (e)) { sexpr b = car (e); nr = cons (sx_join (ca, str_slash, b), nr); } } } else { sexpr b = make_string (t); sexpr c; for (c = r; consp(c); c = cdr(c)) { sexpr ca = car (c); sexpr nf = sx_join (ca, str_slash, b); if (truep(filep (nf))) { nr = cons (nf, nr); } } } r = nr; } return r; }
static sexpr action_wrap (sexpr arguments, struct machine_state *state) { if (eolp (state->stack)) { state->stack = cons(lx_foreign_mu (sym_action_wrap, action_wrap), state->stack); state->stack = cons (car (state->code), state->stack); state->code = cdr (state->code); return sx_nonexistent; } else { sexpr meta = car (arguments), v = sx_true, name = car (meta), act = cdr (meta), t, module; struct kyu_module *mod; t = lx_environment_lookup (my_modules, name); if (!kmodulep (t)) { return sx_false; } mod = (struct kyu_module *)t; t = mod->schedulerflags; arguments = cdr (arguments); while (consp (arguments)) { v = car (arguments); arguments = cdr (arguments); } if (truep (equalp (act, sym_start))) { t = sx_set_remove (t, sym_enabling); if (truep (v)) { t = sx_set_add (t, sym_enabled); } else { t = sx_set_add (t, sym_blocked); } } else if (truep (equalp (act, sym_stop))) { t = sx_set_remove (t, sym_enabled); t = sx_set_remove (t, sym_disabling); } else { t = sx_set_remove (t, cons (sym_action, act)); } module = kyu_make_module (mod->name, mod->description, mod->provides, mod->requires, mod->before, mod->after, mod->conflicts, t, mod->functions); my_modules = lx_environment_unbind (my_modules, name); my_modules = lx_environment_bind (my_modules, name, module); kyu_command (cons (sym_update, cons (native_system, cons (module, sx_end_of_list)))); return sx_true; } }
static void on_event (sexpr sx, void *aux) { if (consp (sx)) { sexpr a = car (sx); if (truep (equalp (a, sym_reply))) { sx = cdr (sx); a = car (sx); if (truep (equalp (a, sym_configuration))) { sx = cdr (sx); a = car (sx); if (truep (equalp (a, sym_server_seteh))) { kyu_command (cons (sym_initialising, cons (sym_server_seteh, sx_end_of_list))); sx = lx_environment_lookup (car (cdr (sx)), sym_source); while (consp (sx)) { sexpr files = read_directory_sx (car (sx)); while (consp (files)) { sexpr t = car (files); open_config_files++; multiplex_add_sexpr (sx_open_i (io_open_read (sx_string (t))), on_script_file_read, (void *)0); files = cdr (files); } sx = cdr (sx); } if (open_config_files == 0) { kyu_command (cons (sym_initialised, cons (sym_server_seteh, sx_end_of_list))); } } } } else if (truep (equalp (a, sym_update))) { /* this might be a request from the scheduler, let's have a look... */ sx = cdr (sx); a = car (sx); if (truep (equalp (a, native_system))) { sx = cdr (sx); while (consp (sx)) { a = car (sx); if (kmodulep (a)) { struct kyu_module *mod = (struct kyu_module *)a; a = lx_environment_lookup (my_modules, mod->name); if (!nexp (a)) { /* someone else updated one of our modules... */ struct kyu_module *mydef = (struct kyu_module *)a; handle_external_mod_update (mod, mydef); } } sx = cdr (sx); } } } else if (truep (equalp (a, sym_process_terminated))) { update_status_from_pid_files (); } } }
static void update_status_from_pid_files ( void ) { sexpr c, a, n, pl, name, m, flags; struct sexpr_io *io; struct kyu_module *mod; int online; for (c = lx_environment_alist (mod_metadata); consp (c); c = cdr (c)) { a = car (c); name = car (a); a = cdr (a); online = 0; if (consp ((pl = cdr (a)))) { while (!online && (consp (pl))) { a = car (pl); if (truep (filep (a))) { io = sx_open_i (io_open_read (sx_string (a))); while (!eofp ((n = sx_read (io)))) { if (integerp (n)) { online = kyu_test_pid (sx_integer (n)); break; } } sx_close_io (io); } pl = cdr (pl); } if (!nexp (m = lx_environment_lookup (my_modules, name))) { mod = (struct kyu_module *)m; flags = mod->schedulerflags; if (truep (sx_set_memberp (flags, sym_enabled)) != online) { my_modules = lx_environment_unbind (my_modules, name); if (online) { flags = sx_set_add (flags, sym_enabled); } else { flags = sx_set_remove (flags, sym_enabled); } m = kyu_make_module (mod->name, mod->description, mod->provides, mod->requires, mod->before, mod->after, mod->conflicts, flags, mod->functions); my_modules = lx_environment_bind (my_modules, name, m); kyu_command (cons (sym_update, cons (native_system, cons (m, sx_end_of_list)))); } } } } }