Merge branch 'master' of git.uio.no:usit-rt

[usit-rt.git] / local / lib / RT / User_Local.not-pm

# BEGIN LICENSE BLOCK
#
# Copyright (c) 2004 Petter Reinholdtsen <pere@hungry.com>
#
# (Except where explictly superceded by other copyright notices)
#
# This work is made available to you under the terms of Version 2 of
# the GNU General Public License. A copy of that license should have
# been provided with this software, but in any event can be snarfed
# from www.gnu.org.
#
# This work is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.
#
# Unless otherwise specified, all modifications, corrections or
# extensions to this work which alter its source code become the
# property of Best Practical Solutions, LLC when submitted for
# inclusion in the work.
#
#
# END LICENSE BLOCK


# LDAP integration in RT 3.  These overrides provide LDAP
# authentication and user info syncronizing.
#
# Written by Petter Reinholdtsen <pere@hungry.com> based on Code from
# Marcelo Bartsch <bartschm_cl@hotmail.com>, Stewart James
# <stewart.james@vu.edu.au> and Carl Makin <carl@xena.IPAustralia.gov.au>.
#
# Copy this file into rt3/local/lib/RT/User_Local.pm to active it.


# Modification Originally by Marcelo Bartsch <bartschm_cl@hotmail.com>
# Update by Stewart James <stewart.james@vu.edu.au for rt3.
# Update with TLS support and more flexible LDAP code by Petter Reinholdtsen.
# Drop this file in /opt/rt3/lib/RT/User_Local.pm
# Drop something like below in yout RT_SiteConfig.pm
#
# Set($LDAPExternalAuth, 1); # Enable LDAP auth
# Set($LdapServer, "ldap.domain.com");
# Set($LdapCAFile, "/site/w3-sertifikater/w3_cacert.pem");
# Set($LdapAuthStartTLS, 1); # Need to use TLS or ldaps to check passwords
# Set($LdapUser, ""); # Can search without username and password
# Set($LdapAuthPass, "");
# Set($LdapAuthBase, "ou=users,dc=domain,dc=com");
# Set($LdapAuthUidAttr, "uid");
# Set($LdapAuthFilter, "(objectclass=posixAccount)");

# Tomas Olaj, 2005-11-01, endret koden etter tips fra Ruslan Zakirov:
# <<<
# 9. Edit /opt/rt3/lib/RT/User_Local.pm to fix a small logic error in
# UIO's code. At line 374, change the != comparison to a ne comparison,
# so that the line reads:
#
# if (defined($RT::LdapUser) && $RT::LdapUser ne '') {
# >>>
# Equive perl code for this is:
# if ( $RT::LdapUser ) {
# ...
# }
package RT::User;
no warnings qw(redefine);

# {{{ sub LookupExternalUserInfo

=item LookupExternalUserInfo

 LookupExternalUserInfo is a site-definable method for synchronizing
 incoming users with an external data source.

 This routine takes a tuple of EmailAddress and FriendlyName
   EmailAddress is the user's email address, ususally taken from
       an email message's From: header.
   RealName is a freeform string, ususally taken from the "comment"
       portion of an email message\'s From: header.

 It returns (FoundInExternalDatabase, ParamHash);

   FoundInExternalDatabase must be set to 1 before return if the user
   was found in the external database.

   ParamHash is a Perl parameter hash which can contain at least the
   following fields. These fields are used to populate RT\'s users
   database when the user is created

     EmailAddress is the email address that RT should use for this user.
     Name is the 'Name' attribute RT should use for this user.
         'Name' is used for things like access control and user lookups.
     RealName is what RT should display as the user\'s name when displaying
         'friendly' names

=cut

sub LookupExternalUserInfo {
  my %UserInfo = ();
  $UserInfo{'EmailAddress'} = shift;
  $UserInfo{'RealName'} = shift;
  $UserInfo{'RealName'} =~ s/\"//g;

  my $FoundInExternalDatabase = 0;

  # Name is the RT username you want to use for this user.
  my %LdapUserInfo = LdapUserFindByMailaddr($UserInfo{'EmailAddress'});
  if ($LdapUserInfo{'Name'}) {
      $FoundInExternalDatabase = 1;
      $RT::Logger->debug("LookupExternalUserInfo: Mapping '".
                        $UserInfo{'EmailAddress'} .
                        "' to '" .
                        $LdapUserInfo{'Name'} . "'");
      foreach my $key (keys %LdapUserInfo) {
          $UserInfo{$key} = $LdapUserInfo{$key};
      }
  } else {
      $RT::Logger->debug("LookupExternalUserInfo: Fail to find username for '".
                        $UserInfo{'EmailAddress'}."'");
  }

  return ($FoundInExternalDatabase, %UserInfo);
}

# }}}

# {{{ sub CanonicalizeUserInfo

sub CanonicalizeUserInfo {
    my $self    = shift;
    my $args    = shift;
    my $success = 1;

    my ($UserFoundInExternalDatabase, %ExternalUserInfo) =
        LookupExternalUserInfo( $args->{'EmailAddress'},
                                $args->{'RealName'} );
    if ($UserFoundInExternalDatabase) {
        for my $key (keys %ExternalUserInfo) {
            $args->{$key} = $ExternalUserInfo{$key};
        }
    }

    return ($success);
}

# }}}

# {{{ sub SetPasswordExternal

=head2 SetPasswordExternal

Takes a string, and try to set this string as the users password in an
external system, if the user is listed in the external system.

Returns 1 if the password was set successfully, undef if it failed,
and -1 if the user is unknown to the external system.

This hook is called from SetPassword.

=cut

sub SetPasswordExternal {
    my $self     = shift;
    my $password = shift;

    # Not allowed to set password for users in LDAP
    if ($RT::LDAPExternalAuth) {
        my $ldap = LdapConnect();
        my $mesg;
        if ( $mesg = LdapFindUser( $ldap, $self->Name )
             && defined $mesg && $mesg->count ) {
            LdapDisconnect($ldap);
            return ( undef,
                     $self->loc("LDAP users must change password in LDAP") );
        }
        LdapDisconnect($ldap);
    }
    return (-1, "No such user in LDAP");
}

# }}}

# {{{ sub SetPassword

=head2 SetPassword

Takes a string. Checks the string's length and sets this user's password
to that string.

Override for function in User_Overlay.pm, with modification for LDAP
authentication.

=cut

sub SetPassword {
    my $self     = shift;
    my $password = shift;

    unless ( $self->CurrentUserCanModify('Password') ) {
        return ( 0, $self->loc('Password: Permission Denied') );
    }

    my ($code, $msg) = $self->SetPasswordExternal($password);
    return ($code, $msg) unless (-1 == $code);

    if ( !$password ) {
        return ( 0, $self->loc("No password set") );
    }
    elsif ( length($password) < $RT::MinimumPasswordLength ) {
        return ( 0, $self->loc("Password needs to be at least [_1] characters long", $RT::MinimumPasswordLength) );
    }
    else {
        my $new = !$self->HasPassword;
        $password = $self->_GeneratePassword($password);
        my ( $val, $msg ) = $self->SUPER::SetPassword($password);
        if ($val) {
            return ( 1, $self->loc("Password set") ) if $new;
            return ( 1, $self->loc("Password changed") );
        }
        else {
            return ( $val, $msg );
        }
    }

}

# }}}

# {{{ sub IsPasswordExternal

=head2 IsPasswordExternal

Returns true if the passed in value is this user's password.  Return
undef if the password don't match.  Return -1 if the user is unknown
in the external system.

This hook is called from IsPassword.

=cut

sub IsPasswordExternal {
    my $self  = shift;
    my $value = shift;
        # Let LDAP be authorative for users in LDAP, and only fall
        # through for users without LDAP entry.
        if ($RT::LDAPExternalAuth) {
            return IsLdapPassword($self->Name, $value);
        }
}

# }}}

# {{{ sub IsPassword

=head2 IsPassword

Check the users password using LDAP.  Override for function in
User_Overlay.pm, with modification for LDAP authentication.

=cut

sub IsPassword {
    my $self  = shift;
    my $value = shift;

    #TODO there isn't any apparent way to legitimately ACL this

    # RT does not allow null passwords
    if ( ( !defined($value) ) or ( $value eq '' ) ) {
        return (undef);
    }

    if ( $self->PrincipalObj->Disabled ) {
        $RT::Logger->info(
                          "Disabled user " . $self->Name . " tried to log in" );
        return (undef);
    }

    my $code = $self->IsPasswordExternal($value);
    return ($code) unless (-1 == $code);

    unless ($self->HasPassword) {
        return(undef);
    }

    my $stored = $self->__Value('Password');
    if (length $stored == 40) {
        # The truncated SHA256(salt,MD5(passwd)) form from 2010/12 is 40 characters long
        my $hash = MIME::Base64::decode_base64($stored);
        # The first 4 bytes are the salt, the rest is substr(SHA256,0,26)
        my $salt = substr($hash, 0, 4, "");
        return substr(Digest::SHA::sha256($salt . Digest::MD5::md5($value)), 0, 26) eq $hash;
    } elsif (length $stored == 32) {
        # Hex nonsalted-md5
        return 0 unless Digest::MD5::md5_hex(encode_utf8($value)) eq $stored;
    } elsif (length $stored == 22) {
        # Base64 nonsalted-md5
        return 0 unless Digest::MD5::md5_base64(encode_utf8($value)) eq $stored;
    } elsif (length $stored == 13) {
        # crypt() output
        return 0 unless crypt(encode_utf8($value), $stored) eq $stored;
    } else {
        $RT::Logger->warn("Unknown password form");
        return 0;
    }

    # We got here by validating successfully, but with a legacy
    # password form.  Update to the most recent form.
    my $obj = $self->isa("RT::CurrentUser") ? $self->UserObj : $self;
    $obj->_Set(Field => 'Password', Value =>  $self->_GeneratePassword($value) );
    return 1;

}

# }}}

# {{{ sub LdapUserFindByMailaddr

=head2 LdapUserFindByMailaddr

Lookup user owning a given email address on UiO, returning user info
in a hash or undef if not known or the search failed.

The following configure options are used by this function in addition
to the ones used by LdapConnect().

 $RT::LdapMailBase
 $RT::LdapMailFilter
 $RT::LdapMailScope
 $RT::LdapMailSearchAttr
 $RT::LdapMailMap

=cut

# Example search
#   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

sub LdapUserFindByMailaddr {
    my $mailaddr = shift;
    my %UserInfo = ();
    $ldap = LdapConnect();
    my $filter = "(&($RT::LdapMailSearchAttr=$mailaddr)$RT::LdapMailFilter)";
    my @attr = keys %RT::LdapMailSearchResultMap;
    $RT::Logger->debug( "LdapUserFindByMailaddr: Looking for ",
                           join(" ", @attr), " filter=", $filter );
    $mesg = $ldap->search(
                          base       => $RT::LdapMailBase,
                          scope      => $RT::LdapMailScope,
                          filter     => $filter,
                          attributes => [@attr],
                          );
    if ( ($mesg->code != LDAP_SUCCESS) and
         ($mesg->code != LDAP_PARTIAL_RESULTS) ) {
        $RT::Logger->critical("LdapUserFindByMailaddr: Search failed: ",
                              "retval=", $mesg->code, " ",
                              ldap_error_name($mesg->code));
        LdapDisconnect($ldap);
        return undef;
    }

    if (1 != $mesg->count) {
        LdapDisconnect($ldap);
        return undef;
    }

    while( my $entry = $mesg->shift_entry) {
        foreach my $attr (keys %RT::LdapMailSearchResultMap) {
            foreach my $value ($entry->get_value($attr)) {
                $UserInfo{$RT::LdapMailSearchResultMap{$attr}} = $value;
            }
        }
    }
    LdapDisconnect($ldap);
    return %UserInfo;
}

# {{{ sub LdapConnect

=head2 LdapConnect

Connect to the LDAP databsae.

The following configure options are used by this function:

  $RT::LdapServer
  $RT::LdapUser
  $RT::LdapPass

=cut

sub LdapConnect {
    use Net::LDAP qw(LDAP_SUCCESS LDAP_PARTIAL_RESULTS);
    use Net::LDAP::Util qw (ldap_error_name); 

    print $@ if $@;

    my $mesg;
    my $ldap = Net::LDAP->new($RT::LdapServer,
                              version => 3);

    unless ($ldap) {
        $RT::Logger->critical("IsLdapPassword: Cannot connect to",
                              "LDAP server ", $RT::LdapServer);
        return undef;
    }

    # I seem to have problems if I try and bind with a NULL username
    # by hand So this now checks to see if we are really going to bind
    # with a username.
    if (defined($RT::LdapUser) && $RT::LdapUser ne '') {
        $mesg = $ldap->bind($RT::LdapUser,
                            password => $RT::LdapPass );
    } else {
        # This bind is redundant with LDAP protocol version 3
        $mesg = $ldap->bind;
    }
    if ($mesg->code != LDAP_SUCCESS) {
        $RT::Logger->critical("IsLdapPassword: Cannot bind to LDAP: ",
                              "retval=", $mesg->code, " ",
                              ldap_error_name($mesg->code));
        return undef;
    }
    return $ldap;
}

# }}}

# {{{ sub LdapDisconnect

=head2 LdapDisconnect

Disconnect from the LDAP database.

=cut

sub LdapDisconnect {
    my $ldap = shift;
    my $mesg = $ldap->unbind();
    if ($mesg->code != LDAP_SUCCESS) {
        $RT::Logger->critical("LdapDisconnect: unbind failed: ",
                              "retval=", $mesg->code, " ",
                              ldap_error_name($mesg->code));
    }
}

# }}}

# {{{ sub LdapFindUser

=head2 LdapFindUser

Locate info on a giver user given the username.

Configure options used by this function:

  $RT::LdpaAuthBase
  $RT::LdpaAuthFilter
  $RT::LdpaAuthUidAttr

=cut

sub LdapFindUser {
    my $ldap = shift;
    my $username = shift;

    my $filter;
    if ($RT::LdapAuthFilter) {
        $filter = "(&(" .$RT::LdapAuthUidAttr . "=$username)$RT::LdapAuthFilter)";
    } else {
        $filter = "(" .$RT::LdapAuthUidAttr . "=$username)";
    }

    $RT::Logger->debug("IsLdapPassword: First search filter '$filter'");
    my $mesg = $ldap->search(base   => $RT::LdapAuthBase,
                             filter => $filter,
                             attrs  => ['dn']);
    if (!(($mesg->code == LDAP_SUCCESS) or
          ($mesg->code == LDAP_PARTIAL_RESULTS)))
    {
        $RT::Logger->debug("IsLdapPassword: Could not search for $filter: ",
                           "retval=", $mesg->code, " ",
                           ldap_error_name($mesg->code));
        return undef;
    }
    return $mesg;
}

# }}}

# {{{ sub IsLdapPassword

=head2 IsLdapPassword

Takes a username and password as argument, and check if the password
is correct for the given user.  Return undef if password check failed,
-1 if the user is unknown, and 1 if the password check succeeded.

=cut

sub IsLdapPassword {
    my $username = shift;
    my $value    = shift;

    $RT::Logger->debug("IsLdapPassword: executing");
    my $ldap = LdapConnect();
    return undef unless $ldap;

    my $mesg = LdapFindUser($ldap, $username);
    unless ($mesg) {
        LdapDisconnect($ldap);
        return undef;
    }
    $RT::Logger->debug("IsLdapPassword: First search produced ",
                       $mesg->count, " results");
    if (! $mesg->count)
    {
        $RT::Logger->info("IsLdapPassword: AUTH FAILED $username");
        LdapDisconnect($ldap);
        return -1;
    }
    $ldap->start_tls( verify => 'require',
                      cafile => $RT::LdapCAFile ) if ($RT::LdapAuthStartTLS);

    my $userdn = $mesg->first_entry->dn;
    $RT::Logger->debug("IsLdapPassword: Trying to bind using DN=$userdn");
    my $mesg2 = $ldap->bind($userdn,
                            password => $value );
    if ($mesg2->code != LDAP_SUCCESS) {
        $RT::Logger->info("IsLdapPassword: Unable to bind as $userdn: ",
                              "retval=", $mesg2->code, " ",
                              ldap_error_name($mesg2->code));
        LdapDisconnect($ldap);
        return undef;
    }
    else
    {
        $RT::Logger->info("IsLdapPassword: AUTH OK $username ($userdn) base:",
                          $RT::LdapAuthBase);
        LdapDisconnect($ldap);
        return 1;
    }
}

# }}}

1;