diff options
author | Přemysl Eric Janouch <p@janouch.name> | 2021-08-06 16:12:15 +0200 |
---|---|---|
committer | Přemysl Eric Janouch <p@janouch.name> | 2021-08-06 16:43:59 +0200 |
commit | 50057d5149dda340b3b47aca4096f4a6ec66b9ee (patch) | |
tree | 79323d20b17c2c8e32942a1ac9b84d9da3041c6d /plugins/zyklonb/script | |
parent | 1f64710e795b0c5434d15813d4f1f568467ca087 (diff) | |
download | xK-50057d5149dda340b3b47aca4096f4a6ec66b9ee.tar.gz xK-50057d5149dda340b3b47aca4096f4a6ec66b9ee.tar.xz xK-50057d5149dda340b3b47aca4096f4a6ec66b9ee.zip |
Come up with sillier names for the binaries
I'm not entirely sure, but it looks like some people might not like
jokes about the Holocaust.
On a more serious note, the project has become more serious over
the 7 or so years of its existence.
Diffstat (limited to 'plugins/zyklonb/script')
-rwxr-xr-x | plugins/zyklonb/script | 2310 |
1 files changed, 0 insertions, 2310 deletions
diff --git a/plugins/zyklonb/script b/plugins/zyklonb/script deleted file mode 100755 index c19b8c5..0000000 --- a/plugins/zyklonb/script +++ /dev/null @@ -1,2310 +0,0 @@ -#!/usr/bin/tcc -run -lm -// -// ZyklonB scripting plugin, using a custom stack-based language -// -// Copyright 2014 Přemysl Eric Janouch -// See the file LICENSE for licensing information. -// -// Just compile this file as usual (sans #!) if you don't feel like using TCC. -// It is a very basic and portable C99 application. It's not supposed to be -// very sophisticated, for it'd get extremely big. -// -// The main influences of the language were Factor and Joy, stripped of all -// even barely complex stuff. In its current state, it's only really useful as -// a calculator but it's got great potential for extending. -// -// If you don't like something, just change it; this is just an experiment. -// -// NOTE: it is relatively easy to abuse. Be careful. -// - -#define _XOPEN_SOURCE 500 - -#include <stdio.h> -#include <stdlib.h> -#include <string.h> -#include <ctype.h> -#include <errno.h> -#include <stdarg.h> -#include <assert.h> -#include <time.h> -#include <stdbool.h> -#include <strings.h> -#include <math.h> - -#define ADDRESS_SPACE_LIMIT (100 * 1024 * 1024) -#include <sys/resource.h> - -#if defined __GNUC__ -#define ATTRIBUTE_PRINTF(x, y) __attribute__ ((format (printf, x, y))) -#else // ! __GNUC__ -#define ATTRIBUTE_PRINTF(x, y) -#endif // ! __GNUC__ - -#define N_ELEMENTS(a) (sizeof (a) / sizeof ((a)[0])) - -// --- Utilities --------------------------------------------------------------- - -static char *strdup_printf (const char *format, ...) ATTRIBUTE_PRINTF (1, 2); - -static char * -strdup_vprintf (const char *format, va_list ap) -{ - va_list aq; - va_copy (aq, ap); - int size = vsnprintf (NULL, 0, format, aq); - va_end (aq); - if (size < 0) - return NULL; - - char buf[size + 1]; - size = vsnprintf (buf, sizeof buf, format, ap); - if (size < 0) - return NULL; - - return strdup (buf); -} - -static char * -strdup_printf (const char *format, ...) -{ - va_list ap; - va_start (ap, format); - char *result = strdup_vprintf (format, ap); - va_end (ap); - return result; -} - -// --- Generic buffer ---------------------------------------------------------- - -struct buffer -{ - char *s; ///< Buffer data - size_t alloc; ///< Number of bytes allocated - size_t len; ///< Number of bytes used - bool memory_failure; ///< Memory allocation failed -}; - -#define BUFFER_INITIALIZER { NULL, 0, 0, false } - -static bool -buffer_append (struct buffer *self, const void *s, size_t n) -{ - if (self->memory_failure) - return false; - - if (!self->s) - self->s = malloc (self->alloc = 8); - while (self->len + n > self->alloc) - self->s = realloc (self->s, self->alloc <<= 1); - - if (!self->s) - { - self->memory_failure = true; - return false; - } - - memcpy (self->s + self->len, s, n); - self->len += n; - return true; -} - -inline static bool -buffer_append_c (struct buffer *self, char c) -{ - return buffer_append (self, &c, 1); -} - -// --- Data types -------------------------------------------------------------- - -enum item_type -{ - ITEM_STRING, - ITEM_WORD, - ITEM_INTEGER, - ITEM_FLOAT, - ITEM_LIST -}; - -struct item -{ -#define ITEM_HEADER \ - enum item_type type; /**< The type of this object */ \ - struct item *next; /**< Next item on the list/stack */ - - ITEM_HEADER -}; - -struct item_string -{ - ITEM_HEADER - size_t len; ///< Length of the string (sans '\0') - char value[]; ///< The null-terminated string value -}; - -#define get_string(item) \ - (assert ((item)->type == ITEM_STRING), \ - ((struct item_string *)(item))->value) - -/// It looks like a string but it doesn't quack like a string -#define item_word item_string - -#define get_word(item) \ - (assert ((item)->type == ITEM_WORD), \ - ((struct item_word *)(item))->value) - -struct item_integer -{ - ITEM_HEADER - long long value; ///< The integer value -}; - -#define get_integer(item) \ - (assert ((item)->type == ITEM_INTEGER), \ - ((struct item_integer *)(item))->value) - -struct item_float -{ - ITEM_HEADER - long double value; ///< The floating point value -}; - -#define get_float(item) \ - (assert ((item)->type == ITEM_FLOAT), \ - ((struct item_float *)(item))->value) - -struct item_list -{ - ITEM_HEADER - struct item *head; ///< The head of the list -}; - -#define get_list(item) \ - (assert ((item)->type == ITEM_LIST), \ - ((struct item_list *)(item))->head) - -#define set_list(item, head_) \ - (assert ((item)->type == ITEM_LIST), \ - item_free_list (((struct item_list *)(item))->head), \ - ((struct item_list *)(item))->head = (head_)) - -const char * -item_type_to_str (enum item_type type) -{ - switch (type) - { - case ITEM_STRING: return "string"; - case ITEM_WORD: return "word"; - case ITEM_INTEGER: return "integer"; - case ITEM_FLOAT: return "float"; - case ITEM_LIST: return "list"; - } - abort (); -} - -// --- Item management --------------------------------------------------------- - -static void item_free_list (struct item *); -static struct item *new_clone_list (const struct item *); - -static void -item_free (struct item *item) -{ - if (item->type == ITEM_LIST) - item_free_list (get_list (item)); - free (item); -} - -static void -item_free_list (struct item *item) -{ - while (item) - { - struct item *link = item; - item = item->next; - item_free (link); - } -} - -static struct item * -new_clone (const struct item *item) -{ - size_t size; - switch (item->type) - { - case ITEM_STRING: - case ITEM_WORD: - { - const struct item_string *x = (const struct item_string *) item; - size = sizeof *x + x->len + 1; - break; - } - case ITEM_INTEGER: size = sizeof (struct item_integer); break; - case ITEM_FLOAT: size = sizeof (struct item_float); break; - case ITEM_LIST: size = sizeof (struct item_list); break; - } - - struct item *clone = malloc (size); - if (!clone) - return NULL; - - memcpy (clone, item, size); - if (item->type == ITEM_LIST) - { - struct item_list *x = (struct item_list *) clone; - if (x->head && !(x->head = new_clone_list (x->head))) - { - free (clone); - return NULL; - } - } - clone->next = NULL; - return clone; -} - -static struct item * -new_clone_list (const struct item *item) -{ - struct item *head = NULL, *clone; - for (struct item **out = &head; item; item = item->next) - { - if (!(clone = *out = new_clone (item))) - { - item_free_list (head); - return NULL; - } - clone->next = NULL; - out = &clone->next; - } - return head; -} - -static struct item * -new_string (const char *s, ssize_t len) -{ - if (len < 0) - len = strlen (s); - - struct item_string *item = calloc (1, sizeof *item + len + 1); - if (!item) - return NULL; - - item->type = ITEM_STRING; - item->len = len; - memcpy (item->value, s, len); - item->value[len] = '\0'; - return (struct item *) item; -} - -static struct item * -new_word (const char *s, ssize_t len) -{ - struct item *item = new_string (s, len); - if (!item) - return NULL; - - item->type = ITEM_WORD; - return item; -} - -static struct item * -new_integer (long long value) -{ - struct item_integer *item = calloc (1, sizeof *item); - if (!item) - return NULL; - - item->type = ITEM_INTEGER; - item->value = value; - return (struct item *) item; -} - -static struct item * -new_float (long double value) -{ - struct item_float *item = calloc (1, sizeof *item); - if (!item) - return NULL; - - item->type = ITEM_FLOAT; - item->value = value; - return (struct item *) item; -} - -static struct item * -new_list (struct item *head) -{ - struct item_list *item = calloc (1, sizeof *item); - if (!item) - return NULL; - - item->type = ITEM_LIST; - item->head = head; - return (struct item *) item; -} - -// --- Parsing ----------------------------------------------------------------- - -#define PARSE_ERROR_TABLE(XX) \ - XX( OK, NULL ) \ - XX( EOF, "unexpected end of input" ) \ - XX( INVALID_HEXA_ESCAPE, "invalid hexadecimal escape sequence" ) \ - XX( INVALID_ESCAPE, "unrecognized escape sequence" ) \ - XX( MEMORY, "memory allocation failure" ) \ - XX( FLOAT_RANGE, "floating point value out of range" ) \ - XX( INTEGER_RANGE, "integer out of range" ) \ - XX( INVALID_INPUT, "invalid input" ) \ - XX( UNEXPECTED_INPUT, "unexpected input" ) - -enum tokenizer_error -{ -#define XX(x, y) PARSE_ERROR_ ## x, - PARSE_ERROR_TABLE (XX) -#undef XX - PARSE_ERROR_COUNT -}; - -struct tokenizer -{ - const char *cursor; - enum tokenizer_error error; -}; - -static bool -decode_hexa_escape (struct tokenizer *self, struct buffer *buf) -{ - int i; - char c, code = 0; - - for (i = 0; i < 2; i++) - { - c = tolower (*self->cursor); - if (c >= '0' && c <= '9') - code = (code << 4) | (c - '0'); - else if (c >= 'a' && c <= 'f') - code = (code << 4) | (c - 'a' + 10); - else - break; - - self->cursor++; - } - - if (!i) - return false; - - buffer_append_c (buf, code); - return true; -} - -static bool -decode_octal_escape (struct tokenizer *self, struct buffer *buf) -{ - int i; - char c, code = 0; - - for (i = 0; i < 3; i++) - { - c = *self->cursor; - if (c < '0' || c > '7') - break; - - code = (code << 3) | (c - '0'); - self->cursor++; - } - - if (!i) - return false; - - buffer_append_c (buf, code); - return true; -} - -static bool -decode_escape_sequence (struct tokenizer *self, struct buffer *buf) -{ - // Support some basic escape sequences from the C language - char c; - switch ((c = *self->cursor)) - { - case '\0': - self->error = PARSE_ERROR_EOF; - return false; - case 'x': - case 'X': - self->cursor++; - if (decode_hexa_escape (self, buf)) - return true; - - self->error = PARSE_ERROR_INVALID_HEXA_ESCAPE; - return false; - default: - if (decode_octal_escape (self, buf)) - return true; - - self->cursor++; - const char *from = "abfnrtv\"\\", *to = "\a\b\f\n\r\t\v\"\\", *x; - if ((x = strchr (from, c))) - { - buffer_append_c (buf, to[x - from]); - return true; - } - - self->error = PARSE_ERROR_INVALID_ESCAPE; - return false; - } -} - -static struct item * -parse_string (struct tokenizer *self) -{ - struct buffer buf = BUFFER_INITIALIZER; - struct item *item = NULL; - char c; - - while (true) - switch ((c = *self->cursor++)) - { - case '\0': - self->cursor--; - self->error = PARSE_ERROR_EOF; - goto end; - case '"': - if (buf.memory_failure - || !(item = new_string (buf.s, buf.len))) - self->error = PARSE_ERROR_MEMORY; - goto end; - case '\\': - if (decode_escape_sequence (self, &buf)) - break; - goto end; - default: - buffer_append_c (&buf, c); - } - -end: - free (buf.s); - return item; -} - -static struct item * -try_parse_number (struct tokenizer *self) -{ - // These two standard library functions can digest a lot of various inputs, - // including NaN and +/- infinity. That may get a bit confusing. - char *float_end; - errno = 0; - long double float_value = strtold (self->cursor, &float_end); - int float_errno = errno; - - char *int_end; - errno = 0; - long long int_value = strtoll (self->cursor, &int_end, 10); - int int_errno = errno; - - // If they both fail, then this is most probably not a number. - if (float_end == int_end && float_end == self->cursor) - return NULL; - - // Only use the floating point result if it parses more characters: - struct item *item; - if (float_end > int_end) - { - if (float_errno == ERANGE) - { - self->error = PARSE_ERROR_FLOAT_RANGE; - return NULL; - } - self->cursor = float_end; - if (!(item = new_float (float_value))) - self->error = PARSE_ERROR_MEMORY; - return item; - } - else - { - if (int_errno == ERANGE) - { - self->error = PARSE_ERROR_INTEGER_RANGE; - return NULL; - } - self->cursor = int_end; - if (!(item = new_integer (int_value))) - self->error = PARSE_ERROR_MEMORY; - return item; - } -} - -static struct item * -parse_word (struct tokenizer *self) -{ - struct buffer buf = BUFFER_INITIALIZER; - struct item *item = NULL; - char c; - - // Here we accept almost anything that doesn't break the grammar - while (!strchr (" []\"", (c = *self->cursor++)) && (unsigned char) c > ' ') - buffer_append_c (&buf, c); - self->cursor--; - - if (buf.memory_failure) - self->error = PARSE_ERROR_MEMORY; - else if (!buf.len) - self->error = PARSE_ERROR_INVALID_INPUT; - else if (!(item = new_word (buf.s, buf.len))) - self->error = PARSE_ERROR_MEMORY; - - free (buf.s); - return item; -} - -static struct item *parse_item_list (struct tokenizer *); - -static struct item * -parse_list (struct tokenizer *self) -{ - struct item *list = parse_item_list (self); - if (self->error) - { - assert (list == NULL); - return NULL; - } - if (!*self->cursor) - { - self->error = PARSE_ERROR_EOF; - item_free_list (list); - return NULL; - } - assert (*self->cursor == ']'); - self->cursor++; - return new_list (list); -} - -static struct item * -parse_item (struct tokenizer *self) -{ - char c; - switch ((c = *self->cursor++)) - { - case '[': return parse_list (self); - case '"': return parse_string (self); - default:; - } - - self->cursor--; - struct item *item = try_parse_number (self); - if (!item && !self->error) - item = parse_word (self); - return item; -} - -static struct item * -parse_item_list (struct tokenizer *self) -{ - struct item *head = NULL; - struct item **tail = &head; - - char c; - bool expected = true; - while ((c = *self->cursor) && c != ']') - { - if (isspace (c)) - { - self->cursor++; - expected = true; - continue; - } - else if (!expected) - { - self->error = PARSE_ERROR_UNEXPECTED_INPUT; - goto fail; - } - - if (!(*tail = parse_item (self))) - goto fail; - tail = &(*tail)->next; - expected = false; - } - return head; - -fail: - item_free_list (head); - return NULL; -} - -static struct item * -parse (const char *s, const char **error) -{ - struct tokenizer self = { .cursor = s, .error = PARSE_ERROR_OK }; - struct item *list = parse_item_list (&self); - if (!self.error && *self.cursor != '\0') - { - self.error = PARSE_ERROR_UNEXPECTED_INPUT; - item_free_list (list); - list = NULL; - } - -#define XX(x, y) y, - static const char *strings[PARSE_ERROR_COUNT] = - { PARSE_ERROR_TABLE (XX) }; -#undef XX - - static char error_buf[128]; - if (self.error && error) - { - snprintf (error_buf, sizeof error_buf, "at character %d: %s", - (int) (self.cursor - s) + 1, strings[self.error]); - *error = error_buf; - } - return list; -} - -// --- Runtime ----------------------------------------------------------------- - -// TODO: try to think of a _simple_ way to do preemptive multitasking - -struct context -{ - struct item *stack; ///< The current top of the stack - size_t stack_size; ///< Number of items on the stack - - size_t reduction_count; ///< # of function calls so far - size_t reduction_limit; ///< The hard limit on function calls - - char *error; ///< Error information - bool error_is_fatal; ///< Whether the error can be catched - bool memory_failure; ///< Memory allocation failure - - void *user_data; ///< User data -}; - -/// Internal handler for a function -typedef bool (*handler_fn) (struct context *); - -struct fn -{ - struct fn *next; ///< The next link in the chain - - handler_fn handler; ///< Internal C handler, or NULL - struct item *script; ///< Alternatively runtime code - char name[]; ///< The name of the function -}; - -struct fn *g_functions; ///< Maps words to functions - -static void -context_init (struct context *ctx) -{ - ctx->stack = NULL; - ctx->stack_size = 0; - - ctx->reduction_count = 0; - ctx->reduction_limit = 2000; - - ctx->error = NULL; - ctx->error_is_fatal = false; - ctx->memory_failure = false; - - ctx->user_data = NULL; -} - -static void -context_free (struct context *ctx) -{ - item_free_list (ctx->stack); - ctx->stack = NULL; - - free (ctx->error); - ctx->error = NULL; -} - -static bool -set_error (struct context *ctx, const char *format, ...) -{ - free (ctx->error); - - va_list ap; - va_start (ap, format); - ctx->error = strdup_vprintf (format, ap); - va_end (ap); - - if (!ctx->error) - ctx->memory_failure = true; - return false; -} - -static bool -push (struct context *ctx, struct item *item) -{ - // The `item' is typically a result from new_<type>(), thus when it is null, - // that function must have failed. This is a shortcut for convenience. - if (!item) - { - ctx->memory_failure = true; - return false; - } - - assert (item->next == NULL); - item->next = ctx->stack; - ctx->stack = item; - ctx->stack_size++; - return true; -} - -static bool -bump_reductions (struct context *ctx) -{ - if (++ctx->reduction_count >= ctx->reduction_limit) - { - ctx->error_is_fatal = true; - return set_error (ctx, "reduction limit reached"); - } - return true; -} - -static bool execute (struct context *, struct item *); - -static bool -call_function (struct context *ctx, const char *name) -{ - struct fn *iter; - for (iter = g_functions; iter; iter = iter->next) - if (!strcmp (name, iter->name)) - goto found; - return set_error (ctx, "unknown function: %s", name); - -found: - if (!bump_reductions (ctx)) - return false; - - if (iter->handler - ? iter->handler (ctx) - : execute (ctx, iter->script)) - return true; - - // In this case, `error' is NULL - if (ctx->memory_failure) - return false; - - // This creates some form of a stack trace - char *tmp = ctx->error; - ctx->error = NULL; - set_error (ctx, "%s -> %s", name, tmp); - free (tmp); - return false; -} - -static void -free_function (struct fn *fn) -{ - item_free_list (fn->script); - free (fn); -} - -static void -unregister_function (const char *name) -{ - for (struct fn **iter = &g_functions; *iter; iter = &(*iter)->next) - if (!strcmp ((*iter)->name, name)) - { - struct fn *tmp = *iter; - *iter = tmp->next; - free_function (tmp); - break; - } -} - -static struct fn * -prepend_new_fn (const char *name) -{ - struct fn *fn = calloc (1, sizeof *fn + strlen (name) + 1); - if (!fn) - return NULL; - - strcpy (fn->name, name); - fn->next = g_functions; - return g_functions = fn; -} - -static bool -register_handler (const char *name, handler_fn handler) -{ - unregister_function (name); - struct fn *fn = prepend_new_fn (name); - if (!fn) - return false; - fn->handler = handler; - return true; -} - -static bool -register_script (const char *name, struct item *script) -{ - unregister_function (name); - struct fn *fn = prepend_new_fn (name); - if (!fn) - return false; - fn->script = script; - return true; -} - -static bool -execute (struct context *ctx, struct item *script) -{ - for (; script; script = script->next) - { - if (script->type != ITEM_WORD) - { - if (!bump_reductions (ctx) - || !push (ctx, new_clone (script))) - return false; - } - else if (!call_function (ctx, get_word (script))) - return false; - } - return true; -} - -// --- Runtime library --------------------------------------------------------- - -#define defn(name) static bool name (struct context *ctx) - -#define check_stack(n) \ - if (ctx->stack_size < n) { \ - set_error (ctx, "stack underflow"); \ - return 0; \ - } - -inline static bool -check_stack_safe (struct context *ctx, size_t n) -{ - check_stack (n); - return true; -} - -static bool -check_type (struct context *ctx, const void *item_, enum item_type type) -{ - const struct item *item = item_; - if (item->type == type) - return true; - - return set_error (ctx, "invalid type: expected `%s', got `%s'", - item_type_to_str (type), item_type_to_str (item->type)); -} - -static struct item * -pop (struct context *ctx) -{ - check_stack (1); - struct item *top = ctx->stack; - ctx->stack = top->next; - top->next = NULL; - ctx->stack_size--; - return top; -} - -// - - Types - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -#define defn_is_type(name, item_type) \ - defn (fn_is_##name) { \ - check_stack (1); \ - struct item *top = pop (ctx); \ - push (ctx, new_integer (top->type == (item_type))); \ - item_free (top); \ - return true; \ - } - -defn_is_type (string, ITEM_STRING) -defn_is_type (word, ITEM_WORD) -defn_is_type (integer, ITEM_INTEGER) -defn_is_type (float, ITEM_FLOAT) -defn_is_type (list, ITEM_LIST) - -defn (fn_to_string) -{ - check_stack (1); - struct item *item = pop (ctx); - char *value; - - switch (item->type) - { - case ITEM_WORD: - item->type = ITEM_STRING; - case ITEM_STRING: - return push (ctx, item); - - case ITEM_FLOAT: - value = strdup_printf ("%Lf", get_float (item)); - break; - case ITEM_INTEGER: - value = strdup_printf ("%lld", get_integer (item)); - break; - - default: - set_error (ctx, "cannot convert `%s' to `%s'", - item_type_to_str (item->type), item_type_to_str (ITEM_STRING)); - item_free (item); - return false; - } - - item_free (item); - if (!value) - { - ctx->memory_failure = true; - return false; - } - - item = new_string (value, -1); - free (value); - return push (ctx, item); -} - -defn (fn_to_integer) -{ - check_stack (1); - struct item *item = pop (ctx); - long long value; - - switch (item->type) - { - case ITEM_INTEGER: - return push (ctx, item); - case ITEM_FLOAT: - value = get_float (item); - break; - - case ITEM_STRING: - { - char *end; - const char *s = get_string (item); - value = strtoll (s, &end, 10); - if (end != s && *s == '\0') - break; - - item_free (item); - return set_error (ctx, "integer conversion error"); - } - - default: - set_error (ctx, "cannot convert `%s' to `%s'", - item_type_to_str (item->type), item_type_to_str (ITEM_INTEGER)); - item_free (item); - return false; - } - - item_free (item); - return push (ctx, new_integer (value)); -} - -defn (fn_to_float) -{ - check_stack (1); - struct item *item = pop (ctx); - long double value; - - switch (item->type) - { - case ITEM_FLOAT: - return push (ctx, item); - case ITEM_INTEGER: - value = get_integer (item); - break; - - case ITEM_STRING: - { - char *end; - const char *s = get_string (item); - value = strtold (s, &end); - if (end != s && *s == '\0') - break; - - item_free (item); - return set_error (ctx, "float conversion error"); - } - - default: - set_error (ctx, "cannot convert `%s' to `%s'", - item_type_to_str (item->type), item_type_to_str (ITEM_FLOAT)); - item_free (item); - return false; - } - - item_free (item); - return push (ctx, new_float (value)); -} - -// - - Miscellaneous - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -defn (fn_length) -{ - check_stack (1); - struct item *item = pop (ctx); - bool success = true; - switch (item->type) - { - case ITEM_STRING: - success = push (ctx, new_integer (((struct item_string *) item)->len)); - break; - case ITEM_LIST: - { - long long length = 0; - struct item *iter; - for (iter = get_list (item); iter; iter = iter->next) - length++; - success = push (ctx, new_integer (length)); - break; - } - default: - success = set_error (ctx, "invalid type"); - } - item_free (item); - return success; -} - -// - - Stack operations - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -defn (fn_dup) -{ - check_stack (1); - return push (ctx, new_clone (ctx->stack)); -} - -defn (fn_drop) -{ - check_stack (1); - item_free (pop (ctx)); - return true; -} - -defn (fn_swap) -{ - check_stack (2); - struct item *second = pop (ctx), *first = pop (ctx); - return push (ctx, second) && push (ctx, first); -} - -defn (fn_call) -{ - check_stack (1); - struct item *script = pop (ctx); - bool success = check_type (ctx, script, ITEM_LIST) - && execute (ctx, get_list (script)); - item_free (script); - return success; -} - -defn (fn_dip) -{ - check_stack (2); - struct item *script = pop (ctx); - struct item *item = pop (ctx); - bool success = check_type (ctx, script, ITEM_LIST) - && execute (ctx, get_list (script)); - item_free (script); - if (!success) - { - item_free (item); - return false; - } - return push (ctx, item); -} - -defn (fn_unit) -{ - check_stack (1); - struct item *item = pop (ctx); - return push (ctx, new_list (item)); -} - -defn (fn_cons) -{ - check_stack (2); - struct item *list = pop (ctx); - struct item *item = pop (ctx); - if (!check_type (ctx, list, ITEM_LIST)) - { - item_free (list); - item_free (item); - return false; - } - item->next = get_list (list); - ((struct item_list *) list)->head = item; - return push (ctx, list); -} - -defn (fn_cat) -{ - check_stack (2); - struct item *scnd = pop (ctx); - struct item *frst = pop (ctx); - if (!check_type (ctx, frst, ITEM_LIST) - || !check_type (ctx, scnd, ITEM_LIST)) - { - item_free (frst); - item_free (scnd); - return false; - } - - // XXX: we shouldn't have to do this in O(n) - struct item **tail = &((struct item_list *) frst)->head; - while (*tail) - tail = &(*tail)->next; - *tail = get_list (scnd); - - ((struct item_list *) scnd)->head = NULL; - item_free (scnd); - return push (ctx, frst); -} - -defn (fn_uncons) -{ - check_stack (1); - struct item *list = pop (ctx); - if (!check_type (ctx, list, ITEM_LIST)) - goto fail; - struct item *first = get_list (list); - if (!first) - { - set_error (ctx, "list is empty"); - goto fail; - } - ((struct item_list *) list)->head = first->next; - first->next = NULL; - return push (ctx, first) && push (ctx, list); -fail: - item_free (list); - return false; -} - -// - - Logical - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -static bool -to_boolean (struct context *ctx, struct item *item, bool *ok) -{ - switch (item->type) - { - case ITEM_STRING: - return *get_string (item) != '\0'; - case ITEM_INTEGER: - return get_integer (item) != 0; - case ITEM_FLOAT: - return get_float (item) != 0.; - default: - return (*ok = set_error (ctx, "cannot convert `%s' to boolean", - item_type_to_str (item->type))); - } -} - -defn (fn_not) -{ - check_stack (1); - struct item *item = pop (ctx); - bool ok = true; - bool result = !to_boolean (ctx, item, &ok); - item_free (item); - return ok && push (ctx, new_integer (result)); -} - -defn (fn_and) -{ - check_stack (2); - struct item *op1 = pop (ctx); - struct item *op2 = pop (ctx); - bool ok = true; - bool result = to_boolean (ctx, op1, &ok) && to_boolean (ctx, op2, &ok); - item_free (op1); - item_free (op2); - return ok && push (ctx, new_integer (result)); -} - -defn (fn_or) -{ - check_stack (2); - struct item *op1 = pop (ctx); - struct item *op2 = pop (ctx); - bool ok = true; - bool result = to_boolean (ctx, op1, &ok) - || !ok || to_boolean (ctx, op2, &ok); - item_free (op1); - item_free (op2); - return ok && push (ctx, new_integer (result)); -} - -// - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -defn (fn_if) -{ - check_stack (3); - struct item *else_ = pop (ctx); - struct item *then_ = pop (ctx); - struct item *cond_ = pop (ctx); - - bool ok = true; - bool condition = to_boolean (ctx, cond_, &ok); - item_free (cond_); - - bool success = false; - if (ok - && check_type (ctx, then_, ITEM_LIST) - && check_type (ctx, else_, ITEM_LIST)) - success = execute (ctx, condition - ? get_list (then_) - : get_list (else_)); - - item_free (then_); - item_free (else_); - return success; -} - -defn (fn_try) -{ - check_stack (2); - struct item *catch = pop (ctx); - struct item *try = pop (ctx); - bool success = false; - if (!check_type (ctx, try, ITEM_LIST) - || !check_type (ctx, catch, ITEM_LIST)) - goto fail; - - if (!execute (ctx, get_list (try))) - { - if (ctx->memory_failure || ctx->error_is_fatal) - goto fail; - - success = push (ctx, new_string (ctx->error, -1)); - free (ctx->error); - ctx->error = NULL; - - if (success) - success = execute (ctx, get_list (catch)); - } - -fail: - item_free (try); - item_free (catch); - return success; -} - -defn (fn_map) -{ - check_stack (2); - struct item *fn = pop (ctx); - struct item *list = pop (ctx); - if (!check_type (ctx, fn, ITEM_LIST) - || !check_type (ctx, list, ITEM_LIST)) - { - item_free (fn); - item_free (list); - return false; - } - - bool success = false; - struct item *result = NULL, **tail = &result; - for (struct item *iter = get_list (list); iter; iter = iter->next) - { - if (!push (ctx, new_clone (iter)) - || !execute (ctx, get_list (fn)) - || !check_stack_safe (ctx, 1)) - goto fail; - - struct item *item = pop (ctx); - *tail = item; - tail = &item->next; - } - success = true; - -fail: - set_list (list, result); - item_free (fn); - if (!success) - { - item_free (list); - return false; - } - return push (ctx, list); -} - -defn (fn_filter) -{ - check_stack (2); - struct item *fn = pop (ctx); - struct item *list = pop (ctx); - if (!check_type (ctx, fn, ITEM_LIST) - || !check_type (ctx, list, ITEM_LIST)) - { - item_free (fn); - item_free (list); - return false; - } - - bool success = false; - bool ok = true; - struct item *result = NULL, **tail = &result; - for (struct item *iter = get_list (list); iter; iter = iter->next) - { - if (!push (ctx, new_clone (iter)) - || !execute (ctx, get_list (fn)) - || !check_stack_safe (ctx, 1)) - goto fail; - - struct item *item = pop (ctx); - bool survived = to_boolean (ctx, item, &ok); - item_free (item); - if (!ok) - goto fail; - if (!survived) - continue; - - if (!(item = new_clone (iter))) - goto fail; - *tail = item; - tail = &item->next; - } - success = true; - -fail: - set_list (list, result); - item_free (fn); - if (!success) - { - item_free (list); - return false; - } - return push (ctx, list); -} - -defn (fn_fold) -{ - check_stack (3); - struct item *op = pop (ctx); - struct item *null = pop (ctx); - struct item *list = pop (ctx); - bool success = false; - if (!check_type (ctx, op, ITEM_LIST) - || !check_type (ctx, list, ITEM_LIST)) - { - item_free (null); - goto fail; - } - - push (ctx, null); - for (struct item *iter = get_list (list); iter; iter = iter->next) - if (!push (ctx, new_clone (iter)) - || !execute (ctx, get_list (op))) - goto fail; - success = true; - -fail: - item_free (op); - item_free (list); - return success; -} - -defn (fn_each) -{ - check_stack (2); - struct item *op = pop (ctx); - struct item *list = pop (ctx); - bool success = false; - if (!check_type (ctx, op, ITEM_LIST) - || !check_type (ctx, list, ITEM_LIST)) - goto fail; - - for (struct item *iter = get_list (list); iter; iter = iter->next) - if (!push (ctx, new_clone (iter)) - || !execute (ctx, get_list (op))) - goto fail; - success = true; - -fail: - item_free (op); - item_free (list); - return success; -} - -// - - Arithmetic - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -// XXX: why not a `struct item_string *` argument? -static bool -push_repeated_string (struct context *ctx, struct item *op1, struct item *op2) -{ - struct item_string *string = (struct item_string *) op1; - struct item_integer *repeat = (struct item_integer *) op2; - assert (string->type == ITEM_STRING); - assert (repeat->type == ITEM_INTEGER); - - if (repeat->value < 0) - return set_error (ctx, "cannot multiply a string by a negative value"); - - char *buf = NULL; - size_t len = string->len * repeat->value; - if (len < string->len && repeat->value != 0) - goto allocation_fail; - - buf = malloc (len); - if (!buf) - goto allocation_fail; - - for (size_t i = 0; i < len; i += string->len) - memcpy (buf + i, string->value, string->len); - struct item *item = new_string (buf, len); - free (buf); - return push (ctx, item); - -allocation_fail: - ctx->memory_failure = true; - return false; -} - -defn (fn_times) -{ - check_stack (2); - struct item *op2 = pop (ctx); - struct item *op1 = pop (ctx); - - bool ok; - if (op1->type == ITEM_INTEGER && op2->type == ITEM_INTEGER) - ok = push (ctx, new_integer (get_integer (op1) * get_integer (op2))); - else if (op1->type == ITEM_INTEGER && op2->type == ITEM_FLOAT) - ok = push (ctx, new_float (get_integer (op1) * get_float (op2))); - else if (op1->type == ITEM_FLOAT && op2->type == ITEM_FLOAT) - ok = push (ctx, new_float (get_float (op1) * get_float (op2))); - else if (op1->type == ITEM_FLOAT && op2->type == ITEM_INTEGER) - ok = push (ctx, new_float (get_float (op1) * get_integer (op2))); - else if (op1->type == ITEM_INTEGER && op2->type == ITEM_STRING) - ok = push_repeated_string (ctx, op2, op1); - else if (op1->type == ITEM_STRING && op2->type == ITEM_INTEGER) - ok = push_repeated_string (ctx, op1, op2); - else - ok = set_error (ctx, "cannot multiply `%s' and `%s'", - item_type_to_str (op1->type), item_type_to_str (op2->type)); - - item_free (op1); - item_free (op2); - return ok; -} - -defn (fn_pow) -{ - check_stack (2); - struct item *op2 = pop (ctx); - struct item *op1 = pop (ctx); - - bool ok; - if (op1->type == ITEM_INTEGER && op2->type == ITEM_INTEGER) - // TODO: implement this properly, outputting an integer - ok = push (ctx, new_float (powl (get_integer (op1), get_integer (op2)))); - else if (op1->type == ITEM_INTEGER && op2->type == ITEM_FLOAT) - ok = push (ctx, new_float (powl (get_integer (op1), get_float (op2)))); - else if (op1->type == ITEM_FLOAT && op2->type == ITEM_FLOAT) - ok = push (ctx, new_float (powl (get_float (op1), get_float (op2)))); - else if (op1->type == ITEM_FLOAT && op2->type == ITEM_INTEGER) - ok = push (ctx, new_float (powl (get_float (op1), get_integer (op2)))); - else - ok = set_error (ctx, "cannot exponentiate `%s' and `%s'", - item_type_to_str (op1->type), item_type_to_str (op2->type)); - - item_free (op1); - item_free (op2); - return ok; -} - -defn (fn_div) -{ - check_stack (2); - struct item *op2 = pop (ctx); - struct item *op1 = pop (ctx); - - bool ok; - if (op1->type == ITEM_INTEGER && op2->type == ITEM_INTEGER) - { - if (get_integer (op2) == 0) - ok = set_error (ctx, "division by zero"); - else - ok = push (ctx, new_integer (get_integer (op1) / get_integer (op2))); - } - else if (op1->type == ITEM_INTEGER && op2->type == ITEM_FLOAT) - ok = push (ctx, new_float (get_integer (op1) / get_float (op2))); - else if (op1->type == ITEM_FLOAT && op2->type == ITEM_FLOAT) - ok = push (ctx, new_float (get_float (op1) / get_float (op2))); - else if (op1->type == ITEM_FLOAT && op2->type == ITEM_INTEGER) - ok = push (ctx, new_float (get_float (op1) / get_integer (op2))); - else - ok = set_error (ctx, "cannot divide `%s' and `%s'", - item_type_to_str (op1->type), item_type_to_str (op2->type)); - - item_free (op1); - item_free (op2); - return ok; -} - -defn (fn_mod) -{ - check_stack (2); - struct item *op2 = pop (ctx); - struct item *op1 = pop (ctx); - - bool ok; - if (op1->type == ITEM_INTEGER && op2->type == ITEM_INTEGER) - { - if (get_integer (op2) == 0) - ok = set_error (ctx, "division by zero"); - else - ok = push (ctx, new_integer (get_integer (op1) % get_integer (op2))); - } - else if (op1->type == ITEM_INTEGER && op2->type == ITEM_FLOAT) - ok = push (ctx, new_float (fmodl (get_integer (op1), get_float (op2)))); - else if (op1->type == ITEM_FLOAT && op2->type == ITEM_FLOAT) - ok = push (ctx, new_float (fmodl (get_float (op1), get_float (op2)))); - else if (op1->type == ITEM_FLOAT && op2->type == ITEM_INTEGER) - ok = push (ctx, new_float (fmodl (get_float (op1), get_integer (op2)))); - else - ok = set_error (ctx, "cannot divide `%s' and `%s'", - item_type_to_str (op1->type), item_type_to_str (op2->type)); - - item_free (op1); - item_free (op2); - return ok; -} - -static bool -push_concatenated_string (struct context *ctx, - struct item *op1, struct item *op2) -{ - struct item_string *s1 = (struct item_string *) op1; - struct item_string *s2 = (struct item_string *) op2; - assert (s1->type == ITEM_STRING); - assert (s2->type == ITEM_STRING); - - char *buf = NULL; - size_t len = s1->len + s2->len; - if (len < s1->len || len < s2->len) - goto allocation_fail; - - buf = malloc (len); - if (!buf) - goto allocation_fail; - - memcpy (buf, s1->value, s1->len); - memcpy (buf + s1->len, s2->value, s2->len); - struct item *item = new_string (buf, len); - free (buf); - return push (ctx, item); - -allocation_fail: - ctx->memory_failure = true; - return false; - -} - -defn (fn_plus) -{ - check_stack (2); - struct item *op2 = pop (ctx); - struct item *op1 = pop (ctx); - - bool ok; - if (op1->type == ITEM_INTEGER && op2->type == ITEM_INTEGER) - ok = push (ctx, new_integer (get_integer (op1) + get_integer (op2))); - else if (op1->type == ITEM_INTEGER && op2->type == ITEM_FLOAT) - ok = push (ctx, new_float (get_integer (op1) + get_float (op2))); - else if (op1->type == ITEM_FLOAT && op2->type == ITEM_FLOAT) - ok = push (ctx, new_float (get_float (op1) + get_float (op2))); - else if (op1->type == ITEM_FLOAT && op2->type == ITEM_INTEGER) - ok = push (ctx, new_float (get_float (op1) + get_integer (op2))); - else if (op1->type == ITEM_STRING && op2->type == ITEM_STRING) - ok = push_concatenated_string (ctx, op1, op2); - else - ok = set_error (ctx, "cannot add `%s' and `%s'", - item_type_to_str (op1->type), item_type_to_str (op2->type)); - - item_free (op1); - item_free (op2); - return ok; -} - -defn (fn_minus) -{ - check_stack (2); - struct item *op2 = pop (ctx); - struct item *op1 = pop (ctx); - - bool ok; - if (op1->type == ITEM_INTEGER && op2->type == ITEM_INTEGER) - ok = push (ctx, new_integer (get_integer (op1) - get_integer (op2))); - else if (op1->type == ITEM_INTEGER && op2->type == ITEM_FLOAT) - ok = push (ctx, new_float (get_integer (op1) - get_float (op2))); - else if (op1->type == ITEM_FLOAT && op2->type == ITEM_FLOAT) - ok = push (ctx, new_float (get_float (op1) - get_float (op2))); - else if (op1->type == ITEM_FLOAT && op2->type == ITEM_INTEGER) - ok = push (ctx, new_float (get_float (op1) - get_integer (op2))); - else - ok = set_error (ctx, "cannot subtract `%s' and `%s'", - item_type_to_str (op1->type), item_type_to_str (op2->type)); - - item_free (op1); - item_free (op2); - return ok; -} - -// - - Comparison - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -static int -compare_strings (struct item_string *s1, struct item_string *s2) -{ - // XXX: not entirely correct wrt. null bytes - size_t len = (s1->len < s2->len ? s1->len : s2->len) + 1; - return memcmp (s1->value, s2->value, len); -} - -static bool compare_lists (struct item *, struct item *); - -static bool -compare_list_items (struct item *op1, struct item *op2) -{ - if (op1->type != op2->type) - return false; - - switch (op1->type) - { - case ITEM_STRING: - case ITEM_WORD: - return !compare_strings ((struct item_string *) op1, - (struct item_string *) op2); - case ITEM_FLOAT: - return get_float (op1) == get_float (op2); - case ITEM_INTEGER: - return get_integer (op1) == get_integer (op2); - case ITEM_LIST: - return compare_lists (get_list (op1), get_list (op2)); - } - abort (); -} - -static bool -compare_lists (struct item *op1, struct item *op2) -{ - while (op1 && op2) - { - if (!compare_list_items (op1, op2)) - return false; - - op1 = op1->next; - op2 = op2->next; - } - return !op1 && !op2; -} - -defn (fn_eq) -{ - check_stack (2); - struct item *op2 = pop (ctx); - struct item *op1 = pop (ctx); - - bool ok; - if (op1->type == ITEM_INTEGER && op2->type == ITEM_INTEGER) - ok = push (ctx, new_integer (get_integer (op1) == get_integer (op2))); - else if (op1->type == ITEM_INTEGER && op2->type == ITEM_FLOAT) - ok = push (ctx, new_integer (get_integer (op1) == get_float (op2))); - else if (op1->type == ITEM_FLOAT && op2->type == ITEM_FLOAT) - ok = push (ctx, new_integer (get_float (op1) == get_float (op2))); - else if (op1->type == ITEM_FLOAT && op2->type == ITEM_INTEGER) - ok = push (ctx, new_integer (get_float (op1) == get_integer (op2))); - else if (op1->type == ITEM_LIST && op2->type == ITEM_LIST) - ok = push (ctx, new_integer (compare_lists - (get_list (op1), get_list (op2)))); - else if (op1->type == ITEM_STRING && op2->type == ITEM_STRING) - ok = push (ctx, new_integer (compare_strings - ((struct item_string *)(op1), (struct item_string *)(op2)) == 0)); - else - ok = set_error (ctx, "cannot compare `%s' and `%s'", - item_type_to_str (op1->type), item_type_to_str (op2->type)); - - item_free (op1); - item_free (op2); - return ok; -} - -defn (fn_lt) -{ - check_stack (2); - struct item *op2 = pop (ctx); - struct item *op1 = pop (ctx); - - bool ok; - if (op1->type == ITEM_INTEGER && op2->type == ITEM_INTEGER) - ok = push (ctx, new_integer (get_integer (op1) < get_integer (op2))); - else if (op1->type == ITEM_INTEGER && op2->type == ITEM_FLOAT) - ok = push (ctx, new_integer (get_integer (op1) < get_float (op2))); - else if (op1->type == ITEM_FLOAT && op2->type == ITEM_FLOAT) - ok = push (ctx, new_integer (get_float (op1) < get_float (op2))); - else if (op1->type == ITEM_FLOAT && op2->type == ITEM_INTEGER) - ok = push (ctx, new_integer (get_float (op1) < get_integer (op2))); - else if (op1->type == ITEM_STRING && op2->type == ITEM_STRING) - ok = push (ctx, new_integer (compare_strings - ((struct item_string *)(op1), (struct item_string *)(op2)) < 0)); - else - ok = set_error (ctx, "cannot compare `%s' and `%s'", - item_type_to_str (op1->type), item_type_to_str (op2->type)); - - item_free (op1); - item_free (op2); - return ok; -} - -// - - Utilities - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -defn (fn_rand) -{ - return push (ctx, new_float ((long double) rand () - / ((long double) RAND_MAX + 1))); -} - -defn (fn_time) -{ - return push (ctx, new_integer (time (NULL))); -} - -// XXX: this is a bit too constrained; combines strftime() with gmtime() -defn (fn_strftime) -{ - check_stack (2); - struct item *format = pop (ctx); - struct item *time_ = pop (ctx); - bool success = false; - if (!check_type (ctx, time_, ITEM_INTEGER) - || !check_type (ctx, format, ITEM_STRING)) - goto fail; - - if (get_integer (time_) < 0) - { - set_error (ctx, "invalid time value"); - goto fail; - } - - char buf[128]; - time_t time__ = get_integer (time_); - struct tm tm; - gmtime_r (&time__, &tm); - buf[strftime (buf, sizeof buf, get_string (format), &tm)] = '\0'; - success = push (ctx, new_string (buf, -1)); - -fail: - item_free (time_); - item_free (format); - return success; -} - -// - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -static void item_list_to_str (const struct item *, struct buffer *); - -static void -string_to_str (const struct item_string *string, struct buffer *buf) -{ - buffer_append_c (buf, '"'); - for (size_t i = 0; i < string->len; i++) - { - char c = string->value[i]; - if (c == '\n') buffer_append (buf, "\\n", 2); - else if (c == '\r') buffer_append (buf, "\\r", 2); - else if (c == '\t') buffer_append (buf, "\\t", 2); - else if (!isprint (c)) - { - char tmp[8]; - snprintf (tmp, sizeof tmp, "\\x%02x", (unsigned char) c); - buffer_append (buf, tmp, strlen (tmp)); - } - else if (c == '\\') buffer_append (buf, "\\\\", 2); - else if (c == '"') buffer_append (buf, "\\\"", 2); - else buffer_append_c (buf, c); - } - buffer_append_c (buf, '"'); -} - -static void -item_to_str (const struct item *item, struct buffer *buf) -{ - switch (item->type) - { - char *x; - case ITEM_STRING: - string_to_str ((struct item_string *) item, buf); - break; - case ITEM_WORD: - { - struct item_word *word = (struct item_word *) item; - buffer_append (buf, word->value, word->len); - break; - } - case ITEM_INTEGER: - if (!(x = strdup_printf ("%lld", get_integer (item)))) - goto alloc_failure; - buffer_append (buf, x, strlen (x)); - free (x); - break; - case ITEM_FLOAT: - if (!(x = strdup_printf ("%Lf", get_float (item)))) - goto alloc_failure; - buffer_append (buf, x, strlen (x)); - free (x); - break; - case ITEM_LIST: - buffer_append_c (buf, '['); - item_list_to_str (get_list (item), buf); - buffer_append_c (buf, ']'); - break; - } - return; - -alloc_failure: - // This is a bit hackish but it simplifies stuff - buf->memory_failure = true; - free (buf->s); - buf->s = NULL; -} - -static void -item_list_to_str (const struct item *script, struct buffer *buf) -{ - if (!script) - return; - - item_to_str (script, buf); - while ((script = script->next)) - { - buffer_append_c (buf, ' '); - item_to_str (script, buf); - } -} - -// --- IRC protocol ------------------------------------------------------------ - -struct message -{ - char *prefix; ///< Message prefix - char *command; ///< IRC command - char *params[16]; ///< Command parameters (0-terminated) - size_t n_params; ///< Number of parameters present -}; - -inline static char * -cut_word (char **s) -{ - char *start = *s, *end = *s + strcspn (*s, " "); - *s = end + strspn (end, " "); - *end = '\0'; - return start; -} - -static bool -parse_message (char *s, struct message *msg) -{ - memset (msg, 0, sizeof *msg); - - // Ignore IRC 3.2 message tags, if present - if (*s == '@') - { - s += strcspn (s, " "); - s += strspn (s, " "); - } - - // Prefix - if (*s == ':') - msg->prefix = cut_word (&s) + 1; - - // Command - if (!*(msg->command = cut_word (&s))) - return false; - - // Parameters - while (*s) - { - size_t n = msg->n_params++; - if (msg->n_params >= N_ELEMENTS (msg->params)) - return false; - if (*s == ':') - { - msg->params[n] = ++s; - break; - } - msg->params[n] = cut_word (&s); - } - return true; -} - -static struct message * -read_message (void) -{ - static bool discard = false; - static char buf[1025]; - static struct message msg; - - bool discard_this; - do - { - if (!fgets (buf, sizeof buf, stdin)) - return NULL; - size_t len = strlen (buf); - - // Just to be on the safe side, if the line overflows our buffer, - // ignore everything up until the next line. - discard_this = discard; - if (len >= 2 && !strcmp (buf + len - 2, "\r\n")) - { - buf[len -= 2] = '\0'; - discard = false; - } - else - discard = true; - } - // Invalid messages are silently ignored - while (discard_this || !parse_message (buf, &msg)); - return &msg; -} - -// --- Interfacing with the bot ------------------------------------------------ - -#define BOT_PRINT "ZYKLONB print :script: " - -static const char * -get_config (const char *key) -{ - printf ("ZYKLONB get_config :%s\r\n", key); - struct message *msg = read_message (); - if (!msg || msg->n_params <= 0) - exit (EXIT_FAILURE); - return msg->params[0]; -} - -// - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -// TODO: implement more functions; try to avoid writing them in C - -static bool -init_runtime_library_scripts (void) -{ - bool ok = true; - - // It's much cheaper (and more fun) to define functions in terms of other - // ones. The "unit tests" serve a secondary purpose of showing the usage. - struct script - { - const char *name; ///< Name of the function - const char *definition; ///< The defining script - const char *unit_test; ///< Trivial unit test, must return 1 - } - scripts[] = - { - { "nip", "swap drop", "1 2 nip 2 =" }, - { "over", "[dup] dip swap", "1 2 over nip nip 1 =" }, - { "swons", "swap cons", "[2] 1 swons [1 2] =" }, - { "first", "uncons drop", "[1 2 3] first 1 =" }, - { "rest", "uncons swap drop", "[1 2 3] rest [2 3] =" }, - { "reverse", "[] swap [swap cons] each", "[1 2] reverse [2 1] =" }, - { "curry", "cons", "1 2 [+] curry call 3 =" }, - - { "xor", "not swap not + 1 =", "1 1 xor 0 =" }, - { "min", "over over < [drop] [nip] if", "1 2 min 1 =" }, - { "max", "over over > [drop] [nip] if", "1 2 max 2 =" }, - - { "all?", "[and] cat 1 swap fold", "[3 4 5] [> 3] all? 0 =" }, - { "any?", "[or] cat 0 swap fold", "[3 4 5] [> 3] any? 1 =" }, - - { ">", "swap <", "1 2 > 0 =" }, - { "!=", "= not", "1 2 != 1 =" }, - { "<=", "> not", "1 2 <= 1 =" }, - { ">=", "< not", "1 2 >= 0 =" }, - - // XXX: this is a bit crazy and does not work with an empty list - { "join", "[uncons] dip swap [[dup] dip swap [+ +] dip] each drop", - "[1 2 3] [>string] map \" -> \" join \"1 -> 2 -> 3\" =" }, - }; - - for (size_t i = 0; i < N_ELEMENTS (scripts); i++) - { - const char *error = NULL; - struct item *script = parse (scripts[i].definition, &error); - if (error) - { - printf (BOT_PRINT "error parsing internal script `%s': %s\r\n", - scripts[i].definition, error); - ok = false; - } - else - ok &= register_script (scripts[i].name, script); - } - - struct context ctx; - for (size_t i = 0; i < N_ELEMENTS (scripts); i++) - { - const char *error = NULL; - struct item *script = parse (scripts[i].unit_test, &error); - if (error) - { - printf (BOT_PRINT "error parsing unit test for `%s': %s\r\n", - scripts[i].name, error); - ok = false; - continue; - } - context_init (&ctx); - execute (&ctx, script); - item_free_list (script); - - const char *failure = NULL; - if (ctx.memory_failure) - failure = "memory allocation failure"; - else if (ctx.error) - failure = ctx.error; - else if (ctx.stack_size != 1) - failure = "too many results on the stack"; - else if (ctx.stack->type != ITEM_INTEGER) - failure = "result is not an integer"; - else if (get_integer (ctx.stack) != 1) - failure = "wrong test result"; - if (failure) - { - printf (BOT_PRINT "error executing unit test for `%s': %s\r\n", - scripts[i].name, failure); - ok = false; - } - context_free (&ctx); - } - return ok; -} - -static bool -init_runtime_library (void) -{ - bool ok = true; - - // Type detection - ok &= register_handler ("string?", fn_is_string); - ok &= register_handler ("word?", fn_is_word); - ok &= register_handler ("integer?", fn_is_integer); - ok &= register_handler ("float?", fn_is_float); - ok &= register_handler ("list?", fn_is_list); - - // Type conversion - ok &= register_handler (">string", fn_to_string); - ok &= register_handler (">integer", fn_to_integer); - ok &= register_handler (">float", fn_to_float); - - // Miscellaneous - ok &= register_handler ("length", fn_length); - - // Basic stack manipulation - ok &= register_handler ("dup", fn_dup); - ok &= register_handler ("drop", fn_drop); - ok &= register_handler ("swap", fn_swap); - - // Calling stuff - ok &= register_handler ("call", fn_call); - ok &= register_handler ("dip", fn_dip); - - // Control flow - ok &= register_handler ("if", fn_if); - ok &= register_handler ("try", fn_try); - - // List processing - ok &= register_handler ("map", fn_map); - ok &= register_handler ("filter", fn_filter); - ok &= register_handler ("fold", fn_fold); - ok &= register_handler ("each", fn_each); - - // List manipulation - ok &= register_handler ("unit", fn_unit); - ok &= register_handler ("cons", fn_cons); - ok &= register_handler ("cat", fn_cat); - ok &= register_handler ("uncons", fn_uncons); - - // Arithmetic operations - ok &= register_handler ("+", fn_plus); - ok &= register_handler ("-", fn_minus); - ok &= register_handler ("*", fn_times); - ok &= register_handler ("^", fn_pow); - ok &= register_handler ("/", fn_div); - ok &= register_handler ("%", fn_mod); - - // Comparison - ok &= register_handler ("=", fn_eq); - ok &= register_handler ("<", fn_lt); - - // Logical operations - ok &= register_handler ("not", fn_not); - ok &= register_handler ("and", fn_and); - ok &= register_handler ("or", fn_or); - - // Utilities - ok &= register_handler ("rand", fn_rand); - ok &= register_handler ("time", fn_time); - ok &= register_handler ("strftime", fn_strftime); - - ok &= init_runtime_library_scripts (); - return ok; -} - -static void -free_runtime_library (void) -{ - struct fn *next, *iter; - for (iter = g_functions; iter; iter = next) - { - next = iter->next; - free_function (iter); - } -} - -// --- Function database ------------------------------------------------------- - -// TODO: a global variable storing the various procedures (db) -// XXX: defining procedures would ideally need some kind of an ACL - -static void -read_db (void) -{ - // TODO -} - -static void -write_db (void) -{ - // TODO -} - -// --- Main -------------------------------------------------------------------- - -static char *g_prefix; - -struct user_info -{ - char *ctx; ///< Context: channel or user - char *ctx_quote; ///< Reply quotation -}; - -defn (fn_dot) -{ - check_stack (1); - struct item *item = pop (ctx); - struct user_info *info = ctx->user_data; - - struct buffer buf = BUFFER_INITIALIZER; - item_to_str (item, &buf); - item_free (item); - buffer_append_c (&buf, '\0'); - if (buf.memory_failure) - { - ctx->memory_failure = true; - return false; - } - - if (buf.len > 255) - buf.s[255] = '\0'; - - printf ("PRIVMSG %s :%s%s\r\n", info->ctx, info->ctx_quote, buf.s); - free (buf.s); - return true; -} - -static void -process_message (struct message *msg) -{ - if (!msg->prefix - || strcasecmp (msg->command, "PRIVMSG") - || msg->n_params < 2) - return; - char *line = msg->params[1]; - - // Filter out only our commands - size_t prefix_len = strlen (g_prefix); - if (strncmp (line, g_prefix, prefix_len)) - return; - line += prefix_len; - - char *command = cut_word (&line); - if (strcasecmp (command, "script")) - return; - - // Retrieve information on how to respond back - char *msg_ctx = msg->prefix, *x; - if ((x = strchr (msg_ctx, '!'))) - *x = '\0'; - - char *msg_ctx_quote; - if (strchr ("#+&!", *msg->params[0])) - { - msg_ctx_quote = strdup_printf ("%s: ", msg_ctx); - msg_ctx = msg->params[0]; - } - else - msg_ctx_quote = strdup (""); - - if (!msg_ctx_quote) - { - printf (BOT_PRINT "%s\r\n", "memory allocation failure"); - return; - } - - struct user_info info; - info.ctx = msg_ctx; - info.ctx_quote = msg_ctx_quote; - - // Finally parse and execute the macro - const char *error = NULL; - struct item *script = parse (line, &error); - if (error) - { - printf ("PRIVMSG %s :%s%s: %s\r\n", - msg_ctx, msg_ctx_quote, "parse error", error); - goto end; - } - - struct context ctx; - context_init (&ctx); - ctx.user_data = &info; - execute (&ctx, script); - item_free_list (script); - - const char *failure = NULL; - if (ctx.memory_failure) - failure = "memory allocation failure"; - else if (ctx.error) - failure = ctx.error; - if (failure) - printf ("PRIVMSG %s :%s%s: %s\r\n", - msg_ctx, msg_ctx_quote, "runtime error", failure); - context_free (&ctx); -end: - free (msg_ctx_quote); -} - -int -main (int argc, char *argv[]) -{ - freopen (NULL, "rb", stdin); setvbuf (stdin, NULL, _IOLBF, BUFSIZ); - freopen (NULL, "wb", stdout); setvbuf (stdout, NULL, _IOLBF, BUFSIZ); - - struct rlimit limit = - { - .rlim_cur = ADDRESS_SPACE_LIMIT, - .rlim_max = ADDRESS_SPACE_LIMIT - }; - - // Lower the memory limits to something sensible to prevent abuse - (void) setrlimit (RLIMIT_AS, &limit); - - read_db (); - if (!init_runtime_library () - || !register_handler (".", fn_dot)) - printf (BOT_PRINT "%s\r\n", "runtime library initialization failed"); - - g_prefix = strdup (get_config ("prefix")); - printf ("ZYKLONB register\r\n"); - struct message *msg; - while ((msg = read_message ())) - process_message (msg); - - free_runtime_library (); - free (g_prefix); - return 0; -} - |