From 50057d5149dda340b3b47aca4096f4a6ec66b9ee Mon Sep 17 00:00:00 2001 From: Přemysl Eric Janouch Date: Fri, 6 Aug 2021 16:12:15 +0200 Subject: 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. --- plugins/degesch/auto-rejoin.lua | 48 - plugins/degesch/censor.lua | 90 -- plugins/degesch/fancy-prompt.lua | 105 -- plugins/degesch/last-fm.lua | 178 --- plugins/degesch/ping-timeout.lua | 32 - plugins/degesch/prime.lua | 68 - plugins/degesch/slack.lua | 147 -- plugins/degesch/thin-cursor.lua | 27 - plugins/degesch/utm-filter.lua | 62 - plugins/xB/calc | 241 ++++ plugins/xB/coin | 128 ++ plugins/xB/eval | 312 +++++ plugins/xB/factoids | 177 +++ plugins/xB/pomodoro | 502 +++++++ plugins/xB/script | 2310 ++++++++++++++++++++++++++++++++ plugins/xB/seen | 160 +++ plugins/xB/seen-import-xC.pl | 39 + plugins/xB/youtube | 111 ++ plugins/xC/auto-rejoin.lua | 48 + plugins/xC/censor.lua | 90 ++ plugins/xC/fancy-prompt.lua | 105 ++ plugins/xC/last-fm.lua | 178 +++ plugins/xC/ping-timeout.lua | 32 + plugins/xC/prime.lua | 68 + plugins/xC/slack.lua | 147 ++ plugins/xC/thin-cursor.lua | 27 + plugins/xC/utm-filter.lua | 62 + plugins/zyklonb/calc | 241 ---- plugins/zyklonb/coin | 128 -- plugins/zyklonb/eval | 312 ----- plugins/zyklonb/factoids | 177 --- plugins/zyklonb/pomodoro | 502 ------- plugins/zyklonb/script | 2310 -------------------------------- plugins/zyklonb/seen | 160 --- plugins/zyklonb/seen-import-degesch.pl | 39 - plugins/zyklonb/youtube | 111 -- 36 files changed, 4737 insertions(+), 4737 deletions(-) delete mode 100644 plugins/degesch/auto-rejoin.lua delete mode 100644 plugins/degesch/censor.lua delete mode 100644 plugins/degesch/fancy-prompt.lua delete mode 100644 plugins/degesch/last-fm.lua delete mode 100644 plugins/degesch/ping-timeout.lua delete mode 100644 plugins/degesch/prime.lua delete mode 100644 plugins/degesch/slack.lua delete mode 100644 plugins/degesch/thin-cursor.lua delete mode 100644 plugins/degesch/utm-filter.lua create mode 100755 plugins/xB/calc create mode 100755 plugins/xB/coin create mode 100755 plugins/xB/eval create mode 100755 plugins/xB/factoids create mode 100755 plugins/xB/pomodoro create mode 100755 plugins/xB/script create mode 100755 plugins/xB/seen create mode 100755 plugins/xB/seen-import-xC.pl create mode 100755 plugins/xB/youtube create mode 100644 plugins/xC/auto-rejoin.lua create mode 100644 plugins/xC/censor.lua create mode 100644 plugins/xC/fancy-prompt.lua create mode 100644 plugins/xC/last-fm.lua create mode 100644 plugins/xC/ping-timeout.lua create mode 100644 plugins/xC/prime.lua create mode 100644 plugins/xC/slack.lua create mode 100644 plugins/xC/thin-cursor.lua create mode 100644 plugins/xC/utm-filter.lua delete mode 100755 plugins/zyklonb/calc delete mode 100755 plugins/zyklonb/coin delete mode 100755 plugins/zyklonb/eval delete mode 100755 plugins/zyklonb/factoids delete mode 100755 plugins/zyklonb/pomodoro delete mode 100755 plugins/zyklonb/script delete mode 100755 plugins/zyklonb/seen delete mode 100755 plugins/zyklonb/seen-import-degesch.pl delete mode 100755 plugins/zyklonb/youtube (limited to 'plugins') diff --git a/plugins/degesch/auto-rejoin.lua b/plugins/degesch/auto-rejoin.lua deleted file mode 100644 index ce82213..0000000 --- a/plugins/degesch/auto-rejoin.lua +++ /dev/null @@ -1,48 +0,0 @@ --- --- auto-rejoin.lua: join back automatically when someone kicks you --- --- Copyright (c) 2016, Přemysl Eric Janouch --- --- Permission to use, copy, modify, and/or distribute this software for any --- purpose with or without fee is hereby granted. --- --- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES --- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF --- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY --- SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES --- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION --- OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN --- CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. --- - -local timeout -degesch.setup_config { - timeout = { - type = "integer", - comment = "auto rejoin timeout", - default = "0", - - on_change = function (v) - timeout = v - end, - validate = function (v) - if v < 0 then error ("timeout must not be negative", 0) end - end, - }, -} - -async, await = degesch.async, coroutine.yield -degesch.hook_irc (function (hook, server, line) - local msg = degesch.parse (line) - if msg.command ~= "KICK" then return line end - - local who = msg.prefix:match ("^[^!]*") - local channel, whom = table.unpack (msg.params) - if who ~= whom and whom == server.user.nickname then - async.go (function () - await (async.timer_ms (timeout * 1000)) - server:send ("JOIN " .. channel) - end) - end - return line -end) diff --git a/plugins/degesch/censor.lua b/plugins/degesch/censor.lua deleted file mode 100644 index cb76c23..0000000 --- a/plugins/degesch/censor.lua +++ /dev/null @@ -1,90 +0,0 @@ --- --- censor.lua: black out certain users' messages --- --- Copyright (c) 2016 - 2021, Přemysl Eric Janouch --- --- Permission to use, copy, modify, and/or distribute this software for any --- purpose with or without fee is hereby granted. --- --- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES --- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF --- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY --- SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES --- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION --- OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN --- CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. --- - -local to_pattern = function (mask) - if not mask:match ("!") then mask = mask .. "!*" end - if not mask:match ("@") then mask = mask .. "@*" end - - -- That is, * acts like a wildcard, otherwise everything is escaped - return "^" .. mask:gsub ("[%^%$%(%)%%%.%[%]%+%-%?]", "%%%0") - :gsub ("%*", ".*") .. "$" -end - -local patterns = {} -local read_masks = function (v) - patterns = {} - local add = function (who, where) - local channels = patterns[who] or {} - table.insert (channels, where) - patterns[who] = channels - end - for item in v:lower ():gmatch ("[^,]+") do - local who, where = item:match ("^([^/]+)/*(.*)") - if who then add (to_pattern (who), where == "" or where) end - end -end - -local quote -degesch.setup_config { - masks = { - type = "string_array", - default = "\"\"", - comment = "user masks (optionally \"/#channel\") to censor", - on_change = read_masks - }, - quote = { - type = "string", - default = "\"\\x0301,01\"", - comment = "formatting prefix for censored messages", - on_change = function (v) quote = v end - }, -} - -local decolor = function (text) - local rebuilt, last = {""}, 1 - for start in text:gmatch ('()\x03') do - table.insert (rebuilt, text:sub (last, start - 1)) - local sub = text:sub (start + 1) - last = start + (sub:match ('^%d%d?,%d%d?()') or sub:match ('^%d?%d?()')) - end - return table.concat (rebuilt) .. text:sub (last) -end - -local censor = function (line) - -- Taking a shortcut to avoid lengthy message reassembly - local start, text = line:match ("^(.- PRIVMSG .- :)(.*)$") - local ctcp, rest = text:match ("^(\x01%g+ )(.*)") - text = ctcp and ctcp .. quote .. decolor (rest) or quote .. decolor (text) - return start .. text -end - -degesch.hook_irc (function (hook, server, line) - local msg = degesch.parse (line) - if msg.command ~= "PRIVMSG" then return line end - - local channel = msg.params[1]:lower () - for who, where in pairs (patterns) do - if msg.prefix:lower ():match (who) then - for _, x in pairs (where) do - if x == true or x == channel then - return censor (line) - end - end - end - end - return line -end) diff --git a/plugins/degesch/fancy-prompt.lua b/plugins/degesch/fancy-prompt.lua deleted file mode 100644 index 93fe67c..0000000 --- a/plugins/degesch/fancy-prompt.lua +++ /dev/null @@ -1,105 +0,0 @@ --- --- fancy-prompt.lua: the fancy multiline prompt you probably want --- --- Copyright (c) 2016, Přemysl Eric Janouch --- --- Permission to use, copy, modify, and/or distribute this software for any --- purpose with or without fee is hereby granted. --- --- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES --- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF --- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY --- SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES --- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION --- OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN --- CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. --- --- Beware that it is a hack and only goes about 90% of the way, which is why --- this functionality is only available as a plugin in the first place --- (well, and also for customizability). --- --- The biggest problem is that the way we work with Readline is incompatible --- with multiline prompts, and normal newlines just don't work. This is being --- circumvented by using an overflowing single-line prompt with a specially --- crafted character in the rightmost column that prevents the bar's background --- from spilling all over the last line. --- --- There is also a problem with C-r search rendering not clearing out the --- background but to really fix that mode, we'd have to fully reimplement it --- since its alternative prompt very often gets overriden by accident anyway. - -degesch.hook_prompt (function (hook) - local current = degesch.current_buffer - local chan = current.channel - local s = current.server - - local bg_color = "255" - local current_n = 0 - local active = "" - for i, buffer in ipairs (degesch.buffers) do - if buffer == current then - current_n = i - elseif buffer.new_messages_count ~= buffer.new_unimportant_count then - if active ~= "" then active = active .. "," end - if buffer.highlighted then - active = active .. "!" - bg_color = "224" - end - active = active .. i - end - end - if active ~= "" then active = "(" .. active .. ")" end - local x = current_n .. ":" .. current.name - if chan and chan.users_len ~= 0 then - local params = "" - for mode, param in pairs (chan.param_modes) do - params = params .. " +" .. mode .. " " .. param - end - local modes = chan.no_param_modes .. params:sub (3) - if modes ~= "" then x = x .. "(+" .. modes .. ")" end - x = x .. "{" .. chan.users_len .. "}" - end - if current.hide_unimportant then x = x .. "" end - - local lines, cols = degesch.get_screen_size () - x = x .. " " .. active .. string.rep (" ", cols) - - -- Readline 7.0.003 seems to be broken and completely corrupts the prompt. - -- However 8.0.004 seems to be fine with these, as is libedit 20191231-3.1. - --x = x:gsub("[\128-\255]", "?") - - -- Cut off extra characters and apply formatting, including the hack. - -- FIXME: this doesn't count with full-width or zero-width characters. - -- We might want to export wcwidth() above term_from_utf8 somehow. - local overflow = utf8.offset (x, cols - 1) - if overflow then x = x:sub (1, overflow) end - x = "\x01\x1b[0;4;1;38;5;16m\x1b[48;5;" .. bg_color .. "m\x02" .. - x .. "\x01\x1b[0;4;1;7;38;5;" .. bg_color .. "m\x02 \x01\x1b[0;1m\x02" - - local user_prefix = function (chan, user) - for i, chan_user in ipairs (chan.users) do - if chan_user.user == user then return chan_user.prefixes end - end - return "" - end - if s then - x = x .. "[" - local state = s.state - if state == "disconnected" or state == "connecting" then - x = x .. "(" .. state .. ")" - elseif state ~= "registered" then - x = x .. "(unregistered)" - else - local user, modes = s.user, s.user_mode - if chan then x = x .. user_prefix (chan, user) end - x = x .. user.nickname - if modes ~= "" then x = x .. "(" .. modes .. ")" end - end - x = x .. "] " - else - -- There needs to be at least one character so that the cursor - -- doesn't get damaged by our hack in that last column - x = x .. "> " - end - return x -end) diff --git a/plugins/degesch/last-fm.lua b/plugins/degesch/last-fm.lua deleted file mode 100644 index 6ade80d..0000000 --- a/plugins/degesch/last-fm.lua +++ /dev/null @@ -1,178 +0,0 @@ --- --- last-fm.lua: "now playing" feature using the last.fm API --- --- Dependencies: lua-cjson (from luarocks e.g.) --- --- I call this style closure-oriented programming --- --- Copyright (c) 2016, Přemysl Eric Janouch --- --- Permission to use, copy, modify, and/or distribute this software for any --- purpose with or without fee is hereby granted. --- --- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES --- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF --- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY --- SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES --- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION --- OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN --- CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. --- - -local cjson = require "cjson" - --- Setup configuration to load last.fm API credentials from -local user, api_key -degesch.setup_config { - user = { - type = "string", - comment = "last.fm username", - on_change = function (v) user = v end - }, - api_key = { - type = "string", - comment = "last.fm API key", - on_change = function (v) api_key = v end - }, -} - --- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - --- Generic error reporting -local report_error = function (buffer, error) - buffer:log ("last-fm error: " .. error) -end - --- Process data return by the server and extract the now playing song -local process = function (buffer, data, action) - -- There's no reasonable Lua package to parse HTTP that I could find - local s, e, v, status, message = string.find (data, "(%S+) (%S+) .+\r\n") - if not s then return "server returned unexpected data" end - if status ~= "200" then return status .. " " .. message end - - local s, e = string.find (data, "\r\n\r\n") - if not s then return "server returned unexpected data" end - - local parser = cjson.new () - data = parser.decode (string.sub (data, e + 1)) - if not data.recenttracks or not data.recenttracks.track then - return "invalid response" end - - -- Need to make some sense of the XML automatically converted to JSON - local text_of = function (node) - if type (node) ~= "table" then return node end - return node["#text"] ~= "" and node["#text"] or nil - end - - local name, artist, album - for i, track in ipairs (data.recenttracks.track) do - if track["@attr"] and track["@attr"].nowplaying then - if track.name then name = text_of (track.name) end - if track.artist then artist = text_of (track.artist) end - if track.album then album = text_of (track.album) end - end - end - - if not name then - action (false) - else - local np = "\"" .. name .. "\"" - if artist then np = np .. " by " .. artist end - if album then np = np .. " from " .. album end - action (np) - end -end - --- Set up the connection and make the request -local on_connected = function (buffer, c, host, action) - -- Buffer data in the connection object - c.data = "" - c.on_data = function (data) - c.data = c.data .. data - end - - -- And process it after we receive everything - c.on_eof = function () - error = process (buffer, c.data, action) - if error then report_error (buffer, error) end - c:close () - end - c.on_error = function (e) - report_error (buffer, e) - end - - -- Make the unencrypted HTTP request - local url = "/2.0/?method=user.getrecenttracks&user=" .. user .. - "&limit=1&api_key=" .. api_key .. "&format=json" - c:send ("GET " .. url .. " HTTP/1.1\r\n") - c:send ("User-agent: last-fm.lua\r\n") - c:send ("Host: " .. host .. "\r\n") - c:send ("Connection: close\r\n") - c:send ("\r\n") -end - --- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - --- Avoid establishing more than one connection at a time -local running - --- Initiate a connection to last.fm servers -async, await = degesch.async, coroutine.yield -local make_request = function (buffer, action) - if not user or not api_key then - report_error (buffer, "configuration is incomplete") - return - end - - if running then running:cancel () end - running = async.go (function () - local c, host, e = await (async.dial ("ws.audioscrobbler.com", 80)) - if e then - report_error (buffer, e) - else - on_connected (buffer, c, host, action) - end - running = nil - end) -end - --- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -local now_playing - -local tell_song = function (buffer) - if now_playing == nil then - buffer:log ("last-fm: I don't know what you're listening to") - elseif not now_playing then - buffer:log ("last-fm: not playing anything right now") - else - buffer:log ("last-fm: now playing: " .. now_playing) - end -end - -local send_song = function (buffer) - if not now_playing then - tell_song (buffer) - else - buffer:execute ("/me is listening to " .. now_playing) - end -end - --- Hook input to simulate new commands -degesch.hook_input (function (hook, buffer, input) - if input == "/np" then - make_request (buffer, function (np) - now_playing = np - send_song (buffer) - end) - elseif input == "/np?" then - make_request (buffer, function (np) - now_playing = np - tell_song (buffer) - end) - elseif input == "/np!" then - send_song (buffer) - else - return input - end -end) diff --git a/plugins/degesch/ping-timeout.lua b/plugins/degesch/ping-timeout.lua deleted file mode 100644 index 6444c0a..0000000 --- a/plugins/degesch/ping-timeout.lua +++ /dev/null @@ -1,32 +0,0 @@ --- --- ping-timeout.lua: ping timeout readability enhancement plugin --- --- Copyright (c) 2015 - 2016, Přemysl Eric Janouch --- --- Permission to use, copy, modify, and/or distribute this software for any --- purpose with or without fee is hereby granted. --- --- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES --- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF --- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY --- SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES --- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION --- OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN --- CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. --- - -degesch.hook_irc (function (hook, server, line) - local msg = degesch.parse (line) - local start, timeout = line:match ("^(.* :Ping timeout:) (%d+) seconds$") - if msg.command ~= "QUIT" or not start then - return line - end - - local minutes = timeout // 60 - if minutes == 0 then - return line - end - - local seconds = timeout % 60 - return ("%s %d minutes, %d seconds"):format (start, minutes, seconds) -end) diff --git a/plugins/degesch/prime.lua b/plugins/degesch/prime.lua deleted file mode 100644 index 420124f..0000000 --- a/plugins/degesch/prime.lua +++ /dev/null @@ -1,68 +0,0 @@ --- --- prime.lua: highlight prime numbers in messages --- --- Copyright (c) 2020, Přemysl Eric Janouch --- --- Permission to use, copy, modify, and/or distribute this software for any --- purpose with or without fee is hereby granted. --- --- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES --- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF --- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY --- SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES --- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION --- OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN --- CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. --- - -local smallest, highlight = 0, "\x1f" -degesch.setup_config { - smallest = { - type = "integer", - default = "0", - comment = "smallest number to scan for primality", - on_change = function (v) smallest = math.max (v, 2) end - }, - highlight = { - type = "string", - default = "\"\\x1f\"", - comment = "the attribute to use for highlights", - on_change = function (v) highlight = v end - }, -} - --- The prime test is actually very fast, so there is no DoS concern -local do_intercolour = function (text) - return tostring (text:gsub ("%f[%w_]%d+", function (n) - if tonumber (n) < smallest then return nil end - for i = 2, n ^ (1 / 2) do if (n % i) == 0 then return nil end end - return highlight .. n .. highlight - end)) -end - -local do_interlink = function (text) - local rebuilt, last = {""}, 1 - for start in text:gmatch ('()\x03') do - table.insert (rebuilt, do_intercolour (text:sub (last, start - 1))) - local sub = text:sub (start + 1) - last = start + (sub:match ('^%d%d?,%d%d?()') or sub:match ('^%d?%d?()')) - table.insert (rebuilt, text:sub (start, last - 1)) - end - return table.concat (rebuilt) .. do_intercolour (text:sub (last)) -end - -local do_message = function (text) - local rebuilt, last = {""}, 1 - for run, link, endpos in text:gmatch ('(.-)(%f[%g]https?://%g+)()') do - last = endpos - table.insert (rebuilt, do_interlink (run) .. link) - end - return table.concat (rebuilt) .. do_interlink (text:sub (last)) -end - --- XXX: sadly it won't typically highlight primes in our own messages, --- unless IRCv3 echo-message is on -degesch.hook_irc (function (hook, server, line) - local start, message = line:match ("^(.- PRIVMSG .- :)(.*)$") - return message and start .. do_message (message) or line -end) diff --git a/plugins/degesch/slack.lua b/plugins/degesch/slack.lua deleted file mode 100644 index dcddb3c..0000000 --- a/plugins/degesch/slack.lua +++ /dev/null @@ -1,147 +0,0 @@ --- --- slack.lua: try to fix up UX when using the Slack IRC gateway --- --- Copyright (c) 2017, Přemysl Eric Janouch --- --- Permission to use, copy, modify, and/or distribute this software for any --- purpose with or without fee is hereby granted. --- --- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES --- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF --- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY --- SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES --- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION --- OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN --- CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. --- - -local servers = {} -local read_servers = function (v) - servers = {} - for name in v:lower ():gmatch "[^,]+" do - servers[name] = true - end -end - --- This is a reverse list of Slack's automatic emoji, noseless forms -local unemojify, emoji, emoji_default = false, {}, { - heart = "<3", - broken_heart = "", - neutral_face = ":|", - open_mouth = ":o", - angry = ">:(", - slightly_smiling_face = ":)", - disappointed = ":(", - confused = ":/", - stuck_out_tongue = ":p", - stuck_out_tongue_winking_eye = ";p", -} -local load_emoji = function (extra) - emoji = {} - for k, v in pairs (emoji_default) do emoji[k] = v end - for k, v in extra:gmatch "([^,]+) ([^,]+)" do emoji[k] = v end -end - -degesch.setup_config { - servers = { - type = "string_array", - default = "\"\"", - comment = "list of server names that are Slack IRC gateways", - on_change = read_servers - }, - unemojify = { - type = "boolean", - default = "true", - comment = "convert emoji to normal ASCII emoticons", - on_change = function (v) unemojify = v end - }, - extra_emoji = { - type = "string_array", - default = "\"grinning :)),joy :'),innocent o:),persevere >_<\"", - comment = "overrides or extra emoji for unemojify", - on_change = function (v) load_emoji (v) end - } -} - --- We can handle external messages about what we've supposedly sent just fine, --- so let's get rid of that "[username] some message sent from the web UI" crap -degesch.hook_irc (function (hook, server, line) - local msg, us = degesch.parse (line), server.user - if not servers[server.name] or msg.command ~= "PRIVMSG" or not us - or msg.params[1]:lower () ~= us.nickname:lower () then return line end - - -- Taking a shortcut to avoid lengthy message reassembly - local quoted_nick = us.nickname:gsub ("[%^%$%(%)%%%.%[%]%*%+%-%?]", "%%%0") - local text = line:match ("^.- PRIVMSG .- :%[" .. quoted_nick .. "%] (.*)$") - if not text then return line end - return ":" .. us.nickname .. "!" .. server.irc_user_host .. " PRIVMSG " - .. msg.prefix:match "^[^!@]*" .. " :" .. text -end) - --- Unfuck emoji and :nick!nick@irc.tinyspeck.com MODE #channel +v nick : active -degesch.hook_irc (function (hook, server, line) - if not servers[server.name] then return line end - if unemojify then - local start, text = line:match ("^(.- PRIVMSG .- :)(.*)$") - if start then return start .. text:gsub (":([a-z_]+):", function (name) - if emoji[name] then return emoji[name] end - return ":" .. name .. ":" - end) end - end - return line:gsub ("^(:%S+ MODE .+) : .*", "%1") -end) - --- The gateway simply ignores the NAMES command altogether -degesch.hook_input (function (hook, buffer, input) - if not buffer.channel or not servers[buffer.server.name] - or not input:match "^/names%s*$" then return input end - - local users = buffer.channel.users - table.sort (users, function (a, b) - if a.prefixes > b.prefixes then return true end - if a.prefixes < b.prefixes then return false end - return a.user.nickname < b.user.nickname - end) - - local names = "Users on " .. buffer.channel.name .. ":" - for i, chan_user in ipairs (users) do - names = names .. " " .. chan_user.prefixes .. chan_user.user.nickname - end - buffer:log (names) -end) - -degesch.hook_completion (function (hook, data, word) - local chan = degesch.current_buffer.channel - local server = degesch.current_buffer.server - if not chan or not servers[server.name] then return end - - -- In /commands there is typically no desire at all to add the at sign - if data.location == 1 and data.words[1]:match "^/" then return end - - -- Handle both when the at sign is already there and when it is not - local needle = word:gsub ("^@", ""):lower () - - local t = {} - local try = function (name) - if data.location == 0 then name = name .. ":" end - if name:sub (1, #needle):lower () == needle then - table.insert (t, "@" .. name) - end - end - for _, chan_user in ipairs (chan.users) do - try (chan_user.user.nickname) - end - for _, special in ipairs { "channel", "here" } do - try (special) - end - return t -end) diff --git a/plugins/degesch/thin-cursor.lua b/plugins/degesch/thin-cursor.lua deleted file mode 100644 index d0fbf38..0000000 --- a/plugins/degesch/thin-cursor.lua +++ /dev/null @@ -1,27 +0,0 @@ --- --- thin-cursor.lua: set a thin cursor --- --- Copyright (c) 2016, Přemysl Eric Janouch --- --- Permission to use, copy, modify, and/or distribute this software for any --- purpose with or without fee is hereby granted. --- --- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES --- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF --- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY --- SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES --- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION --- OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN --- CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. --- --- If tmux doesn't work, add the following to its configuration: --- set -as terminal-overrides ',*:Ss=\E[%p1%d q:Se=\E[2 q' --- Change the "2" as per http://invisible-island.net/xterm/ctlseqs/ctlseqs.html - -local out = io.output () -out:write ("\x1b[6 q"):flush () - --- By registering a global variable, we get notified about plugin unload -x = setmetatable ({}, { __gc = function () - out:write ("\x1b[2 q"):flush () -end }) diff --git a/plugins/degesch/utm-filter.lua b/plugins/degesch/utm-filter.lua deleted file mode 100644 index 63f85e3..0000000 --- a/plugins/degesch/utm-filter.lua +++ /dev/null @@ -1,62 +0,0 @@ --- --- utm-filter.lua: filter out Google Analytics bullshit from URLs --- --- Copyright (c) 2015, Přemysl Eric Janouch --- --- Permission to use, copy, modify, and/or distribute this software for any --- purpose with or without fee is hereby granted. --- --- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES --- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF --- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY --- SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES --- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION --- OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN --- CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. --- - --- A list of useless URL parameters that don't affect page function -local banned = { - gclid = 1, - - utm_source = 1, - utm_medium = 1, - utm_term = 1, - utm_content = 1, - utm_campaign = 1, -} - --- Go through a parameter list and throw out any banned elements -local do_args = function (args) - local filtered = {} - for part in args:gmatch ("[^&]+") do - if not banned[part:match ("^[^=]*")] then - table.insert (filtered, part) - end - end - return table.concat (filtered, "&") -end - --- Filter parameters in both the query and the fragment part of an URL -local do_single_url = function (url) - return url:gsub ('^([^?#]*)%?([^#]*)', function (start, query) - local clean = do_args (query) - return #clean > 0 and start .. "?" .. clean or start - end, 1):gsub ('^([^#]*)#(.*)', function (start, fragment) - local clean = do_args (fragment) - return #clean > 0 and start .. "#" .. clean or start - end, 1) -end - -local do_text = function (text) - return text:gsub ('%f[%g]https?://%g+', do_single_url) -end - -degesch.hook_irc (function (hook, server, line) - local start, message = line:match ("^(.* :)(.*)$") - return message and start .. do_text (message) or line -end) - -degesch.hook_input (function (hook, buffer, input) - return do_text (input) -end) diff --git a/plugins/xB/calc b/plugins/xB/calc new file mode 100755 index 0000000..e67244b --- /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 "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->integer integer->char + ; Strings; XXX - omitted make-string - can cause OOM + 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-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>=? + 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))) diff --git a/plugins/xB/coin b/plugins/xB/coin new file mode 100755 index 0000000..14cabb5 --- /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 "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())}]]. + } + } +} + diff --git a/plugins/xB/eval b/plugins/xB/eval new file mode 100755 index 0000000..24e4050 --- /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 "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; + } + } +} + diff --git a/plugins/xB/factoids b/plugins/xB/factoids new file mode 100755 index 0000000..9e9a7b4 --- /dev/null +++ b/plugins/xB/factoids @@ -0,0 +1,177 @@ +#!/usr/bin/env perl +# +# xB factoids plugin +# +# Copyright 2016 Přemysl Eric Janouch +# 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 )->{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: = ") + 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: ") + 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: []") + 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 = ) { + 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..08b87cb --- /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 "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 | 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 " + 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..948e7e5 --- /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 +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include + +#define ADDRESS_SPACE_LIMIT (100 * 1024 * 1024) +#include + +#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_(), thus when it is null, + // that function must have failed. This is a shortcut for convenience. + if (!item) + { + ctx->memory_failure = true; + return false; + } + + assert (item->next == NULL); + item->next = ctx->stack; + ctx->stack = item; + ctx->stack_size++; + return true; +} + +static bool +bump_reductions (struct context *ctx) +{ + if (++ctx->reduction_count >= ctx->reduction_limit) + { + ctx->error_is_fatal = true; + return set_error (ctx, "reduction limit reached"); + } + return true; +} + +static bool execute (struct context *, struct item *); + +static bool +call_function (struct context *ctx, const char *name) +{ + struct fn *iter; + for (iter = g_functions; iter; iter = iter->next) + if (!strcmp (name, iter->name)) + goto found; + return set_error (ctx, "unknown function: %s", name); + +found: + if (!bump_reductions (ctx)) + return false; + + if (iter->handler + ? iter->handler (ctx) + : execute (ctx, iter->script)) + return true; + + // In this case, `error' is NULL + if (ctx->memory_failure) + return false; + + // This creates some form of a stack trace + char *tmp = ctx->error; + ctx->error = NULL; + set_error (ctx, "%s -> %s", name, tmp); + free (tmp); + return false; +} + +static void +free_function (struct fn *fn) +{ + item_free_list (fn->script); + free (fn); +} + +static void +unregister_function (const char *name) +{ + for (struct fn **iter = &g_functions; *iter; iter = &(*iter)->next) + if (!strcmp ((*iter)->name, name)) + { + struct fn *tmp = *iter; + *iter = tmp->next; + free_function (tmp); + break; + } +} + +static struct fn * +prepend_new_fn (const char *name) +{ + struct fn *fn = calloc (1, sizeof *fn + strlen (name) + 1); + if (!fn) + return NULL; + + strcpy (fn->name, name); + fn->next = g_functions; + return g_functions = fn; +} + +static bool +register_handler (const char *name, handler_fn handler) +{ + unregister_function (name); + struct fn *fn = prepend_new_fn (name); + if (!fn) + return false; + fn->handler = handler; + return true; +} + +static bool +register_script (const char *name, struct item *script) +{ + unregister_function (name); + struct fn *fn = prepend_new_fn (name); + if (!fn) + return false; + fn->script = script; + return true; +} + +static bool +execute (struct context *ctx, struct item *script) +{ + for (; script; script = script->next) + { + if (script->type != ITEM_WORD) + { + if (!bump_reductions (ctx) + || !push (ctx, new_clone (script))) + return false; + } + else if (!call_function (ctx, get_word (script))) + return false; + } + return true; +} + +// --- Runtime library --------------------------------------------------------- + +#define defn(name) static bool name (struct context *ctx) + +#define check_stack(n) \ + if (ctx->stack_size < n) { \ + set_error (ctx, "stack underflow"); \ + return 0; \ + } + +inline static bool +check_stack_safe (struct context *ctx, size_t n) +{ + check_stack (n); + return true; +} + +static bool +check_type (struct context *ctx, const void *item_, enum item_type type) +{ + const struct item *item = item_; + if (item->type == type) + return true; + + return set_error (ctx, "invalid type: expected `%s', got `%s'", + item_type_to_str (type), item_type_to_str (item->type)); +} + +static struct item * +pop (struct context *ctx) +{ + check_stack (1); + struct item *top = ctx->stack; + ctx->stack = top->next; + top->next = NULL; + ctx->stack_size--; + return top; +} + +// - - Types - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +#define defn_is_type(name, item_type) \ + defn (fn_is_##name) { \ + check_stack (1); \ + struct item *top = pop (ctx); \ + push (ctx, new_integer (top->type == (item_type))); \ + item_free (top); \ + return true; \ + } + +defn_is_type (string, ITEM_STRING) +defn_is_type (word, ITEM_WORD) +defn_is_type (integer, ITEM_INTEGER) +defn_is_type (float, ITEM_FLOAT) +defn_is_type (list, ITEM_LIST) + +defn (fn_to_string) +{ + check_stack (1); + struct item *item = pop (ctx); + char *value; + + switch (item->type) + { + case ITEM_WORD: + item->type = ITEM_STRING; + case ITEM_STRING: + return push (ctx, item); + + case ITEM_FLOAT: + value = strdup_printf ("%Lf", get_float (item)); + break; + case ITEM_INTEGER: + value = strdup_printf ("%lld", get_integer (item)); + break; + + default: + set_error (ctx, "cannot convert `%s' to `%s'", + item_type_to_str (item->type), item_type_to_str (ITEM_STRING)); + item_free (item); + return false; + } + + item_free (item); + if (!value) + { + ctx->memory_failure = true; + return false; + } + + item = new_string (value, -1); + free (value); + return push (ctx, item); +} + +defn (fn_to_integer) +{ + check_stack (1); + struct item *item = pop (ctx); + long long value; + + switch (item->type) + { + case ITEM_INTEGER: + return push (ctx, item); + case ITEM_FLOAT: + value = get_float (item); + break; + + case ITEM_STRING: + { + char *end; + const char *s = get_string (item); + value = strtoll (s, &end, 10); + if (end != s && *s == '\0') + break; + + item_free (item); + return set_error (ctx, "integer conversion error"); + } + + default: + set_error (ctx, "cannot convert `%s' to `%s'", + item_type_to_str (item->type), item_type_to_str (ITEM_INTEGER)); + item_free (item); + return false; + } + + item_free (item); + return push (ctx, new_integer (value)); +} + +defn (fn_to_float) +{ + check_stack (1); + struct item *item = pop (ctx); + long double value; + + switch (item->type) + { + case ITEM_FLOAT: + return push (ctx, item); + case ITEM_INTEGER: + value = get_integer (item); + break; + + case ITEM_STRING: + { + char *end; + const char *s = get_string (item); + value = strtold (s, &end); + if (end != s && *s == '\0') + break; + + item_free (item); + return set_error (ctx, "float conversion error"); + } + + default: + set_error (ctx, "cannot convert `%s' to `%s'", + item_type_to_str (item->type), item_type_to_str (ITEM_FLOAT)); + item_free (item); + return false; + } + + item_free (item); + return push (ctx, new_float (value)); +} + +// - - Miscellaneous - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +defn (fn_length) +{ + check_stack (1); + struct item *item = pop (ctx); + bool success = true; + switch (item->type) + { + case ITEM_STRING: + success = push (ctx, new_integer (((struct item_string *) item)->len)); + break; + case ITEM_LIST: + { + long long length = 0; + struct item *iter; + for (iter = get_list (item); iter; iter = iter->next) + length++; + success = push (ctx, new_integer (length)); + break; + } + default: + success = set_error (ctx, "invalid type"); + } + item_free (item); + return success; +} + +// - - Stack operations - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +defn (fn_dup) +{ + check_stack (1); + return push (ctx, new_clone (ctx->stack)); +} + +defn (fn_drop) +{ + check_stack (1); + item_free (pop (ctx)); + return true; +} + +defn (fn_swap) +{ + check_stack (2); + struct item *second = pop (ctx), *first = pop (ctx); + return push (ctx, second) && push (ctx, first); +} + +defn (fn_call) +{ + check_stack (1); + struct item *script = pop (ctx); + bool success = check_type (ctx, script, ITEM_LIST) + && execute (ctx, get_list (script)); + item_free (script); + return success; +} + +defn (fn_dip) +{ + check_stack (2); + struct item *script = pop (ctx); + struct item *item = pop (ctx); + bool success = check_type (ctx, script, ITEM_LIST) + && execute (ctx, get_list (script)); + item_free (script); + if (!success) + { + item_free (item); + return false; + } + return push (ctx, item); +} + +defn (fn_unit) +{ + check_stack (1); + struct item *item = pop (ctx); + return push (ctx, new_list (item)); +} + +defn (fn_cons) +{ + check_stack (2); + struct item *list = pop (ctx); + struct item *item = pop (ctx); + if (!check_type (ctx, list, ITEM_LIST)) + { + item_free (list); + item_free (item); + return false; + } + item->next = get_list (list); + ((struct item_list *) list)->head = item; + return push (ctx, list); +} + +defn (fn_cat) +{ + check_stack (2); + struct item *scnd = pop (ctx); + struct item *frst = pop (ctx); + if (!check_type (ctx, frst, ITEM_LIST) + || !check_type (ctx, scnd, ITEM_LIST)) + { + item_free (frst); + item_free (scnd); + return false; + } + + // XXX: we shouldn't have to do this in O(n) + struct item **tail = &((struct item_list *) frst)->head; + while (*tail) + tail = &(*tail)->next; + *tail = get_list (scnd); + + ((struct item_list *) scnd)->head = NULL; + item_free (scnd); + return push (ctx, frst); +} + +defn (fn_uncons) +{ + check_stack (1); + struct item *list = pop (ctx); + if (!check_type (ctx, list, ITEM_LIST)) + goto fail; + struct item *first = get_list (list); + if (!first) + { + set_error (ctx, "list is empty"); + goto fail; + } + ((struct item_list *) list)->head = first->next; + first->next = NULL; + return push (ctx, first) && push (ctx, list); +fail: + item_free (list); + return false; +} + +// - - Logical - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +static bool +to_boolean (struct context *ctx, struct item *item, bool *ok) +{ + switch (item->type) + { + case ITEM_STRING: + return *get_string (item) != '\0'; + case ITEM_INTEGER: + return get_integer (item) != 0; + case ITEM_FLOAT: + return get_float (item) != 0.; + default: + return (*ok = set_error (ctx, "cannot convert `%s' to boolean", + item_type_to_str (item->type))); + } +} + +defn (fn_not) +{ + check_stack (1); + struct item *item = pop (ctx); + bool ok = true; + bool result = !to_boolean (ctx, item, &ok); + item_free (item); + return ok && push (ctx, new_integer (result)); +} + +defn (fn_and) +{ + check_stack (2); + struct item *op1 = pop (ctx); + struct item *op2 = pop (ctx); + bool ok = true; + bool result = to_boolean (ctx, op1, &ok) && to_boolean (ctx, op2, &ok); + item_free (op1); + item_free (op2); + return ok && push (ctx, new_integer (result)); +} + +defn (fn_or) +{ + check_stack (2); + struct item *op1 = pop (ctx); + struct item *op2 = pop (ctx); + bool ok = true; + bool result = to_boolean (ctx, op1, &ok) + || !ok || to_boolean (ctx, op2, &ok); + item_free (op1); + item_free (op2); + return ok && push (ctx, new_integer (result)); +} + +// - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +defn (fn_if) +{ + check_stack (3); + struct item *else_ = pop (ctx); + struct item *then_ = pop (ctx); + struct item *cond_ = pop (ctx); + + bool ok = true; + bool condition = to_boolean (ctx, cond_, &ok); + item_free (cond_); + + bool success = false; + if (ok + && check_type (ctx, then_, ITEM_LIST) + && check_type (ctx, else_, ITEM_LIST)) + success = execute (ctx, condition + ? get_list (then_) + : get_list (else_)); + + item_free (then_); + item_free (else_); + return success; +} + +defn (fn_try) +{ + check_stack (2); + struct item *catch = pop (ctx); + struct item *try = pop (ctx); + bool success = false; + if (!check_type (ctx, try, ITEM_LIST) + || !check_type (ctx, catch, ITEM_LIST)) + goto fail; + + if (!execute (ctx, get_list (try))) + { + if (ctx->memory_failure || ctx->error_is_fatal) + goto fail; + + success = push (ctx, new_string (ctx->error, -1)); + free (ctx->error); + ctx->error = NULL; + + if (success) + success = execute (ctx, get_list (catch)); + } + +fail: + item_free (try); + item_free (catch); + return success; +} + +defn (fn_map) +{ + check_stack (2); + struct item *fn = pop (ctx); + struct item *list = pop (ctx); + if (!check_type (ctx, fn, ITEM_LIST) + || !check_type (ctx, list, ITEM_LIST)) + { + item_free (fn); + item_free (list); + return false; + } + + bool success = false; + struct item *result = NULL, **tail = &result; + for (struct item *iter = get_list (list); iter; iter = iter->next) + { + if (!push (ctx, new_clone (iter)) + || !execute (ctx, get_list (fn)) + || !check_stack_safe (ctx, 1)) + goto fail; + + struct item *item = pop (ctx); + *tail = item; + tail = &item->next; + } + success = true; + +fail: + set_list (list, result); + item_free (fn); + if (!success) + { + item_free (list); + return false; + } + return push (ctx, list); +} + +defn (fn_filter) +{ + check_stack (2); + struct item *fn = pop (ctx); + struct item *list = pop (ctx); + if (!check_type (ctx, fn, ITEM_LIST) + || !check_type (ctx, list, ITEM_LIST)) + { + item_free (fn); + item_free (list); + return false; + } + + bool success = false; + bool ok = true; + struct item *result = NULL, **tail = &result; + for (struct item *iter = get_list (list); iter; iter = iter->next) + { + if (!push (ctx, new_clone (iter)) + || !execute (ctx, get_list (fn)) + || !check_stack_safe (ctx, 1)) + goto fail; + + struct item *item = pop (ctx); + bool survived = to_boolean (ctx, item, &ok); + item_free (item); + if (!ok) + goto fail; + if (!survived) + continue; + + if (!(item = new_clone (iter))) + goto fail; + *tail = item; + tail = &item->next; + } + success = true; + +fail: + set_list (list, result); + item_free (fn); + if (!success) + { + item_free (list); + return false; + } + return push (ctx, list); +} + +defn (fn_fold) +{ + check_stack (3); + struct item *op = pop (ctx); + struct item *null = pop (ctx); + struct item *list = pop (ctx); + bool success = false; + if (!check_type (ctx, op, ITEM_LIST) + || !check_type (ctx, list, ITEM_LIST)) + { + item_free (null); + goto fail; + } + + push (ctx, null); + for (struct item *iter = get_list (list); iter; iter = iter->next) + if (!push (ctx, new_clone (iter)) + || !execute (ctx, get_list (op))) + goto fail; + success = true; + +fail: + item_free (op); + item_free (list); + return success; +} + +defn (fn_each) +{ + check_stack (2); + struct item *op = pop (ctx); + struct item *list = pop (ctx); + bool success = false; + if (!check_type (ctx, op, ITEM_LIST) + || !check_type (ctx, list, ITEM_LIST)) + goto fail; + + for (struct item *iter = get_list (list); iter; iter = iter->next) + if (!push (ctx, new_clone (iter)) + || !execute (ctx, get_list (op))) + goto fail; + success = true; + +fail: + item_free (op); + item_free (list); + return success; +} + +// - - Arithmetic - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +// XXX: why not a `struct item_string *` argument? +static bool +push_repeated_string (struct context *ctx, struct item *op1, struct item *op2) +{ + struct item_string *string = (struct item_string *) op1; + struct item_integer *repeat = (struct item_integer *) op2; + assert (string->type == ITEM_STRING); + assert (repeat->type == ITEM_INTEGER); + + if (repeat->value < 0) + return set_error (ctx, "cannot multiply a string by a negative value"); + + char *buf = NULL; + size_t len = string->len * repeat->value; + if (len < string->len && repeat->value != 0) + goto allocation_fail; + + buf = malloc (len); + if (!buf) + goto allocation_fail; + + for (size_t i = 0; i < len; i += string->len) + memcpy (buf + i, string->value, string->len); + struct item *item = new_string (buf, len); + free (buf); + return push (ctx, item); + +allocation_fail: + ctx->memory_failure = true; + return false; +} + +defn (fn_times) +{ + check_stack (2); + struct item *op2 = pop (ctx); + struct item *op1 = pop (ctx); + + bool ok; + if (op1->type == ITEM_INTEGER && op2->type == ITEM_INTEGER) + ok = push (ctx, new_integer (get_integer (op1) * get_integer (op2))); + else if (op1->type == ITEM_INTEGER && op2->type == ITEM_FLOAT) + ok = push (ctx, new_float (get_integer (op1) * get_float (op2))); + else if (op1->type == ITEM_FLOAT && op2->type == ITEM_FLOAT) + ok = push (ctx, new_float (get_float (op1) * get_float (op2))); + else if (op1->type == ITEM_FLOAT && op2->type == ITEM_INTEGER) + ok = push (ctx, new_float (get_float (op1) * get_integer (op2))); + else if (op1->type == ITEM_INTEGER && op2->type == ITEM_STRING) + ok = push_repeated_string (ctx, op2, op1); + else if (op1->type == ITEM_STRING && op2->type == ITEM_INTEGER) + ok = push_repeated_string (ctx, op1, op2); + else + ok = set_error (ctx, "cannot multiply `%s' and `%s'", + item_type_to_str (op1->type), item_type_to_str (op2->type)); + + item_free (op1); + item_free (op2); + return ok; +} + +defn (fn_pow) +{ + check_stack (2); + struct item *op2 = pop (ctx); + struct item *op1 = pop (ctx); + + bool ok; + if (op1->type == ITEM_INTEGER && op2->type == ITEM_INTEGER) + // TODO: implement this properly, outputting an integer + ok = push (ctx, new_float (powl (get_integer (op1), get_integer (op2)))); + else if (op1->type == ITEM_INTEGER && op2->type == ITEM_FLOAT) + ok = push (ctx, new_float (powl (get_integer (op1), get_float (op2)))); + else if (op1->type == ITEM_FLOAT && op2->type == ITEM_FLOAT) + ok = push (ctx, new_float (powl (get_float (op1), get_float (op2)))); + else if (op1->type == ITEM_FLOAT && op2->type == ITEM_INTEGER) + ok = push (ctx, new_float (powl (get_float (op1), get_integer (op2)))); + else + ok = set_error (ctx, "cannot exponentiate `%s' and `%s'", + item_type_to_str (op1->type), item_type_to_str (op2->type)); + + item_free (op1); + item_free (op2); + return ok; +} + +defn (fn_div) +{ + check_stack (2); + struct item *op2 = pop (ctx); + struct item *op1 = pop (ctx); + + bool ok; + if (op1->type == ITEM_INTEGER && op2->type == ITEM_INTEGER) + { + if (get_integer (op2) == 0) + ok = set_error (ctx, "division by zero"); + else + ok = push (ctx, new_integer (get_integer (op1) / get_integer (op2))); + } + else if (op1->type == ITEM_INTEGER && op2->type == ITEM_FLOAT) + ok = push (ctx, new_float (get_integer (op1) / get_float (op2))); + else if (op1->type == ITEM_FLOAT && op2->type == ITEM_FLOAT) + ok = push (ctx, new_float (get_float (op1) / get_float (op2))); + else if (op1->type == ITEM_FLOAT && op2->type == ITEM_INTEGER) + ok = push (ctx, new_float (get_float (op1) / get_integer (op2))); + else + ok = set_error (ctx, "cannot divide `%s' and `%s'", + item_type_to_str (op1->type), item_type_to_str (op2->type)); + + item_free (op1); + item_free (op2); + return ok; +} + +defn (fn_mod) +{ + check_stack (2); + struct item *op2 = pop (ctx); + struct item *op1 = pop (ctx); + + bool ok; + if (op1->type == ITEM_INTEGER && op2->type == ITEM_INTEGER) + { + if (get_integer (op2) == 0) + ok = set_error (ctx, "division by zero"); + else + ok = push (ctx, new_integer (get_integer (op1) % get_integer (op2))); + } + else if (op1->type == ITEM_INTEGER && op2->type == ITEM_FLOAT) + ok = push (ctx, new_float (fmodl (get_integer (op1), get_float (op2)))); + else if (op1->type == ITEM_FLOAT && op2->type == ITEM_FLOAT) + ok = push (ctx, new_float (fmodl (get_float (op1), get_float (op2)))); + else if (op1->type == ITEM_FLOAT && op2->type == ITEM_INTEGER) + ok = push (ctx, new_float (fmodl (get_float (op1), get_integer (op2)))); + else + ok = set_error (ctx, "cannot divide `%s' and `%s'", + item_type_to_str (op1->type), item_type_to_str (op2->type)); + + item_free (op1); + item_free (op2); + return ok; +} + +static bool +push_concatenated_string (struct context *ctx, + struct item *op1, struct item *op2) +{ + struct item_string *s1 = (struct item_string *) op1; + struct item_string *s2 = (struct item_string *) op2; + assert (s1->type == ITEM_STRING); + assert (s2->type == ITEM_STRING); + + char *buf = NULL; + size_t len = s1->len + s2->len; + if (len < s1->len || len < s2->len) + goto allocation_fail; + + buf = malloc (len); + if (!buf) + goto allocation_fail; + + memcpy (buf, s1->value, s1->len); + memcpy (buf + s1->len, s2->value, s2->len); + struct item *item = new_string (buf, len); + free (buf); + return push (ctx, item); + +allocation_fail: + ctx->memory_failure = true; + return false; + +} + +defn (fn_plus) +{ + check_stack (2); + struct item *op2 = pop (ctx); + struct item *op1 = pop (ctx); + + bool ok; + if (op1->type == ITEM_INTEGER && op2->type == ITEM_INTEGER) + ok = push (ctx, new_integer (get_integer (op1) + get_integer (op2))); + else if (op1->type == ITEM_INTEGER && op2->type == ITEM_FLOAT) + ok = push (ctx, new_float (get_integer (op1) + get_float (op2))); + else if (op1->type == ITEM_FLOAT && op2->type == ITEM_FLOAT) + ok = push (ctx, new_float (get_float (op1) + get_float (op2))); + else if (op1->type == ITEM_FLOAT && op2->type == ITEM_INTEGER) + ok = push (ctx, new_float (get_float (op1) + get_integer (op2))); + else if (op1->type == ITEM_STRING && op2->type == ITEM_STRING) + ok = push_concatenated_string (ctx, op1, op2); + else + ok = set_error (ctx, "cannot add `%s' and `%s'", + item_type_to_str (op1->type), item_type_to_str (op2->type)); + + item_free (op1); + item_free (op2); + return ok; +} + +defn (fn_minus) +{ + check_stack (2); + struct item *op2 = pop (ctx); + struct item *op1 = pop (ctx); + + bool ok; + if (op1->type == ITEM_INTEGER && op2->type == ITEM_INTEGER) + ok = push (ctx, new_integer (get_integer (op1) - get_integer (op2))); + else if (op1->type == ITEM_INTEGER && op2->type == ITEM_FLOAT) + ok = push (ctx, new_float (get_integer (op1) - get_float (op2))); + else if (op1->type == ITEM_FLOAT && op2->type == ITEM_FLOAT) + ok = push (ctx, new_float (get_float (op1) - get_float (op2))); + else if (op1->type == ITEM_FLOAT && op2->type == ITEM_INTEGER) + ok = push (ctx, new_float (get_float (op1) - get_integer (op2))); + else + ok = set_error (ctx, "cannot subtract `%s' and `%s'", + item_type_to_str (op1->type), item_type_to_str (op2->type)); + + item_free (op1); + item_free (op2); + return ok; +} + +// - - Comparison - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +static int +compare_strings (struct item_string *s1, struct item_string *s2) +{ + // XXX: not entirely correct wrt. null bytes + size_t len = (s1->len < s2->len ? s1->len : s2->len) + 1; + return memcmp (s1->value, s2->value, len); +} + +static bool compare_lists (struct item *, struct item *); + +static bool +compare_list_items (struct item *op1, struct item *op2) +{ + if (op1->type != op2->type) + return false; + + switch (op1->type) + { + case ITEM_STRING: + case ITEM_WORD: + return !compare_strings ((struct item_string *) op1, + (struct item_string *) op2); + case ITEM_FLOAT: + return get_float (op1) == get_float (op2); + case ITEM_INTEGER: + return get_integer (op1) == get_integer (op2); + case ITEM_LIST: + return compare_lists (get_list (op1), get_list (op2)); + } + abort (); +} + +static bool +compare_lists (struct item *op1, struct item *op2) +{ + while (op1 && op2) + { + if (!compare_list_items (op1, op2)) + return false; + + op1 = op1->next; + op2 = op2->next; + } + return !op1 && !op2; +} + +defn (fn_eq) +{ + check_stack (2); + struct item *op2 = pop (ctx); + struct item *op1 = pop (ctx); + + bool ok; + if (op1->type == ITEM_INTEGER && op2->type == ITEM_INTEGER) + ok = push (ctx, new_integer (get_integer (op1) == get_integer (op2))); + else if (op1->type == ITEM_INTEGER && op2->type == ITEM_FLOAT) + ok = push (ctx, new_integer (get_integer (op1) == get_float (op2))); + else if (op1->type == ITEM_FLOAT && op2->type == ITEM_FLOAT) + ok = push (ctx, new_integer (get_float (op1) == get_float (op2))); + else if (op1->type == ITEM_FLOAT && op2->type == ITEM_INTEGER) + ok = push (ctx, new_integer (get_float (op1) == get_integer (op2))); + else if (op1->type == ITEM_LIST && op2->type == ITEM_LIST) + ok = push (ctx, new_integer (compare_lists + (get_list (op1), get_list (op2)))); + else if (op1->type == ITEM_STRING && op2->type == ITEM_STRING) + ok = push (ctx, new_integer (compare_strings + ((struct item_string *)(op1), (struct item_string *)(op2)) == 0)); + else + ok = set_error (ctx, "cannot compare `%s' and `%s'", + item_type_to_str (op1->type), item_type_to_str (op2->type)); + + item_free (op1); + item_free (op2); + return ok; +} + +defn (fn_lt) +{ + check_stack (2); + struct item *op2 = pop (ctx); + struct item *op1 = pop (ctx); + + bool ok; + if (op1->type == ITEM_INTEGER && op2->type == ITEM_INTEGER) + ok = push (ctx, new_integer (get_integer (op1) < get_integer (op2))); + else if (op1->type == ITEM_INTEGER && op2->type == ITEM_FLOAT) + ok = push (ctx, new_integer (get_integer (op1) < get_float (op2))); + else if (op1->type == ITEM_FLOAT && op2->type == ITEM_FLOAT) + ok = push (ctx, new_integer (get_float (op1) < get_float (op2))); + else if (op1->type == ITEM_FLOAT && op2->type == ITEM_INTEGER) + ok = push (ctx, new_integer (get_float (op1) < get_integer (op2))); + else if (op1->type == ITEM_STRING && op2->type == ITEM_STRING) + ok = push (ctx, new_integer (compare_strings + ((struct item_string *)(op1), (struct item_string *)(op2)) < 0)); + else + ok = set_error (ctx, "cannot compare `%s' and `%s'", + item_type_to_str (op1->type), item_type_to_str (op2->type)); + + item_free (op1); + item_free (op2); + return ok; +} + +// - - Utilities - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +defn (fn_rand) +{ + return push (ctx, new_float ((long double) rand () + / ((long double) RAND_MAX + 1))); +} + +defn (fn_time) +{ + return push (ctx, new_integer (time (NULL))); +} + +// XXX: this is a bit too constrained; combines strftime() with gmtime() +defn (fn_strftime) +{ + check_stack (2); + struct item *format = pop (ctx); + struct item *time_ = pop (ctx); + bool success = false; + if (!check_type (ctx, time_, ITEM_INTEGER) + || !check_type (ctx, format, ITEM_STRING)) + goto fail; + + if (get_integer (time_) < 0) + { + set_error (ctx, "invalid time value"); + goto fail; + } + + char buf[128]; + time_t time__ = get_integer (time_); + struct tm tm; + gmtime_r (&time__, &tm); + buf[strftime (buf, sizeof buf, get_string (format), &tm)] = '\0'; + success = push (ctx, new_string (buf, -1)); + +fail: + item_free (time_); + item_free (format); + return success; +} + +// - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +static void item_list_to_str (const struct item *, struct buffer *); + +static void +string_to_str (const struct item_string *string, struct buffer *buf) +{ + buffer_append_c (buf, '"'); + for (size_t i = 0; i < string->len; i++) + { + char c = string->value[i]; + if (c == '\n') buffer_append (buf, "\\n", 2); + else if (c == '\r') buffer_append (buf, "\\r", 2); + else if (c == '\t') buffer_append (buf, "\\t", 2); + else if (!isprint (c)) + { + char tmp[8]; + snprintf (tmp, sizeof tmp, "\\x%02x", (unsigned char) c); + buffer_append (buf, tmp, strlen (tmp)); + } + else if (c == '\\') buffer_append (buf, "\\\\", 2); + else if (c == '"') buffer_append (buf, "\\\"", 2); + else buffer_append_c (buf, c); + } + buffer_append_c (buf, '"'); +} + +static void +item_to_str (const struct item *item, struct buffer *buf) +{ + switch (item->type) + { + char *x; + case ITEM_STRING: + string_to_str ((struct item_string *) item, buf); + break; + case ITEM_WORD: + { + struct item_word *word = (struct item_word *) item; + buffer_append (buf, word->value, word->len); + break; + } + case ITEM_INTEGER: + if (!(x = strdup_printf ("%lld", get_integer (item)))) + goto alloc_failure; + buffer_append (buf, x, strlen (x)); + free (x); + break; + case ITEM_FLOAT: + if (!(x = strdup_printf ("%Lf", get_float (item)))) + goto alloc_failure; + buffer_append (buf, x, strlen (x)); + free (x); + break; + case ITEM_LIST: + buffer_append_c (buf, '['); + item_list_to_str (get_list (item), buf); + buffer_append_c (buf, ']'); + break; + } + return; + +alloc_failure: + // This is a bit hackish but it simplifies stuff + buf->memory_failure = true; + free (buf->s); + buf->s = NULL; +} + +static void +item_list_to_str (const struct item *script, struct buffer *buf) +{ + if (!script) + return; + + item_to_str (script, buf); + while ((script = script->next)) + { + buffer_append_c (buf, ' '); + item_to_str (script, buf); + } +} + +// --- IRC protocol ------------------------------------------------------------ + +struct message +{ + char *prefix; ///< Message prefix + char *command; ///< IRC command + char *params[16]; ///< Command parameters (0-terminated) + size_t n_params; ///< Number of parameters present +}; + +inline static char * +cut_word (char **s) +{ + char *start = *s, *end = *s + strcspn (*s, " "); + *s = end + strspn (end, " "); + *end = '\0'; + return start; +} + +static bool +parse_message (char *s, struct message *msg) +{ + memset (msg, 0, sizeof *msg); + + // Ignore IRC 3.2 message tags, if present + if (*s == '@') + { + s += strcspn (s, " "); + s += strspn (s, " "); + } + + // Prefix + if (*s == ':') + msg->prefix = cut_word (&s) + 1; + + // Command + if (!*(msg->command = cut_word (&s))) + return false; + + // Parameters + while (*s) + { + size_t n = msg->n_params++; + if (msg->n_params >= N_ELEMENTS (msg->params)) + return false; + if (*s == ':') + { + msg->params[n] = ++s; + break; + } + msg->params[n] = cut_word (&s); + } + return true; +} + +static struct message * +read_message (void) +{ + static bool discard = false; + static char buf[1025]; + static struct message msg; + + bool discard_this; + do + { + if (!fgets (buf, sizeof buf, stdin)) + return NULL; + size_t len = strlen (buf); + + // Just to be on the safe side, if the line overflows our buffer, + // ignore everything up until the next line. + discard_this = discard; + if (len >= 2 && !strcmp (buf + len - 2, "\r\n")) + { + buf[len -= 2] = '\0'; + discard = false; + } + else + discard = true; + } + // Invalid messages are silently ignored + while (discard_this || !parse_message (buf, &msg)); + return &msg; +} + +// --- Interfacing with the bot ------------------------------------------------ + +#define BOT_PRINT "ZYKLONB print :script: " + +static const char * +get_config (const char *key) +{ + printf ("ZYKLONB get_config :%s\r\n", key); + struct message *msg = read_message (); + if (!msg || msg->n_params <= 0) + exit (EXIT_FAILURE); + return msg->params[0]; +} + +// - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +// TODO: implement more functions; try to avoid writing them in C + +static bool +init_runtime_library_scripts (void) +{ + bool ok = true; + + // It's much cheaper (and more fun) to define functions in terms of other + // ones. The "unit tests" serve a secondary purpose of showing the usage. + struct script + { + const char *name; ///< Name of the function + const char *definition; ///< The defining script + const char *unit_test; ///< Trivial unit test, must return 1 + } + scripts[] = + { + { "nip", "swap drop", "1 2 nip 2 =" }, + { "over", "[dup] dip swap", "1 2 over nip nip 1 =" }, + { "swons", "swap cons", "[2] 1 swons [1 2] =" }, + { "first", "uncons drop", "[1 2 3] first 1 =" }, + { "rest", "uncons swap drop", "[1 2 3] rest [2 3] =" }, + { "reverse", "[] swap [swap cons] each", "[1 2] reverse [2 1] =" }, + { "curry", "cons", "1 2 [+] curry call 3 =" }, + + { "xor", "not swap not + 1 =", "1 1 xor 0 =" }, + { "min", "over over < [drop] [nip] if", "1 2 min 1 =" }, + { "max", "over over > [drop] [nip] if", "1 2 max 2 =" }, + + { "all?", "[and] cat 1 swap fold", "[3 4 5] [> 3] all? 0 =" }, + { "any?", "[or] cat 0 swap fold", "[3 4 5] [> 3] any? 1 =" }, + + { ">", "swap <", "1 2 > 0 =" }, + { "!=", "= not", "1 2 != 1 =" }, + { "<=", "> not", "1 2 <= 1 =" }, + { ">=", "< not", "1 2 >= 0 =" }, + + // XXX: this is a bit crazy and does not work with an empty list + { "join", "[uncons] dip swap [[dup] dip swap [+ +] dip] each drop", + "[1 2 3] [>string] map \" -> \" join \"1 -> 2 -> 3\" =" }, + }; + + for (size_t i = 0; i < N_ELEMENTS (scripts); i++) + { + const char *error = NULL; + struct item *script = parse (scripts[i].definition, &error); + if (error) + { + printf (BOT_PRINT "error parsing internal script `%s': %s\r\n", + scripts[i].definition, error); + ok = false; + } + else + ok &= register_script (scripts[i].name, script); + } + + struct context ctx; + for (size_t i = 0; i < N_ELEMENTS (scripts); i++) + { + const char *error = NULL; + struct item *script = parse (scripts[i].unit_test, &error); + if (error) + { + printf (BOT_PRINT "error parsing unit test for `%s': %s\r\n", + scripts[i].name, error); + ok = false; + continue; + } + context_init (&ctx); + execute (&ctx, script); + item_free_list (script); + + const char *failure = NULL; + if (ctx.memory_failure) + failure = "memory allocation failure"; + else if (ctx.error) + failure = ctx.error; + else if (ctx.stack_size != 1) + failure = "too many results on the stack"; + else if (ctx.stack->type != ITEM_INTEGER) + failure = "result is not an integer"; + else if (get_integer (ctx.stack) != 1) + failure = "wrong test result"; + if (failure) + { + printf (BOT_PRINT "error executing unit test for `%s': %s\r\n", + scripts[i].name, failure); + ok = false; + } + context_free (&ctx); + } + return ok; +} + +static bool +init_runtime_library (void) +{ + bool ok = true; + + // Type detection + ok &= register_handler ("string?", fn_is_string); + ok &= register_handler ("word?", fn_is_word); + ok &= register_handler ("integer?", fn_is_integer); + ok &= register_handler ("float?", fn_is_float); + ok &= register_handler ("list?", fn_is_list); + + // Type conversion + ok &= register_handler (">string", fn_to_string); + ok &= register_handler (">integer", fn_to_integer); + ok &= register_handler (">float", fn_to_float); + + // Miscellaneous + ok &= register_handler ("length", fn_length); + + // Basic stack manipulation + ok &= register_handler ("dup", fn_dup); + ok &= register_handler ("drop", fn_drop); + ok &= register_handler ("swap", fn_swap); + + // Calling stuff + ok &= register_handler ("call", fn_call); + ok &= register_handler ("dip", fn_dip); + + // Control flow + ok &= register_handler ("if", fn_if); + ok &= register_handler ("try", fn_try); + + // List processing + ok &= register_handler ("map", fn_map); + ok &= register_handler ("filter", fn_filter); + ok &= register_handler ("fold", fn_fold); + ok &= register_handler ("each", fn_each); + + // List manipulation + ok &= register_handler ("unit", fn_unit); + ok &= register_handler ("cons", fn_cons); + ok &= register_handler ("cat", fn_cat); + ok &= register_handler ("uncons", fn_uncons); + + // Arithmetic operations + ok &= register_handler ("+", fn_plus); + ok &= register_handler ("-", fn_minus); + ok &= register_handler ("*", fn_times); + ok &= register_handler ("^", fn_pow); + ok &= register_handler ("/", fn_div); + ok &= register_handler ("%", fn_mod); + + // Comparison + ok &= register_handler ("=", fn_eq); + ok &= register_handler ("<", fn_lt); + + // Logical operations + ok &= register_handler ("not", fn_not); + ok &= register_handler ("and", fn_and); + ok &= register_handler ("or", fn_or); + + // Utilities + ok &= register_handler ("rand", fn_rand); + ok &= register_handler ("time", fn_time); + ok &= register_handler ("strftime", fn_strftime); + + ok &= init_runtime_library_scripts (); + return ok; +} + +static void +free_runtime_library (void) +{ + struct fn *next, *iter; + for (iter = g_functions; iter; iter = next) + { + next = iter->next; + free_function (iter); + } +} + +// --- Function database ------------------------------------------------------- + +// TODO: a global variable storing the various procedures (db) +// XXX: defining procedures would ideally need some kind of an ACL + +static void +read_db (void) +{ + // TODO +} + +static void +write_db (void) +{ + // TODO +} + +// --- Main -------------------------------------------------------------------- + +static char *g_prefix; + +struct user_info +{ + char *ctx; ///< Context: channel or user + char *ctx_quote; ///< Reply quotation +}; + +defn (fn_dot) +{ + check_stack (1); + struct item *item = pop (ctx); + struct user_info *info = ctx->user_data; + + struct buffer buf = BUFFER_INITIALIZER; + item_to_str (item, &buf); + item_free (item); + buffer_append_c (&buf, '\0'); + if (buf.memory_failure) + { + ctx->memory_failure = true; + return false; + } + + if (buf.len > 255) + buf.s[255] = '\0'; + + printf ("PRIVMSG %s :%s%s\r\n", info->ctx, info->ctx_quote, buf.s); + free (buf.s); + return true; +} + +static void +process_message (struct message *msg) +{ + if (!msg->prefix + || strcasecmp (msg->command, "PRIVMSG") + || msg->n_params < 2) + return; + char *line = msg->params[1]; + + // Filter out only our commands + size_t prefix_len = strlen (g_prefix); + if (strncmp (line, g_prefix, prefix_len)) + return; + line += prefix_len; + + char *command = cut_word (&line); + if (strcasecmp (command, "script")) + return; + + // Retrieve information on how to respond back + char *msg_ctx = msg->prefix, *x; + if ((x = strchr (msg_ctx, '!'))) + *x = '\0'; + + char *msg_ctx_quote; + if (strchr ("#+&!", *msg->params[0])) + { + msg_ctx_quote = strdup_printf ("%s: ", msg_ctx); + msg_ctx = msg->params[0]; + } + else + msg_ctx_quote = strdup (""); + + if (!msg_ctx_quote) + { + printf (BOT_PRINT "%s\r\n", "memory allocation failure"); + return; + } + + struct user_info info; + info.ctx = msg_ctx; + info.ctx_quote = msg_ctx_quote; + + // Finally parse and execute the macro + const char *error = NULL; + struct item *script = parse (line, &error); + if (error) + { + printf ("PRIVMSG %s :%s%s: %s\r\n", + msg_ctx, msg_ctx_quote, "parse error", error); + goto end; + } + + struct context ctx; + context_init (&ctx); + ctx.user_data = &info; + execute (&ctx, script); + item_free_list (script); + + const char *failure = NULL; + if (ctx.memory_failure) + failure = "memory allocation failure"; + else if (ctx.error) + failure = ctx.error; + if (failure) + printf ("PRIVMSG %s :%s%s: %s\r\n", + msg_ctx, msg_ctx_quote, "runtime error", failure); + context_free (&ctx); +end: + free (msg_ctx_quote); +} + +int +main (int argc, char *argv[]) +{ + freopen (NULL, "rb", stdin); setvbuf (stdin, NULL, _IOLBF, BUFSIZ); + freopen (NULL, "wb", stdout); setvbuf (stdout, NULL, _IOLBF, BUFSIZ); + + struct rlimit limit = + { + .rlim_cur = ADDRESS_SPACE_LIMIT, + .rlim_max = ADDRESS_SPACE_LIMIT + }; + + // Lower the memory limits to something sensible to prevent abuse + (void) setrlimit (RLIMIT_AS, &limit); + + read_db (); + if (!init_runtime_library () + || !register_handler (".", fn_dot)) + printf (BOT_PRINT "%s\r\n", "runtime library initialization failed"); + + g_prefix = strdup (get_config ("prefix")); + printf ("ZYKLONB register\r\n"); + struct message *msg; + while ((msg = read_message ())) + process_message (msg); + + free_runtime_library (); + free (g_prefix); + return 0; +} + diff --git a/plugins/xB/seen b/plugins/xB/seen new file mode 100755 index 0000000..da20972 --- /dev/null +++ b/plugins/xB/seen @@ -0,0 +1,160 @@ +#!/usr/bin/env lua +-- +-- xB seen plugin +-- +-- Copyright 2016 Přemysl Eric Janouch +-- 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: ") + 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..0bf0c1e --- /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 +# 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 () diff --git a/plugins/xC/auto-rejoin.lua b/plugins/xC/auto-rejoin.lua new file mode 100644 index 0000000..f42fb2e --- /dev/null +++ b/plugins/xC/auto-rejoin.lua @@ -0,0 +1,48 @@ +-- +-- auto-rejoin.lua: join back automatically when someone kicks you +-- +-- Copyright (c) 2016, Přemysl Eric Janouch +-- +-- Permission to use, copy, modify, and/or distribute this software for any +-- purpose with or without fee is hereby granted. +-- +-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES +-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF +-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY +-- SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES +-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION +-- OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN +-- CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. +-- + +local timeout +xC.setup_config { + timeout = { + type = "integer", + comment = "auto rejoin timeout", + default = "0", + + on_change = function (v) + timeout = v + end, + validate = function (v) + if v < 0 then error ("timeout must not be negative", 0) end + end, + }, +} + +async, await = xC.async, coroutine.yield +xC.hook_irc (function (hook, server, line) + local msg = xC.parse (line) + if msg.command ~= "KICK" then return line end + + local who = msg.prefix:match ("^[^!]*") + local channel, whom = table.unpack (msg.params) + if who ~= whom and whom == server.user.nickname then + async.go (function () + await (async.timer_ms (timeout * 1000)) + server:send ("JOIN " .. channel) + end) + end + return line +end) diff --git a/plugins/xC/censor.lua b/plugins/xC/censor.lua new file mode 100644 index 0000000..49cab5b --- /dev/null +++ b/plugins/xC/censor.lua @@ -0,0 +1,90 @@ +-- +-- censor.lua: black out certain users' messages +-- +-- Copyright (c) 2016 - 2021, Přemysl Eric Janouch +-- +-- Permission to use, copy, modify, and/or distribute this software for any +-- purpose with or without fee is hereby granted. +-- +-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES +-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF +-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY +-- SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES +-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION +-- OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN +-- CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. +-- + +local to_pattern = function (mask) + if not mask:match ("!") then mask = mask .. "!*" end + if not mask:match ("@") then mask = mask .. "@*" end + + -- That is, * acts like a wildcard, otherwise everything is escaped + return "^" .. mask:gsub ("[%^%$%(%)%%%.%[%]%+%-%?]", "%%%0") + :gsub ("%*", ".*") .. "$" +end + +local patterns = {} +local read_masks = function (v) + patterns = {} + local add = function (who, where) + local channels = patterns[who] or {} + table.insert (channels, where) + patterns[who] = channels + end + for item in v:lower ():gmatch ("[^,]+") do + local who, where = item:match ("^([^/]+)/*(.*)") + if who then add (to_pattern (who), where == "" or where) end + end +end + +local quote +xC.setup_config { + masks = { + type = "string_array", + default = "\"\"", + comment = "user masks (optionally \"/#channel\") to censor", + on_change = read_masks + }, + quote = { + type = "string", + default = "\"\\x0301,01\"", + comment = "formatting prefix for censored messages", + on_change = function (v) quote = v end + }, +} + +local decolor = function (text) + local rebuilt, last = {""}, 1 + for start in text:gmatch ('()\x03') do + table.insert (rebuilt, text:sub (last, start - 1)) + local sub = text:sub (start + 1) + last = start + (sub:match ('^%d%d?,%d%d?()') or sub:match ('^%d?%d?()')) + end + return table.concat (rebuilt) .. text:sub (last) +end + +local censor = function (line) + -- Taking a shortcut to avoid lengthy message reassembly + local start, text = line:match ("^(.- PRIVMSG .- :)(.*)$") + local ctcp, rest = text:match ("^(\x01%g+ )(.*)") + text = ctcp and ctcp .. quote .. decolor (rest) or quote .. decolor (text) + return start .. text +end + +xC.hook_irc (function (hook, server, line) + local msg = xC.parse (line) + if msg.command ~= "PRIVMSG" then return line end + + local channel = msg.params[1]:lower () + for who, where in pairs (patterns) do + if msg.prefix:lower ():match (who) then + for _, x in pairs (where) do + if x == true or x == channel then + return censor (line) + end + end + end + end + return line +end) diff --git a/plugins/xC/fancy-prompt.lua b/plugins/xC/fancy-prompt.lua new file mode 100644 index 0000000..8ec697a --- /dev/null +++ b/plugins/xC/fancy-prompt.lua @@ -0,0 +1,105 @@ +-- +-- fancy-prompt.lua: the fancy multiline prompt you probably want +-- +-- Copyright (c) 2016, Přemysl Eric Janouch +-- +-- Permission to use, copy, modify, and/or distribute this software for any +-- purpose with or without fee is hereby granted. +-- +-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES +-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF +-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY +-- SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES +-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION +-- OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN +-- CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. +-- +-- Beware that it is a hack and only goes about 90% of the way, which is why +-- this functionality is only available as a plugin in the first place +-- (well, and also for customizability). +-- +-- The biggest problem is that the way we work with Readline is incompatible +-- with multiline prompts, and normal newlines just don't work. This is being +-- circumvented by using an overflowing single-line prompt with a specially +-- crafted character in the rightmost column that prevents the bar's background +-- from spilling all over the last line. +-- +-- There is also a problem with C-r search rendering not clearing out the +-- background but to really fix that mode, we'd have to fully reimplement it +-- since its alternative prompt very often gets overriden by accident anyway. + +xC.hook_prompt (function (hook) + local current = xC.current_buffer + local chan = current.channel + local s = current.server + + local bg_color = "255" + local current_n = 0 + local active = "" + for i, buffer in ipairs (xC.buffers) do + if buffer == current then + current_n = i + elseif buffer.new_messages_count ~= buffer.new_unimportant_count then + if active ~= "" then active = active .. "," end + if buffer.highlighted then + active = active .. "!" + bg_color = "224" + end + active = active .. i + end + end + if active ~= "" then active = "(" .. active .. ")" end + local x = current_n .. ":" .. current.name + if chan and chan.users_len ~= 0 then + local params = "" + for mode, param in pairs (chan.param_modes) do + params = params .. " +" .. mode .. " " .. param + end + local modes = chan.no_param_modes .. params:sub (3) + if modes ~= "" then x = x .. "(+" .. modes .. ")" end + x = x .. "{" .. chan.users_len .. "}" + end + if current.hide_unimportant then x = x .. "" end + + local lines, cols = xC.get_screen_size () + x = x .. " " .. active .. string.rep (" ", cols) + + -- Readline 7.0.003 seems to be broken and completely corrupts the prompt. + -- However 8.0.004 seems to be fine with these, as is libedit 20191231-3.1. + --x = x:gsub("[\128-\255]", "?") + + -- Cut off extra characters and apply formatting, including the hack. + -- FIXME: this doesn't count with full-width or zero-width characters. + -- We might want to export wcwidth() above term_from_utf8 somehow. + local overflow = utf8.offset (x, cols - 1) + if overflow then x = x:sub (1, overflow) end + x = "\x01\x1b[0;4;1;38;5;16m\x1b[48;5;" .. bg_color .. "m\x02" .. + x .. "\x01\x1b[0;4;1;7;38;5;" .. bg_color .. "m\x02 \x01\x1b[0;1m\x02" + + local user_prefix = function (chan, user) + for i, chan_user in ipairs (chan.users) do + if chan_user.user == user then return chan_user.prefixes end + end + return "" + end + if s then + x = x .. "[" + local state = s.state + if state == "disconnected" or state == "connecting" then + x = x .. "(" .. state .. ")" + elseif state ~= "registered" then + x = x .. "(unregistered)" + else + local user, modes = s.user, s.user_mode + if chan then x = x .. user_prefix (chan, user) end + x = x .. user.nickname + if modes ~= "" then x = x .. "(" .. modes .. ")" end + end + x = x .. "] " + else + -- There needs to be at least one character so that the cursor + -- doesn't get damaged by our hack in that last column + x = x .. "> " + end + return x +end) diff --git a/plugins/xC/last-fm.lua b/plugins/xC/last-fm.lua new file mode 100644 index 0000000..3bdfed2 --- /dev/null +++ b/plugins/xC/last-fm.lua @@ -0,0 +1,178 @@ +-- +-- last-fm.lua: "now playing" feature using the last.fm API +-- +-- Dependencies: lua-cjson (from luarocks e.g.) +-- +-- I call this style closure-oriented programming +-- +-- Copyright (c) 2016, Přemysl Eric Janouch +-- +-- Permission to use, copy, modify, and/or distribute this software for any +-- purpose with or without fee is hereby granted. +-- +-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES +-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF +-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY +-- SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES +-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION +-- OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN +-- CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. +-- + +local cjson = require "cjson" + +-- Setup configuration to load last.fm API credentials from +local user, api_key +xC.setup_config { + user = { + type = "string", + comment = "last.fm username", + on_change = function (v) user = v end + }, + api_key = { + type = "string", + comment = "last.fm API key", + on_change = function (v) api_key = v end + }, +} + +-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +-- Generic error reporting +local report_error = function (buffer, error) + buffer:log ("last-fm error: " .. error) +end + +-- Process data return by the server and extract the now playing song +local process = function (buffer, data, action) + -- There's no reasonable Lua package to parse HTTP that I could find + local s, e, v, status, message = string.find (data, "(%S+) (%S+) .+\r\n") + if not s then return "server returned unexpected data" end + if status ~= "200" then return status .. " " .. message end + + local s, e = string.find (data, "\r\n\r\n") + if not s then return "server returned unexpected data" end + + local parser = cjson.new () + data = parser.decode (string.sub (data, e + 1)) + if not data.recenttracks or not data.recenttracks.track then + return "invalid response" end + + -- Need to make some sense of the XML automatically converted to JSON + local text_of = function (node) + if type (node) ~= "table" then return node end + return node["#text"] ~= "" and node["#text"] or nil + end + + local name, artist, album + for i, track in ipairs (data.recenttracks.track) do + if track["@attr"] and track["@attr"].nowplaying then + if track.name then name = text_of (track.name) end + if track.artist then artist = text_of (track.artist) end + if track.album then album = text_of (track.album) end + end + end + + if not name then + action (false) + else + local np = "\"" .. name .. "\"" + if artist then np = np .. " by " .. artist end + if album then np = np .. " from " .. album end + action (np) + end +end + +-- Set up the connection and make the request +local on_connected = function (buffer, c, host, action) + -- Buffer data in the connection object + c.data = "" + c.on_data = function (data) + c.data = c.data .. data + end + + -- And process it after we receive everything + c.on_eof = function () + error = process (buffer, c.data, action) + if error then report_error (buffer, error) end + c:close () + end + c.on_error = function (e) + report_error (buffer, e) + end + + -- Make the unencrypted HTTP request + local url = "/2.0/?method=user.getrecenttracks&user=" .. user .. + "&limit=1&api_key=" .. api_key .. "&format=json" + c:send ("GET " .. url .. " HTTP/1.1\r\n") + c:send ("User-agent: last-fm.lua\r\n") + c:send ("Host: " .. host .. "\r\n") + c:send ("Connection: close\r\n") + c:send ("\r\n") +end + +-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +-- Avoid establishing more than one connection at a time +local running + +-- Initiate a connection to last.fm servers +async, await = xC.async, coroutine.yield +local make_request = function (buffer, action) + if not user or not api_key then + report_error (buffer, "configuration is incomplete") + return + end + + if running then running:cancel () end + running = async.go (function () + local c, host, e = await (async.dial ("ws.audioscrobbler.com", 80)) + if e then + report_error (buffer, e) + else + on_connected (buffer, c, host, action) + end + running = nil + end) +end + +-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +local now_playing + +local tell_song = function (buffer) + if now_playing == nil then + buffer:log ("last-fm: I don't know what you're listening to") + elseif not now_playing then + buffer:log ("last-fm: not playing anything right now") + else + buffer:log ("last-fm: now playing: " .. now_playing) + end +end + +local send_song = function (buffer) + if not now_playing then + tell_song (buffer) + else + buffer:execute ("/me is listening to " .. now_playing) + end +end + +-- Hook input to simulate new commands +xC.hook_input (function (hook, buffer, input) + if input == "/np" then + make_request (buffer, function (np) + now_playing = np + send_song (buffer) + end) + elseif input == "/np?" then + make_request (buffer, function (np) + now_playing = np + tell_song (buffer) + end) + elseif input == "/np!" then + send_song (buffer) + else + return input + end +end) diff --git a/plugins/xC/ping-timeout.lua b/plugins/xC/ping-timeout.lua new file mode 100644 index 0000000..c455c57 --- /dev/null +++ b/plugins/xC/ping-timeout.lua @@ -0,0 +1,32 @@ +-- +-- ping-timeout.lua: ping timeout readability enhancement plugin +-- +-- Copyright (c) 2015 - 2016, Přemysl Eric Janouch +-- +-- Permission to use, copy, modify, and/or distribute this software for any +-- purpose with or without fee is hereby granted. +-- +-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES +-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF +-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY +-- SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES +-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION +-- OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN +-- CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. +-- + +xC.hook_irc (function (hook, server, line) + local msg = xC.parse (line) + local start, timeout = line:match ("^(.* :Ping timeout:) (%d+) seconds$") + if msg.command ~= "QUIT" or not start then + return line + end + + local minutes = timeout // 60 + if minutes == 0 then + return line + end + + local seconds = timeout % 60 + return ("%s %d minutes, %d seconds"):format (start, minutes, seconds) +end) diff --git a/plugins/xC/prime.lua b/plugins/xC/prime.lua new file mode 100644 index 0000000..23740ee --- /dev/null +++ b/plugins/xC/prime.lua @@ -0,0 +1,68 @@ +-- +-- prime.lua: highlight prime numbers in messages +-- +-- Copyright (c) 2020, Přemysl Eric Janouch +-- +-- Permission to use, copy, modify, and/or distribute this software for any +-- purpose with or without fee is hereby granted. +-- +-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES +-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF +-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY +-- SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES +-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION +-- OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN +-- CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. +-- + +local smallest, highlight = 0, "\x1f" +xC.setup_config { + smallest = { + type = "integer", + default = "0", + comment = "smallest number to scan for primality", + on_change = function (v) smallest = math.max (v, 2) end + }, + highlight = { + type = "string", + default = "\"\\x1f\"", + comment = "the attribute to use for highlights", + on_change = function (v) highlight = v end + }, +} + +-- The prime test is actually very fast, so there is no DoS concern +local do_intercolour = function (text) + return tostring (text:gsub ("%f[%w_]%d+", function (n) + if tonumber (n) < smallest then return nil end + for i = 2, n ^ (1 / 2) do if (n % i) == 0 then return nil end end + return highlight .. n .. highlight + end)) +end + +local do_interlink = function (text) + local rebuilt, last = {""}, 1 + for start in text:gmatch ('()\x03') do + table.insert (rebuilt, do_intercolour (text:sub (last, start - 1))) + local sub = text:sub (start + 1) + last = start + (sub:match ('^%d%d?,%d%d?()') or sub:match ('^%d?%d?()')) + table.insert (rebuilt, text:sub (start, last - 1)) + end + return table.concat (rebuilt) .. do_intercolour (text:sub (last)) +end + +local do_message = function (text) + local rebuilt, last = {""}, 1 + for run, link, endpos in text:gmatch ('(.-)(%f[%g]https?://%g+)()') do + last = endpos + table.insert (rebuilt, do_interlink (run) .. link) + end + return table.concat (rebuilt) .. do_interlink (text:sub (last)) +end + +-- XXX: sadly it won't typically highlight primes in our own messages, +-- unless IRCv3 echo-message is on +xC.hook_irc (function (hook, server, line) + local start, message = line:match ("^(.- PRIVMSG .- :)(.*)$") + return message and start .. do_message (message) or line +end) diff --git a/plugins/xC/slack.lua b/plugins/xC/slack.lua new file mode 100644 index 0000000..c1a08de --- /dev/null +++ b/plugins/xC/slack.lua @@ -0,0 +1,147 @@ +-- +-- slack.lua: try to fix up UX when using the Slack IRC gateway +-- +-- Copyright (c) 2017, Přemysl Eric Janouch +-- +-- Permission to use, copy, modify, and/or distribute this software for any +-- purpose with or without fee is hereby granted. +-- +-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES +-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF +-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY +-- SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES +-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION +-- OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN +-- CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. +-- + +local servers = {} +local read_servers = function (v) + servers = {} + for name in v:lower ():gmatch "[^,]+" do + servers[name] = true + end +end + +-- This is a reverse list of Slack's automatic emoji, noseless forms +local unemojify, emoji, emoji_default = false, {}, { + heart = "<3", + broken_heart = "", + neutral_face = ":|", + open_mouth = ":o", + angry = ">:(", + slightly_smiling_face = ":)", + disappointed = ":(", + confused = ":/", + stuck_out_tongue = ":p", + stuck_out_tongue_winking_eye = ";p", +} +local load_emoji = function (extra) + emoji = {} + for k, v in pairs (emoji_default) do emoji[k] = v end + for k, v in extra:gmatch "([^,]+) ([^,]+)" do emoji[k] = v end +end + +xC.setup_config { + servers = { + type = "string_array", + default = "\"\"", + comment = "list of server names that are Slack IRC gateways", + on_change = read_servers + }, + unemojify = { + type = "boolean", + default = "true", + comment = "convert emoji to normal ASCII emoticons", + on_change = function (v) unemojify = v end + }, + extra_emoji = { + type = "string_array", + default = "\"grinning :)),joy :'),innocent o:),persevere >_<\"", + comment = "overrides or extra emoji for unemojify", + on_change = function (v) load_emoji (v) end + } +} + +-- We can handle external messages about what we've supposedly sent just fine, +-- so let's get rid of that "[username] some message sent from the web UI" crap +xC.hook_irc (function (hook, server, line) + local msg, us = xC.parse (line), server.user + if not servers[server.name] or msg.command ~= "PRIVMSG" or not us + or msg.params[1]:lower () ~= us.nickname:lower () then return line end + + -- Taking a shortcut to avoid lengthy message reassembly + local quoted_nick = us.nickname:gsub ("[%^%$%(%)%%%.%[%]%*%+%-%?]", "%%%0") + local text = line:match ("^.- PRIVMSG .- :%[" .. quoted_nick .. "%] (.*)$") + if not text then return line end + return ":" .. us.nickname .. "!" .. server.irc_user_host .. " PRIVMSG " + .. msg.prefix:match "^[^!@]*" .. " :" .. text +end) + +-- Unfuck emoji and :nick!nick@irc.tinyspeck.com MODE #channel +v nick : active +xC.hook_irc (function (hook, server, line) + if not servers[server.name] then return line end + if unemojify then + local start, text = line:match ("^(.- PRIVMSG .- :)(.*)$") + if start then return start .. text:gsub (":([a-z_]+):", function (name) + if emoji[name] then return emoji[name] end + return ":" .. name .. ":" + end) end + end + return line:gsub ("^(:%S+ MODE .+) : .*", "%1") +end) + +-- The gateway simply ignores the NAMES command altogether +xC.hook_input (function (hook, buffer, input) + if not buffer.channel or not servers[buffer.server.name] + or not input:match "^/names%s*$" then return input end + + local users = buffer.channel.users + table.sort (users, function (a, b) + if a.prefixes > b.prefixes then return true end + if a.prefixes < b.prefixes then return false end + return a.user.nickname < b.user.nickname + end) + + local names = "Users on " .. buffer.channel.name .. ":" + for i, chan_user in ipairs (users) do + names = names .. " " .. chan_user.prefixes .. chan_user.user.nickname + end + buffer:log (names) +end) + +xC.hook_completion (function (hook, data, word) + local chan = xC.current_buffer.channel + local server = xC.current_buffer.server + if not chan or not servers[server.name] then return end + + -- In /commands there is typically no desire at all to add the at sign + if data.location == 1 and data.words[1]:match "^/" then return end + + -- Handle both when the at sign is already there and when it is not + local needle = word:gsub ("^@", ""):lower () + + local t = {} + local try = function (name) + if data.location == 0 then name = name .. ":" end + if name:sub (1, #needle):lower () == needle then + table.insert (t, "@" .. name) + end + end + for _, chan_user in ipairs (chan.users) do + try (chan_user.user.nickname) + end + for _, special in ipairs { "channel", "here" } do + try (special) + end + return t +end) diff --git a/plugins/xC/thin-cursor.lua b/plugins/xC/thin-cursor.lua new file mode 100644 index 0000000..d0fbf38 --- /dev/null +++ b/plugins/xC/thin-cursor.lua @@ -0,0 +1,27 @@ +-- +-- thin-cursor.lua: set a thin cursor +-- +-- Copyright (c) 2016, Přemysl Eric Janouch +-- +-- Permission to use, copy, modify, and/or distribute this software for any +-- purpose with or without fee is hereby granted. +-- +-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES +-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF +-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY +-- SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES +-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION +-- OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN +-- CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. +-- +-- If tmux doesn't work, add the following to its configuration: +-- set -as terminal-overrides ',*:Ss=\E[%p1%d q:Se=\E[2 q' +-- Change the "2" as per http://invisible-island.net/xterm/ctlseqs/ctlseqs.html + +local out = io.output () +out:write ("\x1b[6 q"):flush () + +-- By registering a global variable, we get notified about plugin unload +x = setmetatable ({}, { __gc = function () + out:write ("\x1b[2 q"):flush () +end }) diff --git a/plugins/xC/utm-filter.lua b/plugins/xC/utm-filter.lua new file mode 100644 index 0000000..82c4522 --- /dev/null +++ b/plugins/xC/utm-filter.lua @@ -0,0 +1,62 @@ +-- +-- utm-filter.lua: filter out Google Analytics bullshit from URLs +-- +-- Copyright (c) 2015, Přemysl Eric Janouch +-- +-- Permission to use, copy, modify, and/or distribute this software for any +-- purpose with or without fee is hereby granted. +-- +-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES +-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF +-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY +-- SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES +-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION +-- OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN +-- CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. +-- + +-- A list of useless URL parameters that don't affect page function +local banned = { + gclid = 1, + + utm_source = 1, + utm_medium = 1, + utm_term = 1, + utm_content = 1, + utm_campaign = 1, +} + +-- Go through a parameter list and throw out any banned elements +local do_args = function (args) + local filtered = {} + for part in args:gmatch ("[^&]+") do + if not banned[part:match ("^[^=]*")] then + table.insert (filtered, part) + end + end + return table.concat (filtered, "&") +end + +-- Filter parameters in both the query and the fragment part of an URL +local do_single_url = function (url) + return url:gsub ('^([^?#]*)%?([^#]*)', function (start, query) + local clean = do_args (query) + return #clean > 0 and start .. "?" .. clean or start + end, 1):gsub ('^([^#]*)#(.*)', function (start, fragment) + local clean = do_args (fragment) + return #clean > 0 and start .. "#" .. clean or start + end, 1) +end + +local do_text = function (text) + return text:gsub ('%f[%g]https?://%g+', do_single_url) +end + +xC.hook_irc (function (hook, server, line) + local start, message = line:match ("^(.* :)(.*)$") + return message and start .. do_text (message) or line +end) + +xC.hook_input (function (hook, buffer, input) + return do_text (input) +end) diff --git a/plugins/zyklonb/calc b/plugins/zyklonb/calc deleted file mode 100755 index 8e36357..0000000 --- a/plugins/zyklonb/calc +++ /dev/null @@ -1,241 +0,0 @@ -#!/usr/bin/env guile - - ZyklonB 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->integer integer->char - ; Strings; XXX - omitted make-string - can cause OOM - 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-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>=? - 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))) diff --git a/plugins/zyklonb/coin b/plugins/zyklonb/coin deleted file mode 100755 index 7dfe923..0000000 --- a/plugins/zyklonb/coin +++ /dev/null @@ -1,128 +0,0 @@ -#!/usr/bin/env tclsh -# -# ZyklonB 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())}]]. - } - } -} - diff --git a/plugins/zyklonb/eval b/plugins/zyklonb/eval deleted file mode 100755 index ccc7f0a..0000000 --- a/plugins/zyklonb/eval +++ /dev/null @@ -1,312 +0,0 @@ -#!/usr/bin/awk -f -# -# ZyklonB 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; - } - } -} - diff --git a/plugins/zyklonb/factoids b/plugins/zyklonb/factoids deleted file mode 100755 index 431600c..0000000 --- a/plugins/zyklonb/factoids +++ /dev/null @@ -1,177 +0,0 @@ -#!/usr/bin/env perl -# -# ZyklonB factoids plugin -# -# Copyright 2016 Přemysl Eric Janouch -# 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 )->{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: = ") - 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: ") - 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: []") - 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 = ) { - 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/zyklonb/pomodoro b/plugins/zyklonb/pomodoro deleted file mode 100755 index 2bb6531..0000000 --- a/plugins/zyklonb/pomodoro +++ /dev/null @@ -1,502 +0,0 @@ -#!/usr/bin/env ruby -# coding: utf-8 -# -# ZyklonB 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 | 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 " - 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/zyklonb/script b/plugins/zyklonb/script deleted file mode 100755 index c19b8c5..0000000 --- a/plugins/zyklonb/script +++ /dev/null @@ -1,2310 +0,0 @@ -#!/usr/bin/tcc -run -lm -// -// ZyklonB scripting plugin, using a custom stack-based language -// -// Copyright 2014 Přemysl Eric Janouch -// See the file LICENSE for licensing information. -// -// Just compile this file as usual (sans #!) if you don't feel like using TCC. -// It is a very basic and portable C99 application. It's not supposed to be -// very sophisticated, for it'd get extremely big. -// -// The main influences of the language were Factor and Joy, stripped of all -// even barely complex stuff. In its current state, it's only really useful as -// a calculator but it's got great potential for extending. -// -// If you don't like something, just change it; this is just an experiment. -// -// NOTE: it is relatively easy to abuse. Be careful. -// - -#define _XOPEN_SOURCE 500 - -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include - -#define ADDRESS_SPACE_LIMIT (100 * 1024 * 1024) -#include - -#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_(), thus when it is null, - // that function must have failed. This is a shortcut for convenience. - if (!item) - { - ctx->memory_failure = true; - return false; - } - - assert (item->next == NULL); - item->next = ctx->stack; - ctx->stack = item; - ctx->stack_size++; - return true; -} - -static bool -bump_reductions (struct context *ctx) -{ - if (++ctx->reduction_count >= ctx->reduction_limit) - { - ctx->error_is_fatal = true; - return set_error (ctx, "reduction limit reached"); - } - return true; -} - -static bool execute (struct context *, struct item *); - -static bool -call_function (struct context *ctx, const char *name) -{ - struct fn *iter; - for (iter = g_functions; iter; iter = iter->next) - if (!strcmp (name, iter->name)) - goto found; - return set_error (ctx, "unknown function: %s", name); - -found: - if (!bump_reductions (ctx)) - return false; - - if (iter->handler - ? iter->handler (ctx) - : execute (ctx, iter->script)) - return true; - - // In this case, `error' is NULL - if (ctx->memory_failure) - return false; - - // This creates some form of a stack trace - char *tmp = ctx->error; - ctx->error = NULL; - set_error (ctx, "%s -> %s", name, tmp); - free (tmp); - return false; -} - -static void -free_function (struct fn *fn) -{ - item_free_list (fn->script); - free (fn); -} - -static void -unregister_function (const char *name) -{ - for (struct fn **iter = &g_functions; *iter; iter = &(*iter)->next) - if (!strcmp ((*iter)->name, name)) - { - struct fn *tmp = *iter; - *iter = tmp->next; - free_function (tmp); - break; - } -} - -static struct fn * -prepend_new_fn (const char *name) -{ - struct fn *fn = calloc (1, sizeof *fn + strlen (name) + 1); - if (!fn) - return NULL; - - strcpy (fn->name, name); - fn->next = g_functions; - return g_functions = fn; -} - -static bool -register_handler (const char *name, handler_fn handler) -{ - unregister_function (name); - struct fn *fn = prepend_new_fn (name); - if (!fn) - return false; - fn->handler = handler; - return true; -} - -static bool -register_script (const char *name, struct item *script) -{ - unregister_function (name); - struct fn *fn = prepend_new_fn (name); - if (!fn) - return false; - fn->script = script; - return true; -} - -static bool -execute (struct context *ctx, struct item *script) -{ - for (; script; script = script->next) - { - if (script->type != ITEM_WORD) - { - if (!bump_reductions (ctx) - || !push (ctx, new_clone (script))) - return false; - } - else if (!call_function (ctx, get_word (script))) - return false; - } - return true; -} - -// --- Runtime library --------------------------------------------------------- - -#define defn(name) static bool name (struct context *ctx) - -#define check_stack(n) \ - if (ctx->stack_size < n) { \ - set_error (ctx, "stack underflow"); \ - return 0; \ - } - -inline static bool -check_stack_safe (struct context *ctx, size_t n) -{ - check_stack (n); - return true; -} - -static bool -check_type (struct context *ctx, const void *item_, enum item_type type) -{ - const struct item *item = item_; - if (item->type == type) - return true; - - return set_error (ctx, "invalid type: expected `%s', got `%s'", - item_type_to_str (type), item_type_to_str (item->type)); -} - -static struct item * -pop (struct context *ctx) -{ - check_stack (1); - struct item *top = ctx->stack; - ctx->stack = top->next; - top->next = NULL; - ctx->stack_size--; - return top; -} - -// - - Types - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -#define defn_is_type(name, item_type) \ - defn (fn_is_##name) { \ - check_stack (1); \ - struct item *top = pop (ctx); \ - push (ctx, new_integer (top->type == (item_type))); \ - item_free (top); \ - return true; \ - } - -defn_is_type (string, ITEM_STRING) -defn_is_type (word, ITEM_WORD) -defn_is_type (integer, ITEM_INTEGER) -defn_is_type (float, ITEM_FLOAT) -defn_is_type (list, ITEM_LIST) - -defn (fn_to_string) -{ - check_stack (1); - struct item *item = pop (ctx); - char *value; - - switch (item->type) - { - case ITEM_WORD: - item->type = ITEM_STRING; - case ITEM_STRING: - return push (ctx, item); - - case ITEM_FLOAT: - value = strdup_printf ("%Lf", get_float (item)); - break; - case ITEM_INTEGER: - value = strdup_printf ("%lld", get_integer (item)); - break; - - default: - set_error (ctx, "cannot convert `%s' to `%s'", - item_type_to_str (item->type), item_type_to_str (ITEM_STRING)); - item_free (item); - return false; - } - - item_free (item); - if (!value) - { - ctx->memory_failure = true; - return false; - } - - item = new_string (value, -1); - free (value); - return push (ctx, item); -} - -defn (fn_to_integer) -{ - check_stack (1); - struct item *item = pop (ctx); - long long value; - - switch (item->type) - { - case ITEM_INTEGER: - return push (ctx, item); - case ITEM_FLOAT: - value = get_float (item); - break; - - case ITEM_STRING: - { - char *end; - const char *s = get_string (item); - value = strtoll (s, &end, 10); - if (end != s && *s == '\0') - break; - - item_free (item); - return set_error (ctx, "integer conversion error"); - } - - default: - set_error (ctx, "cannot convert `%s' to `%s'", - item_type_to_str (item->type), item_type_to_str (ITEM_INTEGER)); - item_free (item); - return false; - } - - item_free (item); - return push (ctx, new_integer (value)); -} - -defn (fn_to_float) -{ - check_stack (1); - struct item *item = pop (ctx); - long double value; - - switch (item->type) - { - case ITEM_FLOAT: - return push (ctx, item); - case ITEM_INTEGER: - value = get_integer (item); - break; - - case ITEM_STRING: - { - char *end; - const char *s = get_string (item); - value = strtold (s, &end); - if (end != s && *s == '\0') - break; - - item_free (item); - return set_error (ctx, "float conversion error"); - } - - default: - set_error (ctx, "cannot convert `%s' to `%s'", - item_type_to_str (item->type), item_type_to_str (ITEM_FLOAT)); - item_free (item); - return false; - } - - item_free (item); - return push (ctx, new_float (value)); -} - -// - - Miscellaneous - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -defn (fn_length) -{ - check_stack (1); - struct item *item = pop (ctx); - bool success = true; - switch (item->type) - { - case ITEM_STRING: - success = push (ctx, new_integer (((struct item_string *) item)->len)); - break; - case ITEM_LIST: - { - long long length = 0; - struct item *iter; - for (iter = get_list (item); iter; iter = iter->next) - length++; - success = push (ctx, new_integer (length)); - break; - } - default: - success = set_error (ctx, "invalid type"); - } - item_free (item); - return success; -} - -// - - Stack operations - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -defn (fn_dup) -{ - check_stack (1); - return push (ctx, new_clone (ctx->stack)); -} - -defn (fn_drop) -{ - check_stack (1); - item_free (pop (ctx)); - return true; -} - -defn (fn_swap) -{ - check_stack (2); - struct item *second = pop (ctx), *first = pop (ctx); - return push (ctx, second) && push (ctx, first); -} - -defn (fn_call) -{ - check_stack (1); - struct item *script = pop (ctx); - bool success = check_type (ctx, script, ITEM_LIST) - && execute (ctx, get_list (script)); - item_free (script); - return success; -} - -defn (fn_dip) -{ - check_stack (2); - struct item *script = pop (ctx); - struct item *item = pop (ctx); - bool success = check_type (ctx, script, ITEM_LIST) - && execute (ctx, get_list (script)); - item_free (script); - if (!success) - { - item_free (item); - return false; - } - return push (ctx, item); -} - -defn (fn_unit) -{ - check_stack (1); - struct item *item = pop (ctx); - return push (ctx, new_list (item)); -} - -defn (fn_cons) -{ - check_stack (2); - struct item *list = pop (ctx); - struct item *item = pop (ctx); - if (!check_type (ctx, list, ITEM_LIST)) - { - item_free (list); - item_free (item); - return false; - } - item->next = get_list (list); - ((struct item_list *) list)->head = item; - return push (ctx, list); -} - -defn (fn_cat) -{ - check_stack (2); - struct item *scnd = pop (ctx); - struct item *frst = pop (ctx); - if (!check_type (ctx, frst, ITEM_LIST) - || !check_type (ctx, scnd, ITEM_LIST)) - { - item_free (frst); - item_free (scnd); - return false; - } - - // XXX: we shouldn't have to do this in O(n) - struct item **tail = &((struct item_list *) frst)->head; - while (*tail) - tail = &(*tail)->next; - *tail = get_list (scnd); - - ((struct item_list *) scnd)->head = NULL; - item_free (scnd); - return push (ctx, frst); -} - -defn (fn_uncons) -{ - check_stack (1); - struct item *list = pop (ctx); - if (!check_type (ctx, list, ITEM_LIST)) - goto fail; - struct item *first = get_list (list); - if (!first) - { - set_error (ctx, "list is empty"); - goto fail; - } - ((struct item_list *) list)->head = first->next; - first->next = NULL; - return push (ctx, first) && push (ctx, list); -fail: - item_free (list); - return false; -} - -// - - Logical - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -static bool -to_boolean (struct context *ctx, struct item *item, bool *ok) -{ - switch (item->type) - { - case ITEM_STRING: - return *get_string (item) != '\0'; - case ITEM_INTEGER: - return get_integer (item) != 0; - case ITEM_FLOAT: - return get_float (item) != 0.; - default: - return (*ok = set_error (ctx, "cannot convert `%s' to boolean", - item_type_to_str (item->type))); - } -} - -defn (fn_not) -{ - check_stack (1); - struct item *item = pop (ctx); - bool ok = true; - bool result = !to_boolean (ctx, item, &ok); - item_free (item); - return ok && push (ctx, new_integer (result)); -} - -defn (fn_and) -{ - check_stack (2); - struct item *op1 = pop (ctx); - struct item *op2 = pop (ctx); - bool ok = true; - bool result = to_boolean (ctx, op1, &ok) && to_boolean (ctx, op2, &ok); - item_free (op1); - item_free (op2); - return ok && push (ctx, new_integer (result)); -} - -defn (fn_or) -{ - check_stack (2); - struct item *op1 = pop (ctx); - struct item *op2 = pop (ctx); - bool ok = true; - bool result = to_boolean (ctx, op1, &ok) - || !ok || to_boolean (ctx, op2, &ok); - item_free (op1); - item_free (op2); - return ok && push (ctx, new_integer (result)); -} - -// - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -defn (fn_if) -{ - check_stack (3); - struct item *else_ = pop (ctx); - struct item *then_ = pop (ctx); - struct item *cond_ = pop (ctx); - - bool ok = true; - bool condition = to_boolean (ctx, cond_, &ok); - item_free (cond_); - - bool success = false; - if (ok - && check_type (ctx, then_, ITEM_LIST) - && check_type (ctx, else_, ITEM_LIST)) - success = execute (ctx, condition - ? get_list (then_) - : get_list (else_)); - - item_free (then_); - item_free (else_); - return success; -} - -defn (fn_try) -{ - check_stack (2); - struct item *catch = pop (ctx); - struct item *try = pop (ctx); - bool success = false; - if (!check_type (ctx, try, ITEM_LIST) - || !check_type (ctx, catch, ITEM_LIST)) - goto fail; - - if (!execute (ctx, get_list (try))) - { - if (ctx->memory_failure || ctx->error_is_fatal) - goto fail; - - success = push (ctx, new_string (ctx->error, -1)); - free (ctx->error); - ctx->error = NULL; - - if (success) - success = execute (ctx, get_list (catch)); - } - -fail: - item_free (try); - item_free (catch); - return success; -} - -defn (fn_map) -{ - check_stack (2); - struct item *fn = pop (ctx); - struct item *list = pop (ctx); - if (!check_type (ctx, fn, ITEM_LIST) - || !check_type (ctx, list, ITEM_LIST)) - { - item_free (fn); - item_free (list); - return false; - } - - bool success = false; - struct item *result = NULL, **tail = &result; - for (struct item *iter = get_list (list); iter; iter = iter->next) - { - if (!push (ctx, new_clone (iter)) - || !execute (ctx, get_list (fn)) - || !check_stack_safe (ctx, 1)) - goto fail; - - struct item *item = pop (ctx); - *tail = item; - tail = &item->next; - } - success = true; - -fail: - set_list (list, result); - item_free (fn); - if (!success) - { - item_free (list); - return false; - } - return push (ctx, list); -} - -defn (fn_filter) -{ - check_stack (2); - struct item *fn = pop (ctx); - struct item *list = pop (ctx); - if (!check_type (ctx, fn, ITEM_LIST) - || !check_type (ctx, list, ITEM_LIST)) - { - item_free (fn); - item_free (list); - return false; - } - - bool success = false; - bool ok = true; - struct item *result = NULL, **tail = &result; - for (struct item *iter = get_list (list); iter; iter = iter->next) - { - if (!push (ctx, new_clone (iter)) - || !execute (ctx, get_list (fn)) - || !check_stack_safe (ctx, 1)) - goto fail; - - struct item *item = pop (ctx); - bool survived = to_boolean (ctx, item, &ok); - item_free (item); - if (!ok) - goto fail; - if (!survived) - continue; - - if (!(item = new_clone (iter))) - goto fail; - *tail = item; - tail = &item->next; - } - success = true; - -fail: - set_list (list, result); - item_free (fn); - if (!success) - { - item_free (list); - return false; - } - return push (ctx, list); -} - -defn (fn_fold) -{ - check_stack (3); - struct item *op = pop (ctx); - struct item *null = pop (ctx); - struct item *list = pop (ctx); - bool success = false; - if (!check_type (ctx, op, ITEM_LIST) - || !check_type (ctx, list, ITEM_LIST)) - { - item_free (null); - goto fail; - } - - push (ctx, null); - for (struct item *iter = get_list (list); iter; iter = iter->next) - if (!push (ctx, new_clone (iter)) - || !execute (ctx, get_list (op))) - goto fail; - success = true; - -fail: - item_free (op); - item_free (list); - return success; -} - -defn (fn_each) -{ - check_stack (2); - struct item *op = pop (ctx); - struct item *list = pop (ctx); - bool success = false; - if (!check_type (ctx, op, ITEM_LIST) - || !check_type (ctx, list, ITEM_LIST)) - goto fail; - - for (struct item *iter = get_list (list); iter; iter = iter->next) - if (!push (ctx, new_clone (iter)) - || !execute (ctx, get_list (op))) - goto fail; - success = true; - -fail: - item_free (op); - item_free (list); - return success; -} - -// - - Arithmetic - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -// XXX: why not a `struct item_string *` argument? -static bool -push_repeated_string (struct context *ctx, struct item *op1, struct item *op2) -{ - struct item_string *string = (struct item_string *) op1; - struct item_integer *repeat = (struct item_integer *) op2; - assert (string->type == ITEM_STRING); - assert (repeat->type == ITEM_INTEGER); - - if (repeat->value < 0) - return set_error (ctx, "cannot multiply a string by a negative value"); - - char *buf = NULL; - size_t len = string->len * repeat->value; - if (len < string->len && repeat->value != 0) - goto allocation_fail; - - buf = malloc (len); - if (!buf) - goto allocation_fail; - - for (size_t i = 0; i < len; i += string->len) - memcpy (buf + i, string->value, string->len); - struct item *item = new_string (buf, len); - free (buf); - return push (ctx, item); - -allocation_fail: - ctx->memory_failure = true; - return false; -} - -defn (fn_times) -{ - check_stack (2); - struct item *op2 = pop (ctx); - struct item *op1 = pop (ctx); - - bool ok; - if (op1->type == ITEM_INTEGER && op2->type == ITEM_INTEGER) - ok = push (ctx, new_integer (get_integer (op1) * get_integer (op2))); - else if (op1->type == ITEM_INTEGER && op2->type == ITEM_FLOAT) - ok = push (ctx, new_float (get_integer (op1) * get_float (op2))); - else if (op1->type == ITEM_FLOAT && op2->type == ITEM_FLOAT) - ok = push (ctx, new_float (get_float (op1) * get_float (op2))); - else if (op1->type == ITEM_FLOAT && op2->type == ITEM_INTEGER) - ok = push (ctx, new_float (get_float (op1) * get_integer (op2))); - else if (op1->type == ITEM_INTEGER && op2->type == ITEM_STRING) - ok = push_repeated_string (ctx, op2, op1); - else if (op1->type == ITEM_STRING && op2->type == ITEM_INTEGER) - ok = push_repeated_string (ctx, op1, op2); - else - ok = set_error (ctx, "cannot multiply `%s' and `%s'", - item_type_to_str (op1->type), item_type_to_str (op2->type)); - - item_free (op1); - item_free (op2); - return ok; -} - -defn (fn_pow) -{ - check_stack (2); - struct item *op2 = pop (ctx); - struct item *op1 = pop (ctx); - - bool ok; - if (op1->type == ITEM_INTEGER && op2->type == ITEM_INTEGER) - // TODO: implement this properly, outputting an integer - ok = push (ctx, new_float (powl (get_integer (op1), get_integer (op2)))); - else if (op1->type == ITEM_INTEGER && op2->type == ITEM_FLOAT) - ok = push (ctx, new_float (powl (get_integer (op1), get_float (op2)))); - else if (op1->type == ITEM_FLOAT && op2->type == ITEM_FLOAT) - ok = push (ctx, new_float (powl (get_float (op1), get_float (op2)))); - else if (op1->type == ITEM_FLOAT && op2->type == ITEM_INTEGER) - ok = push (ctx, new_float (powl (get_float (op1), get_integer (op2)))); - else - ok = set_error (ctx, "cannot exponentiate `%s' and `%s'", - item_type_to_str (op1->type), item_type_to_str (op2->type)); - - item_free (op1); - item_free (op2); - return ok; -} - -defn (fn_div) -{ - check_stack (2); - struct item *op2 = pop (ctx); - struct item *op1 = pop (ctx); - - bool ok; - if (op1->type == ITEM_INTEGER && op2->type == ITEM_INTEGER) - { - if (get_integer (op2) == 0) - ok = set_error (ctx, "division by zero"); - else - ok = push (ctx, new_integer (get_integer (op1) / get_integer (op2))); - } - else if (op1->type == ITEM_INTEGER && op2->type == ITEM_FLOAT) - ok = push (ctx, new_float (get_integer (op1) / get_float (op2))); - else if (op1->type == ITEM_FLOAT && op2->type == ITEM_FLOAT) - ok = push (ctx, new_float (get_float (op1) / get_float (op2))); - else if (op1->type == ITEM_FLOAT && op2->type == ITEM_INTEGER) - ok = push (ctx, new_float (get_float (op1) / get_integer (op2))); - else - ok = set_error (ctx, "cannot divide `%s' and `%s'", - item_type_to_str (op1->type), item_type_to_str (op2->type)); - - item_free (op1); - item_free (op2); - return ok; -} - -defn (fn_mod) -{ - check_stack (2); - struct item *op2 = pop (ctx); - struct item *op1 = pop (ctx); - - bool ok; - if (op1->type == ITEM_INTEGER && op2->type == ITEM_INTEGER) - { - if (get_integer (op2) == 0) - ok = set_error (ctx, "division by zero"); - else - ok = push (ctx, new_integer (get_integer (op1) % get_integer (op2))); - } - else if (op1->type == ITEM_INTEGER && op2->type == ITEM_FLOAT) - ok = push (ctx, new_float (fmodl (get_integer (op1), get_float (op2)))); - else if (op1->type == ITEM_FLOAT && op2->type == ITEM_FLOAT) - ok = push (ctx, new_float (fmodl (get_float (op1), get_float (op2)))); - else if (op1->type == ITEM_FLOAT && op2->type == ITEM_INTEGER) - ok = push (ctx, new_float (fmodl (get_float (op1), get_integer (op2)))); - else - ok = set_error (ctx, "cannot divide `%s' and `%s'", - item_type_to_str (op1->type), item_type_to_str (op2->type)); - - item_free (op1); - item_free (op2); - return ok; -} - -static bool -push_concatenated_string (struct context *ctx, - struct item *op1, struct item *op2) -{ - struct item_string *s1 = (struct item_string *) op1; - struct item_string *s2 = (struct item_string *) op2; - assert (s1->type == ITEM_STRING); - assert (s2->type == ITEM_STRING); - - char *buf = NULL; - size_t len = s1->len + s2->len; - if (len < s1->len || len < s2->len) - goto allocation_fail; - - buf = malloc (len); - if (!buf) - goto allocation_fail; - - memcpy (buf, s1->value, s1->len); - memcpy (buf + s1->len, s2->value, s2->len); - struct item *item = new_string (buf, len); - free (buf); - return push (ctx, item); - -allocation_fail: - ctx->memory_failure = true; - return false; - -} - -defn (fn_plus) -{ - check_stack (2); - struct item *op2 = pop (ctx); - struct item *op1 = pop (ctx); - - bool ok; - if (op1->type == ITEM_INTEGER && op2->type == ITEM_INTEGER) - ok = push (ctx, new_integer (get_integer (op1) + get_integer (op2))); - else if (op1->type == ITEM_INTEGER && op2->type == ITEM_FLOAT) - ok = push (ctx, new_float (get_integer (op1) + get_float (op2))); - else if (op1->type == ITEM_FLOAT && op2->type == ITEM_FLOAT) - ok = push (ctx, new_float (get_float (op1) + get_float (op2))); - else if (op1->type == ITEM_FLOAT && op2->type == ITEM_INTEGER) - ok = push (ctx, new_float (get_float (op1) + get_integer (op2))); - else if (op1->type == ITEM_STRING && op2->type == ITEM_STRING) - ok = push_concatenated_string (ctx, op1, op2); - else - ok = set_error (ctx, "cannot add `%s' and `%s'", - item_type_to_str (op1->type), item_type_to_str (op2->type)); - - item_free (op1); - item_free (op2); - return ok; -} - -defn (fn_minus) -{ - check_stack (2); - struct item *op2 = pop (ctx); - struct item *op1 = pop (ctx); - - bool ok; - if (op1->type == ITEM_INTEGER && op2->type == ITEM_INTEGER) - ok = push (ctx, new_integer (get_integer (op1) - get_integer (op2))); - else if (op1->type == ITEM_INTEGER && op2->type == ITEM_FLOAT) - ok = push (ctx, new_float (get_integer (op1) - get_float (op2))); - else if (op1->type == ITEM_FLOAT && op2->type == ITEM_FLOAT) - ok = push (ctx, new_float (get_float (op1) - get_float (op2))); - else if (op1->type == ITEM_FLOAT && op2->type == ITEM_INTEGER) - ok = push (ctx, new_float (get_float (op1) - get_integer (op2))); - else - ok = set_error (ctx, "cannot subtract `%s' and `%s'", - item_type_to_str (op1->type), item_type_to_str (op2->type)); - - item_free (op1); - item_free (op2); - return ok; -} - -// - - Comparison - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -static int -compare_strings (struct item_string *s1, struct item_string *s2) -{ - // XXX: not entirely correct wrt. null bytes - size_t len = (s1->len < s2->len ? s1->len : s2->len) + 1; - return memcmp (s1->value, s2->value, len); -} - -static bool compare_lists (struct item *, struct item *); - -static bool -compare_list_items (struct item *op1, struct item *op2) -{ - if (op1->type != op2->type) - return false; - - switch (op1->type) - { - case ITEM_STRING: - case ITEM_WORD: - return !compare_strings ((struct item_string *) op1, - (struct item_string *) op2); - case ITEM_FLOAT: - return get_float (op1) == get_float (op2); - case ITEM_INTEGER: - return get_integer (op1) == get_integer (op2); - case ITEM_LIST: - return compare_lists (get_list (op1), get_list (op2)); - } - abort (); -} - -static bool -compare_lists (struct item *op1, struct item *op2) -{ - while (op1 && op2) - { - if (!compare_list_items (op1, op2)) - return false; - - op1 = op1->next; - op2 = op2->next; - } - return !op1 && !op2; -} - -defn (fn_eq) -{ - check_stack (2); - struct item *op2 = pop (ctx); - struct item *op1 = pop (ctx); - - bool ok; - if (op1->type == ITEM_INTEGER && op2->type == ITEM_INTEGER) - ok = push (ctx, new_integer (get_integer (op1) == get_integer (op2))); - else if (op1->type == ITEM_INTEGER && op2->type == ITEM_FLOAT) - ok = push (ctx, new_integer (get_integer (op1) == get_float (op2))); - else if (op1->type == ITEM_FLOAT && op2->type == ITEM_FLOAT) - ok = push (ctx, new_integer (get_float (op1) == get_float (op2))); - else if (op1->type == ITEM_FLOAT && op2->type == ITEM_INTEGER) - ok = push (ctx, new_integer (get_float (op1) == get_integer (op2))); - else if (op1->type == ITEM_LIST && op2->type == ITEM_LIST) - ok = push (ctx, new_integer (compare_lists - (get_list (op1), get_list (op2)))); - else if (op1->type == ITEM_STRING && op2->type == ITEM_STRING) - ok = push (ctx, new_integer (compare_strings - ((struct item_string *)(op1), (struct item_string *)(op2)) == 0)); - else - ok = set_error (ctx, "cannot compare `%s' and `%s'", - item_type_to_str (op1->type), item_type_to_str (op2->type)); - - item_free (op1); - item_free (op2); - return ok; -} - -defn (fn_lt) -{ - check_stack (2); - struct item *op2 = pop (ctx); - struct item *op1 = pop (ctx); - - bool ok; - if (op1->type == ITEM_INTEGER && op2->type == ITEM_INTEGER) - ok = push (ctx, new_integer (get_integer (op1) < get_integer (op2))); - else if (op1->type == ITEM_INTEGER && op2->type == ITEM_FLOAT) - ok = push (ctx, new_integer (get_integer (op1) < get_float (op2))); - else if (op1->type == ITEM_FLOAT && op2->type == ITEM_FLOAT) - ok = push (ctx, new_integer (get_float (op1) < get_float (op2))); - else if (op1->type == ITEM_FLOAT && op2->type == ITEM_INTEGER) - ok = push (ctx, new_integer (get_float (op1) < get_integer (op2))); - else if (op1->type == ITEM_STRING && op2->type == ITEM_STRING) - ok = push (ctx, new_integer (compare_strings - ((struct item_string *)(op1), (struct item_string *)(op2)) < 0)); - else - ok = set_error (ctx, "cannot compare `%s' and `%s'", - item_type_to_str (op1->type), item_type_to_str (op2->type)); - - item_free (op1); - item_free (op2); - return ok; -} - -// - - Utilities - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -defn (fn_rand) -{ - return push (ctx, new_float ((long double) rand () - / ((long double) RAND_MAX + 1))); -} - -defn (fn_time) -{ - return push (ctx, new_integer (time (NULL))); -} - -// XXX: this is a bit too constrained; combines strftime() with gmtime() -defn (fn_strftime) -{ - check_stack (2); - struct item *format = pop (ctx); - struct item *time_ = pop (ctx); - bool success = false; - if (!check_type (ctx, time_, ITEM_INTEGER) - || !check_type (ctx, format, ITEM_STRING)) - goto fail; - - if (get_integer (time_) < 0) - { - set_error (ctx, "invalid time value"); - goto fail; - } - - char buf[128]; - time_t time__ = get_integer (time_); - struct tm tm; - gmtime_r (&time__, &tm); - buf[strftime (buf, sizeof buf, get_string (format), &tm)] = '\0'; - success = push (ctx, new_string (buf, -1)); - -fail: - item_free (time_); - item_free (format); - return success; -} - -// - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -static void item_list_to_str (const struct item *, struct buffer *); - -static void -string_to_str (const struct item_string *string, struct buffer *buf) -{ - buffer_append_c (buf, '"'); - for (size_t i = 0; i < string->len; i++) - { - char c = string->value[i]; - if (c == '\n') buffer_append (buf, "\\n", 2); - else if (c == '\r') buffer_append (buf, "\\r", 2); - else if (c == '\t') buffer_append (buf, "\\t", 2); - else if (!isprint (c)) - { - char tmp[8]; - snprintf (tmp, sizeof tmp, "\\x%02x", (unsigned char) c); - buffer_append (buf, tmp, strlen (tmp)); - } - else if (c == '\\') buffer_append (buf, "\\\\", 2); - else if (c == '"') buffer_append (buf, "\\\"", 2); - else buffer_append_c (buf, c); - } - buffer_append_c (buf, '"'); -} - -static void -item_to_str (const struct item *item, struct buffer *buf) -{ - switch (item->type) - { - char *x; - case ITEM_STRING: - string_to_str ((struct item_string *) item, buf); - break; - case ITEM_WORD: - { - struct item_word *word = (struct item_word *) item; - buffer_append (buf, word->value, word->len); - break; - } - case ITEM_INTEGER: - if (!(x = strdup_printf ("%lld", get_integer (item)))) - goto alloc_failure; - buffer_append (buf, x, strlen (x)); - free (x); - break; - case ITEM_FLOAT: - if (!(x = strdup_printf ("%Lf", get_float (item)))) - goto alloc_failure; - buffer_append (buf, x, strlen (x)); - free (x); - break; - case ITEM_LIST: - buffer_append_c (buf, '['); - item_list_to_str (get_list (item), buf); - buffer_append_c (buf, ']'); - break; - } - return; - -alloc_failure: - // This is a bit hackish but it simplifies stuff - buf->memory_failure = true; - free (buf->s); - buf->s = NULL; -} - -static void -item_list_to_str (const struct item *script, struct buffer *buf) -{ - if (!script) - return; - - item_to_str (script, buf); - while ((script = script->next)) - { - buffer_append_c (buf, ' '); - item_to_str (script, buf); - } -} - -// --- IRC protocol ------------------------------------------------------------ - -struct message -{ - char *prefix; ///< Message prefix - char *command; ///< IRC command - char *params[16]; ///< Command parameters (0-terminated) - size_t n_params; ///< Number of parameters present -}; - -inline static char * -cut_word (char **s) -{ - char *start = *s, *end = *s + strcspn (*s, " "); - *s = end + strspn (end, " "); - *end = '\0'; - return start; -} - -static bool -parse_message (char *s, struct message *msg) -{ - memset (msg, 0, sizeof *msg); - - // Ignore IRC 3.2 message tags, if present - if (*s == '@') - { - s += strcspn (s, " "); - s += strspn (s, " "); - } - - // Prefix - if (*s == ':') - msg->prefix = cut_word (&s) + 1; - - // Command - if (!*(msg->command = cut_word (&s))) - return false; - - // Parameters - while (*s) - { - size_t n = msg->n_params++; - if (msg->n_params >= N_ELEMENTS (msg->params)) - return false; - if (*s == ':') - { - msg->params[n] = ++s; - break; - } - msg->params[n] = cut_word (&s); - } - return true; -} - -static struct message * -read_message (void) -{ - static bool discard = false; - static char buf[1025]; - static struct message msg; - - bool discard_this; - do - { - if (!fgets (buf, sizeof buf, stdin)) - return NULL; - size_t len = strlen (buf); - - // Just to be on the safe side, if the line overflows our buffer, - // ignore everything up until the next line. - discard_this = discard; - if (len >= 2 && !strcmp (buf + len - 2, "\r\n")) - { - buf[len -= 2] = '\0'; - discard = false; - } - else - discard = true; - } - // Invalid messages are silently ignored - while (discard_this || !parse_message (buf, &msg)); - return &msg; -} - -// --- Interfacing with the bot ------------------------------------------------ - -#define BOT_PRINT "ZYKLONB print :script: " - -static const char * -get_config (const char *key) -{ - printf ("ZYKLONB get_config :%s\r\n", key); - struct message *msg = read_message (); - if (!msg || msg->n_params <= 0) - exit (EXIT_FAILURE); - return msg->params[0]; -} - -// - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -// TODO: implement more functions; try to avoid writing them in C - -static bool -init_runtime_library_scripts (void) -{ - bool ok = true; - - // It's much cheaper (and more fun) to define functions in terms of other - // ones. The "unit tests" serve a secondary purpose of showing the usage. - struct script - { - const char *name; ///< Name of the function - const char *definition; ///< The defining script - const char *unit_test; ///< Trivial unit test, must return 1 - } - scripts[] = - { - { "nip", "swap drop", "1 2 nip 2 =" }, - { "over", "[dup] dip swap", "1 2 over nip nip 1 =" }, - { "swons", "swap cons", "[2] 1 swons [1 2] =" }, - { "first", "uncons drop", "[1 2 3] first 1 =" }, - { "rest", "uncons swap drop", "[1 2 3] rest [2 3] =" }, - { "reverse", "[] swap [swap cons] each", "[1 2] reverse [2 1] =" }, - { "curry", "cons", "1 2 [+] curry call 3 =" }, - - { "xor", "not swap not + 1 =", "1 1 xor 0 =" }, - { "min", "over over < [drop] [nip] if", "1 2 min 1 =" }, - { "max", "over over > [drop] [nip] if", "1 2 max 2 =" }, - - { "all?", "[and] cat 1 swap fold", "[3 4 5] [> 3] all? 0 =" }, - { "any?", "[or] cat 0 swap fold", "[3 4 5] [> 3] any? 1 =" }, - - { ">", "swap <", "1 2 > 0 =" }, - { "!=", "= not", "1 2 != 1 =" }, - { "<=", "> not", "1 2 <= 1 =" }, - { ">=", "< not", "1 2 >= 0 =" }, - - // XXX: this is a bit crazy and does not work with an empty list - { "join", "[uncons] dip swap [[dup] dip swap [+ +] dip] each drop", - "[1 2 3] [>string] map \" -> \" join \"1 -> 2 -> 3\" =" }, - }; - - for (size_t i = 0; i < N_ELEMENTS (scripts); i++) - { - const char *error = NULL; - struct item *script = parse (scripts[i].definition, &error); - if (error) - { - printf (BOT_PRINT "error parsing internal script `%s': %s\r\n", - scripts[i].definition, error); - ok = false; - } - else - ok &= register_script (scripts[i].name, script); - } - - struct context ctx; - for (size_t i = 0; i < N_ELEMENTS (scripts); i++) - { - const char *error = NULL; - struct item *script = parse (scripts[i].unit_test, &error); - if (error) - { - printf (BOT_PRINT "error parsing unit test for `%s': %s\r\n", - scripts[i].name, error); - ok = false; - continue; - } - context_init (&ctx); - execute (&ctx, script); - item_free_list (script); - - const char *failure = NULL; - if (ctx.memory_failure) - failure = "memory allocation failure"; - else if (ctx.error) - failure = ctx.error; - else if (ctx.stack_size != 1) - failure = "too many results on the stack"; - else if (ctx.stack->type != ITEM_INTEGER) - failure = "result is not an integer"; - else if (get_integer (ctx.stack) != 1) - failure = "wrong test result"; - if (failure) - { - printf (BOT_PRINT "error executing unit test for `%s': %s\r\n", - scripts[i].name, failure); - ok = false; - } - context_free (&ctx); - } - return ok; -} - -static bool -init_runtime_library (void) -{ - bool ok = true; - - // Type detection - ok &= register_handler ("string?", fn_is_string); - ok &= register_handler ("word?", fn_is_word); - ok &= register_handler ("integer?", fn_is_integer); - ok &= register_handler ("float?", fn_is_float); - ok &= register_handler ("list?", fn_is_list); - - // Type conversion - ok &= register_handler (">string", fn_to_string); - ok &= register_handler (">integer", fn_to_integer); - ok &= register_handler (">float", fn_to_float); - - // Miscellaneous - ok &= register_handler ("length", fn_length); - - // Basic stack manipulation - ok &= register_handler ("dup", fn_dup); - ok &= register_handler ("drop", fn_drop); - ok &= register_handler ("swap", fn_swap); - - // Calling stuff - ok &= register_handler ("call", fn_call); - ok &= register_handler ("dip", fn_dip); - - // Control flow - ok &= register_handler ("if", fn_if); - ok &= register_handler ("try", fn_try); - - // List processing - ok &= register_handler ("map", fn_map); - ok &= register_handler ("filter", fn_filter); - ok &= register_handler ("fold", fn_fold); - ok &= register_handler ("each", fn_each); - - // List manipulation - ok &= register_handler ("unit", fn_unit); - ok &= register_handler ("cons", fn_cons); - ok &= register_handler ("cat", fn_cat); - ok &= register_handler ("uncons", fn_uncons); - - // Arithmetic operations - ok &= register_handler ("+", fn_plus); - ok &= register_handler ("-", fn_minus); - ok &= register_handler ("*", fn_times); - ok &= register_handler ("^", fn_pow); - ok &= register_handler ("/", fn_div); - ok &= register_handler ("%", fn_mod); - - // Comparison - ok &= register_handler ("=", fn_eq); - ok &= register_handler ("<", fn_lt); - - // Logical operations - ok &= register_handler ("not", fn_not); - ok &= register_handler ("and", fn_and); - ok &= register_handler ("or", fn_or); - - // Utilities - ok &= register_handler ("rand", fn_rand); - ok &= register_handler ("time", fn_time); - ok &= register_handler ("strftime", fn_strftime); - - ok &= init_runtime_library_scripts (); - return ok; -} - -static void -free_runtime_library (void) -{ - struct fn *next, *iter; - for (iter = g_functions; iter; iter = next) - { - next = iter->next; - free_function (iter); - } -} - -// --- Function database ------------------------------------------------------- - -// TODO: a global variable storing the various procedures (db) -// XXX: defining procedures would ideally need some kind of an ACL - -static void -read_db (void) -{ - // TODO -} - -static void -write_db (void) -{ - // TODO -} - -// --- Main -------------------------------------------------------------------- - -static char *g_prefix; - -struct user_info -{ - char *ctx; ///< Context: channel or user - char *ctx_quote; ///< Reply quotation -}; - -defn (fn_dot) -{ - check_stack (1); - struct item *item = pop (ctx); - struct user_info *info = ctx->user_data; - - struct buffer buf = BUFFER_INITIALIZER; - item_to_str (item, &buf); - item_free (item); - buffer_append_c (&buf, '\0'); - if (buf.memory_failure) - { - ctx->memory_failure = true; - return false; - } - - if (buf.len > 255) - buf.s[255] = '\0'; - - printf ("PRIVMSG %s :%s%s\r\n", info->ctx, info->ctx_quote, buf.s); - free (buf.s); - return true; -} - -static void -process_message (struct message *msg) -{ - if (!msg->prefix - || strcasecmp (msg->command, "PRIVMSG") - || msg->n_params < 2) - return; - char *line = msg->params[1]; - - // Filter out only our commands - size_t prefix_len = strlen (g_prefix); - if (strncmp (line, g_prefix, prefix_len)) - return; - line += prefix_len; - - char *command = cut_word (&line); - if (strcasecmp (command, "script")) - return; - - // Retrieve information on how to respond back - char *msg_ctx = msg->prefix, *x; - if ((x = strchr (msg_ctx, '!'))) - *x = '\0'; - - char *msg_ctx_quote; - if (strchr ("#+&!", *msg->params[0])) - { - msg_ctx_quote = strdup_printf ("%s: ", msg_ctx); - msg_ctx = msg->params[0]; - } - else - msg_ctx_quote = strdup (""); - - if (!msg_ctx_quote) - { - printf (BOT_PRINT "%s\r\n", "memory allocation failure"); - return; - } - - struct user_info info; - info.ctx = msg_ctx; - info.ctx_quote = msg_ctx_quote; - - // Finally parse and execute the macro - const char *error = NULL; - struct item *script = parse (line, &error); - if (error) - { - printf ("PRIVMSG %s :%s%s: %s\r\n", - msg_ctx, msg_ctx_quote, "parse error", error); - goto end; - } - - struct context ctx; - context_init (&ctx); - ctx.user_data = &info; - execute (&ctx, script); - item_free_list (script); - - const char *failure = NULL; - if (ctx.memory_failure) - failure = "memory allocation failure"; - else if (ctx.error) - failure = ctx.error; - if (failure) - printf ("PRIVMSG %s :%s%s: %s\r\n", - msg_ctx, msg_ctx_quote, "runtime error", failure); - context_free (&ctx); -end: - free (msg_ctx_quote); -} - -int -main (int argc, char *argv[]) -{ - freopen (NULL, "rb", stdin); setvbuf (stdin, NULL, _IOLBF, BUFSIZ); - freopen (NULL, "wb", stdout); setvbuf (stdout, NULL, _IOLBF, BUFSIZ); - - struct rlimit limit = - { - .rlim_cur = ADDRESS_SPACE_LIMIT, - .rlim_max = ADDRESS_SPACE_LIMIT - }; - - // Lower the memory limits to something sensible to prevent abuse - (void) setrlimit (RLIMIT_AS, &limit); - - read_db (); - if (!init_runtime_library () - || !register_handler (".", fn_dot)) - printf (BOT_PRINT "%s\r\n", "runtime library initialization failed"); - - g_prefix = strdup (get_config ("prefix")); - printf ("ZYKLONB register\r\n"); - struct message *msg; - while ((msg = read_message ())) - process_message (msg); - - free_runtime_library (); - free (g_prefix); - return 0; -} - diff --git a/plugins/zyklonb/seen b/plugins/zyklonb/seen deleted file mode 100755 index 8fc9c82..0000000 --- a/plugins/zyklonb/seen +++ /dev/null @@ -1,160 +0,0 @@ -#!/usr/bin/env lua --- --- ZyklonB seen plugin --- --- Copyright 2016 Přemysl Eric Janouch --- 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: ") - 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/zyklonb/seen-import-degesch.pl b/plugins/zyklonb/seen-import-degesch.pl deleted file mode 100755 index ddef6be..0000000 --- a/plugins/zyklonb/seen-import-degesch.pl +++ /dev/null @@ -1,39 +0,0 @@ -#!/usr/bin/env perl -# Creates a database for the "seen" plugin from logs for degesch. -# The results may not be completely accurate but are good for jumpstarting. -# Usage: ./seen-import-degesch.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/zyklonb/youtube b/plugins/zyklonb/youtube deleted file mode 100755 index 53b86d8..0000000 --- a/plugins/zyklonb/youtube +++ /dev/null @@ -1,111 +0,0 @@ -#!/usr/bin/env python3 -# -# ZyklonB YouTube plugin, displaying info about YouTube links -# -# Copyright 2014 - 2015, Přemysl Eric Janouch -# 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 () -- cgit v1.2.3-70-g09d2