#!/usr/bin/perl

use v5.10.1;
use strict;
use warnings;

use Digest::SHA1;
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 Quota;

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

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

my $ldaphost = "ldap.acu.epita.fr";
my $ldapuri = "ldaps://ldap.acu.epita.fr";
my $binddn = "cn=admin,dc=acu,dc=epita,dc=fr";
my $bindsecret = '';
my $login = "";

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

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 } );

###########################################################
#                                                         #
#                  Messages subroutines                   #
#                                                         #
###########################################################

my $verbosity = 1;
my $debug = 0;

sub do_err($)
{
    say BOLD, RED, ">>>", RESET, " ", BOLD, @_, RESET;
    exit(1);
}

sub do_usage($)
{
    say BOLD, MAGENTA, " * ", RESET, " ", BOLD, @_, RESET;
}

sub do_warn($)
{
    say BOLD, YELLOW, ">>>", RESET, " ", BOLD, @_, RESET;
}

sub do_info($)
{
    if ($verbosity) {
	say BOLD, CYAN, " * ", RESET, " ", @_, RESET;
    }
}

sub do_debug($)
{
    if ($debug) {
	say BOLD, BLUE, " * ", RESET, " ", @_, RESET;
    }
}


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

my $dbh;

my %cmds =
(
  "account"	=> \&cmd_account,
  "group"	=> \&cmd_group,
  "help"	=> \&cmd_help,
  "list"	=> \&cmd_list,
);

my %cmds_account =
(
  "alias"	  => \&cmd_account_alias,
  "close"	  => \&cmd_account_close,
  "cn"		  => \&cmd_account_cn,
  "create"	  => \&cmd_account_create,
  "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,
  "view"	  => \&cmd_account_view,

  "open"	  => \&cmd_account_open,
);

my %cmds_group =
(
  "list"	=> \&cmd_group_list,
  "add"		=> \&cmd_group_add,
  "remove"	=> \&cmd_group_remove,
  "create"	=> \&cmd_group_create,
  "delete"	=> \&cmd_group_delete
);

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


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

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

    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;
}

sub ldap_connect()
{
    if ($bindsecret eq "") {
	ldap_get_password();
    }

    my $ldap = Net::LDAPS->new($ldaphost) or do_err ("$@");
    my $mesg = $ldap->bind($binddn, password => $bindsecret) or do_err ("$@");

    if ($mesg->code) {
	die "An error occurred: " .ldap_error_text($mesg->code)."\n";
    }

    return $ldap;
}

sub ldap_connect_anon()
{
    my $ldap = Net::LDAPS->new($ldaphost) or do_err ("$@");
    my $mesg = $ldap->bind or do_err ("$@");

    if ($mesg->code) {
	die "An error occurred: " .ldap_error_text($mesg->code)."\n";
    }

    return $ldap;
}

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

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

    if (! $login) {
	do_usage "lpt account <login> <command> [arguments ...]";
	return 1;
    }

    my $subcmd = shift // "view";

    if (! $subcmd) {
	pod2usage(-verbose => 99,
		  -sections => [ 'ACCOUNT COMMANDS' ] );
    }
    elsif (! exists $cmds_account{$subcmd}) {
	do_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) {
	do_usage ("<lpt> account <login> close");
	return -1;
    }

    my $ldap = ldap_connect();

    my $mesg = $ldap->search( # search
			      base   => "ou=users,dc=acu,dc=epita,dc=fr",
			      filter => "uid=$login",
			      attrs => ['objectClass', 'userPassword', 'loginShell'],
			      scope => "sub"
	);
    if ($mesg->code != 0) {
	do_err $mesg->error;
    }
    if ($mesg->count != 1) {
	do_err "User $login not found or multiple presence";
    }

    if (grep { "epitaAccount" } $mesg->entry(0)->get_value("objectClass")) {
	do_info "Invalidating password for $login ...";

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

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

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

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

    do_warn "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_create($@)
{
    my $login = shift;

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

    ldap_get_password();
    my $group = shift;
    my $uid = shift;
    my $firstname = shift;
    my $lastname = shift;
    my $pass = shift // "nopass";
    my $ldif = <<"EOF";
dn: uid=$login,ou=$group,ou=users,dc=acu,dc=epita,dc=fr
objectClass: epitaAccount
cn: $firstname $lastname
mail: $login\@epita.fr
uid: $login
uidNumber: $uid
EOF

    open(LDIF, "|-", "ldapadd -x -H '$ldapuri' -w '$bindsecret' -D '$binddn'") || do_err("error !\n");
    say LDIF $ldif;
    close(LDIF);

    if ($? == 0) {
	do_info("Account added: $login");
	return cmd_account($login, $pass) if ($pass ne "nopass");
	return 0;
    }
    else {
	do_err("Unable to add: $login");
    }
}

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

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

    my $ldap = ldap_connect();

    my $mesg = $ldap->search( # search
			      base   => "ou=users,dc=acu,dc=epita,dc=fr",
			      filter => "uid=$login",
			      attrs => ['userPassword'],
			      scope => "sub"
	);
    if ($mesg->code != 0) {
	do_err $mesg->error;
    }
    if ($mesg->count != 1) {
	do_err "User $login not found";
    }

    my $pass = $mesg->entry(0)->get_value("userPassword");

    if (! $pass || $pass eq "{crypt}!toto") {
	$mesg = $ldap->unbind;
	do_warn "Password already empty";
	return 2;
    }
    else {
	printf(STDERR "Are you sure you want to reset password for $login? [y/N] ");
	if (getc(STDIN) ne "y") {
	    do_debug "y response expected to continue; leaving.";
	    do_warn "Password unchanged for $login.";
	    return 2;
	}

	$mesg = $ldap->search( # search
			       base   => "ou=users,dc=acu,dc=epita,dc=fr",
			       filter => "uid=$login",
			       attrs => ['userPassword'],
			       scope => "sub"
	    );
	if ($mesg->code != 0) {
	    do_err $mesg->error;
	}
	if ($mesg->count != 1) {
	    do_err "User $login not found";
	}

	$mesg->entry(0)->replace("userPassword" => "{crypt}!toto");
	$mesg->entry(0)->update($ldap);

	do_info "$login 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) {
	do_usage "lpt account <login> passgen [nb_char>=10]";
	return 1;
    }

    printf(STDERR "Are you sure you want to change password for $login? [y/N] ");
    my $go = <STDIN>;
    chomp $go;
    if ($go ne "y" and $go ne "yes") {
	do_debug "y response expected to continue, leaving.";
	do_warn "Password unchanged for $login.";
	return 2;
    }

    do_debug "Generating a $nb_char chars password...";
    my $pass = "";
    open (HANDLE, "pwgen -s -n -c -y -1 $nb_char 1 |");
    while(<HANDLE>) {
	$pass = $_;
    }
    close(HANDLE);
    chomp($pass);

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

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

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

    if (! $pass) {
	say "Changing password for $login.";

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

	do_debug "Read passwords: $pass1 and $pass2";

	$pass1 eq $pass2 || do_err "Passwords did not match.";
	$pass = $pass1;
    }

    if ($pass eq "") {
	do_err "Empty password refused.";
    }

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

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

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

    my $ldap = ldap_connect();

    my $mesg = $ldap->search( # search
			      base   => "ou=users,dc=acu,dc=epita,dc=fr",
			      filter => "uid=$login",
			      attrs => ['userPassword'],
			      scope => "sub"
	);
    if ($mesg->code != 0) {
	do_err $mesg->error;
    }
    if ($mesg->count != 1) {
	do_err "User $login not found";
    }

    $mesg->entry(0)->replace("userPassword" => $enc_password);
    $mesg->entry(0)->update($ldap);
    $ldap->unbind or die ("couldn't disconnect correctly");
    return 0;
}

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

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

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

    my $ldap = ldap_connect();

    my $mesg = $ldap->search( # search
			      base   => "ou=users,dc=acu,dc=epita,dc=fr",
			      filter => "uid=$login",
			      attrs => ['objectClass', 'cn', 'userPassword', 'loginShell'],
			      scope => "sub"
	);
    if ($mesg->code != 0) {
	do_err $mesg->error;
    }
    if ($mesg->count != 1) {
	do_err "User $login not found or multiple presence";
    }

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

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

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

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

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

    do_warn "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")) {
	do_usage "<lpt> account <login> $typeName [list|add|del|flush] [string]";
	return 1;
    }

    my $ldap;
    $ldap = ldap_connect() if ($action ne "list");
    $ldap = ldap_connect_anon() if ($action eq "list");
    my $mesg = $ldap->search( # search
			      base   => "ou=users,dc=acu,dc=epita,dc=fr",
			      filter => "uid=$login",
			      attrs => [ $type ],
			      scope => "sub"
	);
    if ($mesg->code != 0) {
	do_err $mesg->error;
    }
    if ($mesg->count != 1) {
	do_err "User $login not found or multiple presence";
    }

    if ($action eq "add") {
	do_info "Adding $change as ".$typeName."s for $login ...";

	my @data = $mesg->entry(0)->get_value($type);
	if (! grep(/^$change$/, @data)) {
	    push @data, $change;
	    $mesg->entry(0)->replace($type => \@data) or die $!;
	    $mesg->entry(0)->update($ldap) or die $!;

	    do_info "Done!";
	}
	else {
	    do_warn "$login has already $change $typeName.";
	}
    }
    elsif ($action eq "del") {
	do_info "Checking if $change is a ".$typeName."s of $login ...";
	my @data = $mesg->entry(0)->get_value($type);
	if (grep(/^$change$/, @data)) {
	    do_info "Deleting $change as $typeName for $login ...";

	    @data = grep(!/$change$/, @data);

	    $mesg->entry(0)->replace($type => \@data) or die $!;
	    $mesg->entry(0)->update($ldap) or die $!;

	    do_info "Done!";
	}
	else {
	    do_warn "$change is not a $typeName for $login.";
	}
    }
    elsif ($action eq "flush") {
	$ldap->modify($mesg->entry(0)->dn, delete => [$type]);
	do_info "$login have no more $typeName.";
    }
    else {
	if ($mesg->entry(0)->get_value($type)) {
	    do_info $login."'s ".$typeName."s are:";
	    for my $val ($mesg->entry(0)->get_value($type)) {
		say "  -  $val";
	    }
	}
	else {
	    do_info "$login 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) {
	do_usage ("<lpt> account <login> $typeName [new_string]");
	return 1;
    }

    my $change = shift;

    my $ldap;
    $ldap = ldap_connect() if ($change);
    $ldap = ldap_connect_anon() if (!$change);
    my $mesg = $ldap->search( # search
			      base   => "ou=users,dc=acu,dc=epita,dc=fr",
			      filter => "uid=$login",
			      attrs => [ $type ],
			      scope => "sub"
	);
    if ($mesg->code != 0) {
	do_err $mesg->error;
    }
    if ($mesg->count != 1) {
	do_err "User $login not found or multiple presence";
    }

    if ($change) {
	do_info "Setting $typeName to $change for $login ...";

	$mesg->entry(0)->replace($type => $change) or die $!;
	$mesg->entry(0)->update($ldap) or die $!;

	do_info ("Done!");
    }
    else {
	do_info $login."'s $typeName is ".$mesg->entry(0)->get_value($type).".";
    }

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

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

    my $ldap = ldap_connect_anon();

    my $mesg = $ldap->search(base   => "ou=users,dc=acu,dc=epita,dc=fr",
			     filter => "uid=$login",
			     attrs  => ['objectClass']);

    $mesg->code && do_err $mesg->error;
    if ($mesg->count <= 0) {
	do_err "No such account!";
    }

    do_debug "objectClasses:\t" . join(', ', $mesg->entry(0)->get_value("objectClass"));

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

    do_debug "attrs to get: " . join(', ', @attrs);
    $mesg = $ldap->search(base   => "ou=users,dc=acu,dc=epita,dc=fr",
			  filter => "uid=$login",
			  attrs  => \@attrs);
    $mesg->code && die $mesg->error;

    shift @attrs; # Remove dn
    my $nb = 0;
    for my $entry ($mesg->entries)
    {
	if ($nb > 0) {
	    say "==";
	}
	say BOLD, YELLOW, "dn: ", RESET, YELLOW, $entry->dn, RESET;

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

	$nb++;
    }

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

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


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

sub cmd_group(@)
{
    my $gname = shift;

    if (! $gname) {
	do_usage "lpt group <group-name> <command> [arguments ...]";
	return 1;
    }

    my $subcmd = shift // "view";

    if (! $subcmd) {
	pod2usage(-verbose => 99,
		  -sections => [ 'GROUP COMMANDS' ] );
    }
    elsif (! exists $cmds_group{$subcmd}) {
	do_usage "Unknown command for group: ". $subcmd;
	return 1;
    }

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

sub cmd_group_list(@)
{
    if ($#ARGV > 0)
    {
	do_usage ("<lpt> group list [group]");
	exit(1);
    }

    my $group = $ARGV[0];
    my $ldap = ldap_connect_anon();
    if ($#ARGV == 0)
    {
	my $mesg = $ldap->search( # search a group
				  base   => "cn=$group,ou=groups,dc=acu,dc=epita,dc=fr",
				  filter => "objectClass=posixGroup",
				  attrs => ['memberUid']
	    );
	$mesg->code && die $mesg->error;
	$mesg->count > 0 || return -1;

	foreach my $entry ($mesg->sorted('memberUid'))
	{
	    foreach my $user ($entry->get_value("memberUid"))
	    {
		print "$user\n";
	    }
	}
    }
    else
    {
	my $mesg = $ldap->search( # list groups
				  base   => "ou=groups,dc=acu,dc=epita,dc=fr",
				  filter => "objectClass=posixGroup",
				  attrs => ['cn', 'gidNumber']
	    );


    	$mesg->code && die $mesg->error;
    	$mesg->count > 0 || return -1;

    	foreach my $entry ($mesg->sorted('gidNumber'))
	{
	    print $entry->get_value("cn")." --->";
	    print $entry->get_value("gidNumber")."\n";
	}
    }

    $ldap->unbind;   # take down session
}

sub cmd_group_add(@)
{
    if ($#ARGV < 1)
    {
	do_usage ("<lpt> group add <group> <login>");
    	exit(1);
    }

    my $group = $ARGV[0];
    my $login = $ARGV[1];

    my $ldap = ldap_connect();

    my $mesg = $ldap->search( # search a group
			      base   => "cn=$group,ou=groups,dc=acu,dc=epita,dc=fr",
			      filter => "objectClass=posixGroup",
			      attrs => ['memberUid']
	) or die $!;
    $mesg->code && die $mesg->error;
    $mesg->count > 0 || return -1;

    foreach my $entry ($mesg->sorted('memberUid'))
    {
	my @mem = $entry->get_value("memberUid");

	foreach my $user (@mem)
        {
	    if ($user eq $login)
	    {
		print "$login est deja dans le groupe $group\n";
		$ldap->unbind;
		exit -1;
	    }
	}

	push(@mem, $login);
	$entry->replace("memberUid" => [@mem]);
        $entry->update($ldap);

	print "Nouvelle liste des membres de $group :\n";
    	foreach my $user (@mem)
        {
	    print "$user\n";
        }
    }
    $ldap->unbind;   # take down session

    system('service nscd restart');
}

sub cmd_group_remove(@)
{
    if ($#ARGV < 1)
    {
        do_usage ("<lpt> group remove <group> <login>");
        exit(1);
    }

    my $group = $ARGV[0];
    my $login = $ARGV[1];

    my $ldap = ldap_connect();

    my $mesg = $ldap->search( # search a group
			      base   => "cn=$group,ou=groups,dc=acu,dc=epita,dc=fr",
			      filter => "objectClass=posixGroup",
			      attrs => ['memberUid']
	);
    $mesg->code && die $mesg->error;
    $mesg->count > 0 || return -1;

    foreach my $entry ($mesg->sorted('memberUid'))
    {
        my @mem = $entry->get_value("memberUid");
	my $found = 0;
        foreach my $user (@mem)
        {
            if ($user eq $login)
	    {
		$found = 1;
	    }
        }

	if ($found)
    	{
	    @mem = grep(!/$login$/, @mem);
	    $entry->replace("memberUid" => [@mem]);
    	    $entry->update($ldap);
    	}
    	else
    	{
    	    print "$login n'est pas dans le groupe $group\n";
    	}

        print "Nouvelle liste des membres de $group :\n";
        foreach my $user (@mem)
        {
            print "$user\n";
        }

    }
    $ldap->unbind;   # take down session

    system('service nscd restart');
}

sub cmd_group_create(@)
{
    if ($#ARGV != 1)
    {
	do_usage ("<lpt> group create <yaka|acu> <year>");
	exit(1);
    }

    ldap_get_password();
    my $ldif = "";
    my $type = $ARGV[0];
    my $year = $ARGV[1];
    my $group = $type . $year;
    my $ldif_path = dirname(__FILE__) . "/base-group.ldif";

    my $gid;
    if ($type eq "acu")
    {
	$gid = $year;
    }
    elsif ($type eq "yaka")
    {
	$gid = $year - 1000;
    }
    else
    {
	print "Error: type must be acu or yaka!";
	exit(1);
    }

    open(TEMPLATE, $ldif_path) or do_err("unable to open template.");
    while (<TEMPLATE>)
    {
	$ldif = $ldif . $_;
    }

    $ldif =~ s/\$gid/$gid/g;
    $ldif =~ s/\$group/$group/g;

    open(LDIF, ">/tmp/entry.ldif") || do_err("error !\n");
    print LDIF $ldif;
    close(LDIF);

    system("ldapadd -x -h '$ldaphost' -w '$bindsecret' -D '$binddn' -f /tmp/entry.ldif") && do_err ("unable to add.");
    do_log("group added: $group");
}

sub cmd_group_delete(@)
{
    if ($#ARGV != 1)
    {
	do_usage ("<lpt> group delete <yaka|acu> <year>");
	exit(1);
    }

    print "TODO!";
    print "hint: ldapdelete -v -h ldap.acu.epita.fr -x -w \$LDAP_PASSWD -D 'cn=admin,dc=acu,dc=epita,dc=fr' 'cn=yaka2042,ou=groups,dc=acu,dc=epita,dc=fr'";
    exit(1);
}


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

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

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

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

sub cmd_list_accounts(@)
{
    if ($#_ > 1)
    {
	do_usage ("<lpt> list account [open|close|services]");
	exit(1);
    }
    my $action = shift;

    my $shellFalse = "/bin/false";
    my $ldap = ldap_connect();

    if ($action eq "open")
    {
	my $mesg = $ldap->search(base   => "ou=users,dc=acu,dc=epita,dc=fr",
				 filter => "&(!(loginShell=$shellFalse))(|(objectClass=posixAccount)(objectClass=epitaAccount))",
				 attrs  => [ 'dn', 'userPassword' ]);
	$mesg->code && die $mesg->error;
	if ($mesg->count == 0) {
	    do_warn "No account found";
	}
	else {
	    for my $entry ($mesg->entries) {
		if (! $entry->get_value("userPassword") or $entry->get_value("userPassword") =~ /^\{[^\}]\}!/) {
		    print YELLOW, "Partially closed:\t", RESET;
		} else {
		    print CYAN, "Opened:\t", RESET;
		}
		say $entry->dn;
	    }
	}
    }
    elsif ($action eq "close")
    {
	my $mesg = $ldap->search(base   => "ou=users,dc=acu,dc=epita,dc=fr",
				 filter => "&(loginShell=$shellFalse)(|(objectClass=posixAccount)(objectClass=epitaAccount))",
				 attrs  => [ 'userPassword' ]);
	$mesg->code && die $mesg->error;
	if ($mesg->count == 0) {
	    do_warn "No account found";
	}
	else {
	    for my $entry ($mesg->entries) {
		if ($entry->get_value("userPassword") =~ /^\{[^\}]\}!/) {
		    print YELLOW, "Partially closed:\t", RESET;
		} else {
		    print RED, "Closed:\t", RESET;
		}
		say $entry->dn;
	    }
	}
    }
    elsif ($action eq "services")
    {
	my $service = shift // "*";

	my $mesg = $ldap->search(base   => "ou=users,dc=acu,dc=epita,dc=fr",
				 filter => "&(labService=$service)(|(objectClass=posixAccount)(objectClass=epitaAccount))",
				 attrs  => [ 'uid', 'labService' ]);
	$mesg->code && die $mesg->error;
	if ($mesg->count == 0) {
	    do_warn "No account found!";
	}
	else {
	    for my $entry ($mesg->entries) {
		say YELLOW, $entry->get_value("uid"), "\t", RESET, join(", ", $entry->get_value("labService"));
	    }
	}
    }

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


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

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

    my $action = shift;

    if ($#_ >= 0) {
	cmd_account_quota_set($login, $action, @_);
    }
    elsif ($action eq "sync") {
	cmd_account_quota_sync($login, @_);
    }
    else {
	cmd_account_quota_view($login, @_);
    }
}

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

    my $ldap = ldap_connect_anon();
    my $mesg = $ldap->search(
			   base   => "ou=users,dc=acu,dc=epita,dc=fr",
			   filter => "uid=$login",
			   attrs  => [ 'quotaHomeBlock', 'quotaHomeFile', 'quotaSgoinfreBlock', 'quotaSgoinfreFile' ]
			   );

    $mesg->code && die $mesg->error;
    $mesg->count > 0 || return -1;

    my $nb = 0;
    foreach my $entry ($mesg->entries)
    {
	if ($nb > 0) {
	    say "==";
	}
	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)");

	$nb++;
    }

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

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

    if ($#_ > 2)
    {
	do_usage ("<lpt> account <login> quota <volume> <type> <value>");
	return 1;
    }

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

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

    # 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;
    $ldap = ldap_connect() if ($value);
    $ldap = ldap_connect_anon() if (!$value);
    my $mesg = $ldap->search( # search
			      base   => "ou=users,dc=acu,dc=epita,dc=fr",
			      filter => "uid=$login",
			      attrs => [ $quotaName ],
			      scope => "sub"
	);
    if ($mesg->code != 0) { do_err($mesg->error); }
    if ($mesg->count != 1) { do_err("user $login not found or multiple presence"); }

    my $old_value = $mesg->entry(0)->get_value($quotaName);
    if (!$old_value) {
	$old_value = $def_quota{$type}{$volume};
    }

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

    if ($value =~ '^\+([0-9]+)([MKGTmkgt]?)$') {
	my $t = $1;
	$t *= 1024 if ($2 eq "K" or $2 eq "k");
	$t *= 1048576 if ($2 eq "M" or $2 eq "m");
	$t *= 1073741824 if ($2 eq "G" or $2 eq "g");
	$t *= 1099511627776 if ($2 eq "T" or $2 eq "t");
	$value = $old_value + $t;
    }
    elsif ($value =~ '^-([0-9]+)([MKGTmkgt]?)$') {
	my $t = $1;
	$t *= 1024 if ($2 eq "K" or $2 eq "k");
	$t *= 1048576 if ($2 eq "M" or $2 eq "m");
	$t *= 1073741824 if ($2 eq "G" or $2 eq "g");
	$t *= 1099511627776 if ($2 eq "T" or $2 eq "t");
	$value = $old_value - $t;
    }
    elsif ($value !~ /^[0-9]+$/) {
	do_err "Value must be an integer or +i or -i";
    }

    do_info "Changing quota of $quotaName of $login to $value...";

    $mesg->entry(0)->replace($quotaName => $value) or die $!;
    $mesg->entry(0)->update($ldap) or die $!;

    $ldap->unbind;

    do_info "Done!";
}

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

    my $ldap = ldap_connect_anon();
    my $mesg = $ldap->search(
			   base   => "ou=users,dc=acu,dc=epita,dc=fr",
			   filter => "(&(uid=$login)(objectClass=labAccount))",
			   attrs  => [ 'uid', 'uidNumber',
				       'quotaHomeBlock', 'quotaHomeFile',
				       'quotaSgoinfreBlock', 'quotaSgoinfreFile' ]
			   );
    $mesg->code && die $mesg->error;
    $mesg->count == 1 || do_err "User $login not found or multiple presence";

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

    if (Quota::setqlim($dev_quota{home}, $mesg->entry(0)->get_value("uidNumber"), int(0.9 * $quotaHomeBlock), $quotaHomeBlock, int(0.9 * $quotaHomeFile), $quotaHomeFile, 1, 0) == 0 and
	Quota::setqlim($dev_quota{sgoinfre}, $mesg->entry(0)->get_value("uidNumber"), int(0.9 * $quotaHomeBlock), $quotaHomeBlock, int(0.9 * $quotaHomeFile), $quotaHomeFile, 1, 0) == 0) {
	do_info $login."'s quota synchronized!";
    }
    else {
	do_err "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(@)
{
    my $ldap = ldap_connect_anon();
    my $mesg = $ldap->search(
			   base   => "ou=users,dc=acu,dc=epita,dc=fr",
			   filter => "(objectClass=labAccount)",
			   attrs  => [ 'uid' ]
			   );
    $mesg->code && die $mesg->error;

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

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


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

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

    my $ldap = ldap_connect_anon();
    my $mesg = $ldap->search(
			   base   => "ou=users,dc=acu,dc=epita,dc=fr",
			   filter => "(objectClass=posixAccount)",
			   attrs  => ['uid','cn', 'homeDirectory']
			   );

    $mesg->code && die $mesg->error;
    $mesg->count > 0 || return -1;

    foreach my $entry ($mesg->sorted('uid'))
    {
	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 = ldap_connect_anon();

    foreach my $login (keys %keys_unprotected)
    {
	my $mesg = $ldap->search(
	    base   => "ou=users,dc=acu,dc=epita,dc=fr",
	    filter => "uid=$login",
	    attrs  => [ 'uid', 'cn', 'mailAlias' ]
	    );

	$mesg->code && die $mesg->error;
	$mesg->count > 0 || return -1;

	my $entry = $mesg->entry(0);

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

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

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

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

    cmd_ssh_keys_without_passphrase_generic(\&$process);
}

# warn about unprotected keys
sub cmd_ssh_keys_without_passphrase_warn(@)
{
    my $process = sub() {
	my $entry = shift;
	my $keys = shift;

	# Display
	print $entry->get_value("uid")."\n";

	# create the message
	use Email::MIME;
	my $body = "Bonjour ".$entry->get_value("cn").",

Un outil automatique a découvert une clé sans passphrase sur votre compte
du laboratoire. Il est impératif de mettre une passphrase chiffrant votre
clé 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";
	my $message = Email::MIME->create(
	    header_str => [
		From    => 'root@acu.epita.fr',
		To      => $entry->get_value("mailAlias"),
		Cc      => 'root@acu.epita.fr',
		Subject => '[LAB][SSH-PASSPHRASE] Clef SSH non protégée',
	    ],
	    attributes => {
		encoding => 'quoted-printable',
		charset  => 'UTF-8',
	    },
	    body_str => $body,
	    );

	# send the message
	use Email::Sender::Simple qw(sendmail);
	sendmail($message);
    };

    cmd_ssh_keys_without_passphrase_generic(\&$process);
}

# remove unprotected keys
sub cmd_ssh_keys_without_passphrase_remove(@)
{
    my $process = sub() {
	my $entry = shift;
	my $keys = shift;

	# Display
	print $entry->get_value("uid")."\n";

	# create the message
	use Email::MIME;
	my $body = "Bonjour ".$entry->get_value("cn").",

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 $message = Email::MIME->create(
	    header_str => [
		From    => 'root@acu.epita.fr',
		To      => $entry->get_value("aliasmail"),
		Cc      => 'root@acu.epita.fr',
		Subject => '[LAB][SSH-PASSPHRASE] Clé SSH non protégée supprimée',
	    ],
	    attributes => {
		encoding => 'quoted-printable',
		charset  => 'UTF-8',
	    },
	    body_str => $body,
	    );

	# send the message
	use Email::Sender::Simple qw(sendmail);
	sendmail($message);
    };

    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") {
    $debug = 1;
    $cmd = shift;
}
elsif ($cmd eq "-f" or $cmd eq "--force") {
    $verbosity = 0;
    $cmd = shift;
}

if (! exists $cmds{$cmd})
{
    say BOLD, "Usage: ", RESET, "$0 ", GREEN, "command", RESET, " <arguments>";
    do_err("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> <group-name> [arguments]

	Manage the group <group-name>

B<lpt> I<help>

	Display this screen.

B<lpt> I<year> [year]

	Set or display the current year.


=head1 ACCOUNT COMMANDS

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

	Display information about <login>.

	<login> can be a globbing string.

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

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

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

	This is used to erase the userPassword.

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

	This is used to close an existing account.

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<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 his emails) if
	'new' is empty, and to change it if 'new' is given.

B<lpt account> I<list> <open | close | service>

	List accounts: with access to the PILA, without, with access to
        services.

B<lpt account> I<finger> <login>

	Display information about a login.

B<lpt account> I<service_flush> <login>

	Remove all services associated to a login.


=head1 GROUP COMMANDS

B<lpt group> I<list> [group]

	This is used to list groups available on the PIL or to list the members
	of the specified group.

B<lpt group> I<add> <group> <login>

	This is used to add a user to a posix group.

B<lpt group> I<create> <yaka | acu> <year>

	This is used to create a posix group.

B<lpt group> I<remove> <group> <login>

	This is used to remove a user from a posix group.

B<lpt group> I<delete> <yaka | acu> <year>

	This is used to delete a posix group.


=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 SERVICE COMMANDS

B<lpt service> I<add> <login> <name>

	This is used to add a service to a user.

B<lpt service> I<remove> <login> <name>

	This is used to remove a service from a user.


=head1 SSH_KEYS_WITHOUT_PASSPHRASE COMMANDS

B<lpt ssh> I<keys-without-passphrase> <show | warn | remove>

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


=head1 DESCRIPTION

B<lpt> is a tool developed to replace ancient 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 & nicolas, root@acu 2014

=head1 VERSION

This is B<lpt> version 1.1.

=head1 TODO

Tons of stuff :
 * delete account
 * group delete
 * ...

=head1 BUGS

No bug, just features.

=cut