summaryrefslogtreecommitdiffstats
path: root/modules
diff options
context:
space:
mode:
authorLibravatarJanik Kleinhoff <janik@kleinhoff.de>2015-09-24 01:32:11 +0000
committerLibravatarJanik Kleinhoff <janik@kleinhoff.de>2015-09-24 01:32:11 +0000
commit9b472795d26cd93d1bb58488ef60a062f5237295 (patch)
tree8572778595d145176e720a1b7168c73adbd64ed4 /modules
parentb93c3a24f14e0f64bc46b4945a65ae1bba62dc12 (diff)
Rework module paths
Diffstat (limited to 'modules')
-rw-r--r--modules/classes.pl514
-rw-r--r--modules/command.pl61
-rw-r--r--modules/event.pl887
-rw-r--r--modules/inspect.pl101
-rw-r--r--modules/log.pl112
-rw-r--r--modules/mysql.pl323
-rw-r--r--modules/services.pl69
-rw-r--r--modules/util.pl297
-rw-r--r--modules/xml.pl69
9 files changed, 0 insertions, 2433 deletions
diff --git a/modules/classes.pl b/modules/classes.pl
deleted file mode 100644
index 1054f63..0000000
--- a/modules/classes.pl
+++ /dev/null
@@ -1,514 +0,0 @@
-package ASM::Classes;
-
-use strict;
-use warnings;
-use Text::LevenshteinXS qw(distance);
-use Data::Dumper;
-use Regexp::Wildcards;
-use Carp qw(cluck);
-
-my %sf = ();
-
-sub new
-{
- my $module = shift;
- my $self = {};
- my $tbl = {
- "strbl" => \&strbl,
- "strblnew" => \&strblnew,
- "dnsbl" => \&dnsbl,
- "floodqueue" => \&floodqueue,
- "floodqueue2" => \&floodqueue2,
- "nickspam" => \&nickspam,
- "splitflood" => \&splitflood,
- "advsplitflood" => \&advsplitflood,
- "re" => \&re,
- "nick" => \&nick,
- "ident" => \&ident,
- "host" => \&host,
- "gecos" => \&gecos,
- "nuhg" => \&nuhg,
- "levenflood" => \&levenflood,
- "proxy" => \&proxy,
- "nickbl" => \&nickbl,
- "nickfuzzy" => \&nickfuzzy,
- "asciiflood" => \&asciiflood,
- "joinmsgquit" => \&joinmsgquit,
- "garbagemeter" => \&garbagemeter,
- "cyclebotnet" => \&cyclebotnet,
- "banevade" => \&banevade,
- "urlcrunch" => \&urlcrunch
- };
- $self->{ftbl} = $tbl;
- bless($self);
- return $self;
-}
-
-sub garbagemeter {
- my ($chk, $id, $event, $chan, $rev) = @_;
- my @cut = split(/:/, $chk->{content});
- my $limit = int($cut[0]);
- my $timeout = int($cut[1]);
- my $threshold = int($cut[2]);
- my $threshold2 = int($cut[3]);
- my $wordcount = 0;
- my $line = $event->{args}->[0];
- return 0 unless ($line =~ /^[A-Za-z: ]+$/);
- my @words = split(/ /, $line);
- return 0 unless ((scalar @words) >= $threshold2);
- foreach my $word (@words) {
- if (defined($::wordlist{lc $word})) {
- $wordcount += 1;
- }
- return 0 if ($wordcount >= $threshold);
- }
- return 1 if ( flood_add( $chan, $id, 0, $timeout ) == $limit );
- return 0;
-}
-
-sub joinmsgquit
-{
- my ($chk, $id, $event, $chan, $rev) = @_;
- my $time = $chk->{content};
-##STATE
- $chan = lc $chan; #don't know if this is necessary but I'm trying to track down some mysterious state tracking corruption
- return 0 unless defined($::sc{$chan}{users}{lc $event->{nick}}{jointime});
- return 0 unless defined($::sc{$chan}{users}{lc $event->{nick}}{msgtime});
- return 0 if ((time - $::sc{$chan}{users}{lc $event->{nick}}{jointime}) > $time);
- return 0 if ((time - $::sc{$chan}{users}{lc $event->{nick}}{msgtime}) > $time);
- return 1;
-}
-
-sub urlcrunch
-{
- my ($chk, $id, $event, $chan, $response) = @_;
- return 0 unless defined($response);
- return 0 unless ref($response);
- return 0 unless defined($response->{_previous});
- return 0 unless defined($response->{_previous}->{_headers});
- return 0 unless defined($response->{_previous}->{_headers}->{location});
- if ($response->{_previous}->{_headers}->{location} =~ /$chk->{content}/i) {
- return 1;
- }
- return 0;
-}
-
-sub check
-{
- my $self = shift;
- my $item = shift;
- return $self->{ftbl}->{$item}->(@_);
-}
-
-sub nickbl
-{
- my ($chk, $id, $event, $chan, $rev) = @_;
- my $match = lc $event->{nick};
- foreach my $line (@::nick_blacklist) {
- if ($line eq $match) {
- return 1;
- }
- }
- return 0;
-}
-
-sub banevade
-{
- my ($chk, $id, $event, $chan, $rev) = @_;
- my $ip = ASM::Util->getNickIP($event->{nick});
- return 0 unless defined($ip);
- if (defined($::sc{lc $chan}{ipbans}{$ip})) {
- return 1;
- }
- return 0;
-}
-
-sub proxy
-{
- my ($chk, $id, $event, $chan, $rev) = @_;
- if (defined($rev) and ($rev =~ /(\d+)\.(\d+)\.(\d+)\.(\d+)\./)) {
- if (defined($::proxies{"$4.$3.$2.$1"})) {
- return 1;
- }
- }
- return 0;
-}
-
-my %ls = ();
-sub levenflood
-{
- my ($chk, $id, $event, $chan) = @_;
- my $text;
- if ($event->{type} =~ /^(public|notice|part|caction)$/) {
- $text = $event->{args}->[0];
- }
- return 0 unless ( defined($text) && (length($text) >= 30) );
- if ( ! defined($ls{$chan}) ) {
- $ls{$chan} = [ $text ];
- return 0;
- }
- my @leven = @{$ls{$chan}};
- my $ret = 0;
- if ( $#leven >= 5 ) {
- my $mx = 0;
- foreach my $item ( @leven ) {
- next unless length($text) eq length($item);
- my $tld = distance($text, $item);
- if ($tld <= 4) {
- $mx = $mx + 1;
- }
- }
- if ($mx >= 5) {
- $ret = 1;
- }
- }
- push(@leven, $text);
- shift @leven if $#leven > 10;
- $ls{$chan} = \@leven;
- return $ret;
-}
-
-sub nickfuzzy
-{
- my ($chk, $id, $event, $chan) = @_;
- my $nick = $event->{nick};
- $nick = $event->{args}->[0] if ($event->{type} eq 'nick');
- my ($fuzzy, $match) = split(/:/, $chk->{content});
- my @nicks = split(/,/, $match);
- foreach my $item (@nicks) {
- if (distance(lc $nick, lc $item) <= $fuzzy) {
- return 1;
- }
- }
- return 0;
-}
-
-sub dnsbl
-{
- my ($chk, $id, $event, $chan, $rev) = @_;
-# return unless index($event->{host}, '/') == -1;
-# hopefully getting rid of this won't cause shit to assplode
-# but I'm getting rid of it so it can detect cgi:irc shit
-# return 0;
- if (defined $rev) {
- ASM::Util->dprint("Querying $rev$chk->{content}", "dnsbl");
- #cluck "Calling gethostbyname in dnsbl";
- my $iaddr = gethostbyname( "$rev$chk->{content}" );
- my @dnsbl = unpack( 'C4', $iaddr ) if defined $iaddr;
- my $strip;
- if (@dnsbl) {
- $strip = sprintf("%s.%s.%s.%s", @dnsbl);
- ASM::Util->dprint("found host (rev $rev) in $chk->{content} - $strip", 'dnsbl');
- }
- if ((@dnsbl) && (defined($::dnsbl->{query}->{$chk->{content}}->{response}->{$strip}))) {
- $::lastlookup=$::dnsbl->{query}->{$chk->{content}}->{response}->{$strip}->{content};
- ASM::Util->dprint("chk->content: $chk->{content}", 'dnsbl');
- ASM::Util->dprint("strip: $strip", 'dnsbl');
- ASM::Util->dprint("result: " . $::dnsbl->{query}->{$chk->{content}}->{response}->{$strip}->{content}, 'dnsbl');
- $::sn{lc $event->{nick}}->{dnsbl} = 1;
- # lol really icky hax
- return $::dnsbl->{query}->{$chk->{content}}->{response}->{$strip}->{content};
- }
- }
- return 0;
-}
-
-sub floodqueue2 {
- my ($chk, $id, $event, $chan, $rev) = @_;
- my @cut = split(/:/, $chk->{content});
-
- my $cvt = Regexp::Wildcards->new(type => 'jokers');
- my $hit = 0;
- foreach my $mask ( keys %{$::sc{lc $chan}{quiets}}) {
- if ($mask !~ /^\$/) {
- my @div = split(/\$/, $mask);
- my $regex = $cvt->convert($div[0]);
- if (lc $event->{from} =~ lc $regex) {
- $hit = 1;
- }
- } elsif ( (defined($::sn{lc $event->{nick}}{account})) && ($mask =~ /^\$a:(.*)/)) {
- my @div = split(/\$/, $mask);
- my $regex = $cvt->convert($div[0]);
- if (lc ($::sn{lc $event->{nick}}{account}) =~ lc $regex) {
- $hit = 1;
- }
- }
- }
- return 0 unless $hit;
-
- return 1 if ( flood_add( $chan, $id, $event->{host}, int($cut[1]) ) == int($cut[0]) );
- return 0;
-}
-
-sub floodqueue {
- my ($chk, $id, $event, $chan, $rev) = @_;
- my @cut = split(/:/, $chk->{content});
- return 1 if ( flood_add( $chan, $id, $event->{host}, int($cut[1]) ) == int($cut[0]) );
- return 0;
-}
-
-sub asciiflood {
- my ($chk, $id, $event, $chan, $rev) = @_;
- my @cut = split(/:/, $chk->{content});
- return 0 if (length($event->{args}->[0]) < $cut[0]);
- return 0 if ($event->{args}->[0] =~ /[A-Za-z0-9]/);
- return 1 if ( flood_add( $chan, $id, $event->{host}, int($cut[2]) ) == int($cut[1]) );
- return 0;
-}
-
-sub cyclebotnet
-{
- my ($chk, $id, $event, $chan, $rev) = @_;
- my ($cycletime, $queueamt, $queuetime) = split(/:/, $chk->{content});
- $chan = lc $chan; #don't know if this is necessary but I'm trying to track down some mysterious state tracking corruption
- return 0 unless defined($::sc{$chan}{users}{lc $event->{nick}}{jointime});
- return 0 if ((time - $::sc{$chan}{users}{lc $event->{nick}}{jointime}) > int($cycletime));
- return 1 if ( flood_add( $chan, $id, "cycle", int($queuetime)) == int($queueamt) );
- return 0;
-}
-
-sub nickspam {
- my ($chk, $id, $event, $chan) = @_;
- my @cut = split(/:/, $chk->{content});
- if ( length $event->{args}->[0] >= int($cut[0]) ) {
- my %users = %{$::sc{lc $chan}->{users}};
- my %x = map { $_=>$_ } keys %users;
- my @uniq = grep( $x{$_}, split( /[^a-zA-Z0-9_\\|`[\]{}^-]+/ , lc $event->{args}->[0]) );
- return 1 if ( @uniq >= int($cut[1]) );
- }
- return 0;
-}
-
-my %cf=();
-my %bs=();
-my $cfc = 0;
-sub process_cf
-{
- foreach my $nid ( keys %cf ) {
- foreach my $xchan ( keys %{$cf{$nid}} ) {
- next if $xchan eq 'timeout';
- foreach my $host ( keys %{$cf{$nid}{$xchan}} ) {
- next unless defined $cf{$nid}{$xchan}{$host}[0];
- while ( time >= $cf{$nid}{$xchan}{$host}[0] + $cf{$nid}{'timeout'} ) {
- shift ( @{$cf{$nid}{$xchan}{$host}} );
- if ( (scalar @{$cf{$nid}{$xchan}{$host}}) == 0 ) {
- delete $cf{$nid}{$xchan}{$host};
- last;
- }
-# last if ( $#{ $cf{$nid}{$xchan}{$host} } == 0 );
-# shift ( @{$cf{$nid}{$xchan}{$host}} );
- }
- }
- }
- }
-}
-
-sub splitflood {
- my ($chk, $id, $event, $chan) = @_;
- my $text;
- my @cut = split(/:/, $chk->{content});
- $cf{$id}{timeout}=int($cut[1]);
- if ($event->{type} =~ /^(public|notice|part|caction)$/) {
- $text=$event->{args}->[0];
- }
- return unless defined($text);
- # a bit ugly but this should avoid alerting on spammy bot commands
- # give them the benefit of the doubt if they talked before ... but not too recently
- # if we didn't see them join, assume they did talk at some point
- my $msgtime = $::sc{$chan}{users}{lc $event->{nick}}{msgtime} // 0;
- $msgtime ||= 1 if !$::sc{$chan}{users}{lc $event->{nick}}{jointime};
- return if $text =~ /^[^\w\s]+\w+\s*$/ && $msgtime && ($msgtime + 2 * $cf{$id}{timeout}) < time;
-# return unless length($text) >= 10;
- if (defined($bs{$id}{$text}) && (time <= $bs{$id}{$text} + 600)) {
- return 1;
- }
- push( @{$cf{$id}{$chan}{$text}}, time );
- while ( time >= $cf{$id}{$chan}{$text}[0] + $cf{$id}{'timeout'} ) {
- last if ( $#{$cf{$id}{$chan}{$text}} == 0 );
- shift ( @{$cf{$id}{$chan}{$text}} );
- }
- $cfc = $cfc + 1;
- if ( $cfc >= 100 ) {
- $cfc = 0;
- process_cf();
- }
- if ( scalar @{$cf{$id}{$chan}{$text}} == int($cut[0]) ) {
- $bs{$id}{$text} = time unless length($text) < 10;
- return 1;
- }
- return 0;
-}
-
-sub advsplitflood {
- my ($chk, $id, $event, $chan) = @_;
- my $text;
- my @cut = split(/:/, $chk->{content});
- $cf{$id}{timeout}=int($cut[1]);
- if ($event->{type} =~ /^(public|notice|part|caction)$/) {
- $text=$event->{args}->[0];
- }
- return unless defined($text);
- $text=~s/^\d*(.*)\d*$/$1/;
- return unless length($text) >= 10;
- if (defined($bs{$id}{$text}) && (time <= $bs{$id}{$text} + 600)) {
- return 1;
- }
- push( @{$cf{$id}{$chan}{$text}}, time );
- while ( time >= $cf{$id}{$chan}{$text}[0] + $cf{$id}{'timeout'} ) {
- last if ( $#{$cf{$id}{$chan}{$text}} == 0 );
- shift ( @{$cf{$id}{$chan}{$text}} );
- }
- $cfc = $cfc + 1;
- if ( $cfc >= 100 ) {
- $cfc = 0;
- process_cf();
- }
- if ( scalar @{$cf{$id}{$chan}{$text}} == int($cut[0]) ) {
- $bs{$id}{$text} = time;
- return 1;
- }
- return 0;
-}
-
-sub re {
- my ($chk, $id, $event, $chan) = @_;
- my $match = $event->{args}->[0];
- $match = $event->{nick} if ($event->{type} eq 'join');
- return 1 if ($match =~ /$chk->{content}/);
- return 0;
-}
-
-sub strbl {
- my ($chk, $id, $event, $chan) = @_;
- my $match = lc $event->{args}->[0];
- foreach my $line (@::string_blacklist) {
- my $xline = lc $line;
- my $idx = index $match, $xline;
- if ( $idx != -1 ) {
- return 1;
- }
- }
- return 0;
-}
-
-sub strblnew {
- my ($chk, $xid, $event, $chan) = @_;
- my $match = lc $event->{args}->[0];
- foreach my $id (keys %{$::blacklist->{string}}) {
- my $line = lc $::blacklist->{string}->{$id}->{content};
- my $idx = index $match, $line;
- if ( $idx != -1 ) {
- my $setby = $::blacklist->{string}->{$id}->{setby};
- $setby = substr($setby, 0, 1) . "\x02\x02" . substr($setby, 1);
- return defined($::blacklist->{string}->{$id}->{reason}) ?
- "id $id added by $setby because $::blacklist->{string}->{$id}->{reason}" :
- "id $id added by $setby for no reason";
- }
- }
- return 0;
-}
-
-sub nick {
- my ($chk, $id, $event, $chan) = @_;
- if ( lc $event->{nick} eq lc $chk->{content} ) {
- return 1;
- }
- return 0;
-}
-
-sub ident {
- my ( $chk, $id, $event, $chan) = @_;
- if ( lc $event->{user} eq lc $chk->{content} ) {
- return 1;
- }
- return 0;
-}
-
-sub host {
- my ( $chk, $id, $event, $chan) = @_;
- if ( lc $event->{host} eq lc $chk->{content} ) {
- return 1;
- }
- return 0;
-}
-
-sub gecos {
- my ( $chk, $id, $event, $chan) = @_;
- if ( lc $::sn{lc $event->{nick}}->{gecos} eq lc $chk->{content} ) {
- return 1;
- }
- return 0;
-}
-
-sub nuhg {
- my ( $chk, $id, $event, $chan) = @_;
- return 0 unless defined($::sn{lc $event->{nick}}->{gecos});
- my $match = $event->{from} . '!' . $::sn{lc $event->{nick}}->{gecos};
- return 1 if ($match =~ /$chk->{content}/);
- return 0;
-}
-
-sub invite {
- my ( $chk, $id, $event, $chan) = @_;
- return 1;
-}
-
-my $sfc = 0;
-
-sub flood_add
-{
- my ( $chan, $id, $host, $to ) = @_;
- push( @{$sf{$id}{$chan}{$host}}, time );
- while ( time >= $sf{$id}{$chan}{$host}[0] + $to ) {
- last if ( $#{ $sf{$id}{$chan}{$host} } == 0 );
- shift( @{$sf{$id}{$chan}{$host}} );
- }
- $sf{$id}{'timeout'} = $to;
- $sfc = $sfc + 1;
- if ($sfc > 100) {
- $sfc = 0;
- flood_process();
- }
-# return $#{ @{$sf{$id}{$chan}{$host}}}+1;
- return scalar @{$sf{$id}{$chan}{$host}};
-}
-
-sub flood_process
-{
- for my $id ( keys %sf ) {
- for my $chan ( keys %{$sf{$id}} ) {
- next if $chan eq 'timeout';
- for my $host ( keys %{$sf{$id}{$chan}} ) {
- next unless defined $sf{$id}{$chan}{$host}[0];
- while ( time >= $sf{$id}{$chan}{$host}[0] + $sf{$id}{'timeout'} ) {
- shift ( @{$sf{$id}{$chan}{$host}} );
- if ( (scalar @{$sf{$id}{$chan}{$host}}) == 0 ) {
- delete $sf{$id}{$chan}{$host};
- last;
- }
-# last if ( $#{ $sf{$id}{$chan}{$host} } == 0 );
-# shift ( @{$sf{$id}{$chan}{$host}} );
- }
- }
- }
- }
-}
-
-sub dump
-{
- #%sf, %ls, %cf, %bs
- open(FH, ">", "sf.txt");
- print FH Dumper(\%sf);
- close(FH);
- open(FH, ">", "ls.txt");
- print FH Dumper(\%ls);
- close(FH);
- open(FH, ">", "cf.txt");
- print FH Dumper(\%cf);
- close(FH);
- open(FH, ">", "bs.txt");
- print FH Dumper(\%bs);
- close(FH);
-}
-
-1;
diff --git a/modules/command.pl b/modules/command.pl
deleted file mode 100644
index aa79f4d..0000000
--- a/modules/command.pl
+++ /dev/null
@@ -1,61 +0,0 @@
-package ASM::Commander;
-
-use warnings;
-use strict;
-use IO::All;
-use POSIX qw(strftime);
-use Data::Dumper;
-use URI::Escape;
-
-sub new
-{
- my $module = shift;
- my $self = {};
- bless($self);
- return $self;
-}
-
-sub command
-{
- my ($self, $conn, $event) = @_;
- my $args = $event->{args}->[0];
- my $from = $event->{from};
- my $cmd = $args;
- my $d1;
- my $nick = lc $event->{nick};
- my $acct = lc $::sn{$nick}->{account};
-# return 0 unless (ASM::Util->speak($event->{to}->[0]));
- foreach my $command ( @{$::commands->{command}} )
- {
- my $fail = 0;
- unless ( (ASM::Util->speak($event->{to}->[0])) ) {
- next unless (defined($command->{nohush}) && ($command->{nohush} eq "nohush"));
- }
- if (defined($command->{flag})) { #If the command is restricted,
- if (!defined($::users->{person}->{$acct})) { #make sure the requester has an account
- $fail = 1;
- }
- elsif (!defined($::users->{person}->{$acct}->{flags})) { #make sure the requester has flags defined
- $fail = 1;
- }
- elsif (!(grep {$_ eq $command->{flag}} split('', $::users->{person}->{$acct}->{flags}))) { #make sure the requester has the needed flags
- $fail = 1;
- }
- }
- if ($cmd=~/$command->{cmd}/) {
- ASM::Util->dprint("$event->{from} told me: $cmd", "commander");
- if (!ASM::Util->notRestricted($nick, "nocommands")) {
- $fail = 1;
- }
- if ($fail == 1) {
- $conn->privmsg($nick, "You don't have permission to use that command, or you're not signed into nickserv.");
- } else {
- eval $command->{content};
- warn $@ if $@;
- }
- last;
- }
- }
-}
-
-1;
diff --git a/modules/event.pl b/modules/event.pl
deleted file mode 100644
index e6f4c23..0000000
--- a/modules/event.pl
+++ /dev/null
@@ -1,887 +0,0 @@
-package ASM::Event;
-use warnings;
-use strict;
-
-use Data::Dumper;
-use Text::LevenshteinXS qw(distance);
-use IO::All;
-use POSIX qw(strftime);
-use Regexp::Wildcards;
-use HTTP::Request;
-
-sub cs {
- my ($chan) = @_;
- $chan = lc $chan;
- $chan =~ s/^[@+]//;
- return $::channels->{channel}->{$chan} if ( defined($::channels->{channel}->{$chan}) );
- return $::channels->{channel}->{default};
-}
-
-sub maxlen {
- my ($a, $b) = @_;
- my ($la, $lb) = (length($a), length($b));
- return $la if ($la > $lb);
- return $lb;
-}
-
-sub new
-{
- my $module = shift;
- my ($conn, $inspector) = @_;
- my $self = {};
- $self->{CONN} = $conn;
- $self->{INSPECTOR} = $inspector;
- ASM::Util->dprint('Installing handler routines...', 'startup');
- $conn->add_default_handler(\&blah);
- $conn->add_handler('bannedfromchan', \&on_bannedfromchan);
- $conn->add_handler('mode', \&on_mode);
- $conn->add_handler('join', \&on_join);
- $conn->add_handler('part', \&on_part);
- $conn->add_handler('quit', \&on_quit);
- $conn->add_handler('nick', \&on_nick);
- $conn->add_handler('notice', \&on_notice);
- $conn->add_handler('caction', \&on_public);
- $conn->add_handler('msg', \&on_msg);
- $conn->add_handler('namreply', \&on_names);
- $conn->add_handler('endofnames', \&on_names);
- $conn->add_handler('public', \&on_public);
- $conn->add_handler('376', \&on_connect);
- $conn->add_handler('topic', \&irc_topic);
- $conn->add_handler('topicinfo', \&irc_topic);
- $conn->add_handler('nicknameinuse', \&on_errnickinuse);
- $conn->add_handler('bannickchange', \&on_bannickchange);
- $conn->add_handler('kick', \&on_kick);
- $conn->add_handler('cping', \&on_ctcp);
- $conn->add_handler('cversion', \&on_ctcp);
- $conn->add_handler('csource', \&on_ctcp_source);
- $conn->add_handler('ctime', \&on_ctcp);
- $conn->add_handler('cdcc', \&on_ctcp);
- $conn->add_handler('cuserinfo', \&on_ctcp);
- $conn->add_handler('cclientinfo', \&on_ctcp);
- $conn->add_handler('cfinger', \&on_ctcp);
- $conn->add_handler('354', \&on_whoxreply);
- $conn->add_handler('315', \&on_whoxover);
- $conn->add_handler('263', \&on_whofuckedup);
- $conn->add_handler('account', \&on_account);
- $conn->add_handler('ping', \&on_ping);
- $conn->add_handler('banlist', \&on_banlist);
- $conn->add_handler('dcc_open', \&dcc_open);
- $conn->add_handler('chat', \&on_dchat);
- $conn->add_handler('channelmodeis', \&on_channelmodeis);
- $conn->add_handler('quietlist', \&on_quietlist);
- $conn->add_handler('pong', \&on_pong);
- $conn->add_handler('statsdebug', \&on_statsdebug);
- $conn->add_handler('endofstats', \&on_endofstats);
- $conn->add_handler('channelurlis', \&on_channelurlis);
- $conn->add_handler('480', \&on_jointhrottled);
- $conn->add_handler('invite', \&blah); # This doesn't need to be fancy; I just need it to go through inspect
- bless($self);
- return $self;
-}
-
-my $clearstatsp = 1;
-my %statsp = ();
-my %oldstatsp = ();
-
-sub on_jointhrottled
-{
- my ($conn, $event) = @_;
- my $chan = $event->{args}->[1];
- ASM::Util->dprint("$event->{nick}: $chan: $event->{args}->[2]", 'snotice');
- if ($event->{args}->[2] =~ /throttle exceeded, try again later/) {
- $conn->schedule(5, sub { $conn->join($chan); });
- }
-}
-
-sub on_statsdebug
-{
- my ($conn, $event) = @_;
- my ($char, $line) = ($event->{args}->[1], $event->{args}->[2]);
- if ($char eq 'p') {
- if ($clearstatsp) {
- $clearstatsp = 0;
- %oldstatsp = %statsp;
- %statsp = ();
- }
- if ($line =~ /^(\d+) staff members$/) {
- #this is the end of the report
- } else {
- my ($nick, $userhost) = split(" ", $line);
- $userhost =~ s/\((.*)\)/$1/;
- my ($user, $host) = split("@", $userhost);
- $statsp{$nick}= [$user, $host];
- }
- }
-}
-
-sub on_endofstats
-{
- my ($conn, $event) = @_;
- if ($event->{args}->[1] eq 'p') {
- $clearstatsp=1;
- my $tmp = Dumper(\%statsp); chomp $tmp;
- if ( join(',', sort(keys %oldstatsp)) ne join(',', sort(keys %statsp)) ) {
- open(FH, '>>', 'statsplog.txt');
- say FH strftime('%F %T ', gmtime) . join(',', sort(keys %statsp));
- close(FH);
- ASM::Util->dprint(join(",", keys %statsp), 'statsp');
- }
- # $event->{args}->[2] == "End of /STATS report"
- #end of /stats p
- }
-}
-
-my $lagcycles = 0;
-my $pongcount = 0;
-
-sub on_pong
-{
- my ($conn, $event) = @_;
- alarm 120;
- $conn->schedule( 30, sub { $conn->sl("PING :" . time); } );
- ASM::Util->dprint('Pong? ... Ping!', 'pingpong');
- my $lag = time - $event->{args}->[0];
- my @changes = $::fm->scan();
- if (@changes) {
- if ($::settingschanged) {
- $::settingschanged = 0;
- } else {
- $conn->privmsg($::settings->{masterchan}, "Config files changed, auto rehash triggered. Check console for possible errors.");
- ASM::XML->readXML();
- my @strbl = io('string_blacklist.txt')->getlines;
- chomp @strbl;
- @::string_blacklist = @strbl;
- }
- }
- if ($lag > 1) {
- ASM::Util->dprint("Latency: $lag", 'latency');
- }
- if (($pongcount % 3) == 0) { #easiest way to do something roughly every 90 seconds
- $conn->sl('STATS p');
- }
- if ((time - $::starttime) < 240 ) {
- return; #we don't worry about lag if we've just started up and are still syncing etc.
- }
- if (($lag > 2) && ($lag < 5)) {
- $conn->privmsg( $::settings->{masterchan}, "Warning: I'm currently lagging by $lag seconds.");
- }
- if ($lag >= 5) {
- $lagcycles++;
- if ($lagcycles >= 3) {
- $conn->quit("Automatic restart triggered due to persistent lag. Freenode staff: If this is happening too frequently, please " .
- "set a nickserv freeze on my account, and once my connection is stable, unfreeze the account and /kill me to tri" .
- "gger a reconnect.");
- } else {
- $conn->privmsg( $::settings->{masterchan}, "Warning: I'm currently lagging by $lag seconds. This marks heavy lag cycle " .
- "$lagcycles - automatic restart will be triggered after 3 lag cycles." );
- }
- }
- if (($lag <= 5) && ($lagcycles > 0)) {
- $lagcycles--;
-# $conn->privmsg( $::settings->{masterchan}, "Warning: Heavy lag cycle count has been reduced to $lagcycles" );
- ASM::Util->dprint('$lag = ' . $lag . '; $lagcycles = ' . $lagcycles, 'latency');
- }
-}
-
-sub on_dchat
-{
- my ($conn, $event) = @_;
- ASM::Util->dprint(Dumper($event), 'dcc');
- if ( #(lc $event->{nick} eq 'afterdeath') &&
- ($event->{args}->[0] ne '')) {
- my $msg = $event->{args}->[0];
- if ($msg =~ /^SPY (.*)/) {
- my $chan = $1;
- $::spy{lc $chan} = $event->{to}[0];
- } elsif ($msg =~ /^STOPSPY (.*)/) {
- delete $::spy{lc $1};
- } elsif ($msg =~ /^RETRIEVE (\S+)/) {
- my $chan = lc $1;
- my $out = $event->{to}[0];
- my @time = ($::settings->{log}->{zone} eq 'local') ? localtime : gmtime;
- say $out 'Retrieving ' . "$::settings->{log}->{dir}${chan}/${chan}" . strftime($::settings->{log}->{filefmt}, @time);
- open(FHX, "$::settings->{log}->{dir}${chan}/${chan}" . strftime($::settings->{log}->{filefmt}, @time));
- while (<FHX>) {
- print $out $_;
- }
- close FHX;
- }
- #lols we gots a chat message! :D
- }
-}
-
-sub on_ping
-{
- my ($conn, $event) = @_;
- $conn->sl("PONG " . $event->{args}->[0]);
-# alarm 200;
- ASM::Util->dprint('Ping? Pong!', 'pingpong');
-# ASM::Util->dprint(Dumper($event), 'pingpong');
-}
-
-sub on_account
-{
- my ($conn, $event) = @_;
- $::sn{lc $event->{nick}}{account} = lc $event->{args}->[0];
-}
-
-sub on_connect {
- my ($conn, $event) = @_; # need to check for no services
- $conn->sl("MODE $event->{args}->[0] +Q");
- if (lc $event->{args}->[0] ne lc $::settings->{nick}) {
- ASM::Util->dprint('Attempting to regain my main nick', 'startup');
- $conn->privmsg( 'NickServ@services.', "regain $::settings->{nick} $::settings->{pass}" );
- }
- $conn->sl('CAP REQ :extended-join multi-prefix account-notify'); #god help you if you try to use this bot off freenode
-}
-
-sub on_join {
- my ($conn, $event) = @_;
- my $nick = lc $event->{nick};
- my $chan = lc $event->{to}->[0];
- my $rate;
-# alarm 200;
- if ( lc $conn->{_nick} eq lc $nick) {
- $::sc{$chan} = {};
- mkdir($::settings->{log}->{dir} . $chan);
- $::synced{$chan} = 0;
- unless ( @::syncqueue ) {
- $conn->sl('who ' . $chan . ' %tcnuhra,314');
- $conn->sl('mode ' . $chan);
- $conn->sl('mode ' . $chan . ' bq');
- }
- push @::syncqueue, $chan;
- }
- $::sc{$chan}{users}{$nick} = {};
- $::sc{$chan}{users}{$nick}{hostmask} = $event->{userhost};
- $::sc{$chan}{users}{$nick}{op} = 0;
- $::sc{$chan}{users}{$nick}{voice} = 0;
- $::sc{$chan}{users}{$nick}{jointime} = time;
- $::sc{$chan}{users}{$nick}{msgtime} = 0;
- if (defined($::sn{$nick})) {
- my @mship = ();
- if (defined($::sn{$nick}->{mship})) {
- @mship = @{$::sn{$nick}->{mship}};
- }
- @mship = (@mship, $chan);
- $::sn{$nick}->{mship} = \@mship;
- } else {
- $::sn{$nick} = {};
- $::sn{$nick}->{mship} = [ $chan ];
- }
- $::sn{$nick}->{dnsbl} = 0;
- $::sn{$nick}->{netsplit} = 0;
- $::sn{$nick}->{gecos} = $event->{args}->[1];
- $::sn{$nick}->{user} = $event->{user};
- $::sn{$nick}->{host} = $event->{host};
- $::sn{$nick}->{account} = lc $event->{args}->[0];
- $::db->logg($event) if defined $::db;
- $::log->logg( $event );
- $::inspector->inspect( $conn, $event ) unless $::netsplit;
-}
-
-sub on_part
-{
- my ($conn, $event) = @_;
- my $nick = lc $event->{nick};
- my $chan = lc $event->{to}->[0];
- $::log->logg( $event );
- $::db->logg( $event ) if defined $::db;
- if (defined $::db and $event->{args}->[0] =~ /^requested by/) {
- my $idx = $::db->actionlog( $event);
- $::log->sqlIncident($chan, $idx) if $idx;
- }
-# "to" => [ "#antispammeta" ],
-# "args" => [ "requested by ow (test)" ],
-# "nick" => "aoregcdu",
- $::inspector->inspect( $conn, $event );
- if (defined($::sn{$nick}) && defined($::sn{$nick}->{mship})) {
- my @mship = @{$::sn{$nick}->{mship}};
- @mship = grep { lc $_ ne $chan } @mship;
- if ( @mship ) {
- $::sn{$nick}->{mship} = \@mship;
- } else {
- delete($::sn{$nick});
- }
- }
- if ( lc $conn->{_nick} eq $nick )
- {
- delete( $::sc{$chan} );
- on_byechan($chan);
- }
- else
- {
- delete( $::sc{$chan}{users}{$nick} );
- }
-}
-
-sub on_msg
-{
- my ($conn, $event) = @_;
- $::commander->command($conn, $event);
- ASM::Util->dprint($event->{from} . " - " . $event->{args}->[0], 'msg');
- if ((ASM::Util->notRestricted($event->{nick}, "nomsgs")) && ($event->{args}->[0] !~ /^;;/)) {
-# disabled by DL 130513 due to spammer abuse
-# $conn->privmsg($::settings->{masterchan}, $event->{from} . ' told me: ' . $event->{args}->[0]);
- }
-}
-
-sub on_public
-{
- my ($conn, $event) = @_;
-# alarm 200;
- my $chan = lc $event->{to}[0];
- $chan =~ s/^[+@]//;
- $::log->logg( $event );
- $::db->logg( $event ) if defined $::db;
- if ($event->{args}->[0] =~ /(https?:\/\/bitly.com\/\w+|https?:\/\/bit.ly\/\w+|https?:\/\/j.mp\/\w+|https?:\/\/tinyurl.com\/\w+)/i) {
- my $reqid = $::async->add( HTTP::Request->new( GET => $1 ) );
- $::httpRequests{$reqid} = $event;
- my ($response, $id) = $::async->wait_for_next_response( 1 );
- if (defined($response)) {
- on_httpResponse($conn, $id, $response);
- }
- else { $conn->schedule( 1, sub { checkHTTP($conn); } ); }
- }
- $::inspector->inspect( $conn, $event );
- $::commander->command( $conn, $event );
- $::sc{$chan}{users}{lc $event->{nick}}{msgtime} = time;
-}
-
-sub checkHTTP
-{
- my ($conn) = @_;
- my ($response, $id) = $::async->next_response();
- if (defined ($response)) {
- on_httpResponse($conn, $id, $response);
- }
- $conn->schedule( 1, sub { checkHTTP($conn); } );
-}
-
-sub on_httpResponse
-{
- my ($conn, $id, $response) = @_;
- my $event = $::httpRequests{$id};
- delete $::httpRequests{$id};
- $::inspector->inspect( $conn, $event, $response );
-}
-# if ($response->{_previous}->{_headers}->{location} =~ /^https?:\/\/bitly.com\/a\/warning/)
-
-sub on_notice
-{
- my ($conn, $event) = @_;
- return if ( $event->{to}->[0] eq '$*' ); # if this is a global notice FUCK THAT SHIT
- $::log->logg( $event );
- $::db->logg( $event ) if defined $::db;
- $::inspector->inspect( $conn, $event );
- $::services->doServices($conn, $event);
-}
-
-sub on_errnickinuse
-{
- my ($conn, $event) = @_;
- $_ = ${$::settings->{altnicks}}[rand @{$::settings->{altnicks}}];
- ASM::Util->dprint("Nick is in use, trying $_", 'startup');
- $conn->nick($_);
-}
-
-sub on_bannickchange
-{
- my ($conn, $event) = @_;
- $_ = ${$::settings->{altnicks}}[rand @{$::settings->{altnicks}}];
- ASM::Util->dprint("Nick is in use, trying $_", 'startup');
- $conn->nick($_);
-}
-
-sub on_quit
-{
- my ($conn, $event) = @_;
- my @channels=();
- for ( keys %::sc ) {
- push ( @channels, lc $_ ) if delete $::sc{lc $_}{users}{lc $event->{nick}};
- }
- $event->{to} = \@channels;
- if (defined $::db) {
- my $idx = $::db->actionlog($event);
- $::log->sqlIncident( join(',', @channels), $idx ) if $idx;
- $::db->logg( $event );
- }
- $::log->logg( $event );
-
- if (($::netsplit == 0) && ($event->{args}->[0] eq "*.net *.split") && (lc $event->{nick} ne 'chanserv')) { #special, netsplit situation
- $conn->privmsg($::settings->{masterchan}, "Entering netsplit mode - JOIN and QUIT inspection will be disabled for 60 minutes");
- $::netsplit = 1;
- $conn->schedule(60*60, sub { $::netsplit = 0; $conn->privmsg($::settings->{masterchan}, 'Returning to regular operation'); });
- }
- $::inspector->inspect( $conn, $event ) unless $::netsplit;
- #ugh. Repurge some shit, hopefully this will fix some stuff where things are going wrong
- foreach my $chan ( keys %::sc ) {
- delete $::sc{$chan}{users}{lc $event->{nick}};
- }
- delete($::sn{lc $event->{nick}});
-}
-
-sub blah
-{
- my ($self, $event) = @_;
- ASM::Util->dprint(Dumper($event), 'misc');
- $::inspector->inspect($self, $event);
-}
-
-sub irc_users
-{
- my ( $channel, @users ) = @_;
- for (@users)
- {
- my ( $op, $voice );
- $op = 0; $voice = 0;
- $op = 1 if s/^\@//;
- $voice = 1 if s/^\+//;
- $::sc{lc $channel}{users}{lc $_} = {};
- $::sc{lc $channel}{users}{lc $_}{op} = $op;
- $::sc{lc $channel}{users}{lc $_}{voice} = $voice;
- $::sc{lc $channel}{users}{lc $_}{jointime} = 0;
- }
-}
-
-sub on_names {
- my ($conn, $event) = @_;
- irc_users( $event->{args}->[2], split(/ /, $event->{args}->[3]) ) if ($event->{type} eq 'namreply');
-}
-
-sub irc_topic {
- my ($conn, $event) = @_;
- if ($event->{format} eq 'server')
- {
- my $chan = lc $event->{args}->[1];
- if ($event->{type} eq 'topic')
- {
- $::sc{$chan}{topic}{text} = $event->{args}->[2];
- }
- elsif ($event->{type} eq 'topicinfo')
- {
- $::sc{$chan}{topic}{time} = $event->{args}->[3];
- $::sc{$chan}{topic}{by} = $event->{args}->[2];
- }
- }
- else
- {
- if ($event->{type} eq 'topic')
- {
- my $chan = lc $event->{to}->[0];
- $::sc{$chan}{topic}{text} = $event->{args}->[0];
- $::sc{$chan}{topic}{time} = time;
- $::sc{$chan}{topic}{by} = $event->{from};
- }
- $::log->logg($event);
- $::db->logg( $event ) if defined $::db;
- $::inspector->inspect($conn, $event);
- }
-}
-
-sub on_nick {
- my ($conn, $event) = @_;
- my @channels=();
- my $oldnick = lc $event->{nick};
- my $newnick = lc $event->{args}->[0];
- foreach my $chan ( keys %::sc )
- {
- $chan = lc $chan;
- if ( defined $::sc{$chan}{users}{$oldnick} )
- {
- if ($oldnick ne $newnick) { #otherwise a nick change where they're only
- #changing the case of their nick means that
- #ASM forgets about them.
- $::sc{$chan}{users}{$newnick} = $::sc{$chan}{users}{$oldnick};
- delete( $::sc{$chan}{users}{$oldnick} );
- }
- push ( @channels, $chan );
- }
- }
-
- # unfortunately Net::IRC sucks at IRC so we have to implement this ourselves
- if ($oldnick eq lc $conn->{_nick}) {
- $conn->{_nick} = $event->{args}[0];
- }
-
- $::sn{$newnick} = $::sn{$oldnick} if ($oldnick ne $newnick);
- $::db->logg( $event ) if defined $::db;
- delete( $::sn{$oldnick}) if ($oldnick ne $newnick);
- $event->{to} = \@channels;
- $::log->logg($event);
- # Well, the nick change actually was done from the old nick ... but
- # by the time we process it, they already changed nicks. Therefore
- # we'll pretend it's the *new* nick that generated the event.
- $event->{nick} = $event->{args}[0];
- $::inspector->inspect($conn, $event);
-}
-
-sub on_kick {
- my ($conn, $event) = @_;
- if (lc $event->{to}->[0] eq lc $::settings->{nick}) {
- $conn->privmsg($::settings->{masterchan}, "I've been kicked from " . $event->{args}->[0] . ": " . $event->{args}->[1]);
-# $conn->join($event->{args}->[0]);
- }
- my $nick = lc $event->{to}->[0];
- my $chan = lc $event->{args}->[0];
- $::log->logg( $event );
- if (defined $::db) {
- $::db->logg( $event );
- my $idx = $::db->actionlog($event);
- $::log->sqlIncident($chan, $idx) if $idx;
- }
- if (defined($::sn{$nick}) && defined($::sn{$nick}->{mship})) {
- my @mship = @{$::sn{$nick}->{mship}};
- @mship = grep { lc $_ ne $chan } @mship;
- if ( @mship ) {
- $::sn{$nick}->{mship} = \@mship;
- } else {
- delete($::sn{$nick});
- }
- }
- if ( lc $conn->{_nick} eq $nick )
- {
- delete( $::sc{lc $event->{args}->[0]} );
- on_byechan(lc $event->{to}->[0]);
- }
- else
- {
- delete( $::sc{lc $event->{args}->[0]}{users}{$nick} );
- }
-}
-
-sub parse_modes
-{
- my ( $n ) = @_;
- my @args = @{$n};
- my @modes = split '', shift @args;
- my @new_modes=();
- my $t;
- foreach my $c ( @modes ) {
- if (($c eq '-') || ($c eq '+')) {
- $t=$c;
- }
- else { #eIbq,k,flj,CFLMPQcgimnprstz
- if ($t eq '+') {
- if ( grep( /[eIbqkfljov]/,($c) ) ) { #modes that take args WHEN BEING ADDED
- push (@new_modes, [$t.$c, shift @args]);
- }
- elsif ( grep( /[CFLMPQcgimnprstz]/, ($c) ) ) {
- push (@new_modes, [$t.$c]);
- }
- else {
- die "Unknown mode $c !\n";
- }
- } else {
- if ( grep( /[eIbqov]/,($c) ) ) { #modes that take args WHEN BEING REMOVED
- push (@new_modes, [$t.$c, shift @args]);
- }
- elsif ( grep( /[CFLMPQcgimnprstzkflj]/, ($c) ) ) {
- push (@new_modes, [$t.$c]);
- }
- else {
- die "Unknown mode $c !\n";
- }
- }
- }
- }
- return \@new_modes;
-}
-
-sub on_channelmodeis
-{
- my ($conn, $event) = @_;
- my $chan = lc $event->{args}->[1];
- my @temp = @{$event->{args}};
- shift @temp; shift @temp;
- my @modes = @{parse_modes(\@temp)};
- foreach my $line ( @modes ) {
- my @ex = @{$line};
- my ($what, $mode) = split (//, $ex[0]);
- if ($what eq '+') {
- if (defined($ex[1])) {
- push @{$::sc{$chan}{modes}}, $mode . ' ' . $ex[1];
- } else {
- push @{$::sc{$chan}{modes}}, $mode;
- }
- } else {
- my @modes = grep {!/^$mode/} @{$::sc{$chan}{modes}};
- $::sc{$chan}{modes} = \@modes;
- }
- }
-}
-
-sub whoGotHit
-{
- my ($chan, $mask) = @_;
- my $cvt = Regexp::Wildcards->new(type => 'jokers');
- my @affected = ();
- if ($mask !~ /^\$/) {
- my @div = split(/\$/, $mask);
- my $regex = $cvt->convert($div[0]);
- foreach my $nick (keys %::sn) {
- next unless defined($::sn{$nick}{user});
- if (lc ($nick.'!'.$::sn{$nick}{user}.'@'.$::sn{$nick}{host}) =~ /^$regex$/i) {
- push @affected, $nick if defined($::sc{$chan}{users}{$nick});
- }
- }
- } elsif ($mask =~ /^\$a:(.*)/) {
- my @div = split(/\$/, $1);
- my $regex = $cvt->convert($div[0]);
- foreach my $nick (keys %::sn) {
- next unless defined($::sn{$nick}{account});
- if (lc ($::sn{$nick}{account}) =~ /^$regex$/i) {
- push @affected, $nick if defined($::sc{$chan}{users}{$nick});
- }
- }
- }
- return @affected;
-}
-
-sub on_mode
-{
- my ($conn, $event) = @_;
- my $chan = lc $event->{to}->[0];
-# holy shit, I feel so bad doing this
-# I have no idea how or why Net::IRC fucks up modes if they've got a ':' in one of the args
-# but you do what you must...
- my @splitted = split(/ /, $::lastline); shift @splitted; shift @splitted; shift @splitted;
- $event->{args}=\@splitted;
- if ($chan =~ /^#/) {
- my @modes = @{parse_modes($event->{args})};
- ASM::Util->dprint(Dumper(\@modes), 'misc');
- foreach my $line ( @modes ) {
- my @ex = @{$line};
-
- if ( $ex[0] eq '+o' ) { $::sc{$chan}{users}{lc $ex[1]}{op} = 1; }
- elsif ( $ex[0] eq '-o' ) { $::sc{$chan}{users}{lc $ex[1]}{op} = 0; }
- elsif ( $ex[0] eq '+v' ) { $::sc{$chan}{users}{lc $ex[1]}{voice} = 1; }
- elsif ( $ex[0] eq '-v' ) { $::sc{$chan}{users}{lc $ex[1]}{voice} = 0; }
-
- elsif ( $ex[0] eq '+b' ) {
- $::sc{$chan}{bans}{$ex[1]} = { bannedBy => $event->{from}, bannedOn => time };
- if (lc $event->{nick} !~ /^(floodbot)/) { #ignore the ubuntu floodbots 'cause they quiet people a lot
- my @affected = whoGotHit($chan, $ex[1]);
- if ( defined($::db) && (@affected) && (scalar @affected <= 4) ) {
- foreach my $victim (@affected) {
- my $idx = $::db->actionlog($event, 'ban', $victim);
- $::log->sqlIncident( $chan, $idx ) if $idx;
- }
- }
- if ($ex[1] =~ /^\*\!\*\@(.*)$/) {
- my $ip = ASM::Util->getHostIP($1);
- $::sc{$chan}{ipbans}{$ip} = { bannedBy => $event->{from}, bannedOn => time } if defined($ip);
- }
- }
- }
- elsif ( $ex[0] eq '-b' ) {
- delete $::sc{$chan}{bans}{$ex[1]};
- if ($ex[1] =~ /^\*\!\*\@(.*)$/) {
- my $ip = ASM::Util->getHostIP($1);
- delete $::sc{$chan}{ipbans}{$ip} if defined($ip);
- }
- }
-
- elsif ( $ex[0] eq '+q' ) {
- $::sc{$chan}{quiets}{$ex[1]} = { bannedBy => $event->{from}, bannedOn => time };
- if (lc $event->{nick} !~ /^(floodbot)/) {
- my @affected = whoGotHit($chan, $ex[1]);
- if ( defined($::db) && (@affected) && (scalar @affected <= 4) ) {
- foreach my $victim (@affected) {
- my $idx = $::db->actionlog($event, 'quiet', $victim);
- $::log->sqlIncident( $chan, $idx ) if $idx;
- }
- }
- if ($ex[1] =~ /^\*\!\*\@(.*)$/) {
- my $ip = ASM::Util->getHostIP($1);
- $::sc{$chan}{ipquiets}{$ip} = { bannedBy => $event->{from}, bannedOn => time } if defined($ip);
- }
- }
- }
- elsif ( $ex[0] eq '-q' ) {
- delete $::sc{$chan}{quiets}{$ex[1]};
- if ($ex[1] =~ /^\*\!\*\@(.*)$/) {
- my $ip = ASM::Util->getHostIP($1);
- delete $::sc{$chan}{ipquiets}{$ip} if defined($ip);
- }
- }
-
- else {
- my ($what, $mode) = split (//, $ex[0]);
- if ($what eq '+') {
- if (defined($ex[1])) { push @{$::sc{$chan}{modes}}, $mode . ' ' . $ex[1]; }
- else { push @{$::sc{$chan}{modes}}, $mode; }
- } else {
- my @modes = grep {!/^$mode/} @{$::sc{$chan}{modes}};
- $::sc{$chan}{modes} = \@modes;
- }
- if ( ($ex[0] eq '+r') && (! defined($::watchRegged{$chan})) ) {
- $::watchRegged{$chan} = 1;
- $conn->schedule(60*45, sub { checkRegged($conn, $chan); });
- }
- }
- }
- $::log->logg($event);
- }
-}
-
-sub checkRegged
-{
- my ($conn, $chan) = @_;
- if (grep {/^r/} @{$::sc{$chan}{modes}}
- and not ((defined($::channels->{channel}{$chan}{monitor})) and ($::channels->{channel}{$chan}{monitor} eq "no")) )
- {
- my $tgt = $chan;
- my $risk = "debug";
- my $hilite=ASM::Util->commaAndify(ASM::Util->getAlert($tgt, $risk, 'hilights'));
- my $txtz ="\x03" . $::RCOLOR{$::RISKS{$risk}} . "\u$risk\x03 risk threat [\x02$chan\x02] - channel appears to still be +r after 45 minutes; ping $hilite !att-$chan-$risk";
- my @tgts = ASM::Util->getAlert($tgt, $risk, 'msgs');
- ASM::Util->sendLongMsg($conn, \@tgts, $txtz)
- }
- delete $::watchRegged{$chan};
-}
-
-sub on_banlist
-{
- my ($conn, $event) = @_;
- my ($me, $chan, $ban, $banner, $bantime) = @{$event->{args}};
- $::sc{lc $chan}{bans}{$ban} = { bannedBy => $banner, bannedOn => $bantime };
- if ($ban =~ /^\*\!\*\@((([a-zA-Z0-9]|[a-zA-Z0-9][a-zA-Z0-9\-]*[a-zA-Z0-9])\.)*([A-Za-z0-9]|[A-Za-z0-9][A-Za-z0-9\-]*[A-Za-z0-9]))$/) {
- # ASM::Util->dprint("banlist hostname $ban $1", 'sync');
- my $ip = ASM::Util->getHostIP($1);
- $::sc{lc $chan}{ipbans}{$ip} = { bannedBy => $banner, bannedOn => $bantime } if defined($ip);
- }
-}
-
-sub on_quietlist
-{
- my ($conn, $event) = @_;
- my ($me, $chan, $mode, $ban, $banner, $bantime) = @{$event->{args}};
- $::sc{lc $chan}{quiets}{$ban} = { bannedBy => $banner, bannedOn => $bantime };
- if ($ban =~ /^\*\!\*\@((([a-zA-Z0-9]|[a-zA-Z0-9][a-zA-Z0-9\-]*[a-zA-Z0-9])\.)*([A-Za-z0-9]|[A-Za-z0-9][A-Za-z0-9\-]*[A-Za-z0-9]))$/) {
- # ASM::Util->dprint("quietlist hostname $ban $1", 'sync');
- my $ip = ASM::Util->getHostIP($1);
- $::sc{lc $chan}{ipquiets}{$ip} = { bannedBy => $banner, bannedOn => $bantime } if defined($ip);
- }
-}
-
-sub on_channelurlis
-{
- my ($conn, $event) = @_;
- $::sc{lc $event->{args}->[1]}{url} = $event->{args}->[2];
-}
-
-sub on_ctcp
-{
- my ($conn, $event) = @_;
- my $acct = lc $::sn{lc $event->{nick}}->{account};
- ASM::Util->dprint(Dumper($event), 'ctcp');
- if (($event->{type} eq 'cdcc') &&
- (defined($::users->{person}->{$acct})) &&
- (defined($::users->{person}->{$acct}->{flags})) &&
- (grep {$_ eq 'c'} split('', $::users->{person}->{$acct}->{flags}))) {
- ASM::Util->dprint(Dumper($event), 'dcc');
- my @spit = split(/ /, $event->{args}->[0]);
- if (($spit[0] eq 'CHAT') && ($spit[1] eq 'CHAT')) {
- $::chat = Net::IRC::DCC::CHAT->new($conn, 0, lc $event->{nick}, $spit[2], $spit[3]);
- }
- } else {
- $::inspector->inspect($conn, $event);
- }
-}
-
-sub dcc_open
-{
- my ($conn, $event) = @_;
- $::dsock{lc $event->{nick}} = $event->{args}->[1];
-}
-
-sub on_ctcp_source
-{
- my ($conn, $event) = @_;
- $conn->ctcp_reply($event->{nick}, 'SOURCE https://gitlab.devlabs.linuxassist.net/asm/antispammeta/');
-}
-
-sub on_whoxreply
-{
- my ($conn, $event) = @_;
- return unless $event->{args}->[1] eq '314';
- my ($tgt, $magic, $chan, $user, $host, $nick, $account, $gecos) = @{$event->{args}};
- $nick = lc $nick; $chan = lc $chan;
- if (!defined $::sn{lc $nick}) {
- $::sn{$nick} = {};
- $::sn{$nick}->{mship} = [$chan];
- } else {
- $::sn{$nick}->{mship} = [grep { lc $_ ne $chan } @{$::sn{$nick}->{mship}}];
- push @{$::sn{$nick}->{mship}}, $chan;
- }
- $::sn{$nick}->{gecos} = $gecos;
- $::sn{$nick}->{user} = $user;
- $::sn{$nick}->{host} = $host;
- $::sn{$nick}->{account} = lc $account;
-}
-
-sub on_whoxover
-{
- my ($conn, $event) = @_;
- my $chan = pop @::syncqueue;
- $::synced{lc $event->{args}->[1]} = 1;
- if (defined($chan) ){
- $conn->sl('who ' . $chan . ' %tcnuhra,314');
- $conn->sl('mode ' . $chan);
- $conn->sl('mode ' . $chan . ' bq');
- } else {
- my $size = `ps -p $$ h -o size`;
- my $cputime = `ps -p $$ h -o time`;
- chomp $size; chomp $cputime;
- my ($tx, $rx);
- if ($conn->{_tx}/1024 > 1024) {
- $tx = sprintf("%.2fMB", $conn->{_tx}/(1024*1024));
- } else {
- $tx = sprintf("%.2fKB", $conn->{_tx}/1024);
- }
- if ($conn->{_rx}/1024 > 1024) {
- $rx = sprintf("%.2fMB", $conn->{_rx}/(1024*1024));
- } else {
- $rx = sprintf("%.2fKB", $conn->{_rx}/1024);
- }
- $conn->privmsg($::settings->{masterchan}, "Finished syncing after " . (time - $::starttime) . " seconds. " .
- "I'm tracking " . (scalar (keys %::sn)) . " nicks" .
- " across " . (scalar (keys %::sc)) . " tracked channels." .
- " I'm using " . $size . "KB of RAM" .
- ", have used " . $cputime . " of CPU time" .
- ", have sent $tx of data, and received $rx of data.");
- my %x = ();
- foreach my $c (@{$::settings->{autojoins}}) { $x{$c} = 1; }
- foreach my $cx (keys %::sc) { delete $x{$cx}; }
- if (scalar (keys %x)) {
- $conn->privmsg($::settings->{masterchan}, "Syncing appears to have failed for " . ASM::Util->commaAndify(keys %x));
- }
- }
-}
-
-sub on_whofuckedup
-{
- my ($conn, $event) = @_;
- ASM::Util->dprint('on_whofuckedup called!', 'sync');
- if ($event->{args}->[1] eq "STATS") {
-#most likely this is getting called because we did stats p too often.
-#unfortunately the server doesn't let us know what exactly we called stats for.
-#anyways, we don't need to do anything for this
- } else { #dunno why it got called, print the data and I'll add a handler for it.
- ASM::Util->dprint(Dumper($event), 'sync');
- }
-}
-
-sub on_bannedfromchan {
- my ($conn, $event) = @_;
- ASM::Util->dprint("I'm banned from " . $event->{args}->[1] . "... attempting to unban myself", 'startup');
- $conn->privmsg('ChanServ', "unban $event->{args}->[1]");
-}
-
-sub on_byechan {
- my ($chan) = @_;
- #TODO do del event stuff
-}
-
-return 1;
diff --git a/modules/inspect.pl b/modules/inspect.pl
deleted file mode 100644
index df515dc..0000000
--- a/modules/inspect.pl
+++ /dev/null
@@ -1,101 +0,0 @@
-package ASM::Inspect;
-use warnings;
-use strict;
-use feature qw(say);
-
-use Data::Dumper;
-#use List::Util qw(first);
-use String::Interpolate qw(interpolate);
-use Carp qw(cluck);
-
-%::ignored = ();
-sub new
-{
- my $module = shift;
- my $self = {};
- bless($self);
- return $self;
-}
-
-sub inspect {
- our ($self, $conn, $event, $response) = @_;
- my (%aonx, %dct, $rev, $chan, $id);
- %aonx=(); %dct=(); $chan=""; $id="";
- my (@dnsbl, @uniq);
- my ($match, $txtz, $iaddr);
- my @override = [];
- my $nick = lc $event->{nick};
- my $xresult;
- return if (index($nick, ".") != -1);
- if ( $event->{host} =~ /gateway\/web\// ) {
- if ( $event->{user} =~ /([0-9a-f]{2})([0-9a-f]{2})([0-9a-f]{2})([0-9a-f]{2})/ ) {
- $rev = sprintf("%d.%d.%d.%d.", hex($4), hex($3), hex($2), hex($1));
- }
- }
- if ( (!defined($rev)) && ($event->{type} eq 'join') ) {
-# Only doing DNS lookups for join events will mean that DNSBL will break if we try to do it on something other than joins,
-# But it also means we cut back on the DNS lookups by a metric shitton
- $iaddr = gethostbyname($event->{host}) if ($event->{host} !~ /\//);
- $rev = join('.', reverse(unpack('C4', $iaddr))).'.' if (defined $iaddr);
- }
- ## NB: isn't there a better way to do this with grep, somehow?
- %aonx = %{$::rules->{event}};
- foreach $chan ( @{$event->{to}} ) {
- # don't do anything for channels we haven't synced yet
- # because we can't yet respect stuff like notrigger for these
- next unless $::synced{lc $chan};
- next unless $chan =~ /^#/;
- next if ((defined($::channels->{channel}->{$chan}->{monitor})) and ($::channels->{channel}->{$chan}->{monitor} eq "no"));
- foreach $id (keys %aonx) {
- next unless ( grep { $event->{type} eq $_ } split(/[,:; ]+/, $aonx{$id}{type}) );
- if (defined($response)) {
- if ($aonx{$id}{class} ne 'urlcrunch') { next; } #don't run our regular checks if this is being called from a URL checking function
- else { $xresult = $::classes->check($aonx{$id}{class}, $aonx{$id}, $id, $event, $chan, $response); }
- }
- else {
- $xresult = $::classes->check($aonx{$id}{class}, $aonx{$id}, $id, $event, $chan, $rev); # this is another bad hack done for dnsbl-related stuff
- }
- next unless (defined($xresult)) && ($xresult ne 0);
- ASM::Util->dprint(Dumper($xresult), 'inspector');
- $dct{$id} = $aonx{$id};
- $dct{$id}{xresult} = $xresult;
- }
- }
- foreach ( keys %dct ) {
- if ( defined $dct{$_}{override} ) {
- push( @override, split( /[ ,;]+/, $dct{$_}{override} ) );
- }
- }
- delete $dct{$_} foreach @override;
- my $evcontent = $event->{args}->[0];
- my $evhost = $event->{host};
- foreach $chan (@{$event->{to}}) {
- foreach $id ( keys %dct ) {
- return unless (ASM::Util->notRestricted($nick, "notrigger") && ASM::Util->notRestricted($nick, "no$id"));
- $xresult = $dct{$id}{xresult};
- my $nicereason = interpolate($dct{$id}{reason});
- if (defined $::db) {
- $::db->record($chan, $event->{nick}, $event->{user}, $event->{host}, $::sn{lc $event->{nick}}->{gecos}, $dct{$id}{risk}, $id, $nicereason);
- }
- $txtz = "\x03" . $::RCOLOR{$::RISKS{$dct{$id}{risk}}} . "\u$dct{$id}{risk}\x03 risk threat [\x02$chan\x02] - ".
- "\x02$event->{nick}\x02 - ${nicereason}; ping ";
- $txtz = $txtz . ASM::Util->commaAndify(ASM::Util->getAlert(lc $chan, $dct{$id}{risk}, 'hilights')) if (ASM::Util->getAlert(lc $chan, $dct{$id}{risk}, 'hilights'));
- $txtz = $txtz . ' !att-' . $chan . '-' . $dct{$id}{risk};
- if ($id eq 'last_measure_regex') { #TODO: Note that this is another example of things that shouldn't be hardcoded, but are.
-
- }
- if (
- (!(defined($::ignored{$chan}) && ($::ignored{$chan} >= $::RISKS{$dct{$id}{risk}}))) ||
- (($::pacealerts == 0) && ($dct{$id}{risk} eq 'info'))
- ) {
- my @tgts = ASM::Util->getAlert($chan, $dct{$id}{risk}, 'msgs');
- ASM::Util->sendLongMsg($conn, \@tgts, $txtz);
- $conn->schedule(45, sub { delete($::ignored{$chan}) if $::ignored{$chan} == $::RISKS{$dct{$id}{risk}} });
- $::ignored{$chan} = $::RISKS{$dct{$id}{risk}};
- }
- $::log->incident($chan, "$chan: $dct{$id}{risk} risk: $event->{nick} - $nicereason\n");
- }
- }
-}
-
-1;
diff --git a/modules/log.pl b/modules/log.pl
deleted file mode 100644
index c2a2b72..0000000
--- a/modules/log.pl
+++ /dev/null
@@ -1,112 +0,0 @@
-package ASM::Log;
-
-use warnings;
-use strict;
-
-#use IO::All;
-use POSIX qw(strftime);
-
-sub new
-{
- my $module = shift;
- my $config = shift;
- my $self = {};
- $self->{CONFIG} = $config;
- $self->{backlog} = {};
- bless($self);
- return $self;
-}
-
-sub incident
-{
- my $self = shift;
- my ($chan, $header) = @_;
- $chan = lc $chan;
- open(FH, '>>', 'dctlog.txt');
- print FH $header;
- if (defined($self->{backlog}->{$chan})) {
- print FH join('', @{$self->{backlog}->{$chan}});
- }
- print FH "\n\n";
- close(FH);
-}
-
-#writes out the backlog to a file which correlates to ASM's SQL actionlog table
-sub sqlIncident
-{
- my $self = shift;
- my ($channel, $index) = @_;
- $channel = lc $channel;
- my @chans = split(/,/, $channel);
- open(FH, '>', $self->{CONFIG}->{actiondir} . $index . '.txt');
- foreach my $chan (@chans) {
- if (defined($self->{backlog}->{$chan})) {
- say FH "$chan";
- say FH join('', @{$self->{backlog}->{$chan}});
- }
- }
- close(FH);
-}
-
-sub logg
-{
- my $self = shift;
- my ($event) = @_;
- my $cfg = $self->{CONFIG};
- my @chans = @{$event->{to}};
- @chans = ( $event->{args}->[0] ) if ($event->{type} eq 'kick');
- my @time = ($cfg->{zone} eq 'local') ? localtime : gmtime;
- foreach my $chan ( @chans )
- {
- $chan = lc $chan;
- next if ($chan eq '$$*');
- $chan =~ s/^[@+]//;
- if ($chan eq '*') {
- ASM::Util->dprint("$event->{nick}: $event->{args}->[0]", 'snotice');
- next;
- }
- my $path = ">>$cfg->{dir}${chan}/${chan}" . strftime($cfg->{filefmt}, @time);
- $_ = '';
- $_ = "<$event->{nick}> $event->{args}->[0]" if $event->{type} eq 'public';
- $_ = "*** $event->{nick} has joined $chan" if $event->{type} eq 'join';
- $_ = "*** $event->{nick} has left $chan ($event->{args}->[0])" if $event->{type} eq 'part';
- $_ = "* $event->{nick} $event->{args}->[0]" if $event->{type} eq 'caction';
- $_ = "*** $event->{nick} is now known as $event->{args}->[0]" if $event->{type} eq 'nick';
- $_ = "*** $event->{nick} has quit ($event->{args}->[0])" if $event->{type} eq 'quit';
- $_ = "*** $event->{to}->[0] was kicked by $event->{nick}" if $event->{type} eq 'kick';
- $_ = "-$event->{nick}- $event->{args}->[0]" if $event->{type} eq 'notice';
- $_ = "*** $event->{nick} sets mode: " . join(" ",@{$event->{args}}) if $event->{type} eq 'mode';
- $_ = "*** $event->{nick} changes topic to \"$event->{args}->[0]\"" if $event->{type} eq 'topic';
- my $nostamp = $_;
- $_ = strftime($cfg->{timefmt}, @time) . $_ . "\n";
- my $line = $_;
- my @backlog = ();
- if (defined($self->{backlog}->{$chan})) {
- @backlog = @{$self->{backlog}->{$chan}};
- if (scalar @backlog >= 30) {
- shift @backlog;
- }
- }
- push @backlog, $line;
- $self->{backlog}->{$chan} = \@backlog;
- if (open(FH, $path)) { # or die "Can't open $path: $!";
- print FH $line;
- ASM::Util->dprint($line, 'logger');
- close(FH);
- } else {
- print "COULDN'T PRINT TO $path - $line";
- }
- my $spy;
- if (defined($::spy{$chan})) {
- $spy = $::spy{$chan};
- } elsif (defined($::spy{lc $event->{nick}})) {
- $spy = $::spy{lc $event->{nick}};
- }
- if (defined($spy)) {
- say $spy "$chan: $nostamp";
- }
-# $_ >> io($path);
- }
-}
-
-1;
diff --git a/modules/mysql.pl b/modules/mysql.pl
deleted file mode 100644
index 86a1c78..0000000
--- a/modules/mysql.pl
+++ /dev/null
@@ -1,323 +0,0 @@
-package ASM::DB;
-
-use warnings;
-use strict;
-use DBI;
-use Data::Dumper;
-
-sub new {
- my $module = shift;
- my ($db, $host, $port, $user, $pass, $table, $actiontable, $dblog) = @_;
- my $self = {};
- $self->{DBH} = DBI->connect("DBI:mysql:database=$db;host=$host;port=$port", $user, $pass);
- $self->{DBH_LOG} = DBI->connect("DBI:mysql:database=$dblog;host=$host;port=$port", $user, $pass);
- $self->{DBH}->{mysql_auto_reconnect} = 1;
- $self->{DBH_LOG}->{mysql_auto_reconnect} = 1;
- $self->{TABLE} = $table;
- $self->{ACTIONTABLE} = $actiontable;
- bless($self);
- return $self;
-}
-
-#sub sql_connect
-#{
-# $::dbh = DBI->connect("DBI:mysql:database=$::mysql->{db};host=$::mysql->{host};port=$::mysql->{port}",
-# $::mysql->{user}, $::mysql->{pass});
-# $::dbh->{mysql_auto_reconnect} = 1;
-#}
-
-sub raw
-{
- my $self = shift;
- my ($conn, $tgt, $dbh, $qry) = @_;
- my $sth = $dbh->prepare($qry);
- $sth->execute;
- my $names = $sth->{'NAME'};
- my $numFields = $sth->{'NUM_OF_FIELDS'};
- my $string = "";
- for (my $i = 0; $i < $numFields; $i++) {
- $string = $string . sprintf("%s%s", $i ? "," : "", $$names[$i]);
- }
- $conn->privmsg($tgt, $string);
- while (my $ref = $sth->fetchrow_arrayref) {
- $string = "";
- for (my $i = 0; $i < $numFields; $i++) {
- $string = $string . sprintf("%s%s", $i ? "," : "", $$ref[$i]);
- }
- $conn->privmsg($tgt, $string);
- }
-}
-
-sub record
-{
- my $self = shift;
- my ($channel, $nick, $user, $host, $gecos, $level, $id, $reason) = @_;
- $gecos //= "NOT_DEFINED";
-
- my $dbh = $self->{DBH};
- $dbh->do("INSERT INTO $self->{TABLE} (channel, nick, user, host, gecos, level, id, reason) VALUES (" .
- $dbh->quote($channel) . ", " . $dbh->quote($nick) . ", " . $dbh->quote($user) .
- ", " . $dbh->quote($host) . ", " . $dbh->quote($gecos) . ", " . $dbh->quote($level) . ", " .
- $dbh->quote($id) . ", " . $dbh->quote($reason) . ");");
-}
-
-sub actionlog
-{
- my ($self, $event, $modedata1, $modedata2) = @_;
- my $dbh = $self->{DBH};
- my ($action, $reason, $channel,
- $nick, $user, $host, $gecos, $account, $ip,
- $bynick, $byuser, $byhost, $bygecos, $byaccount);
-
- if ($event->{type} eq 'mode') {
- $action = $modedata1;
- $nick = $modedata2;
- $channel = lc $event->{to}->[0];
- $bynick = $event->{nick};
- $byuser = $event->{user};
- $byhost = $event->{host};
- } elsif ($event->{type} eq 'quit') {
- my $quitmsg = $event->{args}->[0];
- if ($quitmsg =~ /^Killed \((\S+) \((.*)\)\)$/) {
- $bynick = $1;
- $reason = $2 unless ($2 eq '<No reason given>');
- return if ($reason =~ /Nickname regained by services/);
- $action = 'kill';
- } elsif ($quitmsg =~ /^K-Lined$/) {
- $action = 'k-line';
- } else {
- return; #quit not forced/tracked
- }
- $nick = $event->{nick};
- $user = $event->{user};
- $host = $event->{host};
- } elsif (($event->{type} eq 'part') && ($event->{args}->[0] =~ /^requested by (\S+) \((.*)\)/)) {
- $bynick = $1;
- $reason = $2 unless (lc $reason eq lc $event->{nick});
- $action = 'remove';
- $nick = $event->{nick};
- $user = $event->{user};
- $host = $event->{host};
- $channel = $event->{to}->[0];
- } elsif ($event->{type} eq 'kick') {
- $action = 'kick';
- $bynick = $event->{nick};
- $byuser = $event->{user};
- $byhost = $event->{host};
- $reason = $event->{args}->[1] unless ($event->{args}->[1] eq $event->{to}->[0]);
- $nick = $event->{to}->[0];
- $channel = $event->{args}->[0];
- }
- return unless defined($action);
-# $bynick = lc $bynick if defined $bynick; #we will lowercase the NUHGA info later.
- if ( (defined($bynick)) && (defined($::sn{lc $bynick})) ) { #we have the nick taking the action available, fill in missing NUHGA info
- $byuser //= $::sn{lc $bynick}{user};
- $byhost //= $::sn{lc $bynick}{host};
- $bygecos //= $::sn{lc $bynick}{gecos};
- $byaccount //= $::sn{lc $bynick}{account};
- if (($byaccount eq '0') or ($byaccount eq '*')) {
- $byaccount = undef;
- }
- }
-# $nick = lc $nick if defined $nick;
- if ( (defined($nick)) && (defined($::sn{lc $nick})) ) { #this should always be true, else something has gone FUBAR
- $user //= $::sn{lc $nick}{user};
- $host //= $::sn{lc $nick}{host};
- $gecos //= $::sn{lc $nick}{gecos};
- $account //= $::sn{lc $nick}{account};
- if (($account eq '0') or ($account eq '*')) {
- $account = undef;
- }
- $ip = ASM::Util->getNickIP(lc $nick);
- }
-# my ($action, $reason, $channel,
-# $nick, $user, $host, $gecos, $account, $ip
-# $bynick, $byuser, $byhost, $bygecos, $byaccount);
-#Now, time to escape/NULLify everything
- $action = $dbh->quote($action);
- if (defined($reason)) { $reason = $dbh->quote($reason); } else { $reason = 'NULL'; }
-## removed lc's from everything except IP
- if (defined($channel)) { $channel = $dbh->quote($channel); } else { $channel = 'NULL'; }
-
- if (defined($nick)) { $nick = $dbh->quote($nick); } else { $nick = 'NULL'; }
- if (defined($user)) { $user = $dbh->quote($user); } else { $user = 'NULL'; }
- if (defined($host)) { $host = $dbh->quote($host); } else { $host = 'NULL'; }
- if (defined($gecos)) { $gecos = $dbh->quote($gecos); } else { $gecos = 'NULL'; }
- if (defined($account)) { $account = $dbh->quote($account); } else { $account = 'NULL'; }
- if (defined($ip)) { $ip = $dbh->quote($ip); } else { $ip = 'NULL'; }
-
- if (defined($bynick)) { $bynick = $dbh->quote($bynick); } else { $bynick = 'NULL'; }
- if (defined($byuser)) { $byuser = $dbh->quote($byuser); } else { $byuser = 'NULL'; }
- if (defined($byhost)) { $byhost = $dbh->quote($byhost); } else { $byhost = 'NULL'; }
- if (defined($bygecos)) { $bygecos = $dbh->quote($bygecos); } else { $bygecos = 'NULL'; }
- if (defined($byaccount)) { $byaccount = $dbh->quote($byaccount); } else { $byaccount = 'NULL'; }
- my $sqlstr = "INSERT INTO $self->{ACTIONTABLE} " .
- "(action, reason, channel, " .
- "nick, user, host, gecos, account, ip, " .
- "bynick, byuser, byhost, bygecos, byaccount)" .
- " VALUES " .
- "($action, $reason, $channel, " .
- "$nick, $user, $host, $gecos, $account, $ip, " .
- "$bynick, $byuser, $byhost, $bygecos, $byaccount);";
- ASM::Util->dprint( $sqlstr, 'mysql' );
- $dbh->do( $sqlstr );
- return $dbh->last_insert_id(undef, undef, $self->{ACTIONTABLE}, undef);
-# $::sn{ow} looks like:
-#$VAR1 = {
-# "account" => "afterdeath",
-# "gecos" => "William Athanasius Heimbigner",
-# "user" => "icxcnika",
-# "mship" => [
-# "#baadf00d",
-# "#antispammeta-debug",
-# "#antispammeta"
-# ],
-# "host" => "freenode/weird-exception/network-troll/afterdeath"
-# };
-
-}
-
-#FIXME: This function is shit. Also, it doesn't work like I want it to with mode.
-sub logg
-{
- my $self = shift;
- my ($event) = @_;
- my $dbh = $self->{DBH_LOG};
- my $table = $event->{type};
- $table = 'action' if ($table eq 'caction');
- $table = 'privmsg' if ($table eq 'public');
- return if (($table eq 'action') or ($table eq 'privmsg')); #Disabling logging of privmsg stuffs to mysql. no point.
- my $realtable = $table;
- $realtable = 'joins' if $realtable eq 'join'; #mysql doesn't like a table named join
- my $string = 'INSERT INTO `' . $realtable . '` (';
-## begin saner code for this function
- if ($table eq 'quit') {
- $string = 'INSERT INTO `quit` (nick, user, host, geco, ip, account, content1) VALUES (' .
- $dbh->quote($event->{nick}) . ',' . $dbh->quote($event->{user}) . ',' .
- $dbh->quote($event->{host}) . ',' . $dbh->quote($::sn{lc $event->{nick}}->{gecos}) . ',';
- my $ip = ASM::Util->getNickIP(lc $event->{nick}, $event->{host});
- if (defined($ip)) { $ip = $dbh->quote($ip); } else { $ip = 'NULL'; }
- my $account = $::sn{lc $event->{nick}}->{account};
- if (!defined($account) or ($account eq '0') or ($account eq '*')) {
- $account = 'NULL';
- } else {
- $account = $dbh->quote($account);
- }
- $string = $string . $ip . ',' . $account . ',' . $dbh->quote($event->{args}->[0]) . ');';
- $dbh->do($string);
- ASM::Util->dprint($string, 'mysql');
- return;
- } elsif ($table eq 'part') {
- $string = 'INSERT INTO `part` (channel, nick, user, host, geco, ip, account, content1) VALUES (' .
- $dbh->quote($event->{to}->[0]) . ',' .
- $dbh->quote($event->{nick}) . ',' . $dbh->quote($event->{user}) . ',' .
- $dbh->quote($event->{host}) . ',' . $dbh->quote($::sn{lc $event->{nick}}->{gecos}) . ',';
- my $ip = ASM::Util->getNickIP(lc $event->{nick}, $event->{host});
- if (defined($ip)) { $ip = $dbh->quote($ip); } else { $ip = 'NULL'; }
- my $account = $::sn{lc $event->{nick}}->{account};
- if (!defined($account) or ($account eq '0') or ($account eq '*')) {
- $account = 'NULL';
- } else {
- $account = $dbh->quote($account);
- }
- $string = $string . $ip . ',' . $account . ',' . $dbh->quote($event->{args}->[0]) . ');';
- $dbh->do($string);
- ASM::Util->dprint($string, 'mysql');
- return;
- } elsif ($table eq 'kick') {
- $string = 'INSERT INTO `kick` (channel, nick, user, host, geco, ip, account, ' .
- 'victim_nick, victim_user, victim_host, victim_geco, victim_ip, victim_account, content1) VALUES (' .
- $dbh->quote($event->{args}->[0]) . ',' .
- $dbh->quote($event->{nick}) . ',' . $dbh->quote($event->{user}) . ',' .
- $dbh->quote($event->{host}) . ',' . $dbh->quote($::sn{lc $event->{nick}}->{gecos}) . ',';
- my $ip = ASM::Util->getNickIP(lc $event->{nick});
- if (defined($ip)) { $ip = $dbh->quote($ip); } else { $ip = 'NULL'; }
- my $account = $::sn{lc $event->{nick}}->{account};
- if (($account eq '0') or ($account eq '*')) { $account = 'NULL'; } else { $account = $dbh->quote($account); }
- $string = $string . $ip . ',' . $account;
- $string = $string . ', ' . $dbh->quote($event->{to}->[0]);
- $string = $string . ', ' . $dbh->quote($::sn{lc $event->{to}->[0]}->{user});
- $string = $string . ', ' . $dbh->quote($::sn{lc $event->{to}->[0]}->{host});
- $string = $string . ', ' . $dbh->quote($::sn{lc $event->{to}->[0]}->{gecos});
- my $vic_ip = ASM::Util->getNickIP(lc $event->{to}->[0]);
- if (defined($vic_ip)) { $vic_ip = $dbh->quote($vic_ip); } else { $vic_ip = 'NULL'; }
- my $vic_account = $::sn{lc $event->{to}->[0]}->{account};
- if (($vic_account eq '0') or ($vic_account eq '*')) { $vic_account = 'NULL'; } else { $vic_account = $dbh->quote($vic_account); }
- $string = $string . ', ' . $vic_ip . ',' . $vic_account . ',' . $dbh->quote($event->{args}->[1]) . ');';
- $dbh->do($string);
- ASM::Util->dprint($string, 'mysql');
- return;
- }
-## end saner code for this function
- if (($table ne 'nick') && ($table ne 'quit')) {
- $string = $string . 'channel, ';
- }
- $string = $string . 'nick, user, host, geco';
- if (($table ne 'join') && ($table ne 'kick')) {
- $string = $string . ', content1';
- }
- if ($table eq 'mode') {
- $string = $string . ', content2';
- }
- if ($table eq 'kick') {
- $string = $string . ', victim_nick, victim_user, victim_host, victim_geco, content1';
- }
- $string = $string . ') VALUES (';
- if (($table ne 'nick') && ($table ne 'quit') && ($table ne 'kick')) {
- $string = $string . $dbh->quote($event->{to}->[0]) . ", ";
- }
- if ($table eq 'kick') {
- $string = $string . $dbh->quote($event->{args}->[0]) . ", ";
- }
- my $geco = $::sn{lc $event->{nick}}->{gecos};
- $string = $string . $dbh->quote($event->{nick}) . ", " . $dbh->quote($event->{user}) . ", " .
- $dbh->quote($event->{host}) . ", " . $dbh->quote($geco);
- if (($table ne 'join') && ($table ne 'kick')) {
- $string = $string. ', ' . $dbh->quote($event->{args}->[0]);
- }
- if ($table eq 'kick') {
- $string = $string . ', ' . $dbh->quote($event->{to}->[0]);
- $string = $string . ', ' . $dbh->quote($::sn{lc $event->{to}->[0]}->{user});
- $string = $string . ', ' . $dbh->quote($::sn{lc $event->{to}->[0]}->{host});
- $string = $string . ', ' . $dbh->quote($::sn{lc $event->{to}->[0]}->{gecos});
- $string = $string . ', ' . $dbh->quote($event->{args}->[1]);
- }
- if ($table eq 'mode') {
- $string = $string . ', ' . $dbh->quote($event->{args}->[1]);
- }
- $string = $string . ');';
-# ASM::Util->dprint($string, "mysql");
- $dbh->do($string);
-}
-
-sub query
-{
- my $self = shift;
- my ($channel, $nick, $user, $host) = @_;
- my $dbh = $self->{DBH};
- $channel = $dbh->quote($channel);
- $nick = $dbh->quote($nick);
- $user = $dbh->quote($user);
- $host = $dbh->quote($host);
-
- $nick =~ s/\*/%/g;
- $nick =~ s/_/\\_/g;
- $nick =~ s/\?/_/g;
-
- $user =~ s/\*/%/g;
- $user =~ s/_/\\_/g;
- $user =~ s/\?/_/g;
-
- $host =~ s/\*/%/g;
- $host =~ s/_/\\_/g;
- $host =~ s/\?/_/g;
- my $sth = $dbh->prepare("SELECT * from $self->{TABLE} WHERE channel like $channel and nick like $nick and user like $user and host like $host;");
- $sth->execute;
- my $i = 0;
- while (my $ref = $sth->fetchrow_arrayref) {
- $i++;
- }
- return $i;
-}
-
-1;
diff --git a/modules/services.pl b/modules/services.pl
deleted file mode 100644
index 528901d..0000000
--- a/modules/services.pl
+++ /dev/null
@@ -1,69 +0,0 @@
-package ASM::Services;
-use warnings;
-use strict;
-
-use Data::Dumper;
-$Data::Dumper::Useqq=1;
-
-sub new
-{
- my $self = {};
- bless($self);
- return $self;
-}
-
-sub doServices {
- my ($self, $conn, $event) = @_;
- my $i = 1;
- if ($event->{from} eq 'NickServ!NickServ@services.')
- {
- ASM::Util->dprint("NickServ: $event->{args}->[0]", 'snotice');
- if ( $event->{args}->[0] =~ /^This nickname is registered/ )
- {
- $conn->privmsg( 'NickServ@services.', "identify $::settings->{nick} $::settings->{pass}" );
- }
- elsif ( $event->{args}->[0] =~ /^You are now identified/ )
- {
- my @autojoins = @{$::settings->{autojoins}};
- if (defined($autojoins[30])) {
- $conn->join(join(',', @autojoins[0..30]));
- if (defined($autojoins[60])) {
- $conn->join(join(',', @autojoins[30..60]));
- $conn->join(join(',', @autojoins[60..$#autojoins]));
- } else {
- $conn->join(join(',', @autojoins[30..$#autojoins]));
- }
- } else {
- $conn->join(join(',', @autojoins));
- }
- $conn->sl("PING :" . time);
- $conn->schedule(2, sub { $conn->privmsg($::settings->{masterchan}, 'Now joined to all channels in '. (time - $::starttime) . " seconds."); });
- }
- elsif ($event->{args}->[0] =~ /has been (killed|released)/ )
- {
-# ASM::Util->dprint('Got kill/release successful from NickServ!', 'snotice');
- $conn->nick( $::settings->{nick} );
- }
- elsif ($event->{args}->[0] =~ /has been regained/ )
- {
-# ASM::Util->dprint('Got regain successful from nickserv!', 'snotice');
- }
- elsif ($event->{args}->[0] =~ /Password Incorrect/ )
- {
- die("NickServ password invalid.")
- }
- }
- elsif ($event->{from} eq 'ChanServ!ChanServ@services.')
- {
- if ( $event->{args}->[0] =~ /^\[#/ ) {
- return;
- }
- ASM::Util->dprint("ChanServ: $event->{args}->[0]", 'snotice');
- if ( $event->{args}->[0] =~ /^All.*bans matching.*have been cleared on(.*)/)
- {
- $conn->join($1);
- }
- }
-}
-
-return 1;
diff --git a/modules/util.pl b/modules/util.pl
deleted file mode 100644
index f9895a0..0000000
--- a/modules/util.pl
+++ /dev/null
@@ -1,297 +0,0 @@
-package ASM::Util;
-use Array::Utils qw(:all);
-use POSIX qw(strftime);
-use warnings;
-use strict;
-use Term::ANSIColor qw (:constants);
-use Socket qw( inet_aton inet_ntoa );
-use Data::Dumper;
-use Carp qw(cluck);
-
-%::RISKS =
-(
- 'disable'=> -1, #this isn't really an alert
- 'debug' => 10,
- 'info' => 20,
- 'low' => 30,
- 'medium' => 40,
- 'high' => 50,
- 'opalert'=> 9001 #OVER NINE THOUSAND!!!
-);
-
-#leaves room for more levels if for some reason we end up needing more
-#theoretically, you should be able to change those numbers without any damage
-
-%::COLORS =
-(
- 'white' => '00',
- 'black' => '01',
- 'blue' => '02',
- 'green' => '03',
- 'red' => '04',
- 'brown' => '05',
- 'purple' => '06',
- 'orange' => '07',
- 'yellow' => '08',
- 'ltgreen' => '09',
- 'teal' => '10',
- 'ltcyan' => '11',
- 'ltblue' => '12',
- 'pink' => '13',
- 'grey' => '14',
- 'ltgrey' => '15',
-);
-
-%::RCOLOR =
-(
- $::RISKS{debug} => $::COLORS{purple},
- $::RISKS{info} => $::COLORS{blue},
- $::RISKS{low} => $::COLORS{green},
- $::RISKS{medium} => $::COLORS{orange},
- $::RISKS{high} => $::COLORS{red},
-);
-
-sub new
-{
- my $module = shift;
- my $self = {};
- bless ($self);
- return $self;
-}
-
-sub maxlen {
- my ($a, $b) = @_;
- my ($la, $lb) = (length($a), length($b));
- return $la if ($la > $lb);
- return $lb;
-}
-
-#cs: returns the xml settings for the specified chan, or default if there aren't any settings for that chan
-sub cs {
- my ($module, $chan) = @_;
- $chan = lc $chan;
- $chan =~ s/^[@+]//;
- return $::channels->{channel}->{default} unless defined($::channels->{channel}->{$chan});
- if ( defined($::channels->{channel}->{$chan}->{link}) ) {
- return $::channels->{channel}->{ $::channels->{channel}->{$chan}->{link} };
- }
- return $::channels->{channel}->{$chan};
-}
-
-sub getLink
-{
- my ($module, $chan) = @_;
- $chan = lc $chan;
- $chan =~ s/^[@+]//;
- my $link = $::channels->{channel}->{$chan}->{link};
- if ( defined($link) ) {
- return $link;
- }
- return $chan;
-}
-
-sub speak
-{
- my ($module, $chan) = @_;
- $chan = lc $chan;
- $chan =~ s/^[@+]//;
- if ( defined($::channels->{channel}->{$chan}->{silence}) ) {
- if ($::channels->{channel}->{$chan}->{silence} eq "no") {
- return 1;
- }
- elsif ($::channels->{channel}->{$chan}->{silence} eq "yes") {
- return 0;
- }
- }
- if ( defined($::channels->{channel}->{default}->{silence}) ) {
- if ( $::channels->{channel}->{default}->{silence} eq "no" ) {
- return 1;
- }
- elsif ( $::channels->{channel}->{default}->{silence} eq "yes" ) {
- return 0;
- }
- }
- return 1;
-}
-
-#this item is a stub, dur
-sub hostip {
- #cluck "Calling gethostbyname in hostip";
- return gethostbyname($_[0]);
-}
-
-# If $tgts="#antispammeta" that's fine, and if $tgts = ["#antispammeta", "##linux-ops"] that's cool too
-sub sendLongMsg {
- my ($module, $conn, $tgts, $txtz) = @_;
- if (length($txtz) <= 380) {
- $conn->privmsg($tgts, $txtz);
- } else {
- my $splitpart = rindex($txtz, " ", 380);
- $conn->privmsg($tgts, substr($txtz, 0, $splitpart));
- $conn->privmsg($tgts, substr($txtz, $splitpart));
- }
-}
-
-sub getAlert {
- my ($module, $c, $risk, $t) = @_;
- my @disable = ();
- my @x = ();
- $c = lc $c;
- $c =~ s/^[@+]//;
- foreach my $prisk ( keys %::RISKS) {
- if ( $::RISKS{$risk} >= $::RISKS{$prisk} ) {
- push( @x, @{$::channels->{channel}->{master}->{$t}->{$prisk}} ) if defined $::channels->{channel}->{master}->{$t}->{$prisk};
- push( @x, @{cs($module, $c)->{$t}->{$prisk}} ) if defined cs($module, $c)->{$t}->{$prisk};
- }
- }
- push( @disable, @{$::channels->{channel}->{master}->{$t}->{disable}} ) if defined $::channels->{channel}->{master}->{$t}->{disable};
- push( @disable, @{cs($module, $c)->{$t}->{disable}} ) if defined cs($module, $c)->{$t}->{disable};
- @x = unique(@x);
- @x = array_diff(@x, @disable);
- return @x;
-}
-
-sub commaAndify {
- my $module = shift;
- my @seq = @_;
- my $len = ($#seq);
- my $last = $seq[$len];
- return '' if $len eq -1;
- return $seq[0] if $len eq 0;
- return join( ' and ', $seq[0], $seq[1] ) if $len eq 1;
- return join( ', ', splice(@seq,0,$len) ) . ', and ' . $last;
-}
-
-sub leq {
- my ($s1, $s2) = @_;
- return (lc $s1 eq lc $s2);
-}
-
-sub seq {
- my ($n1, $n2) = @_;
- return 0 unless defined($n1);
- return 0 unless defined($n2);
- return ($n1 eq $n2);
-}
-
-#I last worked on this function while having way too many pain meds, if it's fucked up, that's why.
-sub dprint {
- my ($module, $text, $type) = @_;
- if (!defined($type)) {
- die "old method for dprint called!\n";
- }
- if (!defined($::debugx{$type})) {
- die "dprint called with invalid type!\n";
- }
- if ($::debugx{$type} eq 0) {
- return;
- }
- say STDERR strftime("%F %T ", gmtime),
- GREEN, 'DEBUG', RESET, '(', $::debugx{$type}, $type, RESET, ') ', $text;
-}
-
-
-sub intToDottedQuad {
- my ($module, $num) = @_;
- return inet_ntoa(pack('N', $num));
-}
-
-sub dottedQuadToInt
-{
- my ($module, $dottedquad) = @_;
-# my $ip_number = 0;
-# my @octets = split(/\./, $dottedquad);
-# foreach my $octet (@octets) {
-# $ip_number <<= 8;
-# $ip_number |= $octet;
-# }
-# return $ip_number;
- return unpack('N', inet_aton($dottedquad));
-}
-
-sub getHostIP
-{
- my ($module, $host) = @_;
- if ( ($host =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/) or
- ($host =~ /^gateway\/web\/.*\/ip\.(\d+)\.(\d+)\.(\d+)\.(\d+)$/) ) {
- #yay, easy IP!
- return dottedQuadToInt(undef, "$1.$2.$3.$4");
- } elsif (index($host, '/') != -1) {
- return;
- } elsif ($host =~ /^2001:0:/) {
- my @splitip = split(/:/, $host);
- return unless defined($splitip[6]) && defined($splitip[7]);
- #I think I can just do (hex($splitip[6] . $splitip[7]) ^ hex('ffffffff')) here but meh
- my $host = join('.', unpack('C4', pack('N', (hex($splitip[6] . $splitip[7])^hex('ffffffff')))));
- return dottedQuadToInt(undef, $host);
- }
- #cluck "Calling gethostbyname in getHostIP";
- my @resolve = gethostbyname($host);
- return unless @resolve;
- return dottedQuadToInt(undef, join('.', unpack('C4', $resolve[4])));
-}
-
-sub getNickIP
-{
- my ($module, $nick, $host) = @_;
- $nick = lc $nick;
- return unless defined($::sn{$nick});
- if (defined($::sn{$nick}{ip})) {
- return $::sn{$nick}{ip};
- }
- $host //= $::sn{$nick}{host};
- my $ip = getHostIP(undef, $host);
- if (defined($ip)) {
- $::sn{$nick}{ip} = $ip;
- return $ip;
- }
- return;
-# if ( ($host =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/) or
-# ($host =~ /^gateway\/web\/freenode\/ip\.(\d+)\.(\d+)\.(\d+)\.(\d+)$/) ) {
-# #yay, easy IP!
-# $::sn{$nick}{ip} = dottedQuadToInt(undef, "$1.$2.$3.$4");
-# return $::sn{$nick}{ip};
-# } elsif (index($host, '/') != -1) {
-# return;
-# } elsif ($host =~ /^2001:0:/) {
-# my @splitip = split(/:/, $host);
-# #I think I can just do (hex($splitip[6] . $splitip[7]) ^ hex('ffffffff')) here but meh
-# my $host = join('.', unpack('C4', pack('N', (hex($splitip[6] . $splitip[7])^hex('ffffffff')))));
-# $::sn{$nick}{ip} = dottedQuadToInt(undef, $host);
-# return $::sn{$nick}{ip};
-# }
-# my @resolve = gethostbyname($::sn{$nick}{host});
-# return unless @resolve;
-# $::sn{$nick}{ip} = dottedQuadToInt(undef, join('.', unpack('C4', $resolve[4])));
-# return $::sn{$nick}{ip};
-}
-
-sub notRestricted {
- my ($module, $nick, $restriction) = @_;
- $nick = lc $nick;
- my $host = lc $::sn{$nick}{host};
- my $account = lc $::sn{$nick}{account};
- foreach my $regex (keys %{$::restrictions->{nicks}->{nick}}) {
- if ($nick =~ /^$regex$/i && defined($::restrictions->{nicks}->{nick}->{$regex}->{$restriction})) {
- dprint("blah", "Restriction $restriction found for $nick (nick $regex)", "restrictions");
- return 0;
- }
- }
- if ((defined($host)) && (defined($account))) {
- foreach my $regex (keys %{$::restrictions->{accounts}->{account}}) {
- if ($account =~ /^$regex$/i && defined($::restrictions->{accounts}->{account}->{$regex}->{$restriction})) {
- dprint("blah", "Restriction $restriction found for $nick (account $regex)", "restrictions");
- return 0;
- }
- }
- foreach my $regex (keys %{$::restrictions->{hosts}->{host}}) {
- if ($host =~ /^$regex$/i && defined($::restrictions->{hosts}->{host}->{$regex}->{$restriction})) {
- dprint("blah", "Restriction $restriction found for $nick (host $regex)", "restrictions");
- return 0;
- }
- }
- }
- return 1;
-}
-
-return 1;
diff --git a/modules/xml.pl b/modules/xml.pl
deleted file mode 100644
index 1128dda..0000000
--- a/modules/xml.pl
+++ /dev/null
@@ -1,69 +0,0 @@
-package ASM::XML;
-use warnings;
-use strict;
-
-use XML::Simple qw(:strict);
-use IO::All;
-
-$::xs1 = XML::Simple->new( KeyAttr => ['id'], Cache => [ qw/memcopy/ ]);
-
-sub readXML {
- my ( $p ) = $::cset;
- my @fchan = ( 'event', keys %::RISKS );
- $::settings = $::xs1->XMLin( "$p/settings.xml", ForceArray => ['host'],
- 'GroupTags' => { altnicks => 'altnick', server => 'host',
- autojoins => 'autojoin' });
- $::channels = $::xs1->XMLin( "$p/channels.xml", ForceArray => \@fchan );
- $::users = $::xs1->XMLin( "$p/users.xml", ForceArray => 'person');
- $::commands = $::xs1->XMLin( "$p/commands.xml", ForceArray => [qw/command/]);
- $::mysql = $::xs1->XMLin( "$p/mysql.xml", ForceArray => ['ident', 'geco'],
- 'GroupTags' => { ignoredidents => 'ident', ignoredgecos => 'geco' });
- $::dnsbl = $::xs1->XMLin( "$p/dnsbl.xml", ForceArray => []);
- $::rules = $::xs1->XMLin( "$p/rules.xml", ForceArray => []);
- $::restrictions = $::xs1->XMLin( "$p/restrictions.xml", ForceArray => ['host', 'nick', 'account']);
- $::blacklist = $::xs1->XMLin( "$p/blacklist.xml", ForceArray => 'string');
-}
-
-sub writeXML {
- writeSettings();
- writeChannels();
- writeUsers();
- writeRestrictions();
- writeBlacklist();
- writeMysql();
-# $::xs1->XMLout($::commands, RootName => 'commands', KeyAttr => ['id']) > io("$::cset/commands.xml");
-}
-
-sub writeMysql {
- $::settingschanged=1;
- $::xs1->XMLout($::mysql, RootName => 'mysql', KeyAttr => ['id']) > io("$::cset/mysql.xml");
-}
-
-sub writeChannels {
- $::settingschanged=1;
- $::xs1->XMLout($::channels, RootName => 'channels', KeyAttr => ['id'], NumericEscape => 2) > io("$::cset/channels.xml");
-}
-
-sub writeUsers {
- $::settingschanged=1;
- $::xs1->XMLout($::users, RootName => 'people', KeyAttr => ['id']) > io("$::cset/users.xml");
-}
-
-sub writeSettings {
- $::settingschanged=1;
- $::xs1->XMLout($::settings, RootName => 'settings',
- GroupTags => { altnicks => 'altnick', server => 'host', autojoins => 'autojoin' }, NoAttr => 1) > io("$::cset/settings.xml");
-}
-
-sub writeRestrictions {
- $::settingschanged=1;
- $::xs1->XMLout($::restrictions, RootName => 'restrictions', KeyAttr => ['id'],
- GroupTags => { hosts => "host", nicks => "nick", accounts => "account"}) > io("$::cset/restrictions.xml");
-}
-
-sub writeBlacklist {
- $::settingschanged=1;
- $::xs1->XMLout($::blacklist, RootName => 'blacklist', KeyAttr => ['id'], NumericEscape => 2) > io("$::cset/blacklist.xml");
-}
-
-return 1;