1package DJabberd::Stanza::SASL; 2use strict; 3use warnings; 4use base qw(DJabberd::Stanza); 5 6use MIME::Base64 qw/encode_base64 decode_base64/; 7 8sub on_recv_from_server { die "unimplemented" } 9 10## TODO: 11## check number of auth failures, force deconnection, bad for t time §7.3.5 policy-violation 12## Provide hooks for Authen:: modules to return details about errors: 13## - credentials-expired 14## - account-disabled 15## - invalid-authzid 16## - temporary-auth-failure 17## these hooks should probably additions to parameters taken by GetPassword, CheckClearText 18## right now all these errors results in not-authorized being returned 19 20sub on_recv_from_client { 21 my $self = shift; 22 23 return $self->handle_abort(@_) 24 if $self->element_name eq 'abort'; 25 26 return $self->handle_response(@_) 27 if $self->element_name eq 'response'; 28 29 return $self->handle_auth(@_) 30 if $self->element_name eq 'auth'; 31} 32 33## supports §7.3.4, §7.4.1 34## handles: <abort xmlns='urn:ietf:params:xml:ns:xmpp-sasl'/> 35sub handle_abort { 36 my ($self, $conn) = @_; 37 38 $self->send_failure("aborted" => $conn); 39 return; 40} 41 42sub handle_response { 43 my $self = shift; 44 my ($conn) = @_; 45 46 my $sasl = $conn->sasl 47 or return $self->send_failure("malformed-request" => $conn); 48 49 if (my $error = $sasl->error) { 50 return $self->send_failure("not-authorized" => $conn); 51 } 52 if (! $sasl->need_step) { 53 $conn->log->info("sasl negotiation unexpected end"); 54 return $self->send_failure("malformed-request" => $conn); 55 } 56 57 my $response = $self->first_child; 58 $response = $self->decode($response); 59 $conn->log->info("Got the response $response"); 60 61 $sasl->server_step( 62 $response => sub { $self->send_reply($conn->{sasl}, shift() => $conn) }, 63 ); 64} 65 66sub handle_auth { 67 my ($self, $conn) = @_; 68 69 my $fallback = sub { 70 $self->send_failure("invalid-mechanism" => $conn); 71 }; 72 73 my $vhost = $conn->vhost 74 or die "There is no vhost"; 75 76 my $saslmgr; 77 $vhost->run_hook_chain( phase => "GetSASLManager", 78 args => [ conn => $conn ], 79 methods => { 80 get => sub { 81 (undef, $saslmgr) = @_; 82 }, 83 }, 84 fallback => $fallback, 85 ); 86 die "no SASL" unless $saslmgr; 87 88 ## TODO: §7.4.4. encryption-required 89 my $mechanism = $self->attr("{}mechanism"); 90 return $self->send_failure("invalid-mechanism" => $conn) 91 unless $saslmgr->is_mechanism_supported($mechanism); 92 93 ## we don't support it for now 94 my $opts = { no_integrity => 1 }; 95 $saslmgr->mechanism($mechanism); 96 my $sasl_conn = $saslmgr->server_new("xmpp", $vhost->server_name, $opts); 97 $conn->{sasl} = $sasl_conn; 98 99 my $init = $self->first_child; 100 if (!$init or $init eq '=') { 101 $init = ''; 102 } 103 else { 104 $init = $self->decode($init); 105 } 106 107 $sasl_conn->server_start( 108 $init => sub { $self->send_reply($conn->{sasl}, shift() => $conn) }, 109 ); 110} 111 112sub send_challenge { 113 my $self = shift; 114 my ($challenge, $conn) = @_; 115 116 $conn->log->debug("Sending Challenge: $challenge"); 117 my $enc_challenge = $self->encode($challenge); 118 my $xml = "<challenge xmlns='urn:ietf:params:xml:ns:xmpp-sasl'>$enc_challenge</challenge>"; 119 $conn->xmllog->info($xml); 120 $conn->write(\$xml); 121} 122 123sub send_failure { 124 my $self = shift; 125 my ($error, $conn) = @_; 126 $conn->log->debug("Sending error: $error"); 127 my $xml = <<EOF; 128<failure xmlns='urn:ietf:params:xml:ns:xmpp-sasl'><$error/></failure> 129EOF 130 $conn->xmllog->info($xml); 131 $conn->write(\$xml); 132 return; 133} 134 135sub ack_success { 136 my $self = shift; 137 my ($sasl_conn, $challenge, $conn) = @_; 138 139 my $username = $sasl_conn->answer('username') || $sasl_conn->answer('user'); 140 my $sname = $conn->vhost->name; 141 unless ($username && $sname) { 142 $conn->log->error("Couldn't bind to a jid, declining."); 143 $self->send_failure("not-authorized" => $conn); 144 return; 145 } 146 my $authenticated_jid = "$username\@$sname"; 147 $sasl_conn->set_authenticated_jid($authenticated_jid); 148 149 my $xml; 150 if (defined $challenge) { 151 my $enc = $challenge ? $self->encode($challenge) : "="; 152 $xml = "<success xmlns='urn:ietf:params:xml:ns:xmpp-sasl'>$enc</success>"; 153 } 154 else { 155 $xml = "<success xmlns='urn:ietf:params:xml:ns:xmpp-sasl'/>"; 156 } 157 $conn->xmllog->info($xml); 158 $conn->write(\$xml); 159 if (($sasl_conn->property('ssf') || 0) > 0) { 160 $conn->log->info("SASL: Securing socket"); 161 $conn->log->warn("This will probably NOT work"); 162 $sasl_conn->securesocket($conn); 163 } 164 else { 165 $conn->log->info("SASL: Not securing socket"); 166 } 167 $conn->restart_stream; 168} 169 170sub encode { 171 my $self = shift; 172 my $str = shift; 173 return encode_base64($str, ''); 174} 175 176sub decode { 177 my $self = shift; 178 my $str = shift; 179 return decode_base64($str); 180} 181 182sub send_reply { 183 my $self = shift; 184 my ($sasl_conn, $challenge, $conn) = @_; 185 186 if (my $error = $sasl_conn->error) { 187 $self->send_failure("not-authorized" => $conn); 188 } 189 elsif ($sasl_conn->is_success) { 190 $self->ack_success($sasl_conn, $challenge => $conn); 191 } 192 else { 193 $self->send_challenge($challenge => $conn); 194 } 195 return; 196} 197 1981; 199