Barest beginnings

Seems to not explode?

Signed-off-by: Jason Boyer <boyer.jason@gmail.com>

diff --git a/src/perl/lib/OpenSRF/Transport/SlimJabber/XMPPReader.pm b/src/perl/lib/OpenSRF/Transport/SlimJabber/XMPPReader.pm
index 766df6a..140aee1 100644 (file)
--- a/src/perl/lib/OpenSRF/Transport/SlimJabber/XMPPReader.pm
+++ b/src/perl/lib/OpenSRF/Transport/SlimJabber/XMPPReader.pm
@@ -3,10 +3,14 @@ use strict; use warnings;
 use XML::Parser;
 use Fcntl qw(F_GETFL F_SETFL O_NONBLOCK);
 use Time::HiRes qw/time/;
+use MIME::Base64;
+use Authen::SASL qw(XS);
 use OpenSRF::Transport::SlimJabber::XMPPMessage;
 use OpenSRF::Utils::Logger qw/$logger/;
 use OpenSRF::EX;
 
+use Data::Dumper;
+
 # -----------------------------------------------------------
 # Connect, disconnect, and authentication messsage templates
 # -----------------------------------------------------------
@@ -17,6 +21,10 @@ use constant JABBER_BASIC_AUTH =>
     "<iq id='123' type='set'><query xmlns='jabber:iq:auth'>" .
     "<username>%s</username><password>%s</password><resource>%s</resource></query></iq>";
 
+use constant JABBER_SASL_PLAIN => "<auth xmlns='urn:ietf:params:xml:ns:xmpp-sasl' mechanism='PLAIN'>%s</auth>";
+use constant JABBER_SASL_SCRAM => "<auth xmlns='urn:ietf:params:xml:ns:xmpp-sasl' mechanism='SCRAM-SHA-1'>%s</auth>";
+use constant JABBER_SESS_INIT => "<iq type='set' id='123'><session xmlns='urn:ietf:params:xml:ns:xmpp-session'/></iq>";
+
 use constant JABBER_DISCONNECT => "</stream:stream>";
 
 
@@ -26,6 +34,7 @@ use constant JABBER_DISCONNECT => "</stream:stream>";
 use constant DISCONNECTED   => 1;
 use constant CONNECT_RECV   => 2;
 use constant CONNECTED      => 3;
+use constant AUTHENTICATED  => 4;
 
 
 # -----------------------------------------------------------
@@ -48,9 +57,18 @@ sub new {
 
     $self->{queue} = [];
     $self->{stream_state} = DISCONNECTED;
-    $self->{xml_state} = IN_NOTHING;
     $self->socket($socket);
 
+    $self->reset_parser();
+    $self->{message} = OpenSRF::Transport::SlimJabber::XMPPMessage->new;
+    return $self;
+}
+
+sub reset_parser {
+    my $self = shift;
+
+    $self->parser->release() if $self->parser;
+
     my $p = new XML::Parser(Handlers => {
         Start => \&start_element,
         End   => \&end_element,
@@ -59,8 +77,7 @@ sub new {
 
     $self->parser($p->parse_start); # create a push parser
     $self->parser->{_parent_} = $self;
-    $self->{message} = OpenSRF::Transport::SlimJabber::XMPPMessage->new;
-    return $self;
+    $self->{xml_state} = IN_NOTHING;
 }
 
 sub push_msg {
@@ -124,7 +141,38 @@ sub connect {
         return 0;
     }
 
-    $self->send(sprintf(JABBER_BASIC_AUTH, $username, $password, $resource));
+    # Fun times, ejabberd doesn't seem to send the list of supported mechanisms. Perhaps because we don't currently connect over TLS?
+    my $sasl = Authen::SASL->new( mechanism => "PLAIN", callback => { user => $username, pass => $password } );
+    my $conn = $sasl->client_new("xmpp", $domain);
+    my $repl = encode_base64($conn->client_start());
+    my $tosend = "";
+
+    # Since this is supposed to be base64 encoded we're supposed to send a = rather than an empty string
+    $repl='=' if $repl eq '';
+
+$logger->error("sending " . $repl);
+    $self->send(sprintf(JABBER_SASL_PLAIN, $repl));
+
+    $repl = $self->wait(10) || "NOTHING";
+$logger->error("received " . $repl);
+
+    while ($conn->need_step) {
+        $tosend = $conn->client_step($repl);
+$logger->error("sending " . $tosend);
+        $self->send($tosend);
+        $repl = $self->wait(10);
+$logger->error("received " . $repl);
+    }
+
+    # Ejabberd sends a new <?xml... header with new stream responses, and Expat doesn't like that mid-stream.
+    $self->reset_parser();
+
+    if ($conn->code != 0) {
+        $logger->error('SASL Login Error, code = ' . $conn->code);
+        return 0;
+    }
+
+    $self->send(sprintf(JABBER_CONNECT, $domain)); # After SASL authentication you have to re-start the stream
     $self->wait(10);
 
     unless($self->connected) {
@@ -167,6 +215,7 @@ sub tcp_connected {
 sub send {
     my($self, $xml) = @_;
         
+$logger->error("sending " . $xml);
     local $SIG{'PIPE'} = sub {
         $logger->error("Disconnected from Jabber server, exiting immediately");
         exit(99);
@@ -245,6 +294,7 @@ sub wait {
     my $first_read = 1;
 
     while($nbytes = sysread($socket, $buf, $read_size)) {
+$logger->error("read: " . $buf) if $buf;
         $self->{parser}->parse_more($buf) if $buf;
         if($nbytes < $read_size or $self->peek_msg) {
             set_block($socket) if $nonblock;
@@ -302,6 +352,7 @@ sub start_element {
     my($parser, $name, %attrs) = @_;
     my $self = $parser->{_parent_};
 
+$logger->error("name " . $name . " attrs " . Dumper(\%attrs));
     if($name eq 'message') {
 
         my $msg = $self->{message};
@@ -323,11 +374,15 @@ sub start_element {
         $self->{xml_state} = IN_THREAD;
 
     } elsif($name eq 'stream:stream') {
-        $self->{stream_state} = CONNECT_RECV;
-
-    } elsif($name eq 'iq') {
-        if($attrs{type} and $attrs{type} eq 'result') {
+        if ($self->{stream_state} and $self->{stream_state} == AUTHENTICATED) {
             $self->{stream_state} = CONNECTED;
+        } else {
+            $self->{stream_state} = CONNECT_RECV;
+        }
+
+    } elsif($name eq 'success') {
+        if($attrs{xmlns} and $attrs{xmlns} eq 'urn:ietf:params:xml:ns:xmpp-sasl') {
+            $self->{stream_state} = AUTHENTICATED;
         }
 
     } elsif($name eq 'status') {
@@ -376,7 +431,7 @@ sub end_element {
 # read all the data on the jabber socket through the 
 # parser and drop the resulting message
 sub flush_socket {
-       my $self = shift;
+    my $self = shift;
     return 0 unless $self->connected;
 
     while (my $excess = $self->wait(0)) {