Skip to content
Browse files

Initial revision

  • Loading branch information...
1 parent 8747b32 commit 04ad5e4c710e80e1098db821a263e1e979e7b14a @gbarr committed Jan 24, 2002
View
14 MANIFEST
@@ -0,0 +1,14 @@
+MANIFEST
+Makefile.PL
+api.txt
+compat_pl
+example_pl
+lib/Authen/SASL.pm
+lib/Authen/SASL.pod
+lib/Authen/SASL/CRAM_MD5.pm
+lib/Authen/SASL/EXTERNAL.pm
+lib/Authen/SASL/Perl.pm
+lib/Authen/SASL/Perl/ANONYMOUS.pm
+lib/Authen/SASL/Perl/CRAM_MD5.pm
+lib/Authen/SASL/Perl/EXTERNAL.pm
+lib/Authen/SASL/Perl/PLAIN.pm
View
10 Makefile.PL
@@ -0,0 +1,10 @@
+# This -*- perl -*- script makes the Makefile
+
+use 5.004;
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+ VERSION_FROM => 'lib/Authen/SASL.pm',
+ NAME => 'Authen::SASL',
+);
+
View
49 api.txt
@@ -0,0 +1,49 @@
+Basically the Authen::SASL module gathers some info. When ->client_new
+is called the plugin is called to create a $conn object. At that point
+it should query the Authen::SASL object for mechanisms and callbacks
+
+Properties are then set on the $conn object by calling $conn->property
+
+Then client_start is called
+
+ Currently client_start returns the mechanism name and the initial
+ string, but I am thinking about changing that to just the initial
+ string. The mecanism is avaliabe via a method call anyway.
+
+
+Then we call client_step with a challenge string to get a response
+string.
+
+
+Quite simple really I think.
+
+
+So the plugin just needs to support
+
+ client_new
+ client_start
+ client_step
+ property # set/get for properties
+ mechanism # returns the name of the chosen mechanism
+ service # the service name passed to client_new
+ host # the hostname passed to client_new
+
+
+properties and callbacks are passed by name, so you will need to convert
+them to numbers.
+
+There are three types of call back
+
+ user => 'fred'
+
+When the user callback is called, it will just return the string 'fred'
+
+ user => \&subname
+
+When the user callback is called, &subname will be called and it will
+be passed the $conn object as the first argument.
+
+ user => [ \&subname, 1, 2, 3]
+
+When the user callback is called, &subname will be called. It will be passed
+the $conn object, followed by all other values in the array
View
18 compat_pl
@@ -0,0 +1,18 @@
+#!/usr/bin/env perl
+
+# short script to check compatability with previous Authen::SASL library
+
+use lib 'lib';
+use Authen::SASL;
+
+my $sasl = Authen::SASL->new('CRAM-MD5', password => 'fred');
+
+$sasl->user('gbarr');
+
+$initial = $sasl->initial;
+$mech = $sasl->name;
+
+print "$mech;", unpack("H*",$initial),";\n";
+
+print unpack "H*", $sasl->challenge('xyz');
+print "\n";
View
40 example_pl
@@ -0,0 +1,40 @@
+#!/usr/bin/env perl
+
+# short example script
+
+use lib 'lib';
+use Authen::SASL;
+
+# This part is in the user script
+
+my $sasl = Authen::SASL->new(
+ mechanism => 'PLAIN CRAM-MD5 EXTERNAL ANONYMOUS',
+ callback => {
+ user => 'gbarr',
+ pass => 'fred',
+ authname => 'none'
+ },
+);
+
+# $sasl is then passed to a library (eg Net::LDAP)
+# which will then do
+
+my $conn = $sasl->client_new("ldap","localhost", "noplaintext noanonymous");
+
+# The library would also set properties on the connection
+#$conn->property(
+# iplocal => $socket->sockname,
+# ipremote => $socket->peername,
+#);
+
+# It would then start things off and send this info to the server
+
+my $initial = $conn->client_start;
+my $mech = $conn ->mechanism;
+
+print "$mech;", unpack("H*",$initial),";\n";
+
+# When the server want more information, the library would call
+
+print unpack "H*", $conn->client_step("xyz");
+print "\n";
View
89 lib/Authen/SASL.pm
@@ -0,0 +1,89 @@
+# Copyright (c) 2002 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;
+
+use strict;
+use vars qw($VERSION);
+use Carp;
+
+$VERSION = "2.00";
+
+sub new {
+ my $pkg = shift;
+ my %opt = ((@_ % 2 ? 'mechanism' : ()), @_);
+
+ my $self = bless {
+ mechanism => $opt{mechanism} || $opt{mech},
+ callback => {},
+ }, $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;
+
+ foreach my $plugin (qw(Cyrus Perl)) {
+ my $pkg = __PACKAGE__ . "::$plugin";
+ if (eval "require $pkg") {
+ return ($self->{conn} = $pkg->client_new($self, @_));
+ }
+ }
+
+ croak "Cannot find a SASL Connection library";
+}
+
+# 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;
View
146 lib/Authen/SASL.pod
@@ -0,0 +1,146 @@
+
+=head1 NAME
+
+Authen::SASL - SASL Authentication framework
+
+=head1 SYNOPSIS
+
+ use Authen::SASL;
+
+ $sasl = Authen::SASL->new(
+ mechanism => 'CRAM-MD5 PLAIN ANONYMOUS',
+ callback => {
+ pass => \&fetch_password,
+ user => $user,
+ }
+ );
+
+=head1 DESCRIPTION
+
+SASL is a generic mechanism for authentication used by several
+network protocols. B<Authen::SASL> provides an implementation
+framework that all protocols should be able to share.
+
+The framework allows different implementations of the connection
+class to be plugged in. At the time of writing there were two such
+plugins.
+
+=over 4
+
+=item Authen::SASL::Perl
+
+This module implements several mechanisms and is implemented
+entirely in Perl.
+
+=item Authen::SASL::Cyrus
+
+This module uses the cyrus V1 C library.
+
+=back
+
+=head2 CONTRUCTOR
+
+The contructor may be called with or without arguments. Passing arguments is
+just a short cut to calling the C<mechanism> and C<callback> methods.
+
+=head2 METHODS
+
+=over 4
+
+=item mechanism
+
+Returns the current list of mechanisms
+
+=item mechanism NAMES
+
+Set the list of mechanisms to choose from. NAMES should be a space separated string
+of the names.
+
+=item callback NAME
+
+Returns the current callback associated with NAME
+
+=item callback NAME => VALUE, NAME => VALUE, ...
+
+Sets the given callbacks to the given values
+
+=item client_new SERVICE, HOST, SECURITY
+
+Creates and returns a new connection object.
+
+=back
+
+=head1 The Connection Class
+
+=over 4
+
+=item client_start
+
+The initial step to be performed. Returns the initial value to pass to the server.
+
+=item client_step CHALLENGE
+
+This method is called when a response from the server requires it. CHALLENGE
+is the value from the server. Returns the next value to pass to the server.
+
+=item property NAME
+
+=item property NAME => VALUE, NAME => VALUE
+
+=item service
+
+Returns the service argument that was passed to C<client_new>
+
+=item host
+
+Returns the host argument that was passed to C<client_new>
+
+=item mechanism
+
+Returns the name of the chosen mechanism.
+
+=back
+
+=head2 Callbacks
+
+There are three different ways in which a callback may be passed
+
+=over
+
+=item CODEREF
+
+If the value passed is a code reference then, when needed, it will be called
+and the connection object will be passed as the first argument.
+
+=item ARRAYREF
+
+If the value passed is an array reference, the first element in the array
+must be a code reference. When the callback is called the code reference
+will be called with the connection object passed as the first argument
+and all other values from the array passed after.
+
+=item SCALAR
+
+All other values passed will be used directly. ie it is the same as
+passing an code reference that, when called, returns the value.
+
+=back
+
+=head1 SEE ALSO
+
+L<Authen::SASL::Perl>
+
+=head1 AUTHOR
+
+Graham Barr <gbarr@pobox.com>
+
+Please report any bugs, or post any suggestions, to the perl-ldap mailing list
+<perl-ldap-dev@lists.sourceforge.net>
+
+=head1 COPYRIGHT
+
+Copyright (c) 1998-2002 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.
+
+=cut
View
18 lib/Authen/SASL/CRAM_MD5.pm
@@ -0,0 +1,18 @@
+# Copyright (c) 2002 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::CRAM_MD5;
+
+use strict;
+use vars qw($VERSION);
+
+$VERSION = "0.99";
+
+sub new {
+ shift;
+ Authen::SASL->new(@_, mechanism => 'CRAM-MD5');
+}
+
+1;
+
View
18 lib/Authen/SASL/EXTERNAL.pm
@@ -0,0 +1,18 @@
+# Copyright (c) 2002 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::EXTERNAL;
+
+use strict;
+use vars qw($VERSION);
+
+$VERSION = "0.99";
+
+sub new {
+ shift;
+ Authen::SASL->new(@_, mechanism => 'EXTERNAL');
+}
+
+1;
+
View
94 lib/Authen/SASL/Perl.pm
@@ -0,0 +1,94 @@
+# Copyright (c) 2002 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::Perl;
+
+use strict;
+use vars qw($VERSION);
+use Carp;
+
+$VERSION = "1.00";
+
+my %secflags = (
+ noplaintext => 1,
+ noanonymous => 1,
+ nodictionary => 1,
+);
+
+sub client_new {
+ my ($pkg, $parent, $service, $host, $secflags) = @_;
+
+ my @sec = grep { $secflags{$_} } split /\W+/, lc($secflags || '');
+
+ my $self = {
+ callback => { %{$parent->callback} },
+ service => $service || '',
+ host => $host || '',
+ };
+
+ # Dumb selection;
+
+ my @mpkg = grep {
+ eval "require $_;" && $_->_secflags(@sec) == @sec
+ } map {
+ (my $mpkg = __PACKAGE__ . "::$_") =~ s/-/_/g;
+ $mpkg;
+ } split /[^-\w]+/, $parent->mechanism
+ or croak "No SASL mechanism found\n";
+
+ $mpkg[0]->_init($self);
+}
+
+sub code { 0 }
+sub error { '' }
+
+sub service { shift->{service} }
+sub host { shift->{host} }
+
+# set/get property
+sub property {
+ my $self = shift;
+ my $prop = $self->{property} ||= {};
+ return $prop->{ $_[0] } if @_ == 1;
+ my %new = @_;
+ @{$prop}{keys %new} = values %new;
+ 1;
+}
+
+# Should be defined in the mechanism sub-class
+sub mechanism { undef }
+sub client_step { undef }
+sub client_start { undef }
+
+# Private methods used by Authen::SASL::Perl that
+# may be overridden in mechanism sub-calsses
+
+sub _init {
+ my ($pkg, $href) = @_;
+
+ bless $href, $pkg;
+}
+
+sub _call {
+ my ($self, $name) = @_;
+
+ my $cb = $self->{callback}{$name};
+
+ if (ref($cb) eq 'ARRAY') {
+ my @args = @$cb;
+ $cb = shift @args;
+ return $cb->($self, @args);
+ }
+ elsif (ref($cb) eq 'CODE') {
+ return $cb->($self);
+ }
+
+ return $cb;
+}
+
+sub _secflags { 0 }
+
+1;
+
+
View
32 lib/Authen/SASL/Perl/ANONYMOUS.pm
@@ -0,0 +1,32 @@
+# Copyright (c) 2002 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::Perl::ANONYMOUS;
+
+use strict;
+use vars qw($VERSION @ISA);
+
+$VERSION = "1.00";
+@ISA = qw(Authen::SASL::Perl);
+
+my %secflags = (
+ noplaintext => 1,
+);
+
+sub _secflags {
+ shift;
+ grep { $secflags{$_} } @_;
+}
+
+sub mechanism { 'ANONYMOUS' }
+
+sub client_start {
+ shift->_call('authname')
+}
+
+sub client_step {
+ shift->_call('authname')
+}
+
+1;
View
40 lib/Authen/SASL/Perl/CRAM_MD5.pm
@@ -0,0 +1,40 @@
+# Copyright (c) 2002 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::Perl::CRAM_MD5;
+
+use strict;
+use vars qw($VERSION @ISA);
+use Digest::HMAC_MD5 qw(hmac_md5_hex);
+
+$VERSION = "1.00";
+@ISA = qw(Authen::SASL::Perl);
+
+my %secflags = (
+ noplaintext => 1,
+ noanonymous => 1,
+);
+
+sub _secflags {
+ shift;
+ scalar grep { $secflags{$_} } @_;
+}
+
+sub mechanism { 'CRAM-MD5' }
+
+sub client_start {
+ '';
+}
+
+sub client_step {
+ my ($self, $string) = @_;
+ my ($user, $pass) = map {
+ my $v = $self->_call($_);
+ defined($v) ? $v : ''
+ } qw(user pass);
+
+ $user . " " . hmac_md5_hex($string,$pass);
+}
+
+1;
View
35 lib/Authen/SASL/Perl/EXTERNAL.pm
@@ -0,0 +1,35 @@
+# Copyright (c) 1998-2002 Graham Barr <gbarr@pobox.com> and 2001 Chris Ridd
+# <chris.ridd@messagingdirect.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::Perl::EXTERNAL;
+
+use strict;
+use vars qw($VERSION @ISA);
+
+$VERSION = "1.00";
+@ISA = qw(Authen::SASL::Perl);
+
+my %secflags = (
+ noplaintext => 1,
+ nodictionary => 1,
+);
+
+sub _secflags {
+ shift;
+ grep { $secflags{$_} } @_;
+}
+
+sub mechanism { 'EXTERNAL' }
+
+sub client_start {
+ ''
+}
+
+sub client_step {
+ shift->_call('user');
+}
+
+1;
+
View
35 lib/Authen/SASL/Perl/PLAIN.pm
@@ -0,0 +1,35 @@
+# Copyright (c) 2002 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::Perl::PLAIN;
+
+use strict;
+use vars qw($VERSION @ISA);
+
+$VERSION = "1.00";
+@ISA = qw(Authen::SASL::Perl);
+
+my %secflags = (
+ noanonymous => 1,
+);
+
+sub _secflags {
+ shift;
+ grep { $secflags{$_} } @_;
+}
+
+sub mechanism { 'PLAIN' }
+
+sub client_start {
+ my $self = shift;
+
+ my @parts = map {
+ my $v = $self->_call($_);
+ defined($v) ? $v : ''
+ } qw(user authname pass);
+
+ join("\0", @parts);
+}
+
+1;

0 comments on commit 04ad5e4

Please sign in to comment.
Something went wrong with that request. Please try again.