diff options
Diffstat (limited to 'plugins/xB')
| -rwxr-xr-x | plugins/xB/calc | 241 | ||||
| -rwxr-xr-x | plugins/xB/coin | 128 | ||||
| -rwxr-xr-x | plugins/xB/eval | 312 | ||||
| -rwxr-xr-x | plugins/xB/factoids | 177 | ||||
| -rwxr-xr-x | plugins/xB/pomodoro | 502 | ||||
| -rwxr-xr-x | plugins/xB/script | 2310 | ||||
| -rwxr-xr-x | plugins/xB/seen | 160 | ||||
| -rwxr-xr-x | plugins/xB/seen-import-xC.pl | 39 | ||||
| -rwxr-xr-x | plugins/xB/youtube | 111 |
9 files changed, 3980 insertions, 0 deletions
diff --git a/plugins/xB/calc b/plugins/xB/calc new file mode 100755 index 0000000..7d2d660 --- /dev/null +++ b/plugins/xB/calc @@ -0,0 +1,241 @@ +#!/usr/bin/env guile + + xB calc plugin, basic Scheme evaluator + + Copyright 2016 Přemysl Eric Janouch + See the file LICENSE for licensing information. + +!# + +(import (rnrs (6))) +(use-modules ((rnrs) :version (6))) + +; --- Message parsing ---------------------------------------------------------- + +(define-record-type message (fields prefix command params)) +(define (parse-message line) + (let f ([parts '()] [chars (string->list line)]) + (define (take-word w chars) + (if (or (null? chars) (eqv? (car chars) #\x20)) + (f (cons (list->string (reverse w)) parts) + (if (null? chars) chars (cdr chars))) + (take-word (cons (car chars) w) (cdr chars)))) + (if (null? chars) + (let ([data (reverse parts)]) + (when (< (length data) 2) + (error 'parse-message "invalid message")) + (make-message (car data) (cadr data) (cddr data))) + (if (null? parts) + (if (eqv? (car chars) #\:) + (take-word '() (cdr chars)) + (f (cons #f parts) chars)) + (if (eqv? (car chars) #\:) + (f (cons (list->string (cdr chars)) parts) '()) + (take-word '() chars)))))) + +; --- Utilities ---------------------------------------------------------------- + +(define (display-exception e port) + (define (puts . x) + (for-all (lambda (a) (display a port)) x) + (newline port)) + + (define (record-fields rec) + (let* ([rtd (record-rtd rec)] + [v (record-type-field-names rtd)] + [len (vector-length v)]) + (map (lambda (k i) (cons k ((record-accessor rtd i) rec))) + (vector->list v) + (let c ([i len] [ls '()]) + (if (= i 0) ls (c (- i 1) (cons (- i 1) ls))))))) + + (puts "Caught " (record-type-name (record-rtd e))) + (for-all + (lambda (subtype) + (puts " " (record-type-name (record-rtd subtype))) + (for-all + (lambda (field) (puts " " (car field) ": " (cdr field))) + (record-fields subtype))) + (simple-conditions e))) + +; XXX - we have to work around Guile's lack of proper eol-style support +(define xc (make-transcoder (latin-1-codec) 'lf 'replace)) +(define irc-input-port (transcoded-port (standard-input-port) xc)) +(define irc-output-port (transcoded-port (standard-output-port) xc)) + +(define (send . message) + (for-all (lambda (x) (display x irc-output-port)) message) + (display #\return irc-output-port) + (newline irc-output-port) + (flush-output-port irc-output-port)) + +(define (get-line-crlf port) + (define line (get-line port)) + (if (eof-object? line) line + (let ([len (string-length line)]) + (if (and (> len 0) (eqv? (string-ref line (- len 1)) #\return)) + (substring line 0 (- len 1)) line)))) + +(define (get-config name) + (send "XB get_config :" name) + (car (message-params (parse-message (get-line-crlf irc-input-port))))) + +(define (extract-nick prefix) + (do ([i 0 (+ i 1)] [len (string-length prefix)]) + ([or (= i len) (char=? #\! (string-ref prefix i))] + [substring prefix 0 i]))) + +(define (string-after s start) + (let ([s-len (string-length s)] [with-len (string-length start)]) + (and (>= s-len with-len) + (string=? (substring s 0 with-len) start) + (substring s with-len s-len)))) + +; --- Calculator --------------------------------------------------------------- + +; Evaluator derived from the example in The Scheme Programming Language. +; +; Even though EVAL with a carefully crafted environment would also do a good +; job at sandboxing, it would probably be impossible to limit execution time... + +(define (env-new formals actuals env) + (cond [(null? formals) env] + [(symbol? formals) (cons (cons formals actuals) env)] + [else (cons (cons (car formals) (car actuals)) + (env-new (cdr formals) (cdr actuals) env))])) +(define (env-lookup var env) (cdr (assq var env))) +(define (env-assign var val env) (set-cdr! (assq var env) val)) + +(define (check-reductions r) + (if (= (car r) 0) + (error 'check-reductions "reduction limit exceeded") + (set-car! r (- (car r) 1)))) + +; TODO - think about implementing more syntactical constructs, +; however there's not much point in having anything else in a calculator... +(define (exec expr r env) + (check-reductions r) + (cond [(symbol? expr) (env-lookup expr env)] + [(pair? expr) + (case (car expr) + [(quote) (cadr expr)] + [(lambda) (lambda vals + (let ([env (env-new (cadr expr) vals env)]) + (let loop ([exprs (cddr expr)]) + (if (null? (cdr exprs)) + (exec (car exprs) r env) + (begin (exec (car exprs) r env) + (loop (cdr exprs)))))))] + [(if) (if (exec (cadr expr) r env) + (exec (caddr expr) r env) + (exec (cadddr expr) r env))] + [(set!) (env-assign (cadr expr) (exec (caddr expr) r env) env)] + [else (apply (exec (car expr) r env) + (map (lambda (x) (exec x r env)) (cdr expr)))])] + [else expr])) + +(define-syntax forward + (syntax-rules () + [(_) '()] + [(_ a b ...) (cons (cons (quote a) a) (forward b ...))])) + +; ...which can't prevent me from simply importing most of the standard library +(define base-library + (forward + ; Equivalence, procedure predicate, booleans + eqv? eq? equal? procedure? boolean? boolean=? not + ; numbers, numerical input and output + number? complex? real? rational? integer? exact? inexact? exact inexact + real-valued? rational-valued? integer-valued? number->string string->number + ; Arithmetic + = < > <= >= zero? positive? negative? odd? even? finite? infinite? nan? + min max + * - / abs div-and-mod div mod div0-and-mod0 div0 mod0 + gcd lcm numerator denominator floor ceiling truncate round + rationalize exp log sin cos tan asin acos atan sqrt expt + make-rectangular make-polar real-part imag-part magnitude angle + ; Pairs and lists + map for-each cons car cdr caar cadr cdar cddr + caaar caadr cadar caddr cdaar cdadr cddar cdddr + caaaar caaadr caadar caaddr cadaar cadadr caddar cadddr + cdaaar cdaadr cdadar cdaddr cddaar cddadr cdddar cddddr + pair? null? list? list length append reverse list-tail list-ref + ; Symbols + symbol? symbol=? symbol->string string->symbol + ; Characters + char? char=? char<? char>? char<=? char>=? char->integer integer->char + ; Strings; XXX - omitted make-string - can cause OOM + string? string=? string<? string>? string<=? string>=? + string string-length string-ref substring + string-append string->list list->string string-for-each string-copy + ; Vectors; XXX - omitted make-vector - can cause OOM + vector? vector vector-length vector-ref vector-set! + vector->list list->vector vector-fill! vector-map vector-for-each + ; Control features + apply call/cc values call-with-values dynamic-wind)) +(define extended-library + (forward + char-upcase char-downcase char-titlecase char-foldcase + char-ci=? char-ci<? char-ci>? char-ci<=? char-ci>=? + char-alphabetic? char-numeric? char-whitespace? + char-upper-case? char-lower-case? char-title-case? + string-upcase string-downcase string-titlecase string-foldcase + string-ci=? string-ci<? string-ci>? string-ci<=? string-ci>=? + find for-all exists filter partition fold-left fold-right + remp remove remv remq memp member memv memq assp assoc assv assq cons* + list-sort vector-sort vector-sort! + bitwise-not bitwise-and bitwise-ior bitwise-xor bitwise-if + bitwise-bit-count bitwise-length bitwise-first-bit-set bitwise-bit-set? + bitwise-copy-bit bitwise-bit-field bitwise-copy-bit-field + bitwise-arithmetic-shift bitwise-rotate-bit-field bitwise-reverse-bit-field + bitwise-arithmetic-shift-left bitwise-arithmetic-shift-right + set-car! set-cdr! string-set! string-fill!)) +(define (interpret expr) + (exec expr '(2000) (append base-library extended-library))) + +; We could show something a bit nicer but it would be quite Guile-specific +(define (error-string e) + (map (lambda (x) (string-append " " (symbol->string x))) + (filter (lambda (x) (not (member x '(&who &message &irritants &guile)))) + (map (lambda (x) (record-type-name (record-rtd x))) + (simple-conditions e))))) + +(define (calc input respond) + (define (stringify x) + (call-with-string-output-port (lambda (port) (write x port)))) + (guard (e [else (display-exception e (current-error-port)) + (apply respond "caught" (error-string e))]) + (let* ([input (open-string-input-port input)] + [data (let loop () + (define datum (get-datum input)) + (if (eof-object? datum) '() (cons datum (loop))))]) + (call-with-values + (lambda () (interpret (list (append '(lambda ()) data)))) + (lambda message + (for-all (lambda (x) (respond (stringify x))) message)))))) + +; --- Main loop ---------------------------------------------------------------- + +(define prefix (get-config "prefix")) +(send "XB register") + +(define (process msg) + (when (string-ci=? (message-command msg) "PRIVMSG") + (let* ([nick (extract-nick (message-prefix msg))] + [target (car (message-params msg))] + [response-begin + (apply string-append "PRIVMSG " + (if (memv (string-ref target 0) (string->list "#&!+")) + `(,target " :" ,nick ": ") `(,nick " :")))] + [respond (lambda args (apply send response-begin args))] + [text (cadr (message-params msg))] + [input (or (string-after text (string-append prefix "calc ")) + (string-after text (string-append prefix "= ")))]) + (when input (calc input respond))))) + +(let main-loop () + (define line (get-line-crlf irc-input-port)) + (unless (eof-object? line) + (guard (e [else (display-exception e (current-error-port))]) + (unless (string=? "" line) + (process (parse-message line)))) + (main-loop))) diff --git a/plugins/xB/coin b/plugins/xB/coin new file mode 100755 index 0000000..770cb32 --- /dev/null +++ b/plugins/xB/coin @@ -0,0 +1,128 @@ +#!/usr/bin/env tclsh +# +# xB coin plugin, random number-based utilities +# +# Copyright 2012, 2014 Přemysl Eric Janouch +# See the file LICENSE for licensing information. +# + +# This is a terrible excuse for a programming language and I feel dirty. + +proc parse {line} { + global msg + unset -nocomplain msg + + if [regexp {^:([^ ]*) *(.*)} $line -> prefix rest] { + set msg(prefix) $prefix + set line $rest + } + if [regexp {^([^ ]*) *(.*)} $line -> command rest] { + set msg(command) $command + set line $rest + } + while {1} { + set line [string trimleft $line " "] + set i [string first " " $line] + if {$i == -1} { set i [string length $line] } + if {$i == 0} { break } + + if {[string index $line 0] == ":"} { + lappend msg(param) [string range $line 1 end] + break + } + lappend msg(param) [string range $line 0 [expr $i - 1]] + set line [string range $line $i end] + } +} + +proc get_config {key} { + global msg + puts "XB get_config :$key" + gets stdin line + parse $line + return [lindex $msg(param) 0] +} + +proc pmrespond {text} { + global ctx + global ctx_quote + puts "PRIVMSG $ctx :$ctx_quote$text" +} + +fconfigure stdin -translation crlf -encoding iso8859-1 +fconfigure stdout -translation crlf -encoding iso8859-1 + +set prefix [get_config prefix] +puts "XB register" + +set eightball [list \ + "It is certain" \ + "It is decidedly so" \ + "Without a doubt" \ + "Yes - definitely" \ + "You may rely on it" \ + "As I see it, yes" \ + "Most likely" \ + "Outlook good" \ + "Yes" \ + "Signs point to yes" \ + "Reply hazy, try again" \ + "Ask again later" \ + "Better not tell you now" \ + "Cannot predict now" \ + "Concentrate and ask again" \ + "Don't count on it" \ + "My reply is no" \ + "My sources say no" \ + "Outlook not so good" \ + "Very doubtful"] + +while {[gets stdin line] != -1} { + parse $line + + if {! [info exists msg(prefix)] || ! [info exists msg(command)] + || $msg(command) != "PRIVMSG" || ! [info exists msg(param)] + || [llength $msg(param)] < 2} { continue } + + regexp {^[^!]*} $msg(prefix) ctx + if [regexp {^[#&+!]} [lindex $msg(param) 0]] { + set ctx_quote "$ctx: " + set ctx [lindex $msg(param) 0] + } else { set ctx_quote "" } + + set input [lindex $msg(param) 1] + set first_chars [string range $input 0 \ + [expr [string length $prefix] - 1]] + if {$first_chars != $prefix} { continue } + set input [string range $input [string length $prefix] end] + + if {$input == "coin"} { + if {rand() < 0.5} { + pmrespond "Heads." + } else { + pmrespond "Tails." + } + } elseif {[regexp {^dice( +|$)(.*)} $input -> _ args]} { + if {! [string is integer -strict $args] || $args <= 0} { + pmrespond "Invalid or missing number." + } else { + pmrespond [expr {int($args * rand()) + 1}] + } + } elseif {[regexp {^(choose|\?)( +|$)(.*)} $input -> _ _ args]} { + if {$args == ""} { + pmrespond "Nothing to choose from." + } else { + set c [split $args ",|"] + pmrespond [string trim [lindex $c \ + [expr {int([llength $c] * rand())}]]] + } + } elseif {[regexp {^eightball( +|$)(.*)} $input -> _ args]} { + if {$args == ""} { + pmrespond "You should, you know, ask something." + } else { + pmrespond [lindex $eightball \ + [expr {int([llength $eightball] * rand())}]]. + } + } +} + diff --git a/plugins/xB/eval b/plugins/xB/eval new file mode 100755 index 0000000..48ea28d --- /dev/null +++ b/plugins/xB/eval @@ -0,0 +1,312 @@ +#!/usr/bin/awk -f +# +# xB eval plugin, LISP-like expression evaluator +# +# Copyright 2013, 2014 Přemysl Eric Janouch +# See the file LICENSE for licensing information. +# + +BEGIN \ +{ + RS = "\r" + ORS = "\r\n" + IGNORECASE = 1 + srand() + + prefix = get_config("prefix") + + print "XB register" + fflush("") + + # All functions have to be in this particular array + min_args["int"] = 1 + min_args["+"] = 1 + min_args["-"] = 1 + min_args["*"] = 1 + min_args["/"] = 1 + min_args["%"] = 1 + min_args["^"] = 1 + min_args["**"] = 1 + min_args["exp"] = 1 + min_args["sin"] = 1 + min_args["cos"] = 1 + min_args["atan2"] = 2 + min_args["log"] = 1 + min_args["rand"] = 0 + min_args["sqrt"] = 1 + + min_args["pi"] = 0 + min_args["e"] = 0 + + min_args["min"] = 1 + min_args["max"] = 1 + + # Whereas here their presence is only optional + max_args["int"] = 1 + max_args["sin"] = 1 + max_args["cos"] = 1 + max_args["atan2"] = 2 + max_args["log"] = 1 + max_args["rand"] = 0 + max_args["sqrt"] = 1 + + max_args["pi"] = 0 + max_args["e"] = 0 +} + +{ + parse($0) +} + +msg_command == "PRIVMSG" \ +{ + # Context = either channel or user nickname + match(msg_prefix, /^[^!]+/) + ctx = substr(msg_prefix, RSTART, RLENGTH) + if (msg_param[0] ~ /^[#&!+]/) + { + ctx_quote = ctx ": " + ctx = msg_param[0] + } + else + ctx_quote = "" + + + if (substr(msg_param[1], 1, length(prefix)) == prefix) + { + keyword = "eval" + text = substr(msg_param[1], 1 + length(prefix)) + if (match(text, "^" keyword "([^A-Za-z0-9].*|$)")) + process_request(substr(text, 1 + length(keyword))) + } +} + +{ + fflush("") +} + +function pmrespond (text) +{ + print "PRIVMSG " ctx " :" ctx_quote text +} + +function process_request (input, res, x) +{ + delete funs + delete accumulator + delete n_args + + res = "" + fun_top = 0 + funs[0] = "" + accumulator[0] = 0 + n_args[0] = 0 + + if (match(input, "^[ \t]*")) + input = substr(input, RLENGTH + 1) + if (input == "") + res = "expression missing" + + while (res == "" && input != "") { + if (match(input, "^-?[0-9]+\\.?[0-9]*")) { + x = substr(input, RSTART, RLENGTH) + input = substr(input, RLENGTH + 1) + + match(input, "^ *") + input = substr(input, RLENGTH + 1) + + res = process_argument(x) + } else if (match(input, "^[(]([^ ()]+)")) { + x = substr(input, RSTART + 1, RLENGTH - 1) + input = substr(input, RLENGTH + 1) + + match(input, "^ *") + input = substr(input, RLENGTH + 1) + + if (!(x in min_args)) { + res = "undefined function '" x "'" + } else { + fun_top++ + funs[fun_top] = x + accumulator[fun_top] = 636363 + n_args[fun_top] = 0 + } + } else if (match(input, "^[)] *")) { + input = substr(input, RLENGTH + 1) + res = process_end() + } else + res = "invalid input at '" substr(input, 1, 10) "...'" + } + + if (res == "") { + if (fun_top != 0) + res = "unclosed '" funs[fun_top] "'" + else if (n_args[0] != 1) + res = "internal error, expected one result" \ + ", got " n_args[0] " instead" + } + + if (res == "") + pmrespond(accumulator[0]) + else + pmrespond(res) +} + +function process_argument (arg) +{ + if (fun_top == 0) { + if (n_args[0]++ != 0) + return "too many results, I only expect one" + + accumulator[0] = arg + return "" + } + + fun = funs[fun_top] + if (fun in max_args && max_args[fun] <= n_args[fun_top]) + return "too many operands for " fun + + if (fun == "int") { + accumulator[fun_top] = int(arg) + } else if (fun == "+") { + if (n_args[fun_top] == 0) + accumulator[fun_top] = arg + else + accumulator[fun_top] += arg + } else if (fun == "-") { + if (n_args[fun_top] == 0) + accumulator[fun_top] = arg + else + accumulator[fun_top] -= arg + } else if (fun == "*") { + if (n_args[fun_top] == 0) + accumulator[fun_top] = arg + else + accumulator[fun_top] *= arg + } else if (fun == "/") { + if (n_args[fun_top] == 0) + accumulator[fun_top] = arg + else if (arg == 0) + return "division by zero" + else + accumulator[fun_top] /= arg + } else if (fun == "%") { + if (n_args[fun_top] == 0) + accumulator[fun_top] = arg + else if (arg == 0) + return "division by zero" + else + accumulator[fun_top] %= arg + } else if (fun == "^" || fun == "**" || fun == "exp") { + if (n_args[fun_top] == 0) + accumulator[fun_top] = arg + else + accumulator[fun_top] ^= arg + } else if (fun == "sin") { + accumulator[fun_top] = sin(arg) + } else if (fun == "cos") { + accumulator[fun_top] = cos(arg) + } else if (fun == "atan2") { + if (n_args[fun_top] == 0) + accumulator[fun_top] = arg + else + accumulator[fun_top] = atan2(accumulator[fun_top], arg) + } else if (fun == "log") { + accumulator[fun_top] = log(arg) + } else if (fun == "rand") { + # Just for completeness, execution never gets here + } else if (fun == "sqrt") { + accumulator[fun_top] = sqrt(arg) + } else if (fun == "min") { + if (n_args[fun_top] == 0) + accumulator[fun_top] = arg + else if (accumulator[fun_top] > arg) + accumulator[fun_top] = arg + } else if (fun == "max") { + if (n_args[fun_top] == 0) + accumulator[fun_top] = arg + else if (accumulator[fun_top] < arg) + accumulator[fun_top] = arg + } else + return "internal error, unhandled operands for " fun + + n_args[fun_top]++ + return "" +} + +function process_end () +{ + if (fun_top <= 0) + return "extraneous ')'" + + fun = funs[fun_top] + if (!(fun in min_args)) + return "internal error, unhandled ')' for '" fun "'" + if (min_args[fun] > n_args[fun_top]) + return "not enough operands for '" fun "'" + + # There's no 'init' function to do it in + if (fun == "rand") + accumulator[fun_top] = rand() + else if (fun == "pi") + accumulator[fun_top] = 3.141592653589793 + else if (fun == "e") + accumulator[fun_top] = 2.718281828459045 + + return process_argument(accumulator[fun_top--]) +} + +function get_config (key) +{ + print "XB get_config :" key + fflush("") + + getline + parse($0) + return msg_param[0] +} + +function parse (line, s, n, id, token) +{ + s = 1 + id = 0 + + # NAWK only uses the first character of RS + if (line ~ /^\n/) + line = substr(line, 2) + + msg_prefix = "" + msg_command = "" + delete msg_param + + n = match(substr(line, s), / |$/) + while (n) + { + token = substr(line, s, n - 1) + if (token ~ /^:/) + { + if (s == 1) + msg_prefix = substr(token, 2) + else + { + msg_param[id] = substr(line, s + 1) + break + } + } + else if (!msg_command) + msg_command = toupper(token) + else + msg_param[id++] = token + + s = s + n + n = index(substr(line, s), " ") + + if (!n) + { + n = length(substr(line, s)) + 1 + if (n == 1) + break; + } + } +} + diff --git a/plugins/xB/factoids b/plugins/xB/factoids new file mode 100755 index 0000000..84f6559 --- /dev/null +++ b/plugins/xB/factoids @@ -0,0 +1,177 @@ +#!/usr/bin/env perl +# +# xB factoids plugin +# +# Copyright 2016 Přemysl Eric Janouch <p@janouch.name> +# See the file LICENSE for licensing information. +# + +use strict; +use warnings; +use Text::Wrap; + +# --- IRC protocol ------------------------------------------------------------- + +binmode STDIN; select STDIN; $| = 1; $/ = "\r\n"; +binmode STDOUT; select STDOUT; $| = 1; $\ = "\r\n"; + +sub parse ($) { + chomp (my $line = shift); + return undef unless my ($nick, $user, $host, $command, $args) = ($line =~ + qr/^(?::([^! ]*)(?:!([^@]*)@([^ ]*))? +)?([^ ]+)(?: +(.*))?$/o); + return {nick => $nick, user => $user, host => $host, command => $command, + args => defined $args ? [$args =~ /:?((?<=:).*|[^ ]+) */og] : []}; +} + +sub bot_print { + print "XB print :${\shift}"; +} + +# --- Initialization ----------------------------------------------------------- + +my %config; +for my $name (qw(prefix)) { + print "XB get_config :$name"; + $config{$name} = (parse <STDIN>)->{args}->[0]; +} + +print "XB register"; + +# --- Database ----------------------------------------------------------------- +# Simple map of (factoid_name => [definitions]); all factoids are separated +# by newlines and definitions by carriage returns. Both disallowed in IRC. + +sub db_load { + local $/ = "\n"; + my ($path) = @_; + open my $db, "<", $path or return {}; + + my %entries; + while (<$db>) { + chomp; + my @defs = split "\r"; + $entries{shift @defs} = \@defs; + } + \%entries +} + +sub db_save { + local $\ = "\n"; + my ($path, $ref) = @_; + my $path_new = "$path.new"; + open my $db, ">", $path_new or die "db save failed: $!"; + + my %entries = %$ref; + print $db join "\r", ($_, @{$entries{$_}}) for keys %entries; + close $db; + rename $path_new, $path or die "db save failed: $!"; +} + +# --- Factoids ----------------------------------------------------------------- + +my $db_path = 'factoids.db'; +my %db = %{db_load $db_path}; + +sub learn { + my ($respond, $input) = @_; + return &$respond("usage: <name> = <definition>") + unless $input =~ /^([^=]+?)(?:\s+(\d+))?\s*=\s*(.+?)\s*$/; + + my ($name, $number, $definition) = ($1, $2, $3); + return &$respond("trailing numbers in names are disallowed") + if defined $2; + $db{$name} = [] unless exists $db{$name}; + + my $entries = $db{$name}; + return &$respond("duplicate definition") + if grep { lc $_ eq lc $definition } @$entries; + + push @$entries, $definition; + &$respond("saved as #${\scalar @$entries}"); + db_save $db_path, \%db; +} + +sub check_number { + my ($respond, $name, $number) = @_; + my $entries = $db{$name}; + if ($number > @$entries) { + &$respond(qq/"$name" has only ${\scalar @$entries} definitions/); + } elsif (not $number) { + &$respond("number must not be zero"); + } else { + return 1; + } + return 0; +} + +sub forget { + my ($respond, $input) = @_; + return &$respond("usage: <name> <number>") + unless $input =~ /^([^=]+?)\s+(\d+)\s*$/; + + my ($name, $number) = ($1, int($2)); + return &$respond(qq/"$name" is undefined/) + unless exists $db{$name}; + + my $entries = $db{$name}; + return unless check_number $respond, $name, $number; + + splice @$entries, --$number, 1; + &$respond("forgotten"); + db_save $db_path, \%db; +} + +sub whatis { + my ($respond, $input) = @_; + return &$respond("usage: <name> [<number>]") + unless $input =~ /^([^=]+?)(?:\s+(\d+))?\s*$/; + + my ($name, $number) = ($1, $2); + return &$respond(qq/"$name" is undefined/) + unless exists $db{$name}; + + my $entries = $db{$name}; + if (defined $number) { + return unless check_number $respond, $name, $number; + &$respond(qq/"$name" is #$number $entries->[$number - 1]/); + } else { + my $i = 1; + my $definition = join ", ", map { "#${\$i++} $_" } @{$entries}; + &$respond(qq/"$name" is $definition/); + } +} + +sub wildcard { + my ($respond, $input) = @_; + $input =~ /=/ ? learn(@_) : whatis(@_); +} + +my %commands = ( + 'learn' => \&learn, + 'forget' => \&forget, + 'whatis' => \&whatis, + '??' => \&wildcard, +); + +# --- Input loop --------------------------------------------------------------- + +while (my $line = <STDIN>) { + my %msg = %{parse $line}; + my @args = @{$msg{args}}; + + # This plugin only bothers to respond to PRIVMSG messages + next unless $msg{command} eq 'PRIVMSG' and @args >= 2 + and my ($cmd, $input) = $args[1] =~ /^$config{prefix}(\S+)\s*(.*)/; + + # So far the only reaction is a PRIVMSG back to the sender, so all the + # handlers need is a response callback and all arguments to the command + my ($target => $quote) = ($args[0] =~ /^[#+&!]/) + ? ($args[0] => "$msg{nick}: ") : ($msg{nick} => ''); + # Wrap all responses so that there's space for our prefix in the message + my $respond = sub { + local ($Text::Wrap::columns, $Text::Wrap::unexpand) = 400, 0; + my $start = "PRIVMSG $target :$quote"; + print for split "\n", wrap $start, $start, shift; + }; + &{$commands{$cmd}}($respond, $input) if exists($commands{$cmd}); +} diff --git a/plugins/xB/pomodoro b/plugins/xB/pomodoro new file mode 100755 index 0000000..910f707 --- /dev/null +++ b/plugins/xB/pomodoro @@ -0,0 +1,502 @@ +#!/usr/bin/env ruby +# coding: utf-8 +# +# xB pomodoro plugin +# +# Copyright 2015 Přemysl Eric Janouch +# See the file LICENSE for licensing information. +# + +# --- Simple event loop -------------------------------------------------------- + +# This is more or less a straight-forward port of my C event loop. It's a bit +# unfortunate that I really have to implement all this in order to get some +# basic asynchronicity but at least I get to exercise my Ruby. + +class TimerEvent + attr_accessor :index, :when, :callback + + def initialize (callback) + raise ArgumentError unless callback.is_a? Proc + + @index = nil + @when = nil + @callback = callback + end + + def active? + @index != nil + end + + def until + return @when - Time.new + end +end + +class IOEvent + READ = 1 << 0 + WRITE = 1 << 1 + + attr_accessor :read_index, :write_index, :io, :callback + + def initialize (io, callback) + raise ArgumentError unless callback.is_a? Proc + + @read_index = nil + @write_index = nil + @io = io + @callback = callback + end +end + +class EventLoop + def initialize + @running = false + @timers = [] + @readers = [] + @writers = [] + @io_to_event = {} + end + + def set_timer (timer, timeout) + raise ArgumentError unless timer.is_a? TimerEvent + + timer.when = Time.now + timeout + if timer.index + heapify_down timer.index + heapify_up timer.index + else + timer.index = @timers.size + @timers.push timer + heapify_up timer.index + end + end + + def reset_timer (timer) + raise ArgumentError unless timer.is_a? TimerEvent + remove_timer_at timer.index if timer.index + end + + def set_io (io_event, events) + raise ArgumentError unless io_event.is_a? IOEvent + raise ArgumentError unless events.is_a? Numeric + + reset_io io_event + + @io_to_event[io_event.io] = io_event + if events & IOEvent::READ + io_event.read_index = @readers.size + @readers.push io_event.io + end + if events & IOEvent::WRITE + io_event.read_index = @writers.size + @writers.push io_event.io + end + end + + def reset_io (io_event) + raise ArgumentError unless io_event.is_a? IOEvent + + @readers.delete_at io_event.read_index if io_event.read_index + @writers.delete_at io_event.write_index if io_event.write_index + + io_event.read_index = nil + io_event.write_index = nil + + @io_to_event.delete io_event.io + end + + def run + @running = true + while @running do one_iteration end + end + + def quit + @running = false + end + +private + def one_iteration + rs, ws, = IO.select @readers, @writers, [], nearest_timeout + dispatch_timers + (Array(rs) | Array(ws)).each do |io| + @io_to_event[io].callback.call io + end + end + + def dispatch_timers + now = Time.new + while not @timers.empty? and @timers[0].when <= now do + @timers[0].callback.call + remove_timer_at 0 + end + end + + def nearest_timeout + return nil if @timers.empty? + timeout = @timers[0].until + if timeout < 0 then 0 else timeout end + end + + def remove_timer_at (index) + @timers[index].index = nil + moved = @timers.pop + return if index == @timers.size + + @timers[index] = moved + @timers[index].index = index + heapify_down index + end + + def swap_timers (a, b) + @timers[a], @timers[b] = @timers[b], @timers[a] + @timers[a].index = a + @timers[b].index = b + end + + def heapify_up (index) + while index != 0 do + parent = (index - 1) / 2 + break if @timers[parent].when <= @timers[index].when + swap_timers index, parent + index = parent + end + end + + def heapify_down (index) + loop do + parent = index + left = 2 * index + 1 + right = 2 * index + 2 + + lowest = parent + lowest = left if left < @timers.size and + @timers[left] .when < @timers[lowest].when + lowest = right if right < @timers.size and + @timers[right].when < @timers[lowest].when + break if parent == lowest + + swap_timers lowest, parent + index = lowest + end + end +end + +# --- IRC protocol ------------------------------------------------------------- + +$stdin.set_encoding 'ASCII-8BIT' +$stdout.set_encoding 'ASCII-8BIT' + +$stdin.sync = true +$stdout.sync = true + +$/ = "\r\n" +$\ = "\r\n" + +RE_MSG = /(?::([^! ]*)(?:!([^@]*)@([^ ]*))? +)?([^ ]+)(?: +(.*))?$/ +RE_ARGS = /:?((?<=:).*|[^ ]+) */ + +def parse (line) + m = line.match RE_MSG + return nil if not m + + nick, user, host, command, args = *m.captures + args = if args then args.scan(RE_ARGS).flatten else [] end + [nick, user, host, command, args] +end + +def bot_print (what) + print "XB print :#{what}" +end + +# --- Initialization ----------------------------------------------------------- + +# We can only read in configuration from here so far +# To read it from anywhere else, it has to be done asynchronously +$config = {} +[:prefix].each do |name| + print "XB get_config :#{name}" + _, _, _, _, args = *parse($stdin.gets.chomp) + $config[name] = args[0] +end + +print "XB register" + +# --- Plugin logic ------------------------------------------------------------- + +# FIXME: this needs a major refactor as it doesn't make much sense at all + +class MessageMeta < Struct.new(:nick, :user, :host, :channel, :ctx, :quote) + def respond (message) + print "PRIVMSG #{ctx} :#{quote}#{message}" + end +end + +class Context + attr_accessor :nick, :ctx + + def initialize (meta) + @nick = meta.nick + @ctx = meta.ctx + end + + def == (other) + self.class == other.class \ + and other.nick == @nick \ + and other.ctx == @ctx + end + + alias eql? == + + def hash + @nick.hash ^ @ctx.hash + end +end + +class PomodoroTimer + def initialize (context) + @ctx = context.ctx + @nicks = [context.nick] + + @timer_work = TimerEvent.new(lambda { on_work }) + @timer_rest = TimerEvent.new(lambda { on_rest }) + + on_work + end + + def inform (message) + # FIXME: it tells the nick even in PM's + quote = "#{@nicks.join(" ")}: " + print "PRIVMSG #{@ctx} :#{quote}#{message}" + end + + def on_work + inform "work now!" + $loop.set_timer @timer_rest, 25 * 60 + end + + def on_rest + inform "rest now!" + $loop.set_timer @timer_work, 5 * 60 + end + + def join (meta) + return if @nicks.include? meta.nick + + meta.respond "you have joined their pomodoro" + @nicks |= [meta.nick] + end + + def part (meta, requested) + return if not @nicks.include? meta.nick + + if requested + meta.respond "you have stopped your pomodoro" + end + + @nicks -= [meta.nick] + if @nicks.empty? + $loop.reset_timer @timer_work + $loop.reset_timer @timer_rest + end + end + + def status (meta) + return if not @nicks.include? meta.nick + + if @timer_rest.active? + till = @timer_rest.until + meta.respond "working, #{(till / 60).to_i} minutes, " + + "#{(till % 60).to_i} seconds until rest" + end + if @timer_work.active? + till = @timer_work.until + meta.respond "resting, #{(till / 60).to_i} minutes, " + + "#{(till % 60).to_i} seconds until work" + end + end +end + +class Pomodoro + KEYWORD = "pomodoro" + + def initialize + @timers = {} + end + + def on_help (meta, args) + meta.respond "usage: #{KEYWORD} { start | stop | join <nick> | status }" + end + + def on_start (meta, args) + if args.size != 0 + meta.respond "usage: #{KEYWORD} start" + return + end + + context = Context.new meta + if @timers[context] + meta.respond "you already have a timer running here" + else + @timers[context] = PomodoroTimer.new meta + end + end + + def on_join (meta, args) + if args.size != 1 + meta.respond "usage: #{KEYWORD} join <nick>" + return + end + + context = Context.new meta + if @timers[context] + meta.respond "you already have a timer running here" + return + end + + joined_context = Context.new meta + joined_context.nick = args.shift + timer = @timers[joined_context] + if not timer + meta.respond "that person doesn't have a timer here" + else + timer.join meta + @timers[context] = timer + end + end + + def on_stop (meta, args) + if args.size != 0 + meta.respond "usage: #{KEYWORD} stop" + return + end + + context = Context.new meta + timer = @timers[context] + if not timer + meta.respond "you don't have a timer running here" + else + timer.part meta, true + @timers.delete context + end + end + + def on_status (meta, args) + if args.size != 0 + meta.respond "usage: #{KEYWORD} status" + return + end + + timer = @timers[Context.new meta] + if not timer + meta.respond "you don't have a timer running here" + else + timer.status meta + end + end + + def process_command (meta, msg) + args = msg.split + return if args.shift != KEYWORD + + method = "on_#{args.shift}" + send method, meta, args if respond_to? method + end + + def on_server_nick (meta, command, args) + # TODO: either handle this properly... + happened = false + @timers.keys.each do |key| + next if key.nick != meta.nick + @timers[key].part meta, false + @timers.delete key + happened = true + end + if happened + # TODO: ...or at least inform the user via his new nick + end + end + + def on_server_part (meta, command, args) + # TODO: instead of cancelling the user's pomodoros, either redirect + # them to PM's and later upon rejoining undo the redirection... + context = Context.new(meta) + context.ctx = meta.channel + if @timers.include? context + # TODO: ...or at least inform the user about the cancellation + @timers[context].part meta, false + @timers.delete context + end + end + + def on_server_quit (meta, command, args) + @timers.keys.each do |key| + next if key.nick != meta.nick + @timers[key].part meta, false + @timers.delete key + end + end + + def process (meta, command, args) + method = "on_server_#{command.downcase}" + send method, meta, command, args if respond_to? method + end +end + +# --- IRC message processing --------------------------------------------------- + +$handlers = [Pomodoro.new] +def process_line (line) + msg = parse line + return if not msg + + nick, user, host, command, args = *msg + + context = nick + quote = "" + channel = nil + + if args.size >= 1 and args[0].start_with? ?#, ?+, ?&, ?! + case command + when "PRIVMSG", "NOTICE", "JOIN" + context = args[0] + quote = "#{nick}: " + channel = args[0] + when "PART" + channel = args[0] + end + end + + # Handle any IRC message + meta = MessageMeta.new(nick, user, host, channel, context, quote).freeze + $handlers.each do |handler| + handler.process meta, command, args + end + + # Handle pre-processed bot commands + if command == 'PRIVMSG' and args.size >= 2 + msg = args[1] + return unless msg.start_with? $config[:prefix] + $handlers.each do |handler| + handler.process_command meta, msg[$config[:prefix].size..-1] + end + end +end + +buffer = "" +stdin_io = IOEvent.new($stdin, lambda do |io| + begin + buffer << io.read_nonblock(4096) + lines = buffer.split $/, -1 + buffer = lines.pop + lines.each { |line| process_line line } + rescue EOFError + $loop.quit + rescue IO::WaitReadable + # Ignore + end +end) + +$loop = EventLoop.new +$loop.set_io stdin_io, IOEvent::READ +$loop.run diff --git a/plugins/xB/script b/plugins/xB/script new file mode 100755 index 0000000..43bd66f --- /dev/null +++ b/plugins/xB/script @@ -0,0 +1,2310 @@ +#!/usr/bin/tcc -run -lm +// +// xB 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 "XB print :script: " + +static const char * +get_config (const char *key) +{ + printf ("XB 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 ("XB register\r\n"); + struct message *msg; + while ((msg = read_message ())) + process_message (msg); + + free_runtime_library (); + free (g_prefix); + return 0; +} + diff --git a/plugins/xB/seen b/plugins/xB/seen new file mode 100755 index 0000000..da43488 --- /dev/null +++ b/plugins/xB/seen @@ -0,0 +1,160 @@ +#!/usr/bin/env lua +-- +-- xB seen plugin +-- +-- Copyright 2016 Přemysl Eric Janouch <p@janouch.name> +-- See the file LICENSE for licensing information. +-- + +function parse (line) + local msg = { params = {} } + line = line:match ("[^\r]*") + for start, word in line:gmatch ("()([^ ]+)") do + local colon = word:match ("^:(.*)") + if start == 1 and colon then + msg.prefix = colon + elseif not msg.command then + msg.command = word + elseif colon then + table.insert (msg.params, line:sub (start + 1)) + break + elseif start ~= #line then + table.insert (msg.params, word) + end + end + return msg +end + +function get_config (name) + io.write ("XB get_config :", name, "\r\n") + return parse (io.read ()).params[1] +end + +-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +io.output ():setvbuf ('line') +local prefix = get_config ('prefix') +io.write ("XB register\r\n") + +local db = {} +local db_filename = "seen.db" +local db_garbage = 0 + +function remember (who, where, when, what) + if not db[who] then db[who] = {} end + if db[who][where] then db_garbage = db_garbage + 1 end + db[who][where] = { tonumber (when), what } +end + +-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +local db_file, e = io.open (db_filename, "a+") +if not db_file then error ("cannot open database: " .. e, 0) end + +function db_store (who, where, when, what) + db_file:write (string.format + (":%s %s %s %s :%s\n", who, "PRIVMSG", where, when, what)) +end + +function db_compact () + db_file:close () + + -- Unfortunately, default Lua doesn't have anything like mkstemp() + local db_tmpname = db_filename .. "." .. os.time () + db_file, e = io.open (db_tmpname, "a+") + if not db_file then error ("cannot save database: " .. e, 0) end + + for who, places in pairs (db) do + for where, data in pairs (places) do + db_store (who, where, data[1], data[2]) + end + end + db_file:flush () + + local ok, e = os.rename (db_tmpname, db_filename) + if not ok then error ("cannot save database: " .. e, 0) end + db_garbage = 0 +end + +for line in db_file:lines () do + local msg = parse (line) + remember (msg.prefix, table.unpack (msg.params)) +end + +-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +function seen (who, where, args) + local respond = function (...) + local privmsg = function (target, ...) + io.write ("PRIVMSG ", target, " :", table.concat { ... }, "\r\n") + end + if where:match ("^[#&!+]") then + privmsg (where, who, ": ", ...) + else + privmsg (who, ...) + end + end + + local whom, e, garbage = args:match ("^(%S+)()%s*(.*)") + if not whom or #garbage ~= 0 then + return respond ("usage: <name>") + elseif who:lower () == whom:lower () then + return respond ("I can see you right now.") + end + + local top = {} + -- That is, * acts like a wildcard, otherwise everything is escaped + local pattern = "^" .. whom:gsub ("[%^%$%(%)%%%.%[%]%+%-%?]", "%%%0") + :gsub ("%*", ".*"):lower () .. "$" + for name, places in pairs (db) do + if places[where] and name:lower ():match (pattern) then + local when, what = table.unpack (places[where]) + table.insert (top, { name = name, when = when, what = what }) + end + end + if #top == 0 then + return respond ("I have not seen \x02" .. whom .. "\x02 here.") + end + + -- Get all matching nicknames ordered from the most recently active + -- and make the list case insensitive (remove older duplicates) + table.sort (top, function (a, b) return a.when > b.when end) + for i = #top, 2, -1 do + if top[i - 1].name:lower () == top[i].name:lower () then + table.remove (top, i) + end + end + + -- Hopefully the formatting mess will disrupt highlights in clients + for i = 1, math.min (#top, 3) do + local name = top[i].name:gsub ("^.", "%0\x02\x02") + respond (string.format ("\x02%s\x02 -> %s -> %s", + name, os.date ("%c", top[i].when), top[i].what)) + end +end + +function handle (msg) + local who = msg.prefix:match ("^[^!@]*") + local where, what = table.unpack (msg.params) + local when = os.time () + + local what_log = what:gsub ("^\x01ACTION", "*"):gsub ("\x01$", "") + remember (who, where, when, what_log) + db_store (who, where, when, what_log) + + -- Comment out to reduce both disk load and reliability + db_file:flush () + + if db_garbage > 5000 then db_compact () end + + if what:sub (1, #prefix) == prefix then + local command = what:sub (#prefix + 1) + local name, e = command:match ("^(%S+)%s*()") + if name == 'seen' then seen (who, where, command:sub (e)) end + end +end + +for line in io.lines () do + local msg = parse (line) + if msg.command == "PRIVMSG" then handle (msg) end +end diff --git a/plugins/xB/seen-import-xC.pl b/plugins/xB/seen-import-xC.pl new file mode 100755 index 0000000..db706a0 --- /dev/null +++ b/plugins/xB/seen-import-xC.pl @@ -0,0 +1,39 @@ +#!/usr/bin/env perl +# Creates a database for the "seen" plugin from logs for xC. +# The results may not be completely accurate but are good for jumpstarting. +# Usage: ./seen-import-xC.pl LOG-FILE... > seen.db + +use strict; +use warnings; +use File::Basename; +use Time::Piece; + +my $db = {}; +for (@ARGV) { + my $where = (basename($_) =~ /\.(.*).log/)[0]; + unless ($where) { + print STDERR "Invalid filename: $_\n"; + next; + } + + open my $fh, '<', $_ or die "Failed to open log file: $!"; + while (<$fh>) { + my ($when, $who, $who_action, $what) = + /^(.{19}) (?:<[~&@%+]*(.*?)>| \* (\S+)) (.*)/; + next unless $when; + + if ($who_action) { + $who = $who_action; + $what = "* $what"; + } + $db->{$who}->{$where} = + [Time::Piece->strptime($when, "%Y-%m-%d %T")->epoch, $what]; + } +} + +while (my ($who, $places) = each %$db) { + while (my ($where, $data) = each %$places) { + my ($when, $what) = @$data; + print ":$who PRIVMSG $where $when :$what\n"; + } +} diff --git a/plugins/xB/youtube b/plugins/xB/youtube new file mode 100755 index 0000000..feaab96 --- /dev/null +++ b/plugins/xB/youtube @@ -0,0 +1,111 @@ +#!/usr/bin/env python3 +# +# xB YouTube plugin, displaying info about YouTube links +# +# Copyright 2014 - 2015, Přemysl Eric Janouch <p@janouch.name> +# See the file LICENSE for licensing information. +# + +import sys +import io +import re +import json +import urllib.request + +class Plugin: + re_msg = re.compile ('(?::([^! ]*)(?:!([^@]*)@([^ ]*))? +)?' + '([^ ]+)(?: +(.*))?\r\n$') + re_args = re.compile (':?((?<=:).*|[^ ]+) *') + + def parse (self, line): + m = self.re_msg.match (line) + if m is None: + return None + + (nick, user, host, command, args) = m.groups () + args = [] if args is None else self.re_args.findall (args) + return (nick, user, host, command, args) + + def get_config (self, key): + print ("XB get_config :%s" % key) + (_, _, _, _, args) = self.parse (sys.stdin.readline ()) + return args[0] + + def bot_print (self, what): + print ('XB print :%s' % what) + +class YouTube (Plugin): + re_videos = [re.compile (x) for x in [ + r'youtube\.[a-z]+/[^ ]*[&?]v=([-\w]+)', + r'youtube\.[a-z]+/v/([-\w]+)', + r'youtu\.be/([-\w]+)' + ]] + re_playlists = [re.compile (x) for x in [ + r'youtube\.[a-z]+/playlist[&?][^ ]*(?<=&|\?)list=([-\w]+)', + ]] + + def print_info (self, channel, url, cb): + try: + data = json.loads (urllib.request.urlopen + (url, None, 30).read ().decode ('utf-8')) + + for line in map (lambda x: "YouTube: " + cb (x), data['items']): + print ("PRIVMSG %s :%s" % (channel, + line.encode ('utf-8').decode ('iso8859-1'))) + + except Exception as err: + self.bot_print ('youtube: %s' % (err)) + + def print_video_info (self, channel, video_id): + url = 'https://www.googleapis.com/youtube/v3/' \ + + 'videos?id=%s&key=%s&part=snippet,contentDetails,statistics' \ + % (video_id, self.youtube_api_key) + self.print_info (channel, url, lambda x: "%s | %s | %sx" % ( + x['snippet']['title'], + x['contentDetails']['duration'][2:].lower (), + x['statistics']['viewCount'])) + + def print_playlist_info (self, channel, playlist_id): + url = 'https://www.googleapis.com/youtube/v3/' \ + + 'playlists?id=%s&key=%s&part=snippet,contentDetails' \ + % (playlist_id, self.youtube_api_key) + self.print_info (channel, url, lambda x: "%s | %d videos" % ( + x['snippet']['title'], + x['contentDetails']['itemCount'])) + + def process_line (self, line): + msg = self.parse (line) + if msg is None: + return + + (nick, user, host, command, args) = msg + if command != 'PRIVMSG' or len (args) < 2: + return + + ctx = args[0] + if not ctx.startswith (('#', '+', '&', '!')): + ctx = nick + + for regex in self.re_videos: + for i in regex.findall (args[1]): + self.print_video_info (ctx, i) + for regex in self.re_playlists: + for i in regex.findall (args[1]): + self.print_playlist_info (ctx, i) + + def run (self): + self.youtube_api_key = self.get_config ('youtube_api_key') + if self.youtube_api_key == "": + self.bot_print ("youtube: missing `youtube_api_key'") + + print ("XB register") + + for line in sys.stdin: + self.process_line (line) + +sys.stdin = io.TextIOWrapper (sys.__stdin__.buffer, + encoding = 'iso8859-1', newline = '\r\n', line_buffering = True) +sys.stdout = io.TextIOWrapper (sys.__stdout__.buffer, + encoding = 'iso8859-1', newline = '\r\n', line_buffering = True) + +YouTube ().run () |