#!/usr/bin/env perl

use v5.10.1;
use strict;
use warnings;
use utf8;
use open IO => ':utf8';
use open ':std';

use Encode qw(decode);
use Digest::SHA;
use Email::MIME;
use File::Find;
use IPC::Cmd qw[run];
use MIME::Base64;
use Net::LDAPS;
use Net::LDAP::Util qw(ldap_error_text);
use Pod::Usage;
use Term::ANSIColor qw(:constants);
use Term::ReadKey;

#use Cwd 'abs_path';
#use File::Basename;

# Avoid installation of liblerdorf on workstations
use lib "/sgoinfre/root/new_intra/";

use ACU::LDAP;
use ACU::Log;

###########################################################
#                                                         #
#                    Global variables                     #
#                                                         #
###########################################################

my $noconfirm = 0;

my $wksHomePrefix = "/home/";
my $nfsHomePrefix = "/srv/nfs/accounts/";

my $shellFalse = "/bin/false";
my $shellValid = "/bin/zsh";

my $colorize = defined($ENV{'ENABLE_COLOR'});

my %dev_quota = ( home => "/dev/mapper/acu-nfs--accounts",
		  sgoinfre => "/dev/mapper/acu-nfs--sgoinfre" );
my %def_quota = ( block => { home => 2306866, sgoinfre => 5242880 },
		  file => { home => 50000, sgoinfre => 60000 } );

###########################################################
#                                                         #
#                       Main Program                      #
#                                                         #
###########################################################

my $dbh;

my %cmds =
(
  "account"	=> \&cmd_account,
  "group"	=> \&cmd_group,
  "help"	=> \&cmd_help,
  "list"	=> \&cmd_list,
  "role"	=> \&cmd_role,
  "ssh-keys"    => \&cmd_ssh_keys,
  "strong-auth" => \&cmd_strong_auth,
  "sync-quota"  => \&cmd_sync_quota,
  "system-group"=> \&cmd_systemgrp,
  "year"        => \&cmd_year,
);

my %cmds_account =
(
  "add"		  => \&cmd_account_add,
  "alias"	  => \&cmd_account_alias,
  "close"	  => \&cmd_account_close,
  "cn"		  => \&cmd_account_cn,
  "create"	  => \&cmd_account_create,
  "delete"	  => \&cmd_account_delete,
  "finger"	  => \&cmd_account_view,
  "mail"	  => \&cmd_account_mail,
  "name"	  => \&cmd_account_cn,
  "nopass"	  => \&cmd_account_nopass,
  "password"	  => \&cmd_account_password,
  "passgen"	  => \&cmd_account_passgen,
  "photo"	  => \&cmd_account_photo,
  "quota"         => \&cmd_account_quota,
  "reopen"        => \&cmd_account_reopen,
  "rights"        => \&cmd_account_rights,
  "services"	  => \&cmd_account_services,
  "shell"         => \&cmd_account_shell,
  "view"	  => \&cmd_account_view,

  "grant-intra"	  => \&cmd_account_grantintra,
  "grant-lab"	  => \&cmd_account_grantlab,
  "grant-mail"	  => \&cmd_account_grantmail,
);

my %cmds_group =
(
  "view"	=> \&cmd_group_view,
  "members"	=> \&cmd_group_members,
  "rights"	=> \&cmd_group_rights,
  "create"	=> \&cmd_group_create,
  "delete"	=> \&cmd_group_delete
);

my %cmds_list =
(
  "accounts"	=> \&cmd_list_accounts,
  "groups"	=> \&cmd_list_groups,
  "roles"	=> \&cmd_list_roles,
);

my %cmds_strong_auth =
(
  "view"	=> \&cmd_no_strong_auth_view,
  "warn"	=> \&cmd_no_strong_auth_warn,
  "close"	=> \&cmd_no_strong_auth_close,
);

my %cmds_ssh_keys =
(
  "view"	=> \&cmd_ssh_keys_without_passphrase_view,
  "warn"	=> \&cmd_ssh_keys_without_passphrase_warn,
  "remove"	=> \&cmd_ssh_keys_without_passphrase_remove,
);

my %group_types =
(
  "intra"	=> "ou=intra,ou=groups",
  "roles"	=> "ou=roles,ou=groups",
  "system"	=> "ou=system,ou=groups",
);


######################################
#                                    #
#   UTILITY FUNCTIONS		     #
#                                    #
######################################

sub ldap_get_password()
{
    my $bindsecret;
    if (defined($ENV{'LDAP_PASSWORD'}) && $ENV{'LDAP_PASSWORD'} ne "") {
	return $ENV{'LDAP_PASSWORD'};
    }

    say "To avoid typing password everytime, set LDAP_PASSWORD in your env.";
    say "Do not do this in your shell configuration file!";
    say "Use a command like:\n";
    say '  $ echo -n "LDAP password: "; read -s LDAP_PASSWORD; echo';
    say '  $ LDAP_PASSWORD=$LDAP_PASSWORD lpt ...';
    say "The last line prevent you from exporting the LDAP password to all commands but lpt!";
    say "";

    ReadMode("noecho");
    print BOLD, "Need LDAP password: ", RESET;
    $bindsecret = <STDIN>;
    ReadMode("restore");
    print "\n";

    chomp $bindsecret;
    return $bindsecret;
}

$LDAP::binddn = "cn=admin,dc=acu,dc=epita,dc=fr";
$LDAP::secret_search = \&ldap_get_password;

######################################
#                                    #
#   ACCOUNT BLOCK		     #
#                                    #
######################################

sub cmd_account(@)
{
    my $login = shift;

    if (! $login) {
	pod2usage(-verbose => 99,
		  -sections => [ 'ACCOUNT COMMANDS' ],
		  -exitval => 1);
    }

    my $subcmd = shift // "view";

    if (! exists $cmds_account{$subcmd}) {
	log(USAGE, "Unknown command for account: ". $subcmd);
	return 1;
    }

    return $cmds_account{$subcmd}($login, @_);
}

sub cmd_account_alias($@)
{
    return cmd_account_multiple_vieworchange('mailAlias', 'alias', @_);
}

sub cmd_account_close($;@)
{
    my $login = shift;

    if ($#_ > -1) {
	log(USAGE, "<lpt> account <login> close");
	return -1;
    }

    my $ldap;
    eval {
	$ldap = LDAP::ldap_connect();
    };
    log(ERROR, $@) if ($@);

    my $dn;
    eval {
	$dn = LDAP::search_dn($ldap, "ou=users", "uid=$login");
    };
    log(ERROR, $@) if ($@);
    my $entry = LDAP::get_dn($ldap, $dn, 'objectClass', 'userPassword', 'loginShell');

    if (grep { "epitaAccount" } $entry->get_value("objectClass"))
    {
	log(INFO, "Invalidating password for ", YELLOW, $login, RESET, " ...");

	my $passwd = $entry->get_value("userPassword");
	$passwd =~ s/^(\{[^\}]+\})/$1!/ if ($passwd !~ /^\{[^\}]+\}!/);

	$entry->replace("userPassword" => $passwd);
	$entry->update($ldap);
    }

    $ldap->unbind or die ("couldn't disconnect correctly");

    if (grep { "posixAccount" } $entry->get_value("objectClass"))
    {
	log(DEBUG, "Setting shell for $login ...");
	cmd_account_shell($login, "/bin/false");
    }

    log(DONE, "Done; don't forget to restart nscd on servers and workstations!");
    return 0;
}

sub cmd_account_cn($@)
{
    return cmd_account_vieworchange('cn', 'name', @_);
}

sub cmd_account_add($@)
{
    my $login = shift;
    my $passwd_path = shift // "./passwd";

    if (! -f $passwd_path)
    {
	log(USAGE, "lpt account <login> add [./passwd] [nopass|passgen|password]");
	return 1;
    }

    open my $fh, "<", $passwd_path;
    my @passwd_cnt = <$fh>;
    close($fh);

    for my $line (grep { /^$login:x/ } @passwd_cnt)
    {
	if ($line =~ /^$login:x:([0-9]+):([0-9]+):([^ :]+) ?([^:]*):/)
	{
	    my $uid = $1;
	    my $gid = $2;
	    my $firstname = ucfirst $3;
	    my $lastname = ucfirst $4;

	    if (! $noconfirm)
	    {
		say "Add user: ", YELLOW, BOLD, "$login", RESET, ":\n\tFirstname: ", BOLD, $firstname, RESET, "\n\tLastname:  ", BOLD, $lastname, RESET, "\n\tUID:\t", BOLD, $uid, RESET, "\n\tGroup:\t", BOLD, $gid, RESET;

		print "Would you like to add this user? [", GREEN, "y", RESET, "/", RED, "N", RESET, "] ";
		my $go = <STDIN>;
		chomp $go;
		next if ($go ne "y" and $go ne "yes");
	    }

	    cmd_account_create($login, $gid, $uid, $firstname, $lastname, @_);
	}
    }
}

sub cmd_account_create($@)
{
    my $login = shift;

    if ($#_ < 3) {
	log(USAGE, "lpt account <login> create <year> <uid> <prénom> <nom> [nopass|passgen|password]");
	return 1;
    }

    my $group = shift;

    log(DEBUG, "Adding dn: uid=$login,ou=$group,ou=users,dc=acu,dc=epita,dc=fr ...");

    my $ldap = LDAP::ldap_connect();

    # Check if the OU exists
    my $oudn = "ou=$group,ou=users";
    my $ou = LDAP::get_dn($ldap, $oudn);

    if (! $ou)
    {
	my $mesg = $ldap->add( "$oudn,dc=acu,dc=epita,dc=fr",
			       attrs => [
				   objectclass => [ "top", "organizationalUnit" ],
				   ou => "$group",
			       ]
	    );
	if ($mesg->code == 0) {
	    log(INFO, "New OU created: $oudn");
	} else {
	    log(WARN, "Unable to add new OU $oudn: ", RESET, $mesg->error);
	}
    }

    my $mesg = $ldap->add( "uid=$login,$oudn,dc=acu,dc=epita,dc=fr",
			   attrs => [
			       objectclass => [ "top", "epitaAccount" ],
			       uidNumber => shift,
			       cn => ucfirst(shift(@_))." ".ucfirst(shift(@_)),
			       mail => "$login\@epita.fr",
			       uid => $login,
			   ]
	);

    #$ldap->unbind or die ("couldn't disconnect correctly");

    if ($mesg->code == 0)
    {
	log(INFO, "Account added: $login");
	my $pass = shift // "nopass";
	return cmd_account($login, $pass, @_) if ($pass ne "nopass");
	return 0;
    }
    else {
	log(ERROR, "Unable to add: $login: ", RESET, $mesg->error);
    }
}

sub cmd_account_delete($@)
{
    my $login = shift;

    my $ldap = LDAP::ldap_connect();

    my $dn = LDAP::search_dn($ldap, "ou=users", "uid=$login");

    log(DEBUG, "Deleting dn: $dn ...");

    if (LDAP::delete_entry($ldap, $dn))
    {
	log DONE, "Account ", YELLOW, $login, RESET, " successfully deleted.";
	return 0;
    }
    else
    {
	log ERROR, "Unable to delete account ", YELLOW, $login, RESET, ".";
	return 1;
    }
}

sub cmd_account_grantintra($@)
{
    my $login = shift;

    my $ldap = LDAP::ldap_connect();

    my $dn = LDAP::search_dn($ldap, "ou=users", "uid=$login");

    if (LDAP::add_attribute($ldap, $dn, "objectClass", "intraAccount")) {
	log(INFO, "$login now grants to use the intranet.");
    }

    $ldap->unbind or die ("couldn't disconnect correctly");
}

sub cmd_account_grantlab($@)
{
    my $login = shift;
    my $group = shift // "";

    if ($group ne "acu" && $group ne "yaka" && $group ne "ferry")
    {
	log(USAGE, "lpt account <login> grant-lab <acu|yaka|ferry>");
	return 1;
    }

    my $ldap = LDAP::ldap_connect();

    my $dn = LDAP::search_dn($ldap, "ou=users", "uid=$login");
    my $entry = LDAP::get_dn($ldap, $dn, "objectClass", "mail", "mailAlias", "mailAccountActive", "loginShell", "homeDirectory", "gidNumber");

    if (!LDAP::get_attribute($ldap, $dn, "mail")) {
	LDAP::add_attribute($ldap, $dn, "mail", "$login\@epita.fr");
    }

    if ($group eq "acu" || $group eq "yaka")
    {
	if (! grep { $_ eq "MailAccount" } @{ $entry->get_value("objectClass") })
	{
	    $entry->replace("mailAccountActive" => [ "yes" ]);

	    my @oc = $entry->get_value("objectClass");
	    push @oc, "MailAccount";
	    $entry->replace("objectClass" => \@oc);

	    my @aliases = $entry->get_value("mailAlias");
	    push @aliases, "$login\@$group.epita.fr";
	    $entry->replace("objectClass" => \@aliases);
	}

	$entry->replace("loginShell" => [ "/bin/zsh" ]) if ($entry->get_value("loginShell"));
	$entry->replace("homeDirectory" => [ "/home/201X/$login" ]) if ($entry->get_value("homeDirectory"));
	$entry->replace("gidNumber" => [ "4242" ]) if ($entry->get_value("gidNumber"));
    }
    elsif ($group eq "ferry")
    {
	$entry->replace("loginShell" => [ "/bin/noexists" ]);
	$entry->replace("homeDirectory" => [ "/dev/null" ]);
	$entry->replace("gidNumber" => [ "4243" ]);
    }

    my @oc = $entry->get_value("objectClass");
    push @oc, "labAccount";
    $entry->replace("objectClass" => \@oc);

    my $mesg = $entry->update($ldap) or die $!;
    if ($mesg->code != 0) { log(WARN, $mesg->error); return 0; }

    log(INFO, "$login now grants to receive e-mail and connect in laboratory.") if ($group eq "acu" || $group eq "yaka");
    log(INFO, "$login now grants to connect in laboratory for exam.") if ($group eq "ferry");

    $ldap->unbind or die ("couldn't disconnect correctly");
}

sub cmd_account_grantmail($)
{
    my $login = shift;

    my $ldap = LDAP::ldap_connect();

    my $dn = LDAP::search_dn($ldap, "ou=users", "uid=$login");

    my $entry = LDAP::get_dn($ldap, $dn, "mailAccountActive", "objectClass");

    my @oc = $entry->get_value("objectClass");
    push @oc, "MailAccount";

    $entry->replace("objectClass" => \@oc);
    $entry->replace("mailAccountActive" => [ "yes" ]);

    my $mesg = $entry->update($ldap) or die $!;
    if ($mesg->code != 0) { log(WARN, $mesg->error); return 0; }
    else { log(INFO, "$login now grants to receive e-mail. Remember to add some aliases!"); }

    $ldap->unbind or die ("couldn't disconnect correctly");
}

sub cmd_account_mail(@)
{
    return cmd_account_vieworchange('mail', 'mail', @_);
}

sub cmd_account_nopass($@)
{
    my $login = shift;

    my $ldap;
    eval {
	$ldap = LDAP::ldap_connect();
    };
    log(ERROR, $@) if ($@);

    my $dn;
    eval {
	$dn = LDAP::search_dn($ldap, "ou=users", "uid=$login");
    };
    log(ERROR, $@) if ($@);
    my @pass = LDAP::get_attribute($ldap, $dn, 'userPassword');

    if (@pass == 1 && $pass[0] eq "{crypt}!toto")
    {
	$ldap->unbind;
	log(WARN, "Password already empty");
	return 2;
    }
    else
    {
	if (!$noconfirm)
	{
	    print STDERR "Are you sure you want to reset password for ", YELLOW, $login, RESET, "? [", GREEN, "y", RESET, "/", RED, "N", RESET, "] ";
	    my $go = <STDIN>;
	    chomp $go;
	    if ($go ne "y" and $go ne "yes")
	    {
		log(DEBUG, "y response expected to continue, leaving.");
		log(WARN, "Password unchanged for $login.");
		return 2;
	    }
	}

	if (LDAP::update_attribute($ldap, $dn, 'userPassword', "{crypt}!toto"))
	{
	    log(DONE, YELLOW, $login, RESET, " have no more password.");
	}
    }

    $ldap->unbind or die ("couldn't disconnect correctly");

    return 0;
}

sub cmd_account_passgen($@)
{
    my $login = shift;
    my $nb_char = shift // 10;

    if ($nb_char < 10) {
	log(USAGE, "lpt account <login> passgen [nb_char>=10]");
	return 1;
    }

    if (!$noconfirm)
    {
	print STDERR "Are you sure you want to change password for ", YELLOW, $login, RESET, "? [", GREEN, "y", RESET, "/", RED, "N", RESET, "] ";
	my $go = <STDIN>;
	chomp $go;
	if ($go ne "y" and $go ne "yes")
	{
	    log(DEBUG, "y response expected to continue, leaving.");
	    log(WARN, "Password unchanged for $login.");
	    return 2;
	}
    }


    log(DEBUG, "Generating a $nb_char chars password...");
    my $pass = "";
    open (my $fh, "pwgen -s -n -c -y -1 $nb_char 1 |");
    $pass = <$fh>;
    close($fh);
    chomp($pass);

    log(DEBUG, "Setting $pass password to ", YELLOW, $login, RESET, "...");
    if (cmd_account_password($login, $pass)) {
	return 3;
    }
    else {
	say "$login:$pass";
	return 0;
    }
}

sub cmd_account_password($@)
{
    my $login = shift;

    if ($#_ > 0) {
	log(USAGE, "lpt account <login> password [new_password]");
	return 1;
    }
    my $pass = shift;

    if (! $pass)
    {
	say STDERR "Changing password for ", YELLOW, $login, RESET, ".";

	ReadMode("noecho");
	print STDERR "New password: "; my $pass1 = <STDIN>;
	print STDERR "\nRetype new password: "; my $pass2 = <STDIN>;
	ReadMode("restore");
	print STDERR "\n";

	log(DEBUG, "Read passwords: $pass1 and $pass2");

	$pass1 eq $pass2 || log(ERROR, "Passwords did not match.");
	$pass = $pass1;
    }
    chomp($pass);

    log(FATAL, "Empty password refused.") if ($pass eq "");

    my $salt = join '', ('.', '/', 0..9, 'A'..'Z', 'a'..'z')[rand 64, rand 64, rand 64, rand 64];

    my $ctx = Digest::SHA->new(1);
    $ctx->add($pass);
    $ctx->add($salt);

    my $enc_password = "{SSHA}" . encode_base64($ctx->digest . $salt ,'');

    my $ldap;
    eval {
	$ldap = LDAP::ldap_connect();
    };
    log(ERROR, $@) if ($@);

    my $dn;
    eval {
	$dn = LDAP::search_dn($ldap, "ou=users", "uid=$login");
    };
    log(ERROR, $@) if ($@);

    return !LDAP::update_attribute($ldap, $dn, 'userPassword', $enc_password);
}

sub cmd_account_photo($@)
{
    return cmd_account_vieworchange('photoURI', 'photo', @_);
}

sub cmd_account_reopen(@)
{
    my $login = shift;

    if ($#_ != -1) {
	log(USAGE, "<lpt> account <login> reopen");
	return 1;
    }

    my $ldap;
    eval {
	$ldap = LDAP::ldap_connect();
    };
    log(ERROR, $@) if ($@);

    my $dn;
    eval {
	$dn = LDAP::search_dn($ldap, "ou=users", "uid=$login");
    };
    log(ERROR, $@) if ($@);
    my $entry = LDAP::get_dn($ldap, $dn, 'objectClass', 'cn', 'userPassword', 'loginShell');

    if (grep { "epitaAccount" } $entry->get_value("objectClass"))
    {
	# update password
	my $passwd = $entry->get_value("userPassword");
	if ($passwd =~ /^\{[^\}]+\}!/)
	{
	    log(INFO, "Restoring password for ", YELLOW, $login, RESET, " ...");

	    $passwd =~ s/^(\{[^\}]+\})!/$1/;

	    LDAP::update_attribute($ldap, "userPassword", $passwd);
	}
    }

    $ldap->unbind or die ("couldn't disconnect correctly");

    if (grep { "posixAccount" } $entry->get_value("objectClass"))
    {
	log(DEBUG, "Setting shell for $login ...");
	cmd_account_shell($login, $shellValid);
    }

    log(DONE, "Done; don't forget to restart nscd on servers and workstations!");
    return 0;
}

sub cmd_account_rights($@)
{
    return cmd_account_multiple_vieworchange("intraRight", "right", @_);
}

sub cmd_account_services($@)
{
    return cmd_account_multiple_vieworchange("labService", "laboratory_service", @_);
}

sub cmd_account_shell($@)
{
    return cmd_account_vieworchange("loginShell", "shell", @_);
}

sub cmd_account_multiple_vieworchange($$$@)
{
    my $type = shift;
    my $typeName = shift;
    my $login = shift;
    my $action = shift // "list";
    my $change = shift;

    if (($action ne "list" and $action ne "add" and $action ne "del" and $action ne "flush") or (!$change and $action ne "list" and $action ne "flush")) {
	log(USAGE, "lpt account <login> $typeName [list|add|del|flush] [string]");
	return 1;
    }

    my $ldap;
    eval {
	$ldap = LDAP::ldap_connect() if ($action ne "list");
	$ldap = LDAP::ldap_connect_anon() if ($action eq "list");
    };
    log(ERROR, $@) if ($@);

    my $dn;
    eval {
	$dn = LDAP::search_dn($ldap, "ou=users", "uid=$login");
    };
    log(ERROR, $@) if ($@);
    my @attr = LDAP::get_attribute($ldap, $dn, $type);

    if ($action eq "add")
    {
	log(INFO, "Adding ", BOLD, YELLOW, $change, RESET, " as ".$typeName."s for ", YELLOW, $login, RESET, " ...");

	if (LDAP::add_attribute($ldap, $dn, $type, $change)) {
	    log(DONE, "Done!");
	}
    }
    elsif ($action eq "del")
    {
	log(INFO, "Deleting ", BOLD, YELLOW, $change, RESET, " as ".$typeName."s for ", YELLOW, $login, RESET, " ...");

	if (LDAP::delete_attribute($ldap, $dn, $type, $change)) {
	    log(DONE, "Done!");
	}
    }
    elsif ($action eq "flush")
    {
	log(DONE, YELLOW, $login, RESET, " have no more $typeName.") if LDAP::flush_attribute($ldap, $dn, $type);
    }
    else
    {
	if (@attr)
	{
	    log(INFO, BOLD, YELLOW, $login, RESET, "'s ".$typeName."s are:");
	    for my $val (@attr) {
		say "  -  ", BOLD, $val, RESET;
	    }
	}
	else {
	    log(INFO, YELLOW, $login, RESET, " have no $typeName.");
	}
    }

    $ldap->unbind or die ("couldn't disconnect correctly");
    return 0;
}

sub cmd_account_vieworchange($$@)
{
    my $type = shift;
    my $typeName = shift;
    my $login = shift;

    if ($#_ > 0) {
	log(USAGE, "lpt account <login> $typeName [new_$typeName]");
	return 1;
    }

    my $change = shift;

    my $ldap;
    eval {
	$ldap = LDAP::ldap_connect() if ($change);
	$ldap = LDAP::ldap_connect_anon() if (!$change);
    };
    log(ERROR, $@) if ($@);

    my $dn;
    eval {
	$dn = LDAP::search_dn($ldap, "ou=users", "uid=$login");
    };
    log(ERROR, $@) if ($@);
    my $attr = LDAP::get_attribute($ldap, $dn, $type);

    if ($change)
    {
	log(INFO, "Setting $typeName to ", YELLOW, BOLD, $change, RESET " for ", YELLOW, $login, " ...");

	LDAP::update_attribute($ldap, $dn, $type, $change);

	log(DONE, "Done!");
    }
    elsif ($attr) {
	log(INFO, YELLOW, $login, RESET, "'s $typeName is ", BOLD, YELLOW, $attr, RESET, ".");
    }
    else {
	log(INFO, YELLOW, $login, RESET, "'s has no $typeName.");
    }

    $ldap->unbind or die ("couldn't disconnect correctly");
    return 0;
}

sub cmd_account_view($@)
{
    my $login = shift;

    my $ldap = LDAP::ldap_connect_anon();

    my $dn;
    eval {
	$dn = LDAP::search_dn($ldap, "ou=users", "uid=$login");
    };
    log(ERROR, $@) if ($@);
    my @classes = LDAP::get_attribute($ldap, $dn, 'objectClass');

    log(DEBUG, "objectClasses: ", join(', ', @classes));

    my @attrs;
    if ($#_ >= 0) {
	push @attrs, @_;
    }
    else
    {
	push @attrs, 'uid', 'cn', 'mail', 'uidNumber' if (grep { "epitaAccount" } @classes);
	push @attrs, 'gecos', 'loginShell', 'homeDirectory', 'gidNumber' if (grep { "posixAccount" } @classes);
	push @attrs, 'labService', 'quotaHomeBlock', 'quotaHomeFile', 'quotaSgoinfreBlock', 'quotaSgoinfreFile' if (grep { "labAccount" } @classes);
	push @attrs, 'intraRight' if (grep { "intraAccount" } @classes);
	push @attrs, 'mailAlias' if (grep { "MailAccount" } @classes);
    }

    log(DEBUG, "attrs to get: " . join(', ', @attrs));
    my @res = LDAP::get_dn($ldap, $dn, @attrs);

    my $nb = 0;
    for my $entry (@res)
    {
	say "==" if ($nb > 0);
	say BOLD, YELLOW, "dn: ", RESET, YELLOW, $entry->dn, RESET;

	for my $attr (@attrs)
	{
	    if ($#attrs < 3)
	    {
		for my $entry ($entry->get_value($attr)) {
		    say CYAN, "$attr: ", RESET, $entry;
		}
	    }
	    else {
		say CYAN, "$attr: ", RESET, join(', ', $entry->get_value($attr));
	    }
	}

	$nb++;
    }

    say "\n$nb users displayed" if ($nb > 1);

    $ldap->unbind or die ("couldn't disconnect correctly");
    return 0;
}


######################################
#                                    #
#   GROUP BLOCKS		     #
#                                    #
######################################

sub cmd_group(@)
{
    return cmd_groups($group_types{intra}, @_);
}

sub cmd_role(@)
{
    return cmd_groups($group_types{roles}, @_);
}

sub cmd_systemgrp(@)
{
    return cmd_groups($group_types{system}, @_);
}

sub cmd_groups($@)
{
    my $ou = shift;
    my $gname = shift;

    if ($gname && $gname =~ /^(2[0-9]{3})$/)
    {
	$ou = "ou=$1,$ou";
	$gname = shift;
    }

    if (! $gname) {
	pod2usage(-verbose => 99,
		  -sections => [ 'GROUP COMMANDS' ],
		  -exitval => 1);
    }

    my $subcmd = shift // "view";

    if (! exists $cmds_group{$subcmd}) {
	log(USAGE, "Unknown command for group: ". $subcmd);
	return 1;
    }

    return $cmds_group{$subcmd}($ou, $gname, @_);
}

sub cmd_group_multiple_vieworchange
{
    my $type = shift;
    my $typeName = shift;
    my $ou = shift;
    my $gname = shift;
    my $action = shift // "list";
    my $change = shift;

    if (($action ne "list" and $action ne "add" and $action ne "del" and $action ne "flush") or (!$change and $action ne "list" and $action ne "flush")) {
	log(USAGE, "lpt group [year] <group-name> $typeName [list|add|del|flush] [string]");
	return 1;
    }

    my $ldap;
    eval {
	$ldap = LDAP::ldap_connect() if ($action ne "list");
	$ldap = LDAP::ldap_connect_anon() if ($action eq "list");
    };
    log(ERROR, $@) if ($@);

    my $dn;
    eval {
	$dn = LDAP::search_dn($ldap, $ou, "cn=$gname");
    };
    log(ERROR, $@) if ($@);
    my @attr = LDAP::get_attribute($ldap, $dn, $type);

    if ($action eq "add")
    {
	log(INFO, "Adding ", BOLD, YELLOW, $change, RESET, " as ", $typeName, "s for ", YELLOW, $gname, RESET, " ...");

	if (LDAP::add_attribute($ldap, $dn, $type, $change)) {
	    log(DONE, "Done!");
	}
    }
    elsif ($action eq "del")
    {
	log(INFO, "Deleting ", BOLD, YELLOW, $change, RESET, " as ".$typeName."s for ", YELLOW, $gname, RESET, " ...");

	if (LDAP::delete_attribute($ldap, $dn, $type, $change)) {
	    log(DONE, "Done!");
	}
    }
    elsif ($action eq "flush")
    {
	log(DONE, YELLOW, $gname, RESET, " have no more $typeName.") if LDAP::flush_attribute($ldap, $dn, $type);
    }
    else
    {
	if (@attr)
	{
	    log(INFO, BOLD, YELLOW, $gname, RESET, "'s ".$typeName."s are:");
	    for my $val (@attr) {
		say "  -  $val";
	    }
	}
	else {
	    log(INFO, YELLOW, $gname, RESET, " have no $typeName.");
	}
    }

    $ldap->unbind or die ("couldn't disconnect correctly");
    return 0;
}

sub cmd_group_vieworchange
{
    my $type = shift;
    my $typeName = shift;
    my $ou = shift;
    my $gname = shift;

    if ($#_ > 0) {
	log(USAGE, "<lpt> group <group-name> $typeName [new_string]");
	return 1;
    }

    my $change = shift;

    my $ldap;
    eval {
	$ldap = LDAP::ldap_connect() if ($change);
	$ldap = LDAP::ldap_connect_anon() if (!$change);
    };
    log(ERROR, $@) if ($@);

    my $dn;
    eval {
	$dn = LDAP::search_dn($ldap, $ou, "cn=$gname");
    };
    log(ERROR, $@) if ($@);
    my $attr = LDAP::get_attribute($ldap, $dn, $type);

    if ($change)
    {
	log(INFO, "Setting $typeName to ", YELLOW, BOLD, $change, RESET " for ", YELLOW, $gname, " ...");

	LDAP::update_attribute($ldap, $dn, $type, $change);

	log(DONE, "Done!");
    }
    elsif ($attr) {
	log(INFO, YELLOW, $gname, RESET, "'s $typeName is ", BOLD, YELLOW, $attr, RESET, ".");
    }
    else {
	log(INFO, YELLOW, $gname, RESET, "'s has no $typeName.");
    }

    $ldap->unbind or die ("couldn't disconnect correctly");
    return 0;
}

sub cmd_group_view
{
    my $ou = shift;
    my $gname = shift;

    my $ldap = LDAP::ldap_connect_anon();

    my $dn;
    eval {
	$dn = LDAP::search_dn($ldap, $ou, "cn=$gname");
    };
    log(ERROR, $@) if ($@);
    my @classes = LDAP::get_attribute($ldap, $dn, 'objectClass');

    log(DEBUG, "objectClasses: ", join(', ', @classes));

    my @attrs;
    if ($#_ >= 0) {
	push @attrs, @_;
    }
    else
    {
	push @attrs, 'intraRight' if (grep { "intraGroup" } @classes);
	push @attrs, 'cn', 'memberUid' if (grep { "posixGroup" } @classes);
    }

    log(DEBUG, "attrs to get: " . join(', ', @attrs));
    my @res = LDAP::get_dn($ldap, $dn, @attrs);

    my $nb = 0;
    for my $entry (@res)
    {
	say "==" if ($nb > 0);
	say BOLD, YELLOW, "dn: ", RESET, YELLOW, $entry->dn, RESET;

	for my $attr (@attrs)
	{
	    if ($#attrs < 3)
	    {
		for my $entry ($entry->get_value($attr)) {
		    say CYAN, "$attr: ", RESET , $entry;
		}
	    }
	    else {
		say CYAN, "$attr: ", RESET , join(', ', $entry->get_value($attr));
	    }
	}

	$nb++;
    }

    say "\n$nb groups displayed" if ($nb > 1);

    $ldap->unbind or die ("couldn't disconnect correctly");
    return 0;
}

sub cmd_group_members($@)
{
    return cmd_group_multiple_vieworchange('memberUid', 'member', @_);
}

sub cmd_group_rights($@)
{
    return cmd_group_multiple_vieworchange('intraRight', 'right', @_);
}

sub cmd_group_create
{
    my $ou = shift;
    my $gname = shift;

    log(DEBUG, "Adding dn: cn=$gname,ou=intra,ou=groups,dc=acu,dc=epita,dc=fr ...");

    my $dn = "cn=$gname,$ou";

    my $class;
    $class = "intraGroup" if ($ou ne $group_types{system});
    $class = "posixGroup" if ($ou eq $group_types{system});

    my $ldap;
    eval {
	$ldap = LDAP::ldap_connect();
    };
    log(ERROR, $@) if ($@);

    my $mesg = $ldap->add( $dn . ",dc=acu,dc=epita,dc=fr",
			   attrs => [
			       objectclass => [ "top", $class ],
			       cn => $gname,
			   ]
	);

    $ldap->unbind or die ("couldn't disconnect correctly");

    if ($mesg->code == 0)
    {
	log(DONE, "Group added: ", YELLOW, $gname, RESET);
	return 0;
    }
    else {
	log(ERROR, "Unable to add: $gname: ", RESET, $mesg->error);
    }
}

sub cmd_group_delete(@)
{
    my $ou = shift;
    my $gname = shift;

    my $dn = "cn=$gname,$ou";

    log(DEBUG, "Deleting dn: $dn ...");

    my $ldap = LDAP::ldap_connect();
    if (LDAP::delete_entry($ldap, $dn))
    {
	log DONE, "Group ", YELLOW, $gname, RESET, " successfully deleted.";
	return 0;
    }
    else
    {
	log ERROR, "Unable to delete group ", YELLOW, $gname, RESET, ".";
	return 1;
    }
}


######################################
#				     #
# LIST BLOCK			     #
#				     #
######################################

sub cmd_list(@)
{
    my $subcmd = shift;

    if (! $subcmd) {
	pod2usage(-verbose => 99,
		  -sections => [ 'LIST COMMANDS' ] );
    }
    elsif (! exists $cmds_list{$subcmd}) {
	log(USAGE, "Unknown command for list: ". $subcmd);
	return 1;
    }

    return $cmds_list{$subcmd}(@_);
}

sub cmd_list_accounts(@)
{
    my $ou = "ou=users";
    my $action = shift // "all";

    if ($action =~ /^2[0-9{3}]$/)
    {
	$ou = "ou=$action,$ou";
	$action = shift // "all";
    }

    my $ldap;
    eval {
	$ldap = LDAP::ldap_connect_anon() if ($action eq "services");
	$ldap = LDAP::ldap_connect() if ($action ne "services");
    };
    log(ERROR, $@) if ($@);

    if ($action eq "services")
    {
	my $service = shift // "*";

	my @entries = LDAP::search_dns($ldap,
				       $ou,
				       "&(labService=$service)(|(objectClass=posixAccount)(objectClass=epitaAccount))",
				       'uid',
				       'labService');

	if ($#entries < 0) {
	    log(WARN, "No account found!");
	}
	else
	{
	    for my $entry (@entries) {
		say YELLOW, $entry->get_value("uid"), "\t", RESET, join(", ", $entry->get_value("labService"));
	    }
	}
    }
    else
    {
	my $filter;
	if ($action eq "open") {
	    $filter = "&(!(loginShell=$shellFalse))(|(objectClass=posixAccount)(objectClass=epitaAccount))";
	}
	elsif ($action eq "close") {
	    $filter = "&(!(loginShell=$shellFalse))(|(objectClass=posixAccount)(objectClass=epitaAccount))";
	}
	elsif ($action eq "posix") {
	    $filter = "objectClass=posixAccount";
	}
	elsif ($action eq "intra") {
	    $filter = "objectClass=intraAccount";
	}
	elsif ($action eq "all") {
	    $filter = "|(objectClass=posixAccount)(objectClass=epitaAccount)";
	}

	my @entries = LDAP::search_dns($ldap,
				       $ou,
				       $filter,
				       'userPassword',
				       'loginShell');

	if ($#entries < 0) {
	    log(WARN, "No account found");
	}
	else
	{
	    for my $entry (@entries)
	    {
		my $closed = 0;
		$closed++ if (!$entry->get_value("userPassword") || $entry->get_value("userPassword") =~ /^\{[^\}]\}!/);
		$closed++ if (!$entry->get_value("loginShell") || $entry->get_value("loginShell") eq $shellFalse);

		if ($closed == 0) {
		    print GREEN, "Opened:\t", RESET;
		} elsif ($closed == 2) {
		    print RED, "Closed:\t", RESET;
		} else {
		    print YELLOW, "Partially closed:\t", RESET;
		}
		say $entry->dn;
	    }
	}
    }
    $ldap->unbind or die ("couldn't disconnect correctly");
    return 0;
}


######################################
#				     #
# YEAR BLOCK			     #
#				     #
######################################

sub cmd_year(@)
{
    my $year = shift;

    if ($year)
    {
	if ($year =~ /^[0-9]{4}$/)
	{
	    say BOLD, MAGENTA, ">>>", RESET, " Changing current year to: ", YELLOW, BOLD, $year, RESET;
	    log (DONE, "Done!") if (LDAP::update_attribute(undef, LDAP::YEAR_DN, "year", $year))
	}
	else {
	    say BOLD, RED, ">>>", WHITE, " $year is not a valid year.", RESET;
	    return 1;
	}
    }
    else {
	say BOLD, BLUE, ">>>", RESET, " Current year: ", YELLOW, BOLD, LDAP::get_year(), RESET;
    }
    return 0
}


######################################
#                                    #
#   QUOTA COMMAND		     #
#                                    #
######################################

sub cmd_account_quota($@)
{
    my $login = shift;

    my $action = shift // "view";

    if ($action eq "view") {
	cmd_account_quota_view($login, @_);
    }
    elsif ($action eq "sync")
    {
	if (! -d $nfsHomePrefix)
	{
	    log(FATAL, "Quota sychronization can only be performed on the NFS server.");
	    return 1;
	}

	cmd_account_quota_sync($login, 0);
    }
    else {
	cmd_account_quota_set($login, $action, @_);
    }
}

sub cmd_account_quota_view($@)
{
    my $login = shift;

    my $ldap;
    eval {
	$ldap = LDAP::ldap_connect_anon();
    };
    log(ERROR, $@) if ($@);

    my $dn;
    eval {
	$dn = LDAP::search_dn($ldap, "ou=users", "uid=$login");
    };
    log(ERROR, $@) if ($@);
    my $entry = LDAP::get_dn($ldap, $dn, 'quotaHomeBlock', 'quotaHomeFile', 'quotaSgoinfreBlock', 'quotaSgoinfreFile');

    say BOLD, YELLOW, "dn: ", RESET, YELLOW, $entry->dn, ":", RESET;
    say " - ", BLUE, "Home blocks:\t\t", RESET, ($entry->get_value("quotaHomeBlock") or "(standard)");
    say " - ", BLUE, "Home files:\t\t", RESET, ($entry->get_value("quotaHomeFile") or "(standard)");
    say " - ", BLUE, "Sgoinfre blocks:\t", RESET, ($entry->get_value("quotaSgoinfreBlock") or "(standard)");
    say " - ", BLUE, "Sgoinfre files:\t", RESET, ($entry->get_value("quotaSgoinfreFile") or "(standard)");

    $ldap->unbind or die ("couldn't disconnect correctly");
}

sub cmd_account_quota_set($@)
{
    my $login = shift;

    if ($#_ < 2 || $#_ > 2)
    {
	log(USAGE, "<lpt> account <login> quota <volume> <type> <value>");
	say "    With:\n\tvolume := home | sgoinfre\n\ttype := file | block\n\tvalue := [+-]?[0-9]+[TGMk]?";
	return 1;
    }

    my $volume = shift;
    my $type   = shift;
    my $value  = shift;

    # check args
    log(ERROR, "Volume must be home or sgoinfre; given: $volume") if (!($volume eq "home" || $volume eq "sgoinfre"));
    log(ERROR, "Type must be file or block; given: $type") if (!($type eq "file" || $type eq "block"));

    # generate quotaName
    my $quotaName = "quota";
    $quotaName .= "Home" if ($volume eq "home");
    $quotaName .= "Sgoinfre" if ($volume eq "sgoinfre");
    $quotaName .= "File" if ($type eq "file");
    $quotaName .= "Block" if ($type eq "block");

    my $ldap;
    eval {
	$ldap = LDAP::ldap_connect() if ($value);
	$ldap = LDAP::ldap_connect_anon() if (!$value);
    };
    log(ERROR, $@) if ($@);

    my $dn;
    eval {
	$dn = LDAP::search_dn($ldap, "ou=users", "uid=$login");
    };
    log(ERROR, $@) if ($@);
    my $entry = LDAP::get_dn($ldap, $dn, $quotaName);

    my $old_value = $entry->get_value($quotaName) // $def_quota{$type}{$volume};

    if (!$value)
    {
	say YELLOW, "dn: ", $entry->dn, RESET;
	say BLUE, $quotaName, ": ", RESET, $old_value;
	return 0;
    }

    my $nb;

    if ($value =~ '([0-9]+)([MKGTmkgt]?)')
    {
	$nb = $1;
	$nb *= 1024 if ($2 eq "K" or $2 eq "k");
	$nb *= 1048576 if ($2 eq "M" or $2 eq "m");
	$nb *= 1073741824 if ($2 eq "G" or $2 eq "g");
	$nb *= 1099511627776 if ($2 eq "T" or $2 eq "t");
    }

    if ($value =~ '^\+([0-9]+)([MKGTmkgt]?)$')
    {
	$value = $old_value + $nb;
    }
    elsif ($value =~ '^-([0-9]+)([MKGTmkgt]?)$')
    {
	$value = $old_value - $nb;
    }
    elsif ($value !~ /^[0-9]+[MKGTmkgt]?$/) {
	log(ERROR, "Value must be an integer or +i or -i");
    }
    else {
	$value = $nb;
    }

    log(INFO, "Changing quota of $quotaName of $login to $value...");

    if (LDAP::update_attribute($ldap, $dn, $quotaName, $value)) {
	log(DONE, "Done!");
    }

    $ldap->unbind;
}

sub cmd_account_quota_sync($;$)
{
    my $login = shift;
    my $nosync = shift;

    my $ldap;
    eval {
	$ldap = LDAP::ldap_connect_anon();
    };
    log(ERROR, $@) if ($@);

    my $dn;
    eval {
	$dn = LDAP::search_dn($ldap, "ou=users", "(&(uid=$login)(objectClass=labAccount))");
    };
    log(ERROR, $@) if ($@);
    my $entry = LDAP::get_dn($ldap, $dn,
			     'uid', 'uidNumber',
			     'quotaHomeBlock', 'quotaHomeFile',
			     'quotaSgoinfreBlock', 'quotaSgoinfreFile');

    my $quotaHomeBlock = $entry->get_value("quotaHomeBlock") // $def_quota{block}{home};
    my $quotaHomeFile = $entry->get_value("quotaHomeFile") // $def_quota{file}{home};
    my $quotaSgoinfreBlock = $entry->get_value("quotaSgoinfreBlock") // $def_quota{block}{sgoinfre};
    my $quotaSgoinfreFile = $entry->get_value("quotaSgoinfreFile") // $def_quota{file}{sgoinfre};

    require Quota;

    if (Quota::setqlim($dev_quota{home}, $entry->get_value("uidNumber"), int(0.9 * $quotaHomeBlock), $quotaHomeBlock, int(0.9 * $quotaHomeFile), $quotaHomeFile, 1, 0) == 0 and
	Quota::setqlim($dev_quota{sgoinfre}, $entry->get_value("uidNumber"), int(0.9 * $quotaSgoinfreBlock), $quotaSgoinfreBlock, int(0.9 * $quotaSgoinfreFile), $quotaSgoinfreFile, 1, 0) == 0) {
	log(DONE, YELLOW, $login, RESET, "'s quota synchronized!");
    }
    else {
	log(ERROR, "An error occurs during quota synchronization: ", Quota::strerr());
	return 2;
    }

    $ldap->unbind or die ("couldn't disconnect correctly");

    if (!$nosync)
    {
	Quota::sync($dev_quota{home});
	Quota::sync($dev_quota{sgoinfre});
    }

    return 0;
}

sub cmd_sync_quota(@)
{
    require Quota;

    # Set root quota
    Quota::setqlim($dev_quota{home}, 0, 0, 0, 0, 0, 1, 0);
    Quota::setqlim($dev_quota{sgoinfre}, 0, 0, 0, 0, 0, 1, 0);

    my $ldap;
    eval {
	$ldap = LDAP::ldap_connect_anon();
    };
    log(ERROR, $@) if ($@);

    my @entries = LDAP::search_dns($ldap, "ou=users", "(objectClass=labAccount)", "uid");

    $ldap->unbind or die ("couldn't disconnect correctly");

    for my $entry (@entries) {
	cmd_account_quota_sync($entry->get_value("uid"), 1);
    }

    Quota::sync($dev_quota{home});
    Quota::sync($dev_quota{sgoinfre});
}


######################################
#                                    #
#   STRONG_AUTH COMMAND		     #
#                                    #
######################################

sub cmd_strong_auth(@)
{
    my $subcmd = shift // "view";

    if (! exists $cmds_strong_auth{$subcmd}) {
	log(USAGE, "Unknown command for strong_auth: ". $subcmd);
	return 1;
    }

    return $cmds_strong_auth{$subcmd}(@_);
}

sub get_no_strong_auth_user()
{
    my @faulty_users;

    my $ldap;
    eval {
	$ldap = LDAP::ldap_connect_anon();
    };
    log(ERROR, $@) if ($@);

    my @entries = LDAP::search_dns($ldap, "ou=users", "&(&(objectClass=labAccount)(!(homeDirectory=/dev/null)))(!(loginShell=/bin/false))",
				   'uid', 'cn', 'mailAlias', 'homeDirectory', 'labService');
    
    foreach my $entry (@entries)
    {
	my $home = $entry->get_value("homeDirectory");
	$home =~ s#^$wksHomePrefix#$nfsHomePrefix#;
	my $token = $home . "/.google_authenticator";
	my $login = $entry->get_value("uid");

	push @faulty_users, $entry if (! -f $token || -s $token < 90);
    }

    $ldap->unbind or die ("couldn't disconnect correctly");

    return @faulty_users;
}

sub cmd_no_strong_auth_view(@)
{
    for my $entry (get_no_strong_auth_user())
    {
	print $entry->get_value("uid");
	print " ", GREEN, "ACK", RESET if (grep { $_ eq "no-strong-auth" } $entry->get_value('labService'));
	print "\n";
    }
}

sub cmd_no_strong_auth_warn(@)
{
    require Email::Sender::Simple;
    Email::Sender::Simple->import(qw(sendmail));

    for my $entry (get_no_strong_auth_user())
    {
	next if (grep { $_ eq "no-strong-auth" } $entry->get_value('labService'));

	say $entry->get_value("uid");

	my $body = "Bonjour ".decode('UTF-8', $entry->get_value("cn"), Encode::FB_CROAK).",

Vous n'avez pas activé l'authentification forte pour SSH.

Pour connaître la marche à suivre pour l'activer, consultez :
https://www.acu.epita.fr/wiki/index.php?title=Ssh_double_factor_auth

Merci de rectifier la situation au plus vite ou votre compte sera mis
en suspens.

Cordialement,

P.-S. : Ce message est généré automatiquement, les roots sont en copie.
        Pour toute demande, merci de faire un ticket à admin\@acu.epita.fr

-- 
Les roots ACU";

	my $mail = Email::MIME->create(
	    header_str => [
		From    => "Roots assistants <admin\@acu.epita.fr>",
		To      => $entry->get_value("mailAlias"),
		Cc      => 'Roots assistants <root@acu.epita.fr>',
		Subject => "[PILA][AUTH-FORTE] Authentification forte SSH non active"
	    ],
	    attributes => {
		encoding => 'quoted-printable',
		charset  => 'utf-8',
		format   => 'flowed',
	    },
            body_str => $body,
	);
        sendmail($mail);
    }
}

sub cmd_no_strong_auth_close(@)
{
    require Email::Sender::Simple;
    Email::Sender::Simple->import(qw(sendmail));

    for my $entry (get_no_strong_auth_user())
    {
	next if (grep { $_ eq "no-strong-auth" } $entry->get_value('labService'));

	say $entry->get_value("uid");

	cmd_account_close($entry->get_value("uid"));

	my $body = "Bonjour ".decode('UTF-8', $entry->get_value("cn"), Encode::FB_CROAK).",

Après plusieurs relances de notre part, vous n'avez toujours pas activé
l'authentification forte pour SSH. Votre compte a donc été suspendu.

Nous vous invitons à passer au laboratoire pour faire réactiver votre
compte.

Cordialement,

-- 
Les roots ACU";

	# create the message
	my $mail = Email::MIME->create(
	    header_str => [
		From    => "Roots assistants <admin\@acu.epita.fr>",
		To      => $entry->get_value("mailAlias"),
		Cc      => 'Roots assistants <root@acu.epita.fr>',
		Subject => "[PILA][ACCES] Compte suspendu"
	    ],
	    attributes => {
		encoding => 'quoted-printable',
		charset  => 'utf-8',
		format   => 'flowed',
	    },
            body_str => $body,
	);
        sendmail($mail);
    }
}

######################################
#                                    #
#   SSH_KEYS COMMAND		     #
#                                    #
######################################

sub cmd_ssh_keys(@)
{
    my $subcmd = shift // "view";

    if (! exists $cmds_ssh_keys{$subcmd}) {
	log(USAGE, "Unknown command for ssh_keys: ". $subcmd);
	return 1;
    }

    return $cmds_ssh_keys{$subcmd}(@_);
}

sub get_ssh_keys_unprotected()
{
    my %keys_unprotected = qw();

    my $ldap;
    eval {
	$ldap = LDAP::ldap_connect_anon();
    };
    log(ERROR, $@) if ($@);

    my @entries = LDAP::search_dns($ldap, "ou=users", "&(objectClass=posixAccount)(!(homeDirectory=/dev/null))",
				   'uid', 'cn', 'homeDirectory');

    foreach my $entry (@entries)
    {
	my $home = $entry->get_value("homeDirectory");
	$home =~ s#^$wksHomePrefix#$nfsHomePrefix#;
	my $sshDir = $home . "/.ssh";
	my $login = $entry->get_value("uid");

	if (-d $sshDir)
	{
	    my $process_file = sub() {
		my $file = $_;
		if (-f $file)
		{
		    open my $fh, '<', $file or die $!;
		    my @lines = <$fh>;
		    close $fh;
		    if ( grep { chomp; $_ =~ /PRIVATE KEY/ } @lines )
		    {
			if (! grep { chomp; $_ =~ /ENCRYPTED/ } @lines )
			{
			    if (!exists $keys_unprotected{$login}) {
				$keys_unprotected{$login} = [$file];
			    } else {
				push(@{$keys_unprotected{$login}}, $file);
			    }
			}
		    }
		}
	    };

	    find({ wanted => \&$process_file, no_chdir => 1 }, $sshDir);
	}
    }

    $ldap->unbind or die ("couldn't disconnect correctly");

    return %keys_unprotected;
}

sub cmd_ssh_keys_without_passphrase_generic(@)
{
    my $func = shift;

    my %keys_unprotected = get_ssh_keys_unprotected();
    my $ldap;
    eval {
	$ldap = LDAP::ldap_connect_anon();
    };
    log(ERROR, $@) if ($@);

    foreach my $login (keys %keys_unprotected)
    {
	my $dn;
	eval {
	    $dn = LDAP::search_dn($ldap, "ou=users", "(uid=$login)");
	};
	log(ERROR, $@) if ($@);
	my $entry = LDAP::get_dn($ldap, $dn, 'uid', 'cn', 'mailAlias');

	# Apply func
	&$func($entry, \@{$keys_unprotected{$login}});
    }

    $ldap->unbind or die ("couldn't disconnect correctly");
}

# list unprotected keys
sub cmd_ssh_keys_without_passphrase_view(@)
{
    my $process = sub() {
	my $entry = shift;
	my $keys = shift;

	# Display
	say $entry->get_value("cn"), ":";
	for my $key (@$keys) {
	    say " * $key";
	}
	print "\n";
    };

    cmd_ssh_keys_without_passphrase_generic(\&$process);
}

# warn about unprotected keys
sub cmd_ssh_keys_without_passphrase_warn(@)
{
    require Email::Sender::Simple;
    Email::Sender::Simple->import(qw(sendmail));

    my $process = sub() {
	my $entry = shift;
	my $keys = shift;

	# Display
	say $entry->get_value("uid");

	my $body = "Bonjour ".decode('UTF-8', $entry->get_value("cn"), Encode::FB_CROAK).",

Un outil automatique a découvert une clef sans passphrase sur votre compte
du laboratoire. Il est impératif de mettre une passphrase chiffrant votre
clef pour des raisons de sécurité.

Les clefs non protégées sont les suivantes :\n";
	foreach my $key (@$keys)
	{
	    $key =~ s#^$nfsHomePrefix#$wksHomePrefix#;
	    $body .= " - $key\n";
	}
	$body .= "\nPour mettre une passphrase :
\$ ssh-keygen -p -f CHEMIN_VERS_LA_CLE_PRIVEE

Merci de rectifier la situation au plus vite ou votre clé sera supprimée et
votre compte sera mis en suspens.

Cordialement,

PS: Ce message est généré automatiquement, les roots sont en copie.
    Pour toute demande, merci de faire un ticket à admin\@acu.epita.fr

-- 
Les roots ACU";

	# create the message
	my $mail = Email::MIME->create(
	    header_str => [
		From    => "Roots assistants <admin\@acu.epita.fr>",
		To      => $entry->get_value("mailAlias"),
		Cc      => 'Roots assistants <root@acu.epita.fr>',
		Subject => "[PILA][SSH-KEY] Clef SSH non protégée"
	    ],
	    attributes => {
		encoding => 'quoted-printable',
		charset  => 'utf-8',
		format   => 'flowed',
	    },
            body_str => $body,
	);
        sendmail($mail);
    };

    cmd_ssh_keys_without_passphrase_generic(\&$process);
}

# remove unprotected keys
sub cmd_ssh_keys_without_passphrase_remove(@)
{
    require Email::Sender::Simple;
    Email::Sender::Simple->import(qw(sendmail));

    my $process = sub() {
	my $entry = shift;
	my $keys = shift;

	# Display
	say $entry->get_value("uid");

	# create the message
	my $body = "Bonjour ".decode('UTF-8', $entry->get_value("cn"), Encode::FB_CROAK).",

Un outil automatique a découvert une clef sans passphrase sur votre
compte du laboratoire.

N'ayant pas corrigé votre situation après plusieurs relances, nous avons
désactivé votre compte et supprimé le(s) clef(s) incriminées.

Pour information, voici l'empreinte de chacune des clefs supprimée :\n";
	foreach my $key (@$keys)
	{
	    open (FNGR, "ssh-keygen -l -f '$key' | cut -d ' ' -f 2 |");
	    my $fingerprint = <FNGR>;
	    chomp $fingerprint;
	    close (FNGR);

	    unlink($key);

	    $key =~ s#^$nfsHomePrefix#$wksHomePrefix#;
	    $body .= " - $key: $fingerprint\n";
	}
	$body .= "\n
Contacter les roots pour faire reouvrir votre compte.

Cordialement,

PS: Ce message est généré automatiquement, les roots sont en copie.
    Pour toute demande, merci de faire un ticket à admin\@acu.epita.fr

-- 
Les roots ACU";

	my $mail = Email::MIME->create(
	    header_str => [
		From    => "Roots assistants <admin\@acu.epita.fr>",
		To      => $entry->get_value("mailAlias"),
		Cc      => 'Roots assistants <root@acu.epita.fr>',
		Subject => "[PILA][SSH-KEY] Clef SSH non protégée supprimée"
	    ],
	    attributes => {
		encoding => 'quoted-printable',
		charset  => 'utf-8',
		format   => 'flowed',
	    },
            body_str => $body,
	);
        sendmail($mail);
    };

    cmd_ssh_keys_without_passphrase_generic(\&$process);
}


######################################
#                                    #
#   MAIN CORE			     #
#                                    #
######################################

sub cmd_help
{
    pod2usage(-exitval => 1, -verbose => 2);
}

if ($#ARGV == -1) {
    cmd_help();
    exit(1);
}

my $cmd = shift;

if ($cmd eq "-v" or $cmd eq "--verbose" or $cmd eq "--debug") {
    $ACU::Log::display_level = 8;
    $cmd = shift;
}
elsif ($cmd eq "-q" or $cmd eq "--quiet") {
    $ACU::Log::display_level = 6;
    $cmd = shift;
}
elsif ($cmd eq "-y" or $cmd eq "--yes") {
    $noconfirm = 1;
    $cmd = shift;
}

$ACU::Log::fatal_error = 1;
$ACU::Log::fatal_warn = 0;

if (! exists $cmds{$cmd})
{
    say BOLD, "Usage: ", RESET, "$0 ", GREEN, "command", RESET, " <arguments>";
    log(ERROR, "Uknown command : $cmd");
}

exit ($cmds{$cmd}(@ARGV));

__END__
=head1 NAME

lpt - Lab Power Tool

=head1 SYNOPSIS

B<lpt> I<command> [arguments]

I<command> can be:

B<lpt> I<account> <login> [arguments]

	Manage the account <login>.

B<lpt> I<group> [year] <group-name> [arguments]

	Manage the intranet group <group-name> for the current or given year.

B<lpt> I<help>

	Display this screen.

B<lpt> I<role> [year] <role-name> [arguments]

	Manage the intranet role <role-name> for the current or given year.

B<lpt ssh-keys> [view|warn|remove]

	Search for users with SSH keys without passphrase. Warn the users and
        remove them if requested.

B<lpt strong-auth> [view|warn|close]

	Search for users without strong authentication. Warn the users and
        close its account if requested.

B<lpt sync-quota>

        Sync the quota of all users.

B<lpt> I<system-group> <group-name> [arguments]

	Manage the system group <group-name>.

B<lpt> I<year> [year]

	Display or set the current year.


=head1 ACCOUNT COMMANDS

B<lpt account> <login> [I<view> [I<attribute> [I<attribute> [...]]]]

	Display information about <login>.

	<login> can be a globbing string.

        If <attribute> are given, display only those attributes.

B<lpt account> <login> I<add> [./passwd] [nopass|password|passgen]

	This is used to create a new Epita account, base for intra and/or lab account.

	This will use the passwd file given in argument to import information about the login.

B<lpt account> <login> I<create> <promo> <uid> <Prenom> <Nom> [nopass|password|passgen]

	This is used to create a new Epita account, base for intra and/or lab account.

	Promo for professor are professors, other people are guests.

B<lpt account> <login> I<grant-intra>

	Give rights to the user to access the intranet.

B<lpt account> <login> I<grant-lab> <acu | yaka | ferry>

	Give rights to the user to access intern systems of the laboratory (SSH, Unix, ...)

        If ferry is given, open an account for exam only, with restricted rights.

B<lpt account> <login> I<grant-mail>

	Give rights to the user to receive e-mails.

B<lpt account> <login> I<alias> [list|add|del|flush] [string]

	This is used to manage e-mail aliases.

B<lpt account> <login> I<close>

	This is used to close an existing account.

B<lpt account> <login> I<delete>

	This is used to delete an existing account.
        NEVER DELETE AN ACCOUNT, close it instead.

B<lpt account> <login> I<mail> [new-mail]

	This is used to display, or change if [new-mail] is given, the account contact adress.

B<lpt account> <login> I<name> [new-name]

	This is used to display, or change if [new-name] is given, the account common name.

B<lpt account> <login> I<reopen>

	This is used to reopen a previously closed account.

B<lpt account> <login> I<shell> <shell path>

	This is used to change default shell for an existing accout.

B<lpt account> <login> I<nopass>

	This is used to erase the user password.

B<lpt account> <login> I<passgen> [nb_char]

	This is used to set user password. Generated by pwgen.

	nb_char must be at least egal to 10.

B<lpt account> <login> I<password> [password]

	This is used to set user password. Interactively asked if not given.

B<lpt account> I<mail> <login> [new]

	This is used to get user email (to which are forwarded its emails) if
	'new' is empty, and to change it if the 'new' adress is given.

B<lpt account> <login> I<services> [list|add|del|flush] [string]

	Manage services associated to the <login>.

B<lpt account> <login> I<rights> [list|add|del|flush] [string]

	Manage rights associated to the <login>.


=head1 GROUP COMMANDS

B<lpt group|role|system-group> [I<year>] <group-name> [I<view> [I<attribute> [I<attribute> [...]]]]

	This is used to view general informations on the group-name. If attributes are given, display only those one.

B<lpt group|role> I<year> <group-name> I<create>

	This is used to create a new intra group into the OU <year>.

B<lpt system-group> <group-name> I<create>

	This is used to create a new POSIX group.

B<lpt group|role|system-group> [I<year>] <group-name> I<members> [list|add|del|flush] [string]

	This is used to manage group members.

B<lpt group|role> [I<year>] <group-name> I<rights> [list|add|del|flush] [string]

	This is used to manage rights on the group.

B<lpt group|role|system-group> [I<year>] <group-name> I<delete>

	This is used to delete a group.


=head1 LIST COMMANDS

B<lpt> I<list> accounts [year] <open | close | services | posix | intra> [service]

	List accounts: with access to the PILA, without, with access to services, with a POSIX account, with an intra accout.


=head1 QUOTA COMMANDS

B<lpt quota> I<show> <login>

	Display the quota of everyone or someone.

B<lpt quota> I<set> <login> <volume> <type> <value>

	Set the quota of someone. Volume is home/sgoinfre and type is
        block/file.


=head1 DESCRIPTION

B<lpt> is a tool developed to replace old perl scripts used to manage accounts, and some other stuff.
The goal was to give an unique tool with meaningful commands to perform usual operations. lpt is born from ipt.

=head1 AUTHORS

Project started by : Adnan Aita <I<ski@epita.fr>>, root@acu 2006

Modified by Laroche Emeric <I<laroch_e@epita.fr>>, root@acu 2007

Modified by Sterckeman Julien <I<sterck_j@epita.fr>>, root@acu 2008

Modified by Sebastien Luttringer <I<seblu@epita.fr>>, root@acu 2008

Modified by Vincent Nguyen <I<nguyen_v@epita.fr>>, root@acu 2010

Modified by JB et Antoine <I<root@acu.epita.fr>>, root@acu 2012

Modified by megra <I<j@marguerie.org>>, root@acu 2013 : added tons of features :)

Strongly modified by nemunaire <I<nemunaire@nemunai.re>>, root@acu 2014, introducing Lab 2.0!

=head1 VERSION

This is B<lpt> version 2.0.

=head1 BUGS

No bug, just features.

=cut