As I mentioned in the dim and distant past, I've been working on adding
native GSSAPI support to Authen::SASL::Perl, so that the
Authen::SASL::Cyrus module isn't required to use Kerberos.
Attached is the first cut of this support. It supports GSSAPI
authentication, but does not implement security layers. This means that
whilst a connection to the server using this module is authenticated, it
is _not_ encrypted or integrity checked, and can be subverted by a man
in the middle attacker.
Security layers are a work in progress, I suspect that they may require
some changes to the Authen::SASL::Perl framework, so I'll send them in
an additional patch.
Feedback welcome!
Cheers,
Simon.
Index: lib/Authen/SASL/Perl/GSSAPI.pm
===================================================================
--- lib/Authen/SASL/Perl/GSSAPI.pm (revision 0)
+++ lib/Authen/SASL/Perl/GSSAPI.pm (revision 0)
@@ -0,0 +1,87 @@
+# Copyright (c) 2006 Simon Wilkinson
+# 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::GSSAPI;
+
+use strict;
+
+use vars qw($VERSION @ISA);
+use GSSAPI;
+
+$VERSION= "0.01";
[EMAIL PROTECTED] = qw(Authen::SASL::Perl);
+
+my %secflags = (
+ noplaintext => 1,
+ noanonymous => 1,
+);
+
+sub _order { 4 }
+sub _secflags {
+ shift;
+ scalar grep { $secflags{$_} } @_;
+}
+
+sub mechanism { 'GSSAPI' }
+
+sub client_start {
+ my $self = shift;
+ my $status;
+ my $principal = $self->service."@".$self->host;
+
+ $self->{gss_name} = new GSSAPI::Name;
+ $status = $self->{gss_name}->import($self->{gss_name}, $principal,
+ gss_nt_service_name)
+ or return $self->set_error("GSSAPI Error : ".$status);
+ $self->{gss_ctx} = new GSSAPI::Context;
+ $self->{gss_state} = 0;
+ return $self->client_step("");
+}
+
+sub client_step
+{
+ my ($self, $challenge) = @_;
+
+ my $status;
+
+ if ($self->{gss_state}==0) {
+ my $outtok;
+ my $flags;
+ $status = $self->{gss_ctx}->init(undef, $self->{gss_name},
+ gss_mech_krb5,
+ GSS_C_INTEG_FLAG | GSS_C_MUTUAL_FLAG,
+ undef, undef, $challenge, undef,
+ $outtok, $flags, undef);
+
+ if (GSSAPI::Status::GSS_ERROR($status->major)) {
+ return $self->set_error("GSSAPI Error : ".$status);
+ }
+ if ($status->major == GSS_S_COMPLETE) {
+ $self->{gss_state}=1;
+ }
+ return $outtok;
+ } elsif ($self->{gss_state}==1) {
+ # If the server has an empty output token when it COMPLETEs, Cyrus SASL
+ # kindly sends us that empty token. We need to ignore it, which introduces
+ # another round into the process.
+ return "" if $challenge eq "";
+
+ my $unwrapped;
+ $status = $self->{gss_ctx}->unwrap($challenge, $unwrapped, undef, undef)
+ or return $self->set_error("GSSAPI Error : ".$status);
+
+ # XXX - Security layer support will require us to decode this packet
+
+ # Need to set message to be 0x01, 0x00, 0x00, 0x00 for no security layers
+ my $message = pack('CCCC', 0x01, 0x00, 0x00, 0x00);
+ $message.= $self->_call('user');
+ my $outtok;
+ $status = $self->{gss_ctx}->wrap(0, undef, $message, undef, $outtok)
+ or return $self->set_error("GSSAPI Error : ".$status);
+
+ $self->{gss_state}=0;
+ return $outtok;
+ }
+}
+
