gitinfo-irc.pl 15 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534
  1. #!/usr/bin/perl
  2. package BotIrc;
  3. use common::sense;
  4. use Carp;
  5. use JSON;
  6. use File::Slurp;
  7. use POE;
  8. use POE::Component::IRC::State;
  9. use POE::Component::IRC::Plugin::AutoJoin;
  10. use POE::Component::IRC::Plugin::Connector;
  11. use POE::Component::IRC::Plugin::NickServID;
  12. use POE::Component::Client::DNS;
  13. use POE::Component::Client::HTTP;
  14. use POE::Component::Server::TCP;
  15. use POE::Filter::IRCD;
  16. use POE::Filter::Line;
  17. use Socket;
  18. use Socket6;
  19. use lib '.';
  20. use control;
  21. use db;
  22. use http;
  23. use plugin;
  24. our $config;
  25. our $config_file = 'config.json';
  26. $config_file = $ARGV[0] if (defined($ARGV[0]) && -f $ARGV[0]);
  27. our $kernel;
  28. our %heap;
  29. my %handlers = ();
  30. my %handler_ctx = ();
  31. my %timers = ();
  32. sub read_config {
  33. $config = read_file($config_file) or fatal("Config file `$config_file' missing: $!");
  34. $config = decode_json($config);
  35. if (ref($config->{channel}) eq '') {
  36. $config->{channel} = [$config->{channel}];
  37. }
  38. my %chans;
  39. $chans{lc $_} = undef for @{$config->{channel}};
  40. $config->{channel} = \%chans;
  41. }
  42. read_config();
  43. sub msg {
  44. print STDERR "[".localtime."] ".shift."\n";
  45. }
  46. sub info { msg("[INFO] ".shift); }
  47. sub warn { msg("[WARNING] ".shift); }
  48. sub error { msg("[ERROR] ".shift); }
  49. sub fatal { msg("[FATAL] ".shift); exit(1); }
  50. BotDb::init();
  51. BotCtl::init();
  52. BotPlugin::init();
  53. our $irc = POE::Component::IRC::State->spawn(
  54. 'alias' => "IRC",
  55. 'Server' => $config->{server},
  56. 'Port' => ($config->{server_port} // 6697),
  57. 'Nick' => $config->{nick},
  58. 'Username' => $config->{username},
  59. 'Ircname' => $config->{realname},
  60. 'Password' => $config->{server_password},
  61. 'LocalAddr' => $config->{local_addr},
  62. 'useipv6' => $config->{ipv6},
  63. 'UseSSL' => $config->{server_ssl} // 1,
  64. 'Raw' => 1,
  65. );
  66. our $ircd_parser = POE::Filter::IRCD->new(colonify => 0);
  67. POE::Component::Client::HTTP->spawn(
  68. Alias => 'http',
  69. Timeout => 30,
  70. MaxSize => 1_000_000,
  71. FollowRedirects => 2,
  72. );
  73. if ($config->{control_enabled}) {
  74. POE::Component::Server::TCP->new(
  75. Address => $config->{control_addr},
  76. Domain => $config->{control_ipv6} ? AF_INET6 : AF_INET,
  77. Alias => "ControlServer",
  78. Port => $config->{control_port},
  79. Started => sub { info "Control server started."; },
  80. ClientFilter => POE::Filter::Line->new(Literal => "\012"),
  81. ClientConnected => \&BotCtl::on_connected,
  82. ClientDisconnected => \&BotCtl::on_disconnected,
  83. ClientInput => \&BotCtl::on_input,
  84. );
  85. }
  86. our $session = POE::Session->create(
  87. inline_states => {
  88. _start => \&main_start,
  89. tick => \&_tick,
  90. },
  91. heap => {
  92. irc => $irc,
  93. },
  94. );
  95. sub _tick {
  96. my ($ctx, $key, $code, @params) = @_[ARG0..$#_];
  97. delete $timers{$key};
  98. $code->($ctx, $key, @params);
  99. }
  100. sub main_start {
  101. $kernel = $_[KERNEL];
  102. BotHttp::init();
  103. $irc->plugin_add('AutoJoin', POE::Component::IRC::Plugin::AutoJoin->new(Channels => $config->{channel}));
  104. $irc->plugin_add('Connector', POE::Component::IRC::Plugin::Connector->new());
  105. $irc->plugin_add('NickServID', POE::Component::IRC::Plugin::NickServID->new(Password => $config->{nick_pwd})) if defined $config->{nick_pwd};
  106. add_handler('irc_socketerr', 'core', sub {
  107. error("IRC: socket error while connecting: ". $_[ARG0]);
  108. return 0;
  109. });
  110. add_handler('irc_error', 'core', sub {
  111. warn("IRC: general error: ". $_[ARG0]);
  112. return 0;
  113. });
  114. add_handler('irc_connected', 'core', sub {
  115. info("IRC: connected to ". $_[ARG0]);
  116. $irc->yield(cap => req => "account-tag");
  117. return 0;
  118. });
  119. add_handler('irc_disconnected', 'core', sub {
  120. warn("IRC: disconnected from ". $_[ARG0]);
  121. return 0;
  122. });
  123. add_handler('irc_raw', 'core', \&on_irc_raw);
  124. add_handler('irc_raw_public', 'core', \&on_irc_public);
  125. add_handler('irc_raw_msg', 'core', \&on_irc_msg);
  126. for (@{$config->{autoload_plugins}}) {
  127. BotPlugin::load($_);
  128. }
  129. $irc->yield(register => 'all');
  130. $irc->yield(connect => {});
  131. return;
  132. }
  133. POE::Kernel->run();
  134. sub splitmask {
  135. my $mask = shift;
  136. $mask =~ /^(.+)!(.+)@(.+)$/;
  137. if (!$1) {
  138. # No n!u@h, probably server event
  139. return { host => $mask };
  140. }
  141. return {
  142. nick => $1,
  143. user => $2,
  144. host => $3,
  145. userhost => "$2\@$3",
  146. };
  147. }
  148. sub nickonly {
  149. splitmask(shift)->{nick};
  150. }
  151. sub return_path {
  152. my $source = nickonly(shift);
  153. my $targets = shift;
  154. my @targets = ();
  155. if (ref($targets) eq 'ARRAY') {
  156. @targets = @$targets;
  157. }
  158. return $source if (grep { lc($irc->nick_name()) eq lc($_) } @targets);
  159. my @chan_targets = grep { exists($config->{channel}{lc $_}) } @targets;
  160. return undef unless @chan_targets;
  161. # Just ignore additional channels, if any
  162. return $chan_targets[0];
  163. }
  164. sub msg_or_notice($$) {
  165. my ($target, $msg) = @_;
  166. my $method = ($target =~ /^#/) ? 'privmsg' : 'notice';
  167. $irc->yield($method => $target => $msg);
  168. }
  169. sub noisy_check_priv($$$$) {
  170. my ($rpath, $nick, $priv, $account) = @_;
  171. return 0 if (!noisy_command_authed($rpath, $nick, $account));
  172. if (!BotDb::has_priv($account, $priv)) {
  173. $irc->yield(privmsg => $rpath, "$nick: you are not authorised to perform this action ($priv).");
  174. return 0;
  175. }
  176. return 1;
  177. }
  178. sub noisy_check_antipriv($$$$) {
  179. my ($rpath, $nick, $priv, $account) = @_;
  180. my $account //= '!guest';
  181. if (BotDb::has_priv($account, $priv)) {
  182. $irc->yield(privmsg => $rpath, "$nick: you are not authorised to perform this action (due to $priv).");
  183. return 0;
  184. }
  185. return 1;
  186. }
  187. sub noisy_command_authed($$$) {
  188. my ($rpath, $nick, $account) = @_;
  189. if (!$account) {
  190. $irc->yield(privmsg => $rpath, "$nick: you must be logged in to use this command.");
  191. }
  192. return $account;
  193. }
  194. # Convenience methods for handlers {{{
  195. # Called by core stuff that calls handlers; initializes the handler ctx with
  196. # information about which return paths are available in principle. This will
  197. # later be matched against what kinds of return paths a handler requires and
  198. # generate errors if necessary.
  199. sub prepare_ctx_targets($$$$) {
  200. my ($source, $target, $msg, $account) = @_;
  201. my $rpath = return_path($source, $target);
  202. $rpath = undef if lc($rpath) eq lc($source);
  203. %handler_ctx = (
  204. user => $source,
  205. channel => $rpath,
  206. line => $msg,
  207. account => $account,
  208. no_setup => 1,
  209. );
  210. }
  211. # This is the counterpart to prepare_irc_targets. It's called by handlers to
  212. # perform priv/target checks according to the handler's specs.
  213. # Yay function name overload!
  214. sub check_ctx(%) {
  215. my %cfg = @_;
  216. my $account = $handler_ctx{account};
  217. my $source = $handler_ctx{user};
  218. my $channel = $handler_ctx{channel};
  219. $account //= '!guest';
  220. if (!%handler_ctx) {
  221. carp("Trying to use uninitialized handler ctx");
  222. return 0;
  223. }
  224. # First, determine where to send replies to...
  225. # ... but reuse established values if this isn't the first invocation
  226. # in the current run of the handler
  227. my ($noise_prefer_channel, $wisdom_prefer_channel);
  228. if ($handler_ctx{no_setup}) {
  229. $noise_prefer_channel = $cfg{noise_public} // $config->{replies_public};
  230. $wisdom_prefer_channel = $cfg{wisdom_public} // 1;
  231. } else {
  232. $noise_prefer_channel = $cfg{noise_public} // ($handler_ctx{noise_target} eq $channel);
  233. $wisdom_prefer_channel = $cfg{wisdom_public} // ($handler_ctx{wisdom_target} eq $channel);
  234. }
  235. if ($noise_prefer_channel && $channel) {
  236. $handler_ctx{noise_type} = 'privmsg';
  237. $handler_ctx{noise_target} = $channel;
  238. } else {
  239. $handler_ctx{noise_type} = 'notice';
  240. $handler_ctx{noise_target} = $source;
  241. }
  242. if ($wisdom_prefer_channel && $channel) {
  243. $handler_ctx{wisdom_type} = 'privmsg';
  244. $handler_ctx{wisdom_target} = $channel;
  245. } else {
  246. $handler_ctx{wisdom_type} = 'notice';
  247. $handler_ctx{wisdom_target} = $source;
  248. }
  249. if (exists $cfg{wisdom_addressee}) {
  250. ctx_set_addressee($cfg{wisdom_addressee});
  251. } else {
  252. # We can do this by default without clashing with commands
  253. # because both only match at the start of the line and a
  254. # command isn't a valid nickname nor vice versa
  255. ctx_set_addressee('!auto');
  256. }
  257. # Don't auto-redirect by default since it might clash with command
  258. # syntax
  259. ctx_auto_redirect($handler_ctx{wisdom_auto_redirect} // 0);
  260. delete $handler_ctx{no_setup};
  261. if (($cfg{authed} || defined($cfg{priv})) && !$handler_ctx{account}) {
  262. send_noise("You must be logged into NickServ in order to use this command.");
  263. return 0;
  264. }
  265. if (defined $cfg{priv}) {
  266. $cfg{priv} = [$cfg{priv}] if ref($cfg{priv}) eq '';
  267. for (@{$cfg{priv}}) {
  268. if (!BotDb::has_priv($account, $_)) {
  269. send_noise("You are not authorised to perform this action ($_).");
  270. return 0;
  271. }
  272. }
  273. }
  274. if (defined $cfg{antipriv}) {
  275. $cfg{antipriv} = [$cfg{antipriv}] if ref($cfg{antipriv}) eq '';
  276. for (@{$cfg{antipriv}}) {
  277. if (BotDb::has_priv($account, $_)) {
  278. send_noise("You are not authorised to perform this action (due to $_).");
  279. return 0;
  280. }
  281. }
  282. }
  283. return 1;
  284. }
  285. # There are two types of messages sent from handlers: noise and wisdom. Noise
  286. # is stuff like "command successful" or "you lack privileges". Wisdom is stuff
  287. # like "here's the data you requested".
  288. sub send_noise($;$) {
  289. my $ctx = (ref($_[0]) eq 'HASH') ? shift : \%handler_ctx;
  290. my $noise = shift;
  291. if (!%$ctx) {
  292. carp("A handler tried to send this noise without valid ctx: $noise");
  293. return;
  294. }
  295. if ($ctx->{no_setup}) {
  296. carp("Handler sending noise without ctx constraints: $noise -> $ctx->{source}");
  297. }
  298. # In channels, address user
  299. $noise = "$ctx->{user}: $noise" if ($ctx->{noise_type} eq 'privmsg');
  300. $irc->yield($ctx->{noise_type} => $ctx->{noise_target} => $noise);
  301. }
  302. sub send_wisdom($;$) {
  303. my $ctx = (ref($_[0]) eq 'HASH') ? shift : \%handler_ctx;
  304. my $wisdom = shift;
  305. if (!%$ctx) {
  306. carp("A handler tried to send this wisdom without valid ctx: $wisdom");
  307. return;
  308. }
  309. if ($ctx->{no_setup}) {
  310. carp("Handler sending wisdom without ctx constraints: $wisdom -> $ctx->{source}");
  311. }
  312. my $a = $ctx->{wisdom_addressee};
  313. my $address = "";
  314. $address = "$a: " if (defined $a && ctx_target_has_member($ctx, $a));
  315. $irc->yield($ctx->{wisdom_type} => $ctx->{wisdom_target} => ($address.$wisdom));
  316. }
  317. sub set_timer {
  318. my $ctx = (ref($_[0]) eq 'HASH') ? shift: \%handler_ctx;
  319. my ($key, $delta, $code, @params) = @_;
  320. my $target_time = $delta + time;
  321. $kernel->alarm_remove(delete $timers{$key}) if $timers{$key};
  322. my $id = $kernel->alarm_set(tick => $target_time, ctx_frozen(), $key, $code, @params);
  323. $timers{$key} = $id;
  324. }
  325. sub clear_timer {
  326. my $ctx = (ref($_[0]) eq 'HASH') ? shift: \%handler_ctx;
  327. my $key = shift;
  328. my $id = delete $timers{$key};
  329. return if !$id;
  330. $kernel->alarm_remove($id);
  331. 1;
  332. }
  333. # Choose who to address in public wisdom. Set to undef to disable or '!auto'
  334. # to enable black magic.
  335. # Note that this is handled during check_ctx, too, and defaults to black magic
  336. # there.
  337. sub ctx_set_addressee($;$) {
  338. my $ctx = (ref($_[0]) eq 'HASH') ? shift : \%handler_ctx;
  339. my $a = shift;
  340. if ($a eq '!auto') {
  341. $a = undef;
  342. if ($ctx->{line} && $ctx->{line} =~ /^
  343. ([\w\[\]\{\}\\\|`^{}-]+) # nick (broad match)
  344. (?:[,:]|\s-+) # separator
  345. \s+/ix) {
  346. $a = $1;
  347. }
  348. }
  349. $ctx->{wisdom_addressee} = $a;
  350. }
  351. sub ctx_addressee(;$) {
  352. my $ctx = (ref($_[0]) eq 'HASH') ? shift : \%handler_ctx;
  353. return $ctx->{"wisdom_addressee"};
  354. }
  355. sub ctx_target($;$) {
  356. my $ctx = (ref($_[0]) eq 'HASH') ? shift : \%handler_ctx;
  357. return $ctx->{shift."_target"};
  358. }
  359. sub ctx_source(;$) {
  360. my $ctx = (ref($_[0]) eq 'HASH') ? shift : \%handler_ctx;
  361. return $ctx->{user};
  362. }
  363. # This works for wisdom only! Noise should only go to the actual source of a
  364. # message, really.
  365. sub ctx_target_has_member($;$) {
  366. my $ctx = (ref($_[0]) eq 'HASH') ? shift : \%handler_ctx;
  367. my $target = $ctx->{wisdom_target};
  368. return 0 if $target !~ /^#/;
  369. return $irc->is_channel_member($target, shift);
  370. }
  371. sub ctx_redirect_to_channel($;$$) {
  372. my $ctx = (ref($_[0]) eq 'HASH') ? shift : \%handler_ctx;
  373. my ($type, $channel) = @_;
  374. if (exists($config->{channel}{lc $channel})) {
  375. $ctx->{"${type}_target"} = $channel;
  376. $ctx->{"${type}_type"} = 'privmsg';
  377. return 1;
  378. }
  379. return 0;
  380. }
  381. sub ctx_redirect_to_addressee {
  382. my $ctx = (ref($_[0]) eq 'HASH') ? shift: \%handler_ctx;
  383. $ctx->{wisdom_target} = $ctx->{wisdom_addressee} // $ctx->{user};
  384. $ctx->{wisdom_type} = 'notice';
  385. }
  386. # Will redirect wisdom caused by private requests into a channel if the
  387. # request contains "to:#thechannel" and #thechannel is known to us.
  388. sub ctx_auto_redirect(;$) {
  389. my $ctx = (ref($_[0]) eq 'HASH') ? shift : \%handler_ctx;
  390. if ($ctx->{line} && !ctx_can_target_channel($ctx) && $ctx->{line} =~ /\bto:(#[\S]+)/) {
  391. ctx_redirect_to_channel($ctx, 'wisdom', $1);
  392. }
  393. }
  394. # Was the original message addressed to a known channel?
  395. # This ignores redirections.
  396. sub ctx_can_target_channel(;$) {
  397. my $ctx = (ref($_[0]) eq 'HASH') ? shift : \%handler_ctx;
  398. return defined($ctx->{channel});
  399. }
  400. # Get a copy of the current ctx, for use in async scripts
  401. sub ctx_frozen() {
  402. return {%handler_ctx};
  403. }
  404. # }}}
  405. sub on_irc_raw {
  406. my $raw = $_[ARG0];
  407. my $ev = $ircd_parser->get([$raw]);
  408. $ev = $ev->[0];
  409. if ($ev->{tags} && $ev->{tags}{account} && $ev->{tags}{account} ne '*') {
  410. $ev->{account} = $ev->{tags}{account}
  411. } else {
  412. $ev->{account} = undef;
  413. }
  414. my $mask = splitmask($ev->{prefix});
  415. $ev->{$_} = $mask->{$_} for keys %$mask;
  416. $irc->send_event(irc_raw_parsed => $ev);
  417. if ($ev->{command} eq 'PRIVMSG') {
  418. if ($ev->{params}[0] =~ /^#/) {
  419. $irc->send_event(irc_raw_public => $ev);
  420. } else {
  421. $irc->send_event(irc_raw_msg => $ev);
  422. }
  423. }
  424. return 0;
  425. }
  426. sub on_irc_public {
  427. my $ev = $_[ARG0];
  428. my $target = $ev->{params}[0];
  429. my $msg = $ev->{params}[1];
  430. return 1 if ($config->{hardcore_ignore} && BotDb::has_priv($ev->{nick}, 'no_react'));
  431. return 0 if ($msg !~ /^\.([a-z_]+)\s*(.*)$/);
  432. return BotPlugin::maybe_irc_command($ev->{nick}, $target, lc($1), $2, $ev->{account});
  433. }
  434. sub on_irc_msg {
  435. my $ev = $_[ARG0];
  436. my $target = $ev->{params}[0];
  437. my $msg = $ev->{params}[1];
  438. return 1 if ($config->{hardcore_ignore} && BotDb::has_priv($ev->{nick}, 'no_react'));
  439. return 0 if ($msg !~ /^\.([a-z_]+)\s*(.*)$/);
  440. return BotPlugin::maybe_irc_command($ev->{nick}, $target, lc($1), $2, $ev->{account});
  441. }
  442. sub add_handler($$$) {
  443. my ($ev, $origin, $code) = @_;
  444. if ($ev eq "irc_raw_anymsg") {
  445. &add_handler("irc_raw_msg", $origin, $code);
  446. &add_handler("irc_raw_public", $origin, $code);
  447. return;
  448. }
  449. if (!exists $handlers{$ev}) {
  450. $handlers{$ev} = [];
  451. $kernel->state($ev, sub {
  452. for (@{$handlers{$ev}}) {
  453. # Prepare handler ctx
  454. my $data = $_[ARG0];
  455. if ($ev =~ /^irc_raw_(?:msg|public)$/) {
  456. my $target = $data->{params}[0];
  457. my $msg = $data->{params}[1];
  458. my $account = $data->{account};
  459. if (!$account && $config->{use_masks}) {
  460. $account = BotDb::check_mask_auth($data->{nick}, $data->{prefix});
  461. }
  462. prepare_ctx_targets($data->{nick}, $data->{params}, $msg, $account);
  463. } else {
  464. prepare_ctx_targets($data->{nick}, $_[ARG1], "", undef);
  465. }
  466. my $res = $_->{code}(@_);
  467. %handler_ctx = ();
  468. last if ($res);
  469. }
  470. });
  471. }
  472. push @{$handlers{$ev}}, { origin => $origin, code => $code };
  473. }
  474. sub remove_handlers($) {
  475. my $origin = shift;
  476. for my $h (keys %handlers) {
  477. @{$handlers{$h}} = grep { $_->{origin} ne $origin } @{$handlers{$h}};
  478. $kernel->state($h) if (!@{$handlers{$h}});
  479. }
  480. }