SWAMPy

✎ CARVE FLESH

EDITING: SASL.pm

# Copyright (c) 2004-2006 Graham Barr <gbarr@pobox.com>. 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';
use strict;
use warnings;
use vars qw(@Plugins);
use Carp;

@Plugins = qw(
        Authen::SASL::XS
        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];
}

CANCEL

Name	Type	Size	Modified	Actions
↩ ..	DIR	—	—
📁 SASL/	DIR	—	2026-03-10 17:31
📄 SASL.pm	PM	2.7 KB	2023-08-10 10:17	EDIT
📄 SASL.pod	POD	5.8 KB	2023-08-10 10:17	EDIT