Cleanup, CAP is now core and added hook on_capack.

bin/auto

@@ -337,6 +337,12 @@ else {
 
 # Events.
 API::Std::event_add('on_preconnect');
+# CAP.
+my %tcsvrs = conf_get('server');
+foreach my $svr (keys %tcsvrs) {
+    $Proto::IRC::cap{$svr} = 'multi-prefix';
+}
+undef %tcsvrs;
 
 # Load modules.
 if (conf_get('module')) {

doc/CHANGELOG

@@ -3,6 +3,8 @@ Auto IRC Bot 3.0: Change Log
 
 3.0 Indev
 ===============================================================================
+    * Added hook on_capack.
+    * CAP is now core.
     * Fixed a bug with multi-prefix support.
     * Added fpfmt() to API::Std.
     * Auto::GR renamed to $Auto::VERGITREV.

lib/Lib/Auto.pm

@@ -218,6 +218,9 @@ sub ircsock {
     if (defined $cdata->{'pass'}[0]) {
         Auto::socksnd($svrname, 'PASS :'.$cdata->{'pass'}[0]) or return;
     }
+    # Send CAP LS.
+    Auto::socksnd($svrname, 'CAP LS');
+    # Trigger on_preconnect.
     API::Std::event_run('on_preconnect', $svrname);
     # Send NICK/USER.
     API::IRC::nick($svrname, $cdata->{'nick'}[0]);

lib/Proto/IRC.pm

@@ -4,6 +4,7 @@
 package Proto::IRC;
 use strict;
 use warnings;
+use feature qw(switch);
 use API::Std qw(conf_get err awarn trans);
 use API::IRC;
 
@@ -24,6 +25,7 @@ our %RAWC = (
     '474'      => \&num474,
     '475'      => \&num475,
     '477'      => \&num477,
+    'CAP'      => \&cap,
     'JOIN'     => \&cjoin,
     'KICK'     => \&kick,
     'MODE'     => \&mode,
@@ -36,9 +38,10 @@ our %RAWC = (
 );
 
 # Variables for various functions.
-our (%got_001, %botinfo, %botchans, %csprefix, %chanusers, %chanmodes);
+our (%got_001, %botinfo, %botchans, %csprefix, %chanusers, %chanmodes, %cap);
 
 # Events.
+API::Std::event_add('on_capack');
 API::Std::event_add('on_connect');
 API::Std::event_add('on_rcjoin');
 API::Std::event_add('on_ucjoin');
@@ -306,6 +309,57 @@ sub num477 {
     return 1;
 }
 
+# Parse: CAP
+sub cap {
+    my ($svr, @ex) = @_;
+    my $capout;
+
+    # Iterate ex[3].
+    given ($ex[3]) {
+        when ('LS') {
+            # Get our CAP REQ list.
+            my @capreq = ();
+            if ($cap{$svr} =~ m/\s/xsm) { @capreq = split ' ', $cap{$svr} }
+            else { push @capreq, $cap{$svr} }
+
+            # Iterate through what we received from the server.
+            $ex[4] =~ s/^://xsm;
+            foreach my $scap (@ex[4..$#ex]) {
+                # Check if we support this.
+                foreach my $icap (@capreq) {
+                    if ($icap eq $scap) {
+                        $capout .= " $scap";
+                    }
+                }
+            }
+            
+            # Send CAP REQ/CAP END based on what both we and the server support.
+            if (!$capout) { Auto::socksnd($svr, 'CAP END'); }
+            else {
+                $capout = substr $capout, 1;
+                Auto::socksnd($svr, "CAP REQ :$capout");
+            }
+        }
+        when ('ACK') {
+            # Iterate through the ACK arguments.
+            $ex[4] =~ s/^://xsm;
+            my $sasl = 0;
+            foreach (@ex[4..$#ex]) {
+                if ($_ eq 'sasl') { $sasl++ }
+                API::Std::event_run('on_capack', ($svr, $_));
+            }
+            Auto::socksnd($svr, 'CAP END') unless $sasl;
+        }
+        when ('NAK') {
+            # This should never happen, but just in case...
+            API::Log::awarn(2, "$svr: CAP failed: Server refused '$capout'");
+            Auto::socksnd($svr, 'CAP END');
+        }
+    }
+
+    return 1;
+}
+
 # Parse: JOIN
 sub cjoin {
     my ($svr, @ex) = @_;

modules/SASLAuth.pm

@@ -14,18 +14,20 @@ use API::IRC qw(privmsg);
 sub _init
 {
     # Check if this Auto was built with SASL support.
-    err(2, "Auto was not built with SASL support. Aborting SASLAuth.", 0) and return 0 if $Auto::ENFEAT !~ /sasl/;
-    # Add a hook for before we connect.
-    hook_add('on_preconnect', 'CAP', sub { my ($srv) = @_; Auto::socksnd($srv, 'CAP LS'); }
-    ) or return 0;
-    # Hook for parsing CAP.
-    rchook_add('CAP', \&M::SASLAuth::handle_cap) or return 0;
+    if ($Auto::ENFEAT !~ m/sasl/xsm) { err(2, 'Auto was not built with SASL support. Aborting SASLAuth.', 0) and return; }
+    # Add sasl to supported CAP for servers configured with SASL.
+    my %servers = conf_get('server');
+    foreach my $svr (keys %servers) {
+        if (conf_get("server:$svr:sasl_username")) { $Proto::IRC::cap{$svr} .= ' sasl'; }
+    }
+    # Hook for when CAP ACK sasl is received.
+    hook_add('on_capack', 'sasl.cap', \&M::SASLAuth::handle_capack) or return;
     # Hook for parsing 903.
-    rchook_add('903', \&M::SASLAuth::handle_903) or return 0;
+    rchook_add('903', \&M::SASLAuth::handle_903) or return;
     # Hook for parsing 904.
-    rchook_add('904', \&M::SASLAuth::handle_904) or return 0;
+    rchook_add('904', \&M::SASLAuth::handle_904) or return;
     # Hook for parsing 906.
-    rchook_add('906', \&M::SASLAuth::handle_906) or return 0;
+    rchook_add('906', \&M::SASLAuth::handle_906) or return;
     return 1;
 }
 
@@ -33,42 +35,21 @@ sub _init
 sub _void
 {
     # Delete the hooks.
-    hook_del("on_preconnect", "CAP") or return 0;
-    rchook_del('CAP');
-    rchook_del('903');
-    rchook_del('904');
-    rchook_del('906');
+    hook_del('on_capack') or return;
+    rchook_del('903') or return;
+    rchook_del('904') or return;
+    rchook_del('906') or return;
     return 1;
 }
 
-sub handle_cap {
-    my ($srv, @parv) = @_;
-    my $line = join(' ',@parv);
-    my ($tosend);
-    
-    given ($line) {
-        when (/ LS /) {
-            $tosend .= 'multi-prefix ' if $line =~ /multi-prefix/i;
-            $tosend .= 'sasl ' if $line =~ /sasl/ and conf_get("server:$srv:sasl_username");
-            awarn(2, "SASL is unavailable on this server.") if $tosend !~ /sasl/;
-            if ($tosend eq '') { Auto::socksnd($srv, 'CAP END') }
-            else { Auto::socksnd($srv, "CAP REQ :$tosend"); }
-        }
-        when (/ ACK /) {
-            if ( $line =~ /sasl/) {
-                Auto::socksnd($srv, 'AUTHENTICATE PLAIN');
-                timer_add('auth_timeout', 1, (conf_get("server:$srv:sasl_timeout"))[0][0], sub { Auto::socksnd($srv, 'CAP END'); });
-            }
-            else {
-                Auto::socksnd($srv, 'CAP END');
-                awarn(2, "SASL authentication failed at ACK");
-            }
-        }
-        when (/ NAK /) {
-            Auto::socksnd($srv, 'CAP END');
-            awarn(2, "SASL authentication failed. Server refused ".$tosend);
-        }
+sub handle_capack {
+    my (($svr, $sacap)) = @_;
+ 
+    if ($sacap eq 'sasl') {
+        Auto::socksnd($svr, 'AUTHENTICATE PLAIN');
+        timer_add('auth_timeout_'.$svr, 1, (conf_get("server:$svr:sasl_timeout"))[0][0], sub { Auto::socksnd($svr, 'CAP END'); });
     }
+    
     return 1;
 }
 
@@ -105,8 +86,8 @@ sub handle_authenticate
 sub handle_903 
 { 
     my ($srv, undef) = @_; 
-    Auto::socksnd($srv, 'CAP END');
-    timer_del('auth_timeout');
+    timer_add('cap_end_'.$srv, 1, 2, sub { Auto::socksnd($srv, 'CAP END') });
+    timer_del('auth_timeout_'.$srv);
 }
 
 # Parse: Numeric:904
@@ -114,8 +95,8 @@ sub handle_903
 sub handle_904 
 { 
     my ($srv, undef) = @_; 
-    Auto::socksnd($srv, 'CAP END');
-    timer_del('auth_timeout');
+    timer_add('cap_end_'.$srv, 1, 2, sub { Auto::socksnd($srv, 'CAP END') });
+    timer_del('auth_timeout_'.$srv);
     awarn(2, "SASL authentication failed!");
 }
 
@@ -124,8 +105,8 @@ sub handle_904
 sub handle_906 
 {
     my ($svr, undef) = @_;
-    Auto::socksnd($svr, 'CAP END');
-    timer_del('auth_timeout');
+    timer_add('cap_end_'.$svr, 1, 2, sub { Auto::socksnd($svr, 'CAP END') });
+    timer_del('auth_timeout_'.$svr);
     awarn(2, "SASL authentication aborted!");
 }