Come up with sillier names for the binaries

I'm not entirely sure, but it looks like some people might not like
jokes about the Holocaust.

On a more serious note, the project has become more serious over
the 7 or so years of its existence.
This commit is contained in:
2021-08-06 16:12:15 +02:00
parent 1f64710e79
commit 50057d5149
33 changed files with 260 additions and 262 deletions

241
plugins/xB/calc Executable file
View File

@@ -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 "ZYKLONB 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 "ZYKLONB 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)))

128
plugins/xB/coin Executable file
View File

@@ -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 "ZYKLONB 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 "ZYKLONB 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())}]].
}
}
}

312
plugins/xB/eval Executable file
View File

@@ -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 "ZYKLONB 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 "ZYKLONB 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;
}
}
}

177
plugins/xB/factoids Executable file
View File

@@ -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 "ZYKLONB print :${\shift}";
}
# --- Initialization -----------------------------------------------------------
my %config;
for my $name (qw(prefix)) {
print "ZYKLONB get_config :$name";
$config{$name} = (parse <STDIN>)->{args}->[0];
}
print "ZYKLONB 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});
}

502
plugins/xB/pomodoro Executable file
View File

@@ -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 "ZYKLONB 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 "ZYKLONB get_config :#{name}"
_, _, _, _, args = *parse($stdin.gets.chomp)
$config[name] = args[0]
end
print "ZYKLONB 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

2310
plugins/xB/script Executable file

File diff suppressed because it is too large Load Diff

160
plugins/xB/seen Executable file
View File

@@ -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 ("ZYKLONB get_config :", name, "\r\n")
return parse (io.read ()).params[1]
end
-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
io.output ():setvbuf ('line')
local prefix = get_config ('prefix')
io.write ("ZYKLONB 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

39
plugins/xB/seen-import-xC.pl Executable file
View File

@@ -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";
}
}

111
plugins/xB/youtube Executable file
View File

@@ -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 ("ZYKLONB get_config :%s" % key)
(_, _, _, _, args) = self.parse (sys.stdin.readline ())
return args[0]
def bot_print (self, what):
print ('ZYKLONB 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 ("ZYKLONB 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 ()