diff options
Diffstat (limited to 'plugins/script')
| -rwxr-xr-x | plugins/script | 1819 |
1 files changed, 1819 insertions, 0 deletions
diff --git a/plugins/script b/plugins/script new file mode 100755 index 0000000..34ca379 --- /dev/null +++ b/plugins/script @@ -0,0 +1,1819 @@ +#!/usr/bin/tcc -run +// +// ZyklonB scripting plugin, using a custom stack-based language +// +// Copyright 2014 Přemysl Janouch. All rights reserved. +// 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 really easy to crash and 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> + +#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_printf (const char *format, ...) +{ + va_list ap; + va_start (ap, format); + int size = vsnprintf (NULL, 0, format, ap); + va_end (ap); + if (size < 0) + return NULL; + + char buf[size + 1]; + va_start (ap, format); + size = vsnprintf (buf, sizeof buf, format, ap); + va_end (ap); + if (size < 0) + return NULL; + + return strdup (buf); +} + +// --- Generic buffer ---------------------------------------------------------- + +struct buffer +{ + char *s; ///< Buffer data + size_t alloc; ///< Number of bytes allocated + size_t len; ///< Number of bytes used +}; + +#define BUFFER_INITIALIZER {NULL, 0, 0} + +static void +buffer_append (struct buffer *self, const void *s, size_t n) +{ + if (!self->s) + self->s = malloc (self->alloc = 8); + while (self->len + n > self->alloc) + self->s = realloc (self->s, self->alloc <<= 1); + + memcpy (self->s + self->len, s, n); + self->len += n; +} + +inline static void +buffer_append_c (struct buffer *self, char c) +{ + 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 = memcpy (malloc (size), item, size); + if (item->type == ITEM_LIST) + { + struct item_list *x = (struct item_list *) clone; + x->head = new_clone_list (x->head); + } + clone->next = NULL; + return clone; +} + +static struct item * +new_clone_list (const struct item *item) +{ + struct item *head = NULL; + for (struct item **out = &head; item; item = item->next) + { + struct item *clone = *out = new_clone (item); + 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); + item->type = ITEM_WORD; + return item; +} + +static struct item * +new_integer (long long value) +{ + struct item_integer *item = calloc (1, sizeof *item); + 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); + 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); + item->type = ITEM_LIST; + item->head = head; + return (struct item *) item; +} + +// --- Parsing ----------------------------------------------------------------- + +struct tokenizer +{ + const char *cursor; + const char *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 = "unexpected end of input"; + return false; + case 'x': + case 'X': + self->cursor++; + if (decode_hexa_escape (self, buf)) + return true; + + self->error = "invalid hexadecimal escape sequence"; + 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 = "unrecognized escape sequence"; + return false; + } +} + +static struct item * +parse_string (struct tokenizer *self) +{ + struct buffer buf = BUFFER_INITIALIZER; + char c; + + while (true) + switch ((c = *self->cursor++)) + { + case '\0': + self->cursor--; + self->error = "unexpected end of input"; + goto fail; + case '"': + { + struct item *item = new_string (buf.s, buf.len); + free (buf.s); + return item; + } + case '\\': + if (!decode_escape_sequence (self, &buf)) + goto fail; + break; + default: + buffer_append_c (&buf, c); + } + +fail: + free (buf.s); + return NULL; +} + +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: + if (float_end > int_end) + { + if (float_errno == ERANGE) + { + self->error = "floating point value out of range"; + return NULL; + } + self->cursor = float_end; + return new_float (float_value); + } + else + { + if (int_errno == ERANGE) + { + self->error = "integer out of range"; + return NULL; + } + self->cursor = int_end; + return new_integer (int_value); + } +} + +static struct item * +parse_word (struct tokenizer *self) +{ + struct buffer buf = BUFFER_INITIALIZER; + 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--; + + // ...so an empty word can only mean a bug within our caller. + assert (buf.len != 0); + + struct item *item = new_word (buf.s, buf.len); + 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 = "unexpected end of input"; + 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 = "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, char **error) +{ + struct tokenizer self; + self.cursor = s; + self.error = NULL; + + struct item *list = parse_item_list (&self); + if (!self.error && *self.cursor != '\0') + { + self.error = "unexpected input"; + item_free_list (list); + list = NULL; + } + if (self.error && error) + *error = strdup_printf ("at character %d: %s", + (int) (self.cursor - s) + 1, self.error); + 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 + + 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->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 void +push (struct context *ctx, struct item *item) +{ + assert (item->next == NULL); + item->next = ctx->stack; + ctx->stack = item; + ctx->stack_size++; +} + +static bool +bump_reductions (struct context *ctx) +{ + if (++ctx->reduction_count >= ctx->reduction_limit) + { + ctx->error = strdup ("reduction limit reached"); + ctx->error_is_fatal = true; + return false; + } + 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; + + ctx->error = strdup_printf ("unknown function: %s", name); + return false; + +found: + if (!bump_reductions (ctx)) + return false; + + if (iter->handler + ? iter->handler (ctx) + : execute (ctx, iter->script)) + return true; + + // This creates some form of a stack trace + char *error = strdup_printf ("%s -> %s", name, ctx->error); + free (ctx->error); + ctx->error = error; + return false; +} + +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; + if (tmp->script) + item_free_list (tmp->script); + free (tmp); + break; + } +} + +static struct fn * +prepend_new_fn (const char *name) +{ + struct fn *fn = calloc (1, sizeof *fn + strlen (name) + 1); + strcpy (fn->name, name); + fn->next = g_functions; + return g_functions = fn; +} + +static void +register_handler (const char *name, handler_fn handler) +{ + unregister_function (name); + prepend_new_fn (name)->handler = handler; +} + +static void +register_script (const char *name, struct item *script) +{ + unregister_function (name); + prepend_new_fn (name)->script = script; +} + +static bool +execute (struct context *ctx, struct item *script) +{ + for (; script; script = script->next) + { + if (script->type != ITEM_WORD) + { + if (!bump_reductions (ctx)) + return false; + push (ctx, new_clone (script)); + } + 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) { \ + ctx->error = strdup ("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; + + ctx->error = strdup_printf ("invalid type: expected `%s', got `%s'", + item_type_to_str (type), item_type_to_str (item->type)); + return false; +} + +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: + push (ctx, item); + return true; + + case ITEM_FLOAT: + value = strdup_printf ("%Lf", get_float (item)); + break; + case ITEM_INTEGER: + value = strdup_printf ("%lld", get_integer (item)); + break; + + default: + ctx->error = strdup_printf ("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); + item = new_string (value, -1); + free (value); + + push (ctx, item); + return true; +} + +defn (fn_to_integer) +{ + check_stack (1); + struct item *item = pop (ctx); + long long value; + + switch (item->type) + { + case ITEM_INTEGER: + push (ctx, item); + return true; + 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; + + ctx->error = strdup ("integer conversion error"); + item_free (item); + return false; + } + + default: + ctx->error = strdup_printf ("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); + push (ctx, new_integer (value)); + return true; +} + +defn (fn_to_float) +{ + check_stack (1); + struct item *item = pop (ctx); + long double value; + + switch (item->type) + { + case ITEM_FLOAT: + push (ctx, item); + return true; + 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; + + ctx->error = strdup ("float conversion error"); + item_free (item); + return false; + } + + default: + ctx->error = strdup_printf ("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); + push (ctx, new_float (value)); + return true; +} + +// - - Stack operations - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +defn (fn_dup) +{ + check_stack (1); + push (ctx, new_clone (ctx->stack)); + return true; +} + +defn (fn_drop) +{ + check_stack (1); + item_free (pop (ctx)); + return true; +} + +defn (fn_swap) +{ + check_stack (2); + struct item *first = pop (ctx); + struct item *second = pop (ctx); + push (ctx, first); + push (ctx, second); + return true; +} + +defn (fn_call) +{ + check_stack (1); + struct item *item = pop (ctx); + bool success; + // XXX: this behaves differently from if/map/filter + if (item->type == ITEM_LIST) + success = execute (ctx, get_list (item)); + else + success = execute (ctx, item); + item_free (item); + return success; +} + +defn (fn_dip) +{ + check_stack (2); + struct item *item = pop (ctx); + if (!fn_call (ctx)) + { + item_free (item); + return false; + } + push (ctx, item); + return true; +} + +// - - Logical - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +static bool +to_boolean (struct context *ctx, struct item *item) +{ + 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: + ctx->error = strdup_printf ("cannot convert `%s' to boolean", + item_type_to_str (item->type)); + return false; + } +} + +defn (fn_not) +{ + check_stack (1); + struct item *item = pop (ctx); + bool result = !to_boolean (ctx, item); + item_free (item); + if (ctx->error) + return false; + push (ctx, new_integer (result)); + return true; +} + +defn (fn_and) +{ + check_stack (2); + struct item *op1 = pop (ctx); + struct item *op2 = pop (ctx); + bool result = to_boolean (ctx, op1) && to_boolean (ctx, op2); + item_free (op1); + item_free (op2); + push (ctx, new_integer (result)); + return !ctx->error; +} + +defn (fn_or) +{ + check_stack (2); + struct item *op1 = pop (ctx); + struct item *op2 = pop (ctx); + bool result = to_boolean (ctx, op1) || ctx->error || to_boolean (ctx, op2); + item_free (op1); + item_free (op2); + if (ctx->error) + return false; + push (ctx, new_integer (result)); + return true; +} + +// - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +defn (fn_if) +{ + check_stack (3); + struct item *else_ = pop (ctx); + struct item *then_ = pop (ctx); + struct item *cond_ = pop (ctx); + + bool condition = to_boolean (ctx, cond_); + item_free (cond_); + + bool success = false; + if (!ctx->error + && 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->error_is_fatal) + goto fail; + + push (ctx, new_string (ctx->error, -1)); + free (ctx->error); + ctx->error = NULL; + + if (!execute (ctx, get_list (catch))) + goto fail; + } + success = true; + +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) + { + push (ctx, new_clone (iter)); + if (!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); + if (success) + push (ctx, list); + else + item_free (list); + + item_free (fn); + return success; +} + +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; + struct item *result = NULL, **tail = &result; + for (struct item *iter = get_list (list); iter; iter = iter->next) + { + push (ctx, new_clone (iter)); + if (!execute (ctx, get_list (fn)) + || !check_stack_safe (ctx, 1)) + goto fail; + + struct item *item = pop (ctx); + bool survived = to_boolean (ctx, item); + item_free (item); + if (ctx->error) + goto fail; + + if (!survived) + continue; + + item = new_clone (iter); + *tail = item; + tail = &item->next; + } + success = true; + +fail: + set_list (list, result); + if (success) + push (ctx, list); + else + item_free (list); + + item_free (fn); + 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) + { + ctx->error = strdup ("cannot multiply a string by a negative value"); + return false; + } + + 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); + if (!item) + goto allocation_fail; + + push (ctx, item); + return true; + +allocation_fail: + // TODO: resolve the memory issues correctly, watch _all_ allocations + ctx->error = strdup ("memory allocation failed"); + return false; +} + +defn (fn_times) +{ + check_stack (2); + struct item *op1 = pop (ctx); + struct item *op2 = pop (ctx); + bool success = true; + + if (op1->type == ITEM_INTEGER && op2->type == ITEM_INTEGER) + push (ctx, new_integer (get_integer (op1) * get_integer (op2))); + else if (op1->type == ITEM_INTEGER && op2->type == ITEM_FLOAT) + push (ctx, new_float (get_integer (op1) * get_float (op2))); + else if (op1->type == ITEM_FLOAT && op2->type == ITEM_FLOAT) + push (ctx, new_float (get_float (op1) * get_float (op2))); + else if (op1->type == ITEM_FLOAT && op2->type == ITEM_INTEGER) + push (ctx, new_float (get_float (op1) * get_integer (op2))); + else if (op1->type == ITEM_INTEGER && op2->type == ITEM_STRING) + success = push_repeated_string (ctx, op2, op1); + else if (op1->type == ITEM_STRING && op2->type == ITEM_INTEGER) + success = push_repeated_string (ctx, op1, op2); + else + { + ctx->error = strdup_printf ("cannot multiply `%s' and `%s'", + item_type_to_str (op1->type), item_type_to_str (op2->type)); + success = false; + } + + item_free (op1); + item_free (op2); + return success; +} + +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); + if (!item) + goto allocation_fail; + + push (ctx, item); + return true; + +allocation_fail: + // TODO: resolve the memory issues correctly, watch _all_ allocations + ctx->error = strdup ("memory allocation failed"); + return false; + +} + +defn (fn_plus) +{ + check_stack (2); + struct item *op1 = pop (ctx); + struct item *op2 = pop (ctx); + bool success = true; + + if (op1->type == ITEM_INTEGER && op2->type == ITEM_INTEGER) + push (ctx, new_integer (get_integer (op1) + get_integer (op2))); + else if (op1->type == ITEM_INTEGER && op2->type == ITEM_FLOAT) + push (ctx, new_float (get_integer (op1) + get_float (op2))); + else if (op1->type == ITEM_FLOAT && op2->type == ITEM_FLOAT) + push (ctx, new_float (get_float (op1) + get_float (op2))); + else if (op1->type == ITEM_FLOAT && op2->type == ITEM_INTEGER) + push (ctx, new_float (get_float (op1) + get_integer (op2))); + else if (op1->type == ITEM_STRING && op2->type == ITEM_STRING) + success = push_concatenated_string (ctx, op2, op1); + else + { + ctx->error = strdup_printf ("cannot add `%s' and `%s'", + item_type_to_str (op1->type), item_type_to_str (op2->type)); + success = false; + } + + item_free (op1); + item_free (op2); + return success; +} + +// - - 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 success = true; + + if (op1->type == ITEM_INTEGER && op2->type == ITEM_INTEGER) + push (ctx, new_integer (get_integer (op1) == get_integer (op2))); + else if (op1->type == ITEM_INTEGER && op2->type == ITEM_FLOAT) + push (ctx, new_integer (get_integer (op1) == get_float (op2))); + else if (op1->type == ITEM_FLOAT && op2->type == ITEM_FLOAT) + push (ctx, new_integer (get_float (op1) == get_float (op2))); + else if (op1->type == ITEM_FLOAT && op2->type == ITEM_INTEGER) + push (ctx, new_integer (get_float (op1) == get_integer (op2))); + else if (op1->type == ITEM_LIST && op2->type == ITEM_LIST) + push (ctx, new_integer (compare_lists + (get_list (op1), get_list (op2)))); + else if (op1->type == ITEM_STRING && op2->type == ITEM_STRING) + push (ctx, new_integer (compare_strings + ((struct item_string *)(op1), (struct item_string *)(op2)) == 0)); + else + { + ctx->error = strdup_printf ("cannot compare `%s' and `%s'", + item_type_to_str (op1->type), item_type_to_str (op2->type)); + success = false; + } + + item_free (op1); + item_free (op2); + return success; +} + +defn (fn_lt) +{ + check_stack (2); + struct item *op2 = pop (ctx); + struct item *op1 = pop (ctx); + bool success = true; + + if (op1->type == ITEM_INTEGER && op2->type == ITEM_INTEGER) + push (ctx, new_integer (get_integer (op1) < get_integer (op2))); + else if (op1->type == ITEM_INTEGER && op2->type == ITEM_FLOAT) + push (ctx, new_integer (get_integer (op1) < get_float (op2))); + else if (op1->type == ITEM_FLOAT && op2->type == ITEM_FLOAT) + push (ctx, new_integer (get_float (op1) < get_float (op2))); + else if (op1->type == ITEM_FLOAT && op2->type == ITEM_INTEGER) + push (ctx, new_integer (get_float (op1) < get_integer (op2))); + else if (op1->type == ITEM_STRING && op2->type == ITEM_STRING) + push (ctx, new_integer (compare_strings + ((struct item_string *)(op1), (struct item_string *)(op2)) < 0)); + else + { + ctx->error = strdup_printf ("cannot compare `%s' and `%s'", + item_type_to_str (op1->type), item_type_to_str (op2->type)); + success = false; + } + + item_free (op1); + item_free (op2); + return success; +} + +// - - Utilities - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +defn (fn_rand) +{ + push (ctx, new_float ((long double) rand () + / ((long double) RAND_MAX + 1))); + return true; +} + +defn (fn_time) +{ + push (ctx, new_integer (time (NULL))); + return true; +} + +// 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) + { + ctx->error = strdup ("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'; + push (ctx, new_string (buf, -1)); + success = true; + +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: + x = strdup_printf ("%lld", get_integer (item)); + buffer_append (buf, x, strlen (x)); + free (x); + break; + case ITEM_FLOAT: + x = strdup_printf ("%Lf", get_float (item)); + 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; + } +} + +static void +item_list_to_str (const struct item *script, struct buffer *buf) +{ + bool first = true; + for (; script; script = script->next) + { + if (!first) + buffer_append_c (buf, ' '); + item_to_str (script, buf); + first = false; + } +} + +// - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +// TODO: implement more functions; try to avoid writing it in C +// +// ? fold +// join { list delim -- string } -- string join -> script this +// +// concat { list list -- list } -- join two lists +// -, /, %, ** -- arithmetic +// >, !=, <=, >= -- comparison +// first -- first character of a string, first element in a list +// rest -- [1:] of a string, the "tail" in a list +// at { value index -- sub-value } -- get n-th subvalue of a string/list +// cons { item value } -- prepend an item to the list/string +// <each> step { value program } -- foreach + +static void +init_runtime_library (void) +{ + // Type detection + register_handler ("string?", fn_is_string); + register_handler ("word?", fn_is_word); + register_handler ("integer?", fn_is_integer); + register_handler ("float?", fn_is_float); + register_handler ("list?", fn_is_list); + + // Type conversion + register_handler (">string", fn_to_string); + register_handler (">integer", fn_to_integer); + register_handler (">float", fn_to_float); + + // Basic stack manipulation + register_handler ("dup", fn_dup); + register_handler ("drop", fn_drop); + register_handler ("swap", fn_swap); + + // Calling stuff + register_handler ("call", fn_call); + register_handler ("dip", fn_dip); + + // Control flow + register_handler ("if", fn_if); + register_handler ("try", fn_try); + + // List processing + register_handler ("map", fn_map); + register_handler ("filter", fn_filter); + + // Arithmetic operations + register_handler ("*", fn_times); + register_handler ("+", fn_plus); + + // Comparison + register_handler ("=", fn_eq); + register_handler ("<", fn_lt); + + // Logical operations + register_handler ("not", fn_not); + register_handler ("and", fn_and); + register_handler ("or", fn_or); + + // Utilities + register_handler ("rand", fn_rand); + register_handler ("time", fn_time); + register_handler ("strftime", fn_strftime); +} + +// --- 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)) + exit (EXIT_SUCCESS); + 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->n_params <= 0) + exit (EXIT_FAILURE); + return msg->params[0]; +} + +// --- 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'); + 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 (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 (""); + + struct user_info info; + info.ctx = msg_ctx; + info.ctx_quote = msg_ctx_quote; + + // Finally parse and execute the macro + 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); + free (error); + goto end; + } + + struct context ctx; + context_init (&ctx); + ctx.user_data = &info; + execute (&ctx, script); + item_free_list (script); + if (ctx.error) + printf ("PRIVMSG %s :%s%s: %s\r\n", + msg_ctx, msg_ctx_quote, "runtime error", ctx.error); + 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); + + read_db (); + init_runtime_library (); + register_handler (".", fn_dot); + + g_prefix = strdup (get_config ("prefix")); + printf ("ZYKLONB register\r\n"); + while (true) + { + struct message *msg = read_message (); + process_message (msg); + } + return 0; +} + |