home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / xampp / xampp-perl-addon-1.4.9-installer.exe / SASL.pm < prev    next >
Encoding:
Perl POD Document  |  2004-05-25  |  2.3 KB  |  105 lines
  1. # Copyright (c) 2004 Graham Barr <gbarr@pobox.com>. All rights reserved.
  2. # This program is free software; you can redistribute it and/or
  3. # modify it under the same terms as Perl itself.
  4.  
  5. package Authen::SASL;
  6.  
  7. use strict;
  8. use vars qw($VERSION @Plugins);
  9. use Carp;
  10.  
  11. $VERSION = "2.08";
  12.  
  13. @Plugins = qw(
  14.     Authen::SASL::Cyrus
  15.     Authen::SASL::Perl
  16. );
  17.  
  18. sub new {
  19.   my $pkg = shift;
  20.   my %opt = ((@_ % 2 ? 'mechanism' : ()), @_);
  21.  
  22.   my $self = bless {
  23.     mechanism => $opt{mechanism} || $opt{mech},
  24.     callback  => {},
  25.   }, $pkg;
  26.  
  27.   $self->callback(%{$opt{callback}}) if ref($opt{callback}) eq 'HASH';
  28.  
  29.   # Compat
  30.   $self->callback(user => ($self->{user} = $opt{user})) if exists $opt{user};
  31.   $self->callback(pass => $opt{password}) if exists $opt{password};
  32.   $self->callback(pass => $opt{response}) if exists $opt{response};
  33.  
  34.   $self;
  35. }
  36.  
  37.  
  38. sub mechanism {
  39.   my $self = shift;
  40.   @_ ? $self->{mechanism} = shift
  41.      : $self->{mechanism};
  42. }
  43.  
  44. sub callback {
  45.   my $self = shift;
  46.  
  47.   return $self->{callback}{$_[0]} if @_ == 1;
  48.  
  49.   my %new = @_;
  50.   @{$self->{callback}}{keys %new} = values %new;
  51.  
  52.   $self->{callback};
  53. }
  54.  
  55. # The list of packages should not really be hardcoded here
  56. # We need some way to discover what plugins are installed
  57.  
  58. sub client_new { # $self, $service, $host, $secflags
  59.   my $self = shift;
  60.  
  61.   foreach my $pkg (@Plugins) {
  62.     if (eval "require $pkg" and $pkg->can("client_new")) {
  63.       return ($self->{conn} = $pkg->client_new($self, @_));
  64.     }
  65.   }
  66.  
  67.   croak "Cannot find a SASL Connection library";
  68. }
  69.  
  70. sub server_new { # $self, $service, $host, $secflags
  71.   my $self = shift;
  72.  
  73.   foreach my $pkg (@Plugins) {
  74.     if (eval "require $pkg" and $pkg->can("server_new")) {
  75.       return ($self->{conn} = $pkg->server_new($self, @_));
  76.     }
  77.   }
  78.   croak "Cannot find a SASL Connection library for server-side authentication";
  79. }
  80.  
  81. # Compat.
  82. sub user {
  83.   my $self = shift;
  84.   my $user = $self->{callback}{user};
  85.   $self->{callback}{user} = shift if @_;
  86.   $user;
  87. }
  88.  
  89. sub challenge {
  90.   my $self = shift;
  91.   $self->{conn}->client_step(@_);
  92. }
  93.  
  94. sub initial {
  95.   my $self = shift;
  96.   $self->client_new($self)->client_start;
  97. }
  98.  
  99. sub name {
  100.   my $self = shift;
  101.   $self->{conn} ? $self->{conn}->mechanism : ($self->{mechanism} =~ /(\S+)/)[0];
  102. }
  103.  
  104. 1;
  105.