diff options
| -rw-r--r-- | IdaliusConfig.pm | 70 | ||||
| -rw-r--r-- | ListParser.pm | 107 | ||||
| -rw-r--r-- | Plugin/Admin.pm | 21 | ||||
| -rw-r--r-- | Plugin/Antiflood.pm | 7 | ||||
| -rw-r--r-- | Plugin/DevNull.pm | 3 | ||||
| -rw-r--r-- | Plugin/Echo.pm | 4 | ||||
| -rw-r--r-- | Plugin/Introspect.pm | 9 | ||||
| -rw-r--r-- | Plugin/Jinx.pm | 3 | ||||
| -rw-r--r-- | Plugin/Map.pm | 52 | ||||
| -rw-r--r-- | Plugin/Random.pm | 4 | ||||
| -rw-r--r-- | Plugin/Source.pm | 2 | ||||
| -rw-r--r-- | Plugin/Thanks.pm | 2 | ||||
| -rw-r--r-- | Plugin/Timezone.pm | 12 | ||||
| -rw-r--r-- | Plugin/Titillate.pm | 14 | ||||
| -rw-r--r-- | Plugin/URL_Title.pm | 12 | ||||
| -rwxr-xr-x | idalius.pl | 64 |
16 files changed, 210 insertions, 176 deletions
diff --git a/IdaliusConfig.pm b/IdaliusConfig.pm index 0180569..5827209 100644 --- a/IdaliusConfig.pm +++ b/IdaliusConfig.pm @@ -4,8 +4,11 @@ use strict; use warnings; use Config::Tiny; -sub parse_config +use ListParser; + +sub check_config { + # FIXME to do: check that passed config is sane for core config vars my @scalar_configs = ( 'nick', 'username', @@ -30,54 +33,41 @@ sub parse_config 'plugins'); my @optional_configs = ( 'password'); + +} + +sub parse_config +{ my $file = $_[0]; my %built_config; my $config = Config::Tiny->read($file); - # FIXME catch undefined/missing config options - foreach my $option (@scalar_configs) { - my $value = $config->{_}->{$option}; - if (! defined $value && ! grep {$_ eq $option} @optional_configs) { - die "Option \"$option\" must be set in $file\n"; + foreach my $section (keys %{$config}) { + foreach my $opt (keys %{$config->{$section}}) { + # Detect list or hash config option + my $c = substr $config->{$section}->{$opt}, 0, 1; + if ($c eq "[") { + my ($error, @listified) = ListParser::parse_list($config->{$section}->{$opt}, 0); + die $error if $error; + $config->{$section}->{$opt} = \@listified; + } elsif ($c eq "{") { + my ($error, %hashified) = ListParser::parse_list($config->{$section}->{$opt}, 1); + die $error if $error; + $config->{$section}->{$opt} = \%hashified; + } } - $built_config{$option} = $config->{_}->{$option}; - } - - foreach my $option (@list_configs) { - my $vals = $config->{_}->{$option}; - $vals =~ s/^\s+|\s+$//g; - @built_config{$option} = [split /\s*,\s*/, $vals]; - } - - # special case: triggers hash - my %triggers; - foreach (split ',', $config->{_}->{triggers}) { - my ($match, $response) = split /=>/; - # strip outer quotes - $match =~ s/^[^']*'|'[^']*$//g; - $response =~ s/^[^']*'|'[^']*$//g; - $triggers{$match} = $response; - } - - # special case: timezones hash - my %timezone; - foreach (split ',', $config->{_}->{timezone}) { - my ($who, $tz) = split /=>/; - # strip outer quotes - $who =~ s/^[^']*'|'[^']*$//g; - $tz =~ s/^[^']*'|'[^']*$//g; - $timezone{$who} = $tz; } - $built_config{uid} = getpwnam($built_config{user}) - or die "Cannot get uid of $built_config{user}: $!\n"; - $built_config{gid} = getgrnam($built_config{group}) - or die "Cannot get gid of $built_config{group}: $!\n"; +# my ($error, @tmp) = ListParser::parse_list($config->{_}->{plugins}); +# $config->{_}->{plugins} = \@tmp; - $built_config{triggers} = \%triggers; - $built_config{timezone} = \%timezone; + # Special case + $config->{_}->{uid} = getpwnam($config->{_}->{user}) + or die "Cannot get uid of $config->{_}->{user}: $!\n"; + $config->{_}->{gid} = getgrnam($config->{_}->{group}) + or die "Cannot get gid of $config->{_}->{group}: $!\n"; - return %built_config; + return $config; } 1; diff --git a/ListParser.pm b/ListParser.pm new file mode 100644 index 0000000..9e3e511 --- /dev/null +++ b/ListParser.pm @@ -0,0 +1,107 @@ +package ListParser; + +sub parse_mapping { + my ($input) = @_; + my $key, $value; + my $i = 0; + my $string_start, $string_end; + $string_start = $string_end = undef; + + # Are we currently lexing inside a string literal? + my $is_string = 0; + + # Currently parsing key or value? + my $is_key = 1; + + while ($i < length($input)) { + my $c = substr($input, $i, 1); + my $lookahead = substr($input, $i+1, 1); + + if ($is_string and $c eq "'") { + $is_string = 0; + $string_end = $i; + if (not $is_key) { + $value = substr($input, $string_start, $string_end - $string_start); + } + $i++; + next; + } + if (not $is_string) { + if ($c =~ /\s/) { + # allow whitespace + } elsif ($c eq "'") { + return ("Key/value must consist of single string", undef, undef) if defined $string_end; + $is_string = 1; + $string_start = $i + 1; + } elsif ($c eq "=") { + return ("Expected > after =, got $lookahead", undef, undef) unless $lookahead eq ">"; + return ("Unexpected '=>'.", undef, undef) unless $is_key; + $i++; + + $key = substr($input, $string_start, $string_end - $string_start); + $string_start = $string_end = undef; + $is_key = 0; + } else { + return ("Unexpected $c", undef, undef); + } + } + $i++; + } + + return (undef, $key, $value); +} + +sub parse_list { + my ($input, $is_hash) = @_; + my $c_start = $is_hash ? "{" : "["; + my $c_end = $is_hash ? "}" : "]"; + my %h_res; + my @a_res; + my $i = 0; + + # Index of the start of the current item + my $item_i = 0; + + # Level of nested lists, 1 being the minimum + my $nest = 1; + + return ("Error: expected $c_start", undef) unless substr($input, $i, 1) eq $c_start; + + $i++; + $item_i = $i; + + while ($nest != 0 && $i < length($input)) { + my $c = substr($input, $i, 1); + + if ($c eq $c_start) { + $nest++; + } elsif ($c eq $c_end) { + $nest--; + } + + if (($nest == 1 and $c eq ",") || ($nest == 0 and $c eq $c_end)) { + my $item = substr($input, $item_i, $i - $item_i); + $item =~ s/^\s+|\s+$//g; + if ($is_hash) { + # FIXME should we die on duplicate keys or no? + my ($error, $key, $value) = parse_mapping($item); + die $error if $error; + $h_res{$key} = $value; + } else { + push @a_res, $item; + } + $item_i = $i+1; + } + $i++; + } + + return ("Error: expected $c_end, got end of line", undef) unless $nest == 0; + + if ($i != length($input)) { + return ("Error: unexpected item in the bagging area (after '$c_end')", undef); + } + + return (undef, %h_res) if $is_hash; + return (undef, @a_res); +} +1; diff --git a/Plugin/Admin.pm b/Plugin/Admin.pm index 02046da..f67df4d 100644 --- a/Plugin/Admin.pm +++ b/Plugin/Admin.pm @@ -3,13 +3,13 @@ package Plugin::Admin; use strict; use warnings; -my %config; +my $config; sub configure { - my $self = $_[0]; - my $cmdref = $_[1]; - my $cref = $_[2]; - %config = %$cref; + my $self = shift; + my $cmdref = shift; + shift; # run_command + $config = shift; $cmdref->("say", sub { $self->say(@_); } ); $cmdref->("action", sub { $self->do_action(@_); } ); @@ -32,7 +32,8 @@ sub configure { sub is_admin { my $who = shift; - my $is_admin = grep {$_ eq $who} @{$config{admins}}; + print "admins are ".(join ", ", $config->{admins})."\n"; + my $is_admin = grep {$_ eq $who} @{$config->{admins}}; if (!$is_admin) { # Uhh log this rather than print print "$who isn't an admin, but tried to use a command"; @@ -148,7 +149,7 @@ sub ignore { return unless is_admin($who); return "Syntax: ignore <nick>" unless @arguments == 1; - push @{$config{ignore}}, $arguments[0]; + push @{$config->{ignore}}, $arguments[0]; return "Ignoring $arguments[0]"; } @@ -161,8 +162,8 @@ sub do_not_ignore { my $target = $arguments[0]; - if (grep { $_ eq $target} @{$config{ignore}}) { - @{$config{ignore}} = grep { $_ ne $target } @{$config{ignore}}; + if (grep { $_ eq $target} @{$config->{ignore}}) { + @{$config->{ignore}} = grep { $_ ne $target } @{$config->{ignore}}; return "No longer ignoring $target."; } else { return "I wasn't ignoring $target anyway."; @@ -175,7 +176,7 @@ sub dump_ignore { return "Syntax: who are you ignoring?" unless @arguments == 0; # FIXME special case for empty ignore - return "I am ignoring: " . join ", ", @{$config{ignore}}; + return "I am ignoring: " . join ", ", @{$config->{ignore}}; } sub exit { diff --git a/Plugin/Antiflood.pm b/Plugin/Antiflood.pm index eafa50c..77d7f17 100644 --- a/Plugin/Antiflood.pm +++ b/Plugin/Antiflood.pm @@ -7,14 +7,11 @@ my $message_count = 5; my $message_period = 11; -my %config; my %lastmsg = (); sub configure { - my $self = $_[0]; - my $cmdref = $_[1]; - my $cref = $_[2]; - %config = %$cref; + my $self = shift; + my $cmdref = shift; return $self; } diff --git a/Plugin/DevNull.pm b/Plugin/DevNull.pm index b29a71a..0565aec 100644 --- a/Plugin/DevNull.pm +++ b/Plugin/DevNull.pm @@ -3,15 +3,12 @@ package Plugin::DevNull; use strict; use warnings; -my %config; my $run_command; sub configure { my $self = shift; my $cmdref = shift; - my $cref = shift; $run_command = shift; - %config = %$cref; $cmdref->("hush", sub { $self->hush(@_); } ); $cmdref->("devnull", sub { $self->hush(@_); } ); diff --git a/Plugin/Echo.pm b/Plugin/Echo.pm index 76a245a..2cd59fc 100644 --- a/Plugin/Echo.pm +++ b/Plugin/Echo.pm @@ -3,13 +3,9 @@ package Plugin::Echo; use strict; use warnings; -my %config; - sub configure { my $self = shift; my $cmdref = shift; - my $cref = shift; - %config = %$cref; $cmdref->("echo", sub { $self->echo(@_); } ); diff --git a/Plugin/Introspect.pm b/Plugin/Introspect.pm index 2f42cb2..4c53984 100644 --- a/Plugin/Introspect.pm +++ b/Plugin/Introspect.pm @@ -3,13 +3,14 @@ package Plugin::Introspect; use strict; use warnings; -my %config; +my $root_config; sub configure { my $self = shift; my $cmdref = shift; - my $cref = shift; - %config = %$cref; + shift; # run_command + shift; # module config + $root_config = shift; $cmdref->("plugins", sub { $self->dump_plugins(@_); } ); @@ -18,6 +19,6 @@ sub configure { sub dump_plugins { my ($self, $irc, $logger, $who, $where, $rest, @arguments) = @_; - return "Plugins: " . join ", ", @{$config{plugins}}; + return "Plugins: " . join ", ", $root_config->{plugins}; } 1; diff --git a/Plugin/Jinx.pm b/Plugin/Jinx.pm index a514bb8..f1e712b 100644 --- a/Plugin/Jinx.pm +++ b/Plugin/Jinx.pm @@ -11,13 +11,10 @@ my %last_response; # Last message said on the channel my %last; -my %config; sub configure { my $self = $_[0]; my $cmdref = $_[1]; - my $cref = $_[2]; - %config = %$cref; return $self; } diff --git a/Plugin/Map.pm b/Plugin/Map.pm index 665f41f..1e24f9c 100644 --- a/Plugin/Map.pm +++ b/Plugin/Map.pm @@ -3,15 +3,13 @@ package Plugin::Map; use strict; use warnings; -my %config; -my $run_command; +use ListParser; +my $run_command; sub configure { my $self = shift; my $cmdref = shift; - my $cref = shift; - %config = %$cref; $run_command = shift; $cmdref->("map", sub { $self->map(@_); } ); @@ -19,50 +17,6 @@ sub configure { return $self; } -sub parse_list { - my ($input) = @_; - my @res; - my $i = 0; - - # Index of the start of the current item - my $item_i = 0; - - # Level of nested lists, 1 being the minimum - my $nest = 1; - - # Are we currently lexing inside a string literal? - my $is_string = 0; - - return ("Error: expected [", undef) unless substr($input, $i, 1) eq "["; - $i++; - $item_i = $i; - - while ($nest != 0 && $i < length($input)) { - my $c = substr($input, $i, 1); - - if ($c eq "[") { - $nest++; - } elsif ($c eq "]") { - $nest--; - } - - if (($nest == 1 and $c eq ",") || ($nest == 0 and $c eq "]")) { - my $item = substr($input, $item_i, $i - $item_i); - $item =~ s/^\s+|\s+$//g; - push @res, $item; - $item_i = $i+1; - } - $i++; - } - - return ("Error: expected ], got end of line", undef) unless $nest == 0; - - if ($i != length($input)) { - return ("Error: unexpected item in the bagging area (after ']')", undef); - } - - return (undef, @res); -} sub map { my ($self, $irc, $logger, $who, $where, $rest, @arguments) = @_; @@ -70,7 +24,7 @@ sub map { return "Syntax: map command [item1, item2, ...]" unless $command and $subjects_raw; - my ($e, @subjects) = parse_list($subjects_raw); + my ($e, @subjects) = ListParser::parse_list($subjects_raw); return $e if $e; my @results = map { $run_command->("$command $_", $who, $where) } @subjects; diff --git a/Plugin/Random.pm b/Plugin/Random.pm index bd1c4d2..27332f8 100644 --- a/Plugin/Random.pm +++ b/Plugin/Random.pm @@ -5,13 +5,9 @@ use warnings; use List::Util; -my %config; - sub configure { my $self = shift; my $cmdref = shift; - my $cref = shift; - %config = %$cref; $cmdref->("shuffle", sub { $self->shuffle(@_); } ); $cmdref->("choose", sub { $self->choose(@_); } ); diff --git a/Plugin/Source.pm b/Plugin/Source.pm index dcb92e6..e3774e9 100644 --- a/Plugin/Source.pm +++ b/Plugin/Source.pm @@ -3,8 +3,6 @@ package Plugin::Source; use strict; use warnings; -my %config; - sub configure { my $self = shift; my $cmdref = shift; diff --git a/Plugin/Thanks.pm b/Plugin/Thanks.pm index 431db5d..e40e3ef 100644 --- a/Plugin/Thanks.pm +++ b/Plugin/Thanks.pm @@ -3,8 +3,6 @@ package Plugin::Thanks; use strict; use warnings; -my %config; - sub configure { my $self = shift; my $cmdref = shift; diff --git a/Plugin/Timezone.pm b/Plugin/Timezone.pm index 53f8f4a..b88b6b9 100644 --- a/Plugin/Timezone.pm +++ b/Plugin/Timezone.pm @@ -8,10 +8,10 @@ use DateTime; my %config; sub configure { - my $self = $_[0]; - my $cmdref = $_[1]; - my $cref = $_[2]; - %config = %$cref; + my $self = shift; + my $cmdref = shift; + shift; # run_command + $config = shift; $cmdref->("time", sub { $self->time(@_); } ); @@ -22,7 +22,7 @@ sub time { my ($self, $irc, $logger, $who, $where, $rest, @arguments) = @_; my $requester = (split /!/, $who)[0]; - my @known_zones = (keys %{$config{timezone}}); + my @known_zones = (keys %{$config->{timezone}}); return "Syntax: time [nick]" unless @arguments == 1; @@ -30,7 +30,7 @@ sub time { my ($case_nick) = grep {/^$nick$/i} @known_zones; if ($case_nick) { my $d = DateTime->now(); - $d->set_time_zone($config{timezone}->{$case_nick}); + $d->set_time_zone($config->{timezone}->{$case_nick}); my $timestr = $d->strftime("%Y-%m-%d %H:%M %Z"); return "$requester: $nick\'s clock reads $timestr"; } else { diff --git a/Plugin/Titillate.pm b/Plugin/Titillate.pm index 79f1a4a..5ce5eeb 100644 --- a/Plugin/Titillate.pm +++ b/Plugin/Titillate.pm @@ -3,20 +3,20 @@ package Plugin::Titillate; use strict; use warnings; -my %config; +my $config; sub configure { - my $self = $_[0]; - my $cmdref = $_[1]; - my $cref = $_[2]; - %config = %$cref; + my $self = shift; + my $cmdref = shift; + shift; # run_command + $config = shift; return $self; } sub on_message { my ($self, $logger, $me, $who, $where, $raw_what, $what, $irc) = @_; my $gathered = ""; - my @expressions = (keys %{$config{triggers}}); + my @expressions = (keys %{$config->{triggers}}); my $expression = join '|', @expressions; while ($what =~ /($expression)/gi) { my $matched = $1; @@ -28,7 +28,7 @@ sub on_message { last; } } - $gathered .= $config{triggers}->{$key}; + $gathered .= $config->{triggers}->{$key}; } return $gathered; } diff --git a/Plugin/URL_Title.pm b/Plugin/URL_Title.pm index 53d6326..9d20cd6 100644 --- a/Plugin/URL_Title.pm +++ b/Plugin/URL_Title.pm @@ -6,13 +6,13 @@ use HTTP::Tiny; use HTML::Parser; use utf8; -my %config; +my $config; sub configure { - my $self = $_[0]; - my $cmdref = $_[1]; - my $cref = $_[2]; - %config = %$cref; + my $self = shift; + my $cmdref = shift; + shift; # run_command + $config = shift; return $self; } @@ -75,7 +75,7 @@ sub on_message $shorturl =~ s,/$,,g; # truncate URL without http(s):// to configured length if needed - $shorturl = (substr $shorturl, 0, $config{url_len}) . "β¦" if length ($shorturl) > $config{url_len}; + $shorturl = (substr $shorturl, 0, $config->{url_len}) . "β¦" if length ($shorturl) > $config->{url_len}; my $composed_title = "$title ($shorturl)"; return $composed_title; @@ -11,7 +11,7 @@ use IdaliusConfig; use IRC::Utils qw(strip_color strip_formatting); my $config_file = "bot.conf"; -my %config = IdaliusConfig::parse_config($config_file); +my $config = IdaliusConfig::parse_config($config_file); my %laststrike = (); my $ping_delay = 300; my %commands = (); @@ -23,42 +23,44 @@ sub log_info { } eval { - for my $module (@{$config{plugins}}) { + for my $module (@{$config->{_}->{plugins}}) { log_info "Loading $module"; (my $path = $module) =~ s,::,/,g; require $path . ".pm"; - $module->configure(\®ister_command, \%config, \&run_command); + $module->configure( + \®ister_command, + \&run_command, + $config->{$module}, + $config->{_}); } 1; } or do { log_info "Error: failed to load module: $@"; + die; }; $| = 1; -my $current_nick = $config{nick}; - -# Hack: coerce into numeric type -+$config{url_len}; +my $current_nick = $config->{_}->{nick}; # New PoCo-IRC object my $irc = POE::Component::IRC->spawn( - UseSSL => $config{usessl}, - SSLCert => $config{sslcert}, - SSLKey => $config{sslkey}, - nick => $config{nick}, - ircname => $config{ircname}, - port => $config{port}, - server => $config{server}, - username => $config{username}, + UseSSL => $config->{_}->{usessl}, + SSLCert => $config->{_}->{sslcert}, + SSLKey => $config->{_}->{sslkey}, + nick => $config->{_}->{nick}, + ircname => $config->{_}->{ircname}, + port => $config->{_}->{port}, + server => $config->{_}->{server}, + username => $config->{_}->{username}, ) or die "Failed to create new PoCo-IRC: $!"; # Plugins -$config{password} and $irc->plugin_add( +$config->{_}->{password} and $irc->plugin_add( 'NickServID', POE::Component::IRC::Plugin::NickServID->new( - Password => $config{password} + Password => $config->{_}->{password} )); POE::Session->create( @@ -88,7 +90,7 @@ $poe_kernel->run(); sub module_is_enabled { my $module = $_[0]; - return grep {$_ eq $module} @{$config{plugins}}; + return grep {$_ eq $module} @{$config->{_}->{plugins}}; } # Register a command name to a certain sub @@ -127,8 +129,8 @@ sub custom_ping { } sub drop_priv { - setgid($config{gid}) or die "Failed to setgid: $!\n"; - setuid($config{uid}) or die "Failed to setuid: $!\n"; + setgid($config->{_}->{gid}) or die "Failed to setgid: $!\n"; + setuid($config->{_}->{uid}) or die "Failed to setuid: $!\n"; } # Add a strike against a nick for module flood protection @@ -147,14 +149,14 @@ sub strike_add { if ($now - $first <= $strike_period) { log_info "Ignoring $nick because of command flood"; $irc->yield(privmsg => $channel => "$nick: I'm ignoring you now, you've caused me to talk too much"); - push @{$config{ignore}}, $nick; + push @{$config->{_}->{ignore}}, $nick; } } } sub should_ignore { my ($nick) = @_; - return grep {$_ eq $nick} @{$config{ignore}}; + return grep {$_ eq $nick} @{$config->{_}->{ignore}}; } sub _start { @@ -171,8 +173,8 @@ sub irc_001 { log_info("Connected to server ", $heap->server_name()); - $current_nick = $config{nick}; - $heap->yield(join => $_) for @{$config{channels}}; + $current_nick = $config->{_}->{nick}; + $heap->yield(join => $_) for @{$config->{_}->{channels}}; $irc->delay(custom_ping => $ping_delay); return; } @@ -205,8 +207,8 @@ sub handle_common { my $stripped_what = strip_color(strip_formatting($what)); my $no_prefix_what = $stripped_what; - if (!should_ignore($nick) && ($config{prefix_nick} && $no_prefix_what =~ s/^\Q$current_nick\E[:,]\s+//g || - $no_prefix_what =~ s/^$config{prefix}//)) { + if (!should_ignore($nick) && ($config->{_}->{prefix_nick} && $no_prefix_what =~ s/^\Q$current_nick\E[:,]\s+//g || + $no_prefix_what =~ s/^$config->{_}->{prefix}//)) { $output = run_command($no_prefix_what, $who, $where); $irc->yield(privmsg => $where => $output) if $output; strike_add($nick, $channel) if $output; @@ -215,7 +217,7 @@ sub handle_common { # handler names are defined as being prefixed with on_ $message_type = "on_$message_type"; my $ignore_suffix = "_yes_really_even_from_ignored_nicks"; - for my $module (@{$config{plugins}}) { + for my $module (@{$config->{_}->{plugins}}) { if (module_is_enabled($module)) { if (!should_ignore($nick) and $module->can($message_type)) { # Leave message type unchanged @@ -258,12 +260,12 @@ sub irc_public { sub irc_msg { my ($who, $to, $what, $ided) = @_[ARG0 .. ARG3]; my $nick = (split /!/, $who)[0]; - my $is_admin = grep {$_ eq $who} @{$config{admins}}; + my $is_admin = grep {$_ eq $who} @{$config->{_}->{admins}}; # reject ignored nicks who aren't also admins (prevent lockout) return if should_ignore($nick) and not $is_admin; - if ($config{must_id} && $ided != 1) { + if ($config->{_}->{must_id} && $ided != 1) { $irc->yield(privmsg => $nick => "You must identify with services"); return; } @@ -278,12 +280,12 @@ sub irc_msg { sub irc_invite { my ($who, $where) = @_[ARG0 .. ARG1]; - $irc->yield(join => $where) if (grep {$_ eq $where} @{$config{channels}}); + $irc->yield(join => $where) if (grep {$_ eq $where} @{$config->{_}->{channels}}); } sub irc_disconnected { _default(@_); # Dump the message - %config = IdaliusConfig::parse_config($config_file); + $config = IdaliusConfig::parse_config($config_file); $irc->yield(connect => { }); } |