view release on metacpan or  search on metacpan

lib/DJabberd/Stanza/SASL.pm  view on Meta::CPAN

package DJabberd::Stanza::SASL;
use strict;
use warnings;
use base qw(DJabberd::Stanza);

use MIME::Base64 qw/encode_base64 decode_base64/;

sub on_recv_from_server { die "unimplemented" }

## TODO:
## check number of auth failures, force deconnection, bad for t time §7.3.5 policy-violation
## Provide hooks for Authen:: modules to return details about errors:
## - credentials-expired
## - account-disabled
## - invalid-authzid
## - temporary-auth-failure
## these hooks should probably additions to parameters taken by GetPassword, CheckClearText
## right now all these errors results in not-authorized being returned

sub on_recv_from_client {
    my $self = shift;

    return $self->handle_abort(@_)
        if $self->element_name eq 'abort';

    return $self->handle_response(@_)
        if $self->element_name eq 'response';

    return $self->handle_auth(@_)
        if $self->element_name eq 'auth';
}

## supports §7.3.4, §7.4.1
## handles: <abort xmlns='urn:ietf:params:xml:ns:xmpp-sasl'/>
sub handle_abort {
    my ($self, $conn) = @_;

    $self->send_failure("aborted" => $conn);
    return;
}

sub handle_response {
    my $self = shift;
    my ($conn) = @_;

    my $sasl = $conn->sasl
        or return $self->send_failure("malformed-request" => $conn);

    if (my $error = $sasl->error) {
        return $self->send_failure("not-authorized" => $conn);
    }
    if (! $sasl->need_step) {
        $conn->log->info("sasl negotiation unexpected end");
        return $self->send_failure("malformed-request" => $conn);
    }

    my $response = $self->first_child;
    $response = $self->decode($response);
    $conn->log->info("Got the response $response");

    $sasl->server_step(
        $response => sub { $self->send_reply($conn->{sasl}, shift() => $conn) },
    );
}

sub handle_auth {
    my ($self, $conn) = @_;

    my $fallback = sub {
        $self->send_failure("invalid-mechanism" => $conn);
    };

    my $vhost = $conn->vhost