/usr/share/perl5/Authen/SASL/Perl/GSSAPI.pm is in libauthen-sasl-perl 2.1600-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 | # 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.05";
@ISA = qw(Authen::SASL::Perl);
my %secflags = (
noplaintext => 1,
noanonymous => 1,
);
sub _order { 4 }
sub _secflags {
shift;
scalar grep { $secflags{$_} } @_;
}
sub mechanism { 'GSSAPI' }
sub _init {
my ($pkg, $self) = @_;
bless $self, $pkg;
# set default security properties
$self->property('minssf', 0);
$self->property('maxssf', int 2**31 - 1); # XXX - arbitrary "high" value
$self->property('maxbuf', 0xFFFFFF); # maximum supported by GSSAPI mech
$self->property('externalssf', 0);
# the cyrus sasl library allows only one bit to be set in the
# layer selection mask in the client reply, we default to
# compatibility with that bug
$self->property('COMPAT_CYRUSLIB_REPLY_MASK_BUG', 1);
$self;
}
sub client_start {
my $self = shift;
my $status;
my $principal = $self->service.'@'.$self->host;
# GSSAPI::Name->import is the *constructor*,
# storing the new GSSAPI::Name into $target.
# GSSAPI::Name->import is not the standard
# import() method as used in Perl normally
my $target;
$status = GSSAPI::Name->import($target, $principal, gss_nt_service_name)
or return $self->set_error("GSSAPI Error : ".$status);
$self->{gss_name} = $target;
$self->{gss_ctx} = new GSSAPI::Context;
$self->{gss_state} = 0;
$self->{gss_layer} = undef;
my $cred = $self->_call('pass');
$self->{gss_cred} = (ref($cred) && $cred->isa('GSSAPI::Cred')) ? $cred : GSS_C_NO_CREDENTIAL;
$self->{gss_mech} = $self->_call('gssmech') || gss_mech_krb5;
# reset properties for new session
$self->property(maxout => undef);
$self->property(ssf => undef);
return $self->client_step('');
}
sub client_step {
my ($self, $challenge) = @_;
my $debug = $self->{debug};
my $status;
if ($self->{gss_state} == 0) {
my $outtok;
my $inflags = GSS_C_INTEG_FLAG | GSS_C_MUTUAL_FLAG;#todo:set according to ssf props
my $outflags;
$status = $self->{gss_ctx}->init($self->{gss_cred}, $self->{gss_name},
$self->{gss_mech},
$inflags,
0, GSS_C_NO_CHANNEL_BINDINGS, $challenge, undef,
$outtok, $outflags, undef);
print STDERR "state(0): ".
$status->generic_message.';'.$status->specific_message.
"; output token sz: ".length($outtok)."\n"
if ($debug & 1);
if (GSSAPI::Status::GSS_ERROR($status->major)) {
return $self->set_error("GSSAPI Error (init): ".$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.
print STDERR " state(1): challenge is EMPTY\n"
if ($debug and $challenge eq '');
return '' if ($challenge eq '');
my $unwrapped;
$status = $self->{gss_ctx}->unwrap($challenge, $unwrapped, undef, undef)
or return $self->set_error("GSSAPI Error (unwrap challenge): ".$status);
return $self->set_error("GSSAPI Error : invalid security layer token")
if (length($unwrapped) != 4);
# the security layers the server supports: bitmask of
# 1 = no security layer,
# 2 = integrity protection,
# 4 = confidelity protection
# which is encoded in the first octet of the response;
# the remote maximum buffer size is encoded in the next three octets
#
my $layer = ord(substr($unwrapped, 0, 1, chr(0)));
my ($rsz) = unpack('N',$unwrapped);
# get local receive buffer size
my $lsz = $self->property('maxbuf');
# choose security layer
my $choice = $self->_layer($layer,$rsz,$lsz);
return $self->set_error("GSSAPI Error: security too weak") unless $choice;
$self->{gss_layer} = $choice;
if ($choice > 1) {
# determine maximum plain text message size for peer's cipher buffer
my $psz;
$status = $self->{gss_ctx}->wrap_size_limit($choice & 4, 0, $rsz, $psz)
or return $self->set_error("GSSAPI Error (wrap size): ".$status);
return $self->set_error("GSSAPI wrap size = 0") unless ($psz);
$self->property(maxout => $psz);
# set SSF property; if we have just integrity protection SSF is set
# to 1. If we have confidentiality, SSF would be an estimate of the
# strength of the actual encryption ciphers in use which is not
# available through the GSSAPI interface; for now just set it to
# the lowest value that signifies confidentiality.
$self->property(ssf => (($choice & 4) ? 2 : 1));
} else {
# our advertised buffer size should be 0 if no layer selected
$lsz = 0;
$self->property(ssf => 0);
}
print STDERR "state(1): layermask $layer,rsz $rsz,lsz $lsz,choice $choice\n"
if ($debug & 1);
my $message = pack('CCCC', $choice,
($lsz >> 16)&0xff, ($lsz >> 8)&0xff, $lsz&0xff);
# append authorization identity if we have one
my $authz = $self->_call('authname');
$message .= $authz if ($authz);
my $outtok;
$status = $self->{gss_ctx}->wrap(0, 0, $message, undef, $outtok)
or return $self->set_error("GSSAPI Error (wrap token): ".$status);
$self->{gss_state} = 0;
return $outtok;
}
}
# default layer selection
sub _layer {
my ($self, $theirmask, $rsz, $lsz) = @_;
my $maxssf = $self->property('maxssf') - $self->property('externalssf');
$maxssf = 0 if ($maxssf < 0);
my $minssf = $self->property('minssf') - $self->property('externalssf');
$minssf = 0 if ($minssf < 0);
return undef if ($maxssf < $minssf); # sanity check
# ssf values > 1 mean integrity and confidentiality
# ssf == 1 means integrity but no confidentiality
# ssf < 1 means neither integrity nor confidentiality
# no security layer can be had if buffer size is 0
my $ourmask = 0;
$ourmask |= 1 if ($minssf < 1);
$ourmask |= 2 if ($minssf <= 1 and $maxssf >= 1);
$ourmask |= 4 if ($maxssf > 1);
$ourmask &= 1 unless ($rsz and $lsz);
# mask the bits they dont have
$ourmask &= $theirmask;
return $ourmask unless $self->property('COMPAT_CYRUSLIB_REPLY_MASK_BUG');
# in cyrus sasl bug compat mode, select the highest bit set
return 4 if ($ourmask & 4);
return 2 if ($ourmask & 2);
return 1 if ($ourmask & 1);
return undef;
}
sub encode { # input: self, plaintext buffer,length (length not used here)
my $self = shift;
my $wrapped;
my $status = $self->{gss_ctx}->wrap($self->{gss_layer} & 4, 0, $_[0], undef, $wrapped);
$self->set_error("GSSAPI Error (encode): " . $status), return
unless ($status);
return $wrapped;
}
sub decode { # input: self, cipher buffer,length (length not used here)
my $self = shift;
my $unwrapped;
my $status = $self->{gss_ctx}->unwrap($_[0], $unwrapped, undef, undef);
$self->set_error("GSSAPI Error (decode): " . $status), return
unless ($status);
return $unwrapped;
}
__END__
=head1 NAME
Authen::SASL::Perl::GSSAPI - GSSAPI (Kerberosv5) Authentication class
=head1 SYNOPSIS
use Authen::SASL qw(Perl);
$sasl = Authen::SASL->new( mechanism => 'GSSAPI' );
$sasl = Authen::SASL->new( mechanism => 'GSSAPI',
callback => { pass => $mycred });
$sasl->client_start( $service, $host );
=head1 DESCRIPTION
This method implements the client part of the GSSAPI SASL algorithm,
as described in RFC 2222 section 7.2.1 resp. draft-ietf-sasl-gssapi-XX.txt.
With a valid Kerberos 5 credentials cache (aka TGT) it allows
to connect to I<service>@I<host> given as the first two parameters
to Authen::SASL's client_start() method. Alternatively, a GSSAPI::Cred
object can be passed in via the Authen::SASL callback hash using
the `pass' key.
Please note that this module does not currently implement a SASL
security layer following authentication. Unless the connection is
protected by other means, such as TLS, it will be vulnerable to
man-in-the-middle attacks. If security layers are required, then the
L<Authen::SASL::XS> GSSAPI module should be used instead.
=head2 CALLBACK
The callbacks used are:
=over 4
=item authname
The authorization identity to be used in SASL exchange
=item gssmech
The GSS mechanism to be used in the connection
=item pass
The GSS credentials to be used in the connection (optional)
=back
=head1 EXAMPLE
#! /usr/bin/perl -w
use strict;
use Net::LDAP 0.33;
use Authen::SASL 2.10;
# -------- Adjust to your environment --------
my $adhost = 'theserver.bla.net';
my $ldap_base = 'dc=bla,dc=net';
my $ldap_filter = '(&(sAMAccountName=BLAAGROL))';
my $sasl = Authen::SASL->new(mechanism => 'GSSAPI');
my $ldap;
eval {
$ldap = Net::LDAP->new($adhost,
onerror => 'die')
or die "Cannot connect to LDAP host '$adhost': '$@'";
$ldap->bind(sasl => $sasl);
};
if ($@) {
chomp $@;
die "\nBind error : $@",
"\nDetailed SASL error: ", $sasl->error,
"\nTerminated";
}
print "\nLDAP bind() succeeded, working in authenticated state";
my $mesg = $ldap->search(base => $ldap_base,
filter => $ldap_filter);
# -------- evaluate $mesg
=head2 PROPERTIES
The properties used are:
=over 4
=item maxbuf
The maximum buffer size for receiving cipher text
=item minssf
The minimum SSF value that should be provided by the SASL security layer.
The default is 0
=item maxssf
The maximum SSF value that should be provided by the SASL security layer.
The default is 2**31
=item externalssf
The SSF value provided by an underlying external security layer.
The default is 0
=item ssf
The actual SSF value provided by the SASL security layer after the SASL
authentication phase has been completed. This value is read-only and set
by the implementation after the SASL authentication phase has been completed.
=item maxout
The maximum plaintext buffer size for sending data to the peer.
This value is set by the implementation after the SASL authentication
phase has been completed and a SASL security layer is in effect.
=back
=head1 SEE ALSO
L<Authen::SASL>,
L<Authen::SASL::Perl>
=head1 AUTHORS
Written by Simon Wilkinson, with patches and extensions by Achim Grolms
and Peter Marschall.
Please report any bugs, or post any suggestions, to the perl-ldap mailing list
<perl-ldap@perl.org>
=head1 COPYRIGHT
Copyright (c) 2006 Simon Wilkinson, Achim Grolms and Peter Marschall.
All rights reserved. This program is free software; you can redistribute
it and/or modify it under the same terms as Perl itself.
=cut
|