<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;"># Copyright (c) 2004-2006 Graham Barr &lt;gbarr@pobox.com&gt;. 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;

use strict;
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 =&gt; $opt{mechanism} || $opt{mech},
    callback  =&gt; {},
    debug =&gt; $opt{debug},
  }, $pkg;

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

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

  $self;
}


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

sub callback {
  my $self = shift;

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

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

  $self-&gt;{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-&gt;can("client_new")) {
      if ($self-&gt;{conn} = eval { $pkg-&gt;client_new($self, @_) }) {
        return $self-&gt;{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-&gt;can("server_new")) {
      if ($self-&gt;{conn} = eval { $pkg-&gt;server_new($self, @_) } ) {
        return $self-&gt;{conn};
      }
      $err = $@;
    }
  }
  croak $err || "Cannot find a SASL Connection library for server-side authentication";
}

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

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

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

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

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

1;
</pre></body></html>