Initial commit 4.0.5-3
[usit-rt.git] / local / lib / RT / User_Local.not-pm
1 # BEGIN LICENSE BLOCK
2 #
3 # Copyright (c) 2004 Petter Reinholdtsen <pere@hungry.com>
4 #
5 # (Except where explictly superceded by other copyright notices)
6 #
7 # This work is made available to you under the terms of Version 2 of
8 # the GNU General Public License. A copy of that license should have
9 # been provided with this software, but in any event can be snarfed
10 # from www.gnu.org.
11 #
12 # This work is distributed in the hope that it will be useful, but
13 # WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
15 # General Public License for more details.
16 #
17 # Unless otherwise specified, all modifications, corrections or
18 # extensions to this work which alter its source code become the
19 # property of Best Practical Solutions, LLC when submitted for
20 # inclusion in the work.
21 #
22 #
23 # END LICENSE BLOCK
24
25
26 # LDAP integration in RT 3.  These overrides provide LDAP
27 # authentication and user info syncronizing.
28 #
29 # Written by Petter Reinholdtsen <pere@hungry.com> based on Code from
30 # Marcelo Bartsch <bartschm_cl@hotmail.com>, Stewart James
31 # <stewart.james@vu.edu.au> and Carl Makin <carl@xena.IPAustralia.gov.au>.
32 #
33 # Copy this file into rt3/local/lib/RT/User_Local.pm to active it.
34
35
36 # Modification Originally by Marcelo Bartsch <bartschm_cl@hotmail.com>
37 # Update by Stewart James <stewart.james@vu.edu.au for rt3.
38 # Update with TLS support and more flexible LDAP code by Petter Reinholdtsen.
39 # Drop this file in /opt/rt3/lib/RT/User_Local.pm
40 # Drop something like below in yout RT_SiteConfig.pm
41 #
42 # Set($LDAPExternalAuth, 1); # Enable LDAP auth
43 # Set($LdapServer, "ldap.domain.com");
44 # Set($LdapCAFile, "/site/w3-sertifikater/w3_cacert.pem");
45 # Set($LdapAuthStartTLS, 1); # Need to use TLS or ldaps to check passwords
46 # Set($LdapUser, ""); # Can search without username and password
47 # Set($LdapAuthPass, "");
48 # Set($LdapAuthBase, "ou=users,dc=domain,dc=com");
49 # Set($LdapAuthUidAttr, "uid");
50 # Set($LdapAuthFilter, "(objectclass=posixAccount)");
51
52 # Tomas Olaj, 2005-11-01, endret koden etter tips fra Ruslan Zakirov:
53 # <<<
54 # 9. Edit /opt/rt3/lib/RT/User_Local.pm to fix a small logic error in
55 # UIO's code. At line 374, change the != comparison to a ne comparison,
56 # so that the line reads:
57 #
58 # if (defined($RT::LdapUser) && $RT::LdapUser ne '') {
59 # >>>
60 # Equive perl code for this is:
61 # if ( $RT::LdapUser ) {
62 # ...
63 # }
64 package RT::User;
65 no warnings qw(redefine);
66
67 # {{{ sub LookupExternalUserInfo
68
69 =item LookupExternalUserInfo
70
71  LookupExternalUserInfo is a site-definable method for synchronizing
72  incoming users with an external data source.
73
74  This routine takes a tuple of EmailAddress and FriendlyName
75    EmailAddress is the user's email address, ususally taken from
76        an email message's From: header.
77    RealName is a freeform string, ususally taken from the "comment"
78        portion of an email message\'s From: header.
79
80  It returns (FoundInExternalDatabase, ParamHash);
81
82    FoundInExternalDatabase must be set to 1 before return if the user
83    was found in the external database.
84
85    ParamHash is a Perl parameter hash which can contain at least the
86    following fields. These fields are used to populate RT\'s users
87    database when the user is created
88
89      EmailAddress is the email address that RT should use for this user.
90      Name is the 'Name' attribute RT should use for this user.
91          'Name' is used for things like access control and user lookups.
92      RealName is what RT should display as the user\'s name when displaying
93          'friendly' names
94
95 =cut
96
97 sub LookupExternalUserInfo {
98   my %UserInfo = ();
99   $UserInfo{'EmailAddress'} = shift;
100   $UserInfo{'RealName'} = shift;
101   $UserInfo{'RealName'} =~ s/\"//g;
102
103   my $FoundInExternalDatabase = 0;
104
105   # Name is the RT username you want to use for this user.
106   my %LdapUserInfo = LdapUserFindByMailaddr($UserInfo{'EmailAddress'});
107   if ($LdapUserInfo{'Name'}) {
108       $FoundInExternalDatabase = 1;
109       $RT::Logger->debug("LookupExternalUserInfo: Mapping '".
110                         $UserInfo{'EmailAddress'} .
111                         "' to '" .
112                         $LdapUserInfo{'Name'} . "'");
113       foreach my $key (keys %LdapUserInfo) {
114           $UserInfo{$key} = $LdapUserInfo{$key};
115       }
116   } else {
117       $RT::Logger->debug("LookupExternalUserInfo: Fail to find username for '".
118                         $UserInfo{'EmailAddress'}."'");
119   }
120
121   return ($FoundInExternalDatabase, %UserInfo);
122 }
123
124 # }}}
125
126 # {{{ sub CanonicalizeUserInfo
127
128 sub CanonicalizeUserInfo {
129     my $self    = shift;
130     my $args    = shift;
131     my $success = 1;
132
133     my ($UserFoundInExternalDatabase, %ExternalUserInfo) =
134         LookupExternalUserInfo( $args->{'EmailAddress'},
135                                 $args->{'RealName'} );
136     if ($UserFoundInExternalDatabase) {
137         for my $key (keys %ExternalUserInfo) {
138             $args->{$key} = $ExternalUserInfo{$key};
139         }
140     }
141
142     return ($success);
143 }
144
145 # }}}
146
147 # {{{ sub SetPasswordExternal
148
149 =head2 SetPasswordExternal
150
151 Takes a string, and try to set this string as the users password in an
152 external system, if the user is listed in the external system.
153
154 Returns 1 if the password was set successfully, undef if it failed,
155 and -1 if the user is unknown to the external system.
156
157 This hook is called from SetPassword.
158
159 =cut
160
161 sub SetPasswordExternal {
162     my $self     = shift;
163     my $password = shift;
164
165     # Not allowed to set password for users in LDAP
166     if ($RT::LDAPExternalAuth) {
167         my $ldap = LdapConnect();
168         my $mesg;
169         if ( $mesg = LdapFindUser( $ldap, $self->Name )
170              && defined $mesg && $mesg->count ) {
171             LdapDisconnect($ldap);
172             return ( undef,
173                      $self->loc("LDAP users must change password in LDAP") );
174         }
175         LdapDisconnect($ldap);
176     }
177     return (-1, "No such user in LDAP");
178 }
179
180 # }}}
181
182 # {{{ sub SetPassword
183
184 =head2 SetPassword
185
186 Takes a string. Checks the string's length and sets this user's password
187 to that string.
188
189 Override for function in User_Overlay.pm, with modification for LDAP
190 authentication.
191
192 =cut
193
194 sub SetPassword {
195     my $self     = shift;
196     my $password = shift;
197
198     unless ( $self->CurrentUserCanModify('Password') ) {
199         return ( 0, $self->loc('Password: Permission Denied') );
200     }
201
202     my ($code, $msg) = $self->SetPasswordExternal($password);
203     return ($code, $msg) unless (-1 == $code);
204
205     if ( !$password ) {
206         return ( 0, $self->loc("No password set") );
207     }
208     elsif ( length($password) < $RT::MinimumPasswordLength ) {
209         return ( 0, $self->loc("Password needs to be at least [_1] characters long", $RT::MinimumPasswordLength) );
210     }
211     else {
212         my $new = !$self->HasPassword;
213         $password = $self->_GeneratePassword($password);
214         my ( $val, $msg ) = $self->SUPER::SetPassword($password);
215         if ($val) {
216             return ( 1, $self->loc("Password set") ) if $new;
217             return ( 1, $self->loc("Password changed") );
218         }
219         else {
220             return ( $val, $msg );
221         }
222     }
223
224 }
225
226 # }}}
227
228 # {{{ sub IsPasswordExternal
229
230 =head2 IsPasswordExternal
231
232 Returns true if the passed in value is this user's password.  Return
233 undef if the password don't match.  Return -1 if the user is unknown
234 in the external system.
235
236 This hook is called from IsPassword.
237
238 =cut
239
240 sub IsPasswordExternal {
241     my $self  = shift;
242     my $value = shift;
243         # Let LDAP be authorative for users in LDAP, and only fall
244         # through for users without LDAP entry.
245         if ($RT::LDAPExternalAuth) {
246             return IsLdapPassword($self->Name, $value);
247         }
248 }
249
250 # }}}
251
252 # {{{ sub IsPassword
253
254 =head2 IsPassword
255
256 Check the users password using LDAP.  Override for function in
257 User_Overlay.pm, with modification for LDAP authentication.
258
259 =cut
260
261 sub IsPassword {
262     my $self  = shift;
263     my $value = shift;
264
265     #TODO there isn't any apparent way to legitimately ACL this
266
267     # RT does not allow null passwords
268     if ( ( !defined($value) ) or ( $value eq '' ) ) {
269         return (undef);
270     }
271
272     if ( $self->PrincipalObj->Disabled ) {
273         $RT::Logger->info(
274                           "Disabled user " . $self->Name . " tried to log in" );
275         return (undef);
276     }
277
278     my $code = $self->IsPasswordExternal($value);
279     return ($code) unless (-1 == $code);
280
281     unless ($self->HasPassword) {
282         return(undef);
283     }
284
285     my $stored = $self->__Value('Password');
286     if (length $stored == 40) {
287         # The truncated SHA256(salt,MD5(passwd)) form from 2010/12 is 40 characters long
288         my $hash = MIME::Base64::decode_base64($stored);
289         # The first 4 bytes are the salt, the rest is substr(SHA256,0,26)
290         my $salt = substr($hash, 0, 4, "");
291         return substr(Digest::SHA::sha256($salt . Digest::MD5::md5($value)), 0, 26) eq $hash;
292     } elsif (length $stored == 32) {
293         # Hex nonsalted-md5
294         return 0 unless Digest::MD5::md5_hex(encode_utf8($value)) eq $stored;
295     } elsif (length $stored == 22) {
296         # Base64 nonsalted-md5
297         return 0 unless Digest::MD5::md5_base64(encode_utf8($value)) eq $stored;
298     } elsif (length $stored == 13) {
299         # crypt() output
300         return 0 unless crypt(encode_utf8($value), $stored) eq $stored;
301     } else {
302         $RT::Logger->warn("Unknown password form");
303         return 0;
304     }
305
306     # We got here by validating successfully, but with a legacy
307     # password form.  Update to the most recent form.
308     my $obj = $self->isa("RT::CurrentUser") ? $self->UserObj : $self;
309     $obj->_Set(Field => 'Password', Value =>  $self->_GeneratePassword($value) );
310     return 1;
311
312 }
313
314 # }}}
315
316 # {{{ sub LdapUserFindByMailaddr
317
318 =head2 LdapUserFindByMailaddr
319
320 Lookup user owning a given email address on UiO, returning user info
321 in a hash or undef if not known or the search failed.
322
323 The following configure options are used by this function in addition
324 to the ones used by LdapConnect().
325
326  $RT::LdapMailBase
327  $RT::LdapMailFilter
328  $RT::LdapMailScope
329  $RT::LdapMailSearchAttr
330  $RT::LdapMailMap
331
332 =cut
333
334 # Example search
335 #   ldapsearch -x -b ou=mail,dc=uio,dc=no -ZZ -h ldap.uio.no -D uid=pre,ou=users,dc=uio,dc=no -W target=mathiasm
336
337 sub LdapUserFindByMailaddr {
338     my $mailaddr = shift;
339     my %UserInfo = ();
340     $ldap = LdapConnect();
341     my $filter = "(&($RT::LdapMailSearchAttr=$mailaddr)$RT::LdapMailFilter)";
342     my @attr = keys %RT::LdapMailSearchResultMap;
343     $RT::Logger->debug( "LdapUserFindByMailaddr: Looking for ",
344                            join(" ", @attr), " filter=", $filter );
345     $mesg = $ldap->search(
346                           base       => $RT::LdapMailBase,
347                           scope      => $RT::LdapMailScope,
348                           filter     => $filter,
349                           attributes => [@attr],
350                           );
351     if ( ($mesg->code != LDAP_SUCCESS) and
352          ($mesg->code != LDAP_PARTIAL_RESULTS) ) {
353         $RT::Logger->critical("LdapUserFindByMailaddr: Search failed: ",
354                               "retval=", $mesg->code, " ",
355                               ldap_error_name($mesg->code));
356         LdapDisconnect($ldap);
357         return undef;
358     }
359
360     if (1 != $mesg->count) {
361         LdapDisconnect($ldap);
362         return undef;
363     }
364
365     while( my $entry = $mesg->shift_entry) {
366         foreach my $attr (keys %RT::LdapMailSearchResultMap) {
367             foreach my $value ($entry->get_value($attr)) {
368                 $UserInfo{$RT::LdapMailSearchResultMap{$attr}} = $value;
369             }
370         }
371     }
372     LdapDisconnect($ldap);
373     return %UserInfo;
374 }
375
376 # {{{ sub LdapConnect
377
378 =head2 LdapConnect
379
380 Connect to the LDAP databsae.
381
382 The following configure options are used by this function:
383
384   $RT::LdapServer
385   $RT::LdapUser
386   $RT::LdapPass
387
388 =cut
389
390 sub LdapConnect {
391     use Net::LDAP qw(LDAP_SUCCESS LDAP_PARTIAL_RESULTS);
392     use Net::LDAP::Util qw (ldap_error_name); 
393
394     print $@ if $@;
395
396     my $mesg;
397     my $ldap = Net::LDAP->new($RT::LdapServer,
398                               version => 3);
399
400     unless ($ldap) {
401         $RT::Logger->critical("IsLdapPassword: Cannot connect to",
402                               "LDAP server ", $RT::LdapServer);
403         return undef;
404     }
405
406     # I seem to have problems if I try and bind with a NULL username
407     # by hand So this now checks to see if we are really going to bind
408     # with a username.
409     if (defined($RT::LdapUser) && $RT::LdapUser ne '') {
410         $mesg = $ldap->bind($RT::LdapUser,
411                             password => $RT::LdapPass );
412     } else {
413         # This bind is redundant with LDAP protocol version 3
414         $mesg = $ldap->bind;
415     }
416     if ($mesg->code != LDAP_SUCCESS) {
417         $RT::Logger->critical("IsLdapPassword: Cannot bind to LDAP: ",
418                               "retval=", $mesg->code, " ",
419                               ldap_error_name($mesg->code));
420         return undef;
421     }
422     return $ldap;
423 }
424
425 # }}}
426
427 # {{{ sub LdapDisconnect
428
429 =head2 LdapDisconnect
430
431 Disconnect from the LDAP database.
432
433 =cut
434
435 sub LdapDisconnect {
436     my $ldap = shift;
437     my $mesg = $ldap->unbind();
438     if ($mesg->code != LDAP_SUCCESS) {
439         $RT::Logger->critical("LdapDisconnect: unbind failed: ",
440                               "retval=", $mesg->code, " ",
441                               ldap_error_name($mesg->code));
442     }
443 }
444
445 # }}}
446
447 # {{{ sub LdapFindUser
448
449 =head2 LdapFindUser
450
451 Locate info on a giver user given the username.
452
453 Configure options used by this function:
454
455   $RT::LdpaAuthBase
456   $RT::LdpaAuthFilter
457   $RT::LdpaAuthUidAttr
458
459 =cut
460
461 sub LdapFindUser {
462     my $ldap = shift;
463     my $username = shift;
464
465     my $filter;
466     if ($RT::LdapAuthFilter) {
467         $filter = "(&(" .$RT::LdapAuthUidAttr . "=$username)$RT::LdapAuthFilter)";
468     } else {
469         $filter = "(" .$RT::LdapAuthUidAttr . "=$username)";
470     }
471
472     $RT::Logger->debug("IsLdapPassword: First search filter '$filter'");
473     my $mesg = $ldap->search(base   => $RT::LdapAuthBase,
474                              filter => $filter,
475                              attrs  => ['dn']);
476     if (!(($mesg->code == LDAP_SUCCESS) or
477           ($mesg->code == LDAP_PARTIAL_RESULTS)))
478     {
479         $RT::Logger->debug("IsLdapPassword: Could not search for $filter: ",
480                            "retval=", $mesg->code, " ",
481                            ldap_error_name($mesg->code));
482         return undef;
483     }
484     return $mesg;
485 }
486
487 # }}}
488
489 # {{{ sub IsLdapPassword
490
491 =head2 IsLdapPassword
492
493 Takes a username and password as argument, and check if the password
494 is correct for the given user.  Return undef if password check failed,
495 -1 if the user is unknown, and 1 if the password check succeeded.
496
497 =cut
498
499 sub IsLdapPassword {
500     my $username = shift;
501     my $value    = shift;
502
503     $RT::Logger->debug("IsLdapPassword: executing");
504     my $ldap = LdapConnect();
505     return undef unless $ldap;
506
507     my $mesg = LdapFindUser($ldap, $username);
508     unless ($mesg) {
509         LdapDisconnect($ldap);
510         return undef;
511     }
512     $RT::Logger->debug("IsLdapPassword: First search produced ",
513                        $mesg->count, " results");
514     if (! $mesg->count)
515     {
516         $RT::Logger->info("IsLdapPassword: AUTH FAILED $username");
517         LdapDisconnect($ldap);
518         return -1;
519     }
520     $ldap->start_tls( verify => 'require',
521                       cafile => $RT::LdapCAFile ) if ($RT::LdapAuthStartTLS);
522
523     my $userdn = $mesg->first_entry->dn;
524     $RT::Logger->debug("IsLdapPassword: Trying to bind using DN=$userdn");
525     my $mesg2 = $ldap->bind($userdn,
526                             password => $value );
527     if ($mesg2->code != LDAP_SUCCESS) {
528         $RT::Logger->info("IsLdapPassword: Unable to bind as $userdn: ",
529                               "retval=", $mesg2->code, " ",
530                               ldap_error_name($mesg2->code));
531         LdapDisconnect($ldap);
532         return undef;
533     }
534     else
535     {
536         $RT::Logger->info("IsLdapPassword: AUTH OK $username ($userdn) base:",
537                           $RT::LdapAuthBase);
538         LdapDisconnect($ldap);
539         return 1;
540     }
541 }
542
543 # }}}
544
545 1;