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