Use Tie::CPHash to make %::sn and %::sc case-insensitiveish.

Clean up commands.xml and fix some bugs
Add clone detection
Minimize some excessive warnings
Greatly improve syncing speed

6 files changed, 72 insertions, 25 deletions

diff --git a/config-default/commands.xml b/config-default/commands.xml
index 7a568de..8c81588 100644
--- a/config-default/commands.xml
+++ b/config-default/commands.xml
@@ -200,11 +200,11 @@
     my $dbh = $::db->{DBH};
 
     my $mnicks = $dbh->do("SELECT * from $::db->{ACTIONTABLE} WHERE nick like " .    $dbh->quote($nick) . ';');
-    my $musers = (lc $person->{user} ~~ $::mysql->{ignoredidents}) ? "didn't check ($person->{user})" :
+    my $musers = (lc $person->{user} ~~ $::mysql->{ignoredidents}) ? "didn't check" :
                  $dbh->do("SELECT * from $::db->{ACTIONTABLE} WHERE user like " .    $dbh->quote($person->{user}) . ';');
     my $mhosts = $dbh->do("SELECT * from $::db->{ACTIONTABLE} WHERE host like " .    $dbh->quote($person->{host}) . ';');
     my $maccts = $dbh->do("SELECT * from $::db->{ACTIONTABLE} WHERE account like " . $dbh->quote($person->{account}) . ';');
-    my $mgecos = (lc $person->{gecos} ~~ $::mysql->{ignoredgecos}) ? "didn't check ($person->{gecos})" :
+    my $mgecos = (lc $person->{gecos} ~~ $::mysql->{ignoredgecos}) ? "didn't check" :
                  $dbh->do("SELECT * from $::db->{ACTIONTABLE} WHERE gecos like " .   $dbh->quote($person->{gecos}) . ';');
 
     my $ip = ASM::Util->getNickIP($nick);
@@ -218,14 +218,14 @@
     $matchedip =~ s/0E0/0/;
     my $dq = '';
     if (defined($ip)) {
-      $dq = '&realip=' . join '.', unpack 'C4', pack 'N', $ip;
+      $dq = join '.', unpack 'C4', pack 'N', $ip;
     }
-    $conn->privmsg($event->replyto, "I found $mnicks matches by nick, $musers user matches, $mhosts by hostname, " .
-                                 "$maccts by NickServ account, $mgecos by gecos field, and $matchedip by real IP." .
+    $conn->privmsg($event->replyto, "I found $mnicks matches by nick ($nick), $musers by user ($person->{user}), $mhosts by hostname ($person->{host}), " .
+                                 "$maccts by NickServ account ($person->{account}), $mgecos by gecos field ($person->{gecos}), and $matchedip by real IP ($dq)." .
                     ' Web results are at https://antispammeta.net/cgi-bin/secret/investigate.pl?nick=' . uri_escape($nick) .
         ((lc $person->{user} ~~ $::mysql->{ignoredidents}) ? '' : '&user=' . uri_escape($person->{user})) .
         '&host=' . uri_escape($person->{host}) . '&account=' . uri_escape($person->{account}) .
-        ((lc $person->{gecos} ~~ $::mysql->{ignoredgecos}) ? '' : '&gecos=' . uri_escape($person->{gecos})) . $dq);
+        ((lc $person->{gecos} ~~ $::mysql->{ignoredgecos}) ? '' : '&gecos=' . uri_escape($person->{gecos})) . '&realip=' . $dq);
   ]]>
   </command>
   <command cmd="^;investigate2 (\S+) ?(\d*) *$" flag="s">
@@ -426,11 +426,11 @@
   </command>
   <command cmd="^;showhilights (\S+) *$" flag="h">
   <![CDATA[
-    my $nick = lc $1;
+    my $nick = $1;
     my @channels = ();
     foreach my $chan (keys(%{$::channels->{channel}})) {
       foreach my $level (keys(%{$::channels->{channel}->{$chan}->{hilights}})) {
-        if (grep(/^${nick}$/i, @{$::channels->{channel}->{$chan}->{hilights}->{$level}})) {
+        if ( $nick ~~ $::channels->{channel}->{$chan}->{hilights}->{$level}) {
           push @channels, $chan . " ($level)";
         }
       }
diff --git a/lib/ASM/Classes.pm b/lib/ASM/Classes.pm
index 2fae035..1f0e3ef 100644
--- a/lib/ASM/Classes.pm
+++ b/lib/ASM/Classes.pm
@@ -37,13 +37,26 @@ sub new
     "garbagemeter" => \&garbagemeter,
     "cyclebotnet" => \&cyclebotnet,
     "banevade" => \&banevade,
-    "urlcrunch" => \&urlcrunch
+    "urlcrunch" => \&urlcrunch,
+    "cloning" => \&cloning
   };
   $self->{ftbl} = $tbl;
   bless($self);
   return $self;
 }
 
+sub cloning {
+  my ($chk, $id, $event, $chan, $rev) = @_;
+  my $max = int($chk->{content});
+  my @nicks = grep {($::sn{$_}->{host} eq $event->{host}) && (lc $chan ~~ $::sn{$_}->{mship})} keys %::sn;
+  # It's lines like these that make me love Perl no matter how much it drives dwfreed up a tree.
+  # Understanding how that line works is simple and is left as an exercise to the reader.
+  if ($#nicks >= $max) {
+    return ASM::Util->commaAndify(@nicks);
+  }
+  return 0;
+}
+
 sub garbagemeter {
   my ($chk, $id, $event, $chan, $rev) = @_;
   my @cut = split(/:/, $chk->{content});
diff --git a/lib/ASM/Commander.pm b/lib/ASM/Commander.pm
index d864800..c1f93ef 100644
--- a/lib/ASM/Commander.pm
+++ b/lib/ASM/Commander.pm
@@ -35,7 +35,10 @@ sub command
       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
+      if (!defined($acct)) {
+        $fail = 1;
+      }
+      elsif (!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
diff --git a/lib/ASM/Event.pm b/lib/ASM/Event.pm
index 04046c4..f057582 100644
--- a/lib/ASM/Event.pm
+++ b/lib/ASM/Event.pm
@@ -7,6 +7,7 @@ use IO::All;
 use POSIX qw(strftime);
 use Regexp::Wildcards;
 use HTTP::Request;
+use Array::Utils qw(:all);
 
 sub new
 {
@@ -144,7 +145,7 @@ sub on_pong
   if (($pongcount++ % 3) == 0) { #easiest way to do something roughly every 90 seconds
     $conn->sl('STATS p');
   }
-  if ( @::syncqueue || $::netsplit_ignore_lag ) {
+  if ( @::syncqueue || $::netsplit_ignore_lag || $::pendingsync) {
     return; #we don't worry about lag if we've just started up and are still syncing, or just experienced a netsplit
   }
   if (($lag > 2) && ($lag < 5)) {
@@ -216,9 +217,9 @@ sub on_connect {
   if (lc $event->{args}->[0] ne lc $::settings->{nick}) {
     ASM::Util->dprint('Attempting to regain my main nick', 'startup');
     $conn->sl("NickServ regain $::settings->{nick} $::settings->{pass}");
-  } else {
-    $conn->sl("NickServ identify $::settings->{nick} $::settings->{pass}");
-  }
+  }# else {
+#    $conn->sl("NickServ identify $::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
 }
 
@@ -232,12 +233,14 @@ sub on_join {
     $::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;
+    $::pendingsync++;
+#    unless ( (scalar @::syncqueue) > 4 ) {
+#      ASM::Util->dprint("Syncing $chan", "sync");
+#      $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};
@@ -421,6 +424,7 @@ sub blah
 {
   my ($self, $event) = @_;
   ASM::Util->dprint(Dumper($event), 'misc');
+  return if ($event->{nick} =~ /\./);
   $::inspector->inspect($self, $event);
 }
 
@@ -640,6 +644,7 @@ sub whoGotHit
 sub on_mode
 {
   my ($conn, $event) = @_;
+  return if ($event->{nick} =~ /\./); #if I ever want to track what modes ASM has on itself, this will have to die
   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
@@ -829,13 +834,19 @@ sub on_whoxreply
 sub on_whoxover
 {
   my ($conn, $event) = @_;
-  my $chan = pop @::syncqueue;
+  $::pendingsync--;
   $::synced{lc $event->{args}->[1]} = 1;
+  if ($event->{args}->[1] ~~ @::syncqueue) {
+    my @diff = (lc $event->{args}->[1]);
+    @::syncqueue = array_diff(@::syncqueue, @diff);
+  }
+  my $chan = pop @::syncqueue;
   if (defined($chan) ){
+    ASM::Util->dprint("Syncing $chan", "sync");
     $conn->sl('who ' . $chan . ' %tcnuhra,314');
     $conn->sl('mode ' . $chan);
-    $conn->sl('mode ' . $chan . ' bq');
-  } else {
+    $conn->sl('mode ' . $chan . ' b');
+  } elsif ($::pendingsync == 0) {
     my $size = `ps -p $$ h -o size`;
     my $cputime = `ps -p $$ h -o time`;
     chomp $size; chomp $cputime;
@@ -862,6 +873,15 @@ sub on_whoxover
     if (scalar (keys %x)) {
       $conn->privmsg($::settings->{masterchan}, "Syncing appears to have failed for " . ASM::Util->commaAndify(keys %x)) unless $::no_autojoins;
     }
+    # There are some odd undefined values getting made somewhere, this is a nice way of fixing it
+    foreach my $nick (keys %::sn) { 
+      if ( !defined($::sn{$nick}->{mship}) ) {
+        $::sn{$nick}->{mship} = [];
+      }
+      if (!defined($::sn{$nick}->{host})) {
+        $::sn{$nick}->{host} = "";
+      }
+    }
   }
 }
 
diff --git a/lib/ASM/Services.pm b/lib/ASM/Services.pm
index f88ddac..7cbf1ff 100644
--- a/lib/ASM/Services.pm
+++ b/lib/ASM/Services.pm
@@ -38,7 +38,14 @@ sub doServices {
         $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."); });
+      foreach my $chan (@autojoins[0..1]) {
+        ASM::Util->dprint("Syncing $chan", "sync");
+        $conn->sl('who ' . $chan . ' %tcnuhra,314');
+        $conn->sl('mode ' . $chan);
+        $conn->sl('mode ' . $chan . ' b');
+      }
+        @::syncqueue = @autojoins[1..$#autojoins];
+#      $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)/ )
     {
diff --git a/meta.pl b/meta.pl
index 8ee498d..76af728 100755
--- a/meta.pl
+++ b/meta.pl
@@ -2,7 +2,6 @@
 
 use strict;
 use warnings;
-no if $] >= 5.017011, warnings => 'experimental::smartmatch';
 
 use FindBin;
 use lib "$FindBin::Bin/lib";;
@@ -17,6 +16,7 @@ use File::Monitor;
 use feature qw(say);
 use HTTP::Async;
 use Carp;
+use Tie::CPHash;
 
 use ASM::Util;
 use ASM::XML;
@@ -28,6 +28,7 @@ use ASM::Commander;
 use ASM::Classes;
 use ASM::DB;
 use ASM::Fifo;
+no if $] >= 5.017011, warnings => 'experimental::smartmatch';
 
 $Data::Dumper::Useqq=1;
 
@@ -68,8 +69,10 @@ $::settingschanged = 0;
 %::spy = ();
 $::starttime = time;
 @::syncqueue = ();
+$::pendingsync = 0;
 %::watchRegged = ();
 $::lastline = "";
+%::sn = (); %::sc = (); tie %::sc, 'Tie::CPHash'; tie %::sn, 'Tie::CPHash';
 
 $SIG{__WARN__} = sub {
   $Data::Dumper::Useqq=1;
@@ -113,6 +116,7 @@ sub init {
                          Nick => $::settings->{nick},
                          Ircname => $::settings->{realname},
                          Username => $::settings->{username},
+                         Password => $::settings->{pass},
 			 Pacing => 0 );
   $conn->debug($::debug);
   $::inspector = ASM::Inspect->new();