File Coverage

blib/lib/Authen/SASL.pm

Criterion	Covered	Total	%
statement	61	65	93.8
branch	25	36	69.4
condition	8	15	53.3
subroutine	15	15	100.0
pod	6	10	60.0
total	115	141	81.5

# Copyright (c) 2004-2006 Graham Barr . All rights reserved.
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.

package Authen::SASL;
$Authen::SASL::VERSION = '2.1700'; # TRIAL
use strict;
use warnings;
use vars qw($VERSION @Plugins);
use Carp;

$VERSION = "2.16";

@Plugins = qw(
	Authen::SASL::XS
	Authen::SASL::Cyrus
	Authen::SASL::Perl
);


sub import {
  shift;
  return unless @_;

  local $SIG{__DIE__};
  @Plugins = grep { /^[:\w]+$/ and eval "require $_" } map { /::/ ? $_ : "Authen::SASL::$_" } @_
    or croak "no valid Authen::SASL plugins found";
}


sub new {
  my $pkg = shift;
  my %opt = ((@_ % 2 ? 'mechanism' : ()), @_);

  my $self = bless {
    mechanism => $opt{mechanism} || $opt{mech},
    callback  => {},
    debug => $opt{debug},
  }, $pkg;

  $self->callback(%{$opt{callback}}) if ref($opt{callback}) eq 'HASH';

  # Compat
  $self->callback(user => ($self->{user} = $opt{user})) if exists $opt{user};
  $self->callback(pass => $opt{password}) if exists $opt{password};
  $self->callback(pass => $opt{response}) if exists $opt{response};

  $self;
}


sub mechanism {
  my $self = shift;
  @_ ? $self->{mechanism} = shift
     : $self->{mechanism};
}

sub callback {
  my $self = shift;

  return $self->{callback}{$_[0]} if @_ == 1;

  my %new = @_;
  @{$self->{callback}}{keys %new} = values %new;

  $self->{callback};
}

# The list of packages should not really be hardcoded here
# We need some way to discover what plugins are installed

sub client_new { # $self, $service, $host, $secflags
  my $self = shift;

  my $err;
  foreach my $pkg (@Plugins) {
    if (eval "require $pkg" and $pkg->can("client_new")) {
      if ($self->{conn} = eval { $pkg->client_new($self, @_) }) {
        return $self->{conn};
      }
      $err = $@;
    }
  }

  croak $err || "Cannot find a SASL Connection library";
}

sub server_new { # $self, $service, $host, $secflags
  my $self = shift;

  my $err;
  foreach my $pkg (@Plugins) {
    if (eval "require $pkg" and $pkg->can("server_new")) {
      if ($self->{conn} = eval { $pkg->server_new($self, @_) } ) {
        return $self->{conn};
      }
      $err = $@;
    }
  }
  croak $err || "Cannot find a SASL Connection library for server-side authentication";
}

sub error {
  my $self = shift;
  $self->{conn} && $self->{conn}->error;
}

# Compat.
sub user {
  my $self = shift;
  my $user = $self->{callback}{user};
  $self->{callback}{user} = shift if @_;
  $user;
}

sub challenge {
  my $self = shift;
  $self->{conn}->client_step(@_);
}

sub initial {
  my $self = shift;
  $self->client_new($self)->client_start;
}

sub name {
  my $self = shift;
  $self->{conn} ? $self->{conn}->mechanism : (($self->{mechanism} || '') =~ /(\S+)/)[0];
}

1;