summaryrefslogtreecommitdiffstats
path: root/lib/ASM
diff options
context:
space:
mode:
Diffstat (limited to 'lib/ASM')
-rw-r--r--lib/ASM/Classes.pm514
-rw-r--r--lib/ASM/Commander.pm61
-rw-r--r--lib/ASM/DB.pm323
-rw-r--r--lib/ASM/Event.pm887
-rw-r--r--lib/ASM/Inspect.pm101
-rw-r--r--lib/ASM/Log.pm112
-rw-r--r--lib/ASM/Services.pm69
-rw-r--r--lib/ASM/Util.pm297
-rw-r--r--lib/ASM/XML.pm69
9 files changed, 2433 insertions, 0 deletions
diff --git a/lib/ASM/Classes.pm b/lib/ASM/Classes.pm
new file mode 100644
index 0000000..1054f63
--- /dev/null
+++ b/lib/ASM/Classes.pm
@@ -0,0 +1,514 @@
+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/lib/ASM/Commander.pm b/lib/ASM/Commander.pm
new file mode 100644
index 0000000..aa79f4d
--- /dev/null
+++ b/lib/ASM/Commander.pm
@@ -0,0 +1,61 @@
+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/lib/ASM/DB.pm b/lib/ASM/DB.pm
new file mode 100644
index 0000000..86a1c78
--- /dev/null
+++ b/lib/ASM/DB.pm
@@ -0,0 +1,323 @@
+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/lib/ASM/Event.pm b/lib/ASM/Event.pm
new file mode 100644
index 0000000..e6f4c23
--- /dev/null
+++ b/lib/ASM/Event.pm
@@ -0,0 +1,887 @@
+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/lib/ASM/Inspect.pm b/lib/ASM/Inspect.pm
new file mode 100644
index 0000000..df515dc
--- /dev/null
+++ b/lib/ASM/Inspect.pm
@@ -0,0 +1,101 @@
+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/lib/ASM/Log.pm b/lib/ASM/Log.pm
new file mode 100644
index 0000000..c2a2b72
--- /dev/null
+++ b/lib/ASM/Log.pm
@@ -0,0 +1,112 @@
+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/lib/ASM/Services.pm b/lib/ASM/Services.pm
new file mode 100644
index 0000000..528901d
--- /dev/null
+++ b/lib/ASM/Services.pm
@@ -0,0 +1,69 @@
+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/lib/ASM/Util.pm b/lib/ASM/Util.pm
new file mode 100644
index 0000000..f9895a0
--- /dev/null
+++ b/lib/ASM/Util.pm
@@ -0,0 +1,297 @@
+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/lib/ASM/XML.pm b/lib/ASM/XML.pm
new file mode 100644
index 0000000..1128dda
--- /dev/null
+++ b/lib/ASM/XML.pm
@@ -0,0 +1,69 @@
+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;
generated by cgit v1.2.3 (git 2.46.0) at 2026-01-26 23:51:05 +0000