#!/usr/bin/perl

########################################################################
#
#  argonaut-user-reminder
#
#  Check for expired users and send them a mail allowing to postpone expiration
#
#  This code is part of FusionDirectory (http://www.fusiondirectory.org/)
#  Copyright (C) 2015-2018  FusionDirectory
#
#  This program is free software; you can redistribute it and/or modify
#  it under the terms of the GNU General Public License as published by
#  the Free Software Foundation; either version 2 of the License, or
#  (at your option) any later version.
#
#  This program 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.
#
#  You should have received a copy of the GNU General Public License
#  along with this program; if not, write to the Free Software
#  Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
#
########################################################################

use strict;
use warnings;
use 5.008;

use Digest::SHA qw(sha256_base64);

use Argonaut::Libraries::Common qw(:ldap :string :config);

use Net::LDAP::Constant qw(LDAP_NO_SUCH_OBJECT);
use Net::LDAP::Util qw(generalizedTime_to_time);

use Mail::Sendmail qw(sendmail);
use MIME::Base64;
use MIME::Words qw(encode_mimewords);

my $config;

$config = argonaut_read_config;
$config->{'fd_rdn'} = 'ou=fusiondirectory';

my $verbose = 0;


sub print_usage
{
  print "Usage : argonaut-user-reminder [--verbose]\n";
  exit(0);
}

foreach my $arg ( @ARGV ) {
  if (lc($arg) eq "--verbose") {
    $verbose = 1;
  } else {
    print_usage();
  }
}

check_expired_users();

exit 0;

##########################################################################################

# Die on all LDAP error except for «No such object»
sub die_on_ldap_errors
{
  my ($mesg) = @_;
  if (($mesg->code != 0) && ($mesg->code != LDAP_NO_SUCH_OBJECT)) {
    die $mesg->error;
  }
}

#############################################################

# Read FD config in the LDAP
sub read_reminder_ldap_config
{
  my ($ldap) = @_;

  # Default values
  $config->{'user_rdn'}       = 'ou=people';
  $config->{'token_rdn'}      = 'ou=reminder';
  # Days before expiration to send the first mail
  $config->{'alert_delay'}    = 15;
  # Days after first mail to send a new one
  $config->{'resend_delay'}   = 7;
  # Should alert mails be forwarded to the manager
  $config->{'forward_alert'}  = 1;

  my $entry = argonaut_read_ldap_config(
    $ldap,
    $config->{'ldap_base'},
    $config,
    '(&(objectClass=fusionDirectoryConf)(objectClass=fdUserReminderPluginConf))',
    {
      'user_rdn'          => "fdUserRDN",
      'token_rdn'         => "fdReminderTokenRDN",
      'alert_delay'       => "fdUserReminderAlertDelay",
      'resend_delay'      => "fdUserReminderResendDelay",
      'alert_mailsubject' => "fdUserReminderAlertSubject",
      'alert_mailbody'    => "fdUserReminderAlertBody",
      'alert_mailaddress' => "fdUserReminderEmail",
      'ppolicy_default'   => "fdPpolicyDefaultCn",
      'ppolicy_rdn'       => "fdPpolicyRDN"
    }
  );

  if ($entry->exists('fdUserReminderForwardAlert')) {
    $config->{'forward_alert'} = ($entry->get_value('fdUserReminderForwardAlert') eq "TRUE");
  }
}

sub check_expired_users
{
  my ($ldap,$ldap_base) = argonaut_ldap_handle($config);
  $config->{'ldap_base'} = $ldap_base;
  read_reminder_ldap_config($ldap);

  # Time and date in seconds
  my $now = time();

  # Convert alert_delay (days) to seconds and add it to $now (86400 is 24*60*60)
  my $next_alert_date = ($now + ($config->{'alert_delay'} * 86400));

  # POSIX expiration
  my $mesg = $ldap->search(
    base    => $config->{'ldap_base'},
    filter  => '(&(objectClass=person)(shadowExpire=*))',
    scope   => 'subtree'
  );
  die_on_ldap_errors($mesg);

  foreach my $entry ($mesg->entries()) {
    my $cn = $entry->get_value('cn');
    my $shadowExpireSeconds = $entry->get_value('shadowExpire') * 86400;
    if ($shadowExpireSeconds <= $now) {
      print "$cn is Expired\n" if $verbose;
    } elsif ($shadowExpireSeconds <= $next_alert_date) {
      alert_user_if_needed($ldap,$entry,$now);
    }
  }

  # PPOLICY expiration
  if (($config->{'ppolicy_default'}) && ($config->{'ppolicy_rdn'})) {
    my $defaultMaxAge;
    my $ppolicydn = 'cn='.$config->{'ppolicy_default'}.','.$config->{'ppolicy_rdn'}.','.$config->{'ldap_base'};
    $mesg = $ldap->search(
      base    => $ppolicydn,
      filter  => '(objectClass=*)',
      scope   => 'base',
      attrs   => ['pwdMaxAge']
    );
    die_on_ldap_errors($mesg);
    if ($mesg->count > 0) {
      $defaultMaxAge = ($mesg->entries)[0]->get_value("pwdMaxAge");
    } else {
      die "Default ppolicy '".$ppolicydn."' could not be found in the LDAP!\n";
    }

    $mesg = $ldap->search(
      base    => $config->{'ldap_base'},
      filter  => '(&(objectClass=person)(pwdChangedTime=*))',
      scope   => 'subtree',
      attrs   => ['uid','cn','mail','fdPrivateMail','supannAutreMail','manager','pwdChangedTime','pwdPolicySubentry','pwdAccountLockedTime'],
    );
    die_on_ldap_errors($mesg);

    my %maxAgeCache = ();
    my @entries = $mesg->entries();
    foreach my $entry (@entries) {
      my $cn = $entry->get_value('cn');
      if (not defined $cn) {
        $cn = $entry->dn;
      }

      my $pwdChangedTimestamp = generalizedTime_to_time($entry->get_value('pwdChangedTime'));
      if (not defined $pwdChangedTimestamp) {
        print "Failed to parse value '".$entry->get_value('pwdChangedTime')."' for $cn\n";
        next;
      }

      my $maxAge = $defaultMaxAge;
      if (defined $entry->get_value('pwdPolicySubentry')) {
        my $userPolicy = $entry->get_value('pwdPolicySubentry');
        if (defined $maxAgeCache{$userPolicy}) {
          $maxAge = $maxAgeCache{$userPolicy};
        } else {
          $mesg = $ldap->search(
            base    => $userPolicy,
            filter  => '(objectClass=*)',
            scope   => 'base',
            attrs   => ['pwdMaxAge']
          );
          die_on_ldap_errors($mesg);
          if ($mesg->count > 0) {
            $maxAge = ($mesg->entries)[0]->get_value("pwdMaxAge");
          }
          $maxAgeCache{$userPolicy} = $maxAge;
        }
      }

      if ((not defined $maxAge) || ($maxAge == 0)) {
        print "No ppolicy max age defined for $cn\n" if $verbose;
        next;
      }

      if ($pwdChangedTimestamp + $maxAge <= $now) {
        print "$cn is Expired\n" if $verbose;
      } elsif ($pwdChangedTimestamp + $maxAge <= $next_alert_date) {
        alert_user_if_needed($ldap,$entry,$now);
      }
    }
  }
}

sub alert_user_if_needed
{
  my ($ldap,$entry,$now) = @_;
  my $cn = $entry->get_value('cn');

  # Check if we have a mail address for this user.
  my $mail_address = $entry->get_value('mail');
  if (not defined $mail_address) {
    $mail_address = $entry->get_value('fdPrivateMail');
  }
  if (not defined $mail_address) {
    $mail_address = $entry->get_value('supannAutreMail');
  }
  if (not defined $mail_address) {
    print "User $cn has no mail address, skipping…\n";
    return;
  }

  # Check if we already sent an email.
  my ($token_hash, $token_datetime) = get_ldap_token($ldap, $entry->get_value('uid'));
  if ((defined $token_datetime) && ($token_datetime + ($config->{'resend_delay'} * 86400) > $now)) {
    print "User $cn was already sent a mail, not resending yet.\n" if $verbose;
    return;
  } elsif ((defined $token_hash) || (defined $token_datetime)) {
    # Delete obsolete token so we may create it again
    delete_ldap_token($ldap, $entry->get_value('uid'));
  }

  my ($manager_cn, $manager_mail);
  if ($config->{'forward_alert'}) {
    # Find the manager
    my $manager_dn = $entry->get_value('manager');
    if (not defined $manager_dn) {
      my $ou = $entry->dn;
      $ou =~ s/^[^,]+,$config->{'user_rdn'}//;
      my $manager_mesg = $ldap->search(
        base    => $ou,
        filter  => '(objectClass=*)',
        scope   => 'base'
      );
      if ($manager_mesg->count() > 0) {
        $manager_dn = ($manager_mesg->entries)[0]->get_value('manager');
      }
    }
    if (not defined $manager_dn) {
      print "No manager found for $cn\n";
    }
    my $manager_mesg = $ldap->search(
      base    => $manager_dn,
      filter  => '(objectClass=*)',
      scope   => 'base'
    );
    if ($manager_mesg->count() > 0) {
      $manager_cn   = ($manager_mesg->entries)[0]->get_value('cn');
      $manager_mail = ($manager_mesg->entries)[0]->get_value('mail');
    }
  }
  send_alert_mail($ldap, $entry->get_value('uid'), $now, $cn, $mail_address, $manager_cn, $manager_mail);
}

sub send_alert_mail
{
  my ($ldap, $uid, $datetime, $user_cn, $user_mail, $manager_cn, $manager_mail) = @_;
  my $token = store_ldap_token($ldap, $uid, $datetime);
  print "Sending mail to $user_cn<$user_mail>" if $verbose;
  my $cc = "";
  if (defined $manager_mail) {
    print ", copy to $manager_cn<$manager_mail>" if $verbose;
    $cc = encode_mimewords($manager_cn, Charset => 'utf-8', Encoding => 'B')." <$manager_mail>";
  }
  print " with token $token\n" if $verbose;
  my $body = sprintf($config->{'alert_mailbody'},$user_cn,$uid,$token);
  my %message = (
    'From'                      => $config->{'alert_mailaddress'},
    'To'                        => encode_mimewords($user_cn, Charset => 'utf-8', Encoding => 'B')." <$user_mail>",
    'Cc'                        => $cc,
    'Subject'                   => encode_mimewords($config->{'alert_mailsubject'}, Charset => 'utf-8', Encoding => 'B'),
    'Content-type'              => 'text/plain; charset="utf-8"',
    'Content-Transfer-Encoding' => 'base64',
    'Message'                   => encode_base64($body)
  );
  sendmail(%message) or die $Mail::Sendmail::error;
}

sub get_ldap_token
{
  my ($ldap, $uid) = @_;

  my $dn = "ou=$uid,".$config->{'token_rdn'}.','.$config->{'fd_rdn'}.','.$config->{'ldap_base'};

  my $mesg = $ldap->search(
    base    => $dn,
    filter  => "(ou=$uid)",
    scope   => 'base'
  );

  if ($mesg->count()) {
    return (($mesg->entries)[0]->get_value('userPassword'), ($mesg->entries)[0]->get_value('description'));
  } else {
    return ();
  }
}

sub delete_ldap_token
{
  my ($ldap, $uid) = @_;

  my $dn = "ou=$uid,".$config->{'token_rdn'}.','.$config->{'fd_rdn'}.','.$config->{'ldap_base'};

  my $mesg = $ldap->delete($dn);
  $mesg->code && warn "! failed to delete token $dn: ".$mesg->error."\n";
}

sub store_ldap_token
{
  my ($ldap, $uid, $datetime) = @_;

  my $token_password  = argonaut_gen_random_str(48);
  my $token_hash      = sha256_base64('expired'.$token_password);
  while (length($token_hash) % 4) {
    $token_hash .= '=';
  }
  $token_hash = "{SHA}".$token_hash;

  my $dn = "ou=$uid,".$config->{'token_rdn'}.','.$config->{'fd_rdn'}.','.$config->{'ldap_base'};

  if (!argonaut_ldap_branch_exists($ldap, $config->{'token_rdn'}.','.$config->{'fd_rdn'}.','.$config->{'ldap_base'})) {
    die "! Branch ".$config->{'token_rdn'}.','.$config->{'fd_rdn'}.','.$config->{'ldap_base'}." doesnt exist \n";
  }

  my $mesg = $ldap->add(
    $dn,
    attr => [
      'ou'            => $uid,
      'objectClass'   => 'organizationalUnit',
      'userPassword'  => $token_hash,
      'description'   => $datetime
    ]
  );

  $mesg->code && die "! failed to create token $dn: ".$mesg->error."\n";

  return $token_password;
}

__END__

=head1 NAME

argonaut-user-reminder - read account expiration date from ldap and send emails reminders

=head1 SYNOPSIS

argonaut-user-reminder [--verbose]

=head1 DESCRIPTION

argonaut-user-reminder is a program used to read account expiration dates from the LDAP.
It reads the delay before expiration from the LDAP and send emails for user to postpone
expiration date.

=head1 OPTIONS

=over 3

=item B<--verbose>

be verbose

=back

=head1 BUGS

Please report any bugs, or post any suggestions, to the fusiondirectory mailing list fusiondirectory-users or to
<https://gitlab.fusiondirectory.org/argonaut/argonaut/issues/new>

=head1 AUTHORS

Come Bernigaud

=head1 LICENCE AND COPYRIGHT

This code is part of Argonaut Project <https://www.argonaut-project.org/>

=over 1

=item Copyright (C) 2015-2018 FusionDirectory project

=back

This program 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.

=cut
