Merge branch 'master' of ssh://cpp/liblerdorf

ACU/Log.pm

@@ -5,6 +5,7 @@ use strict;
 use warnings;
 use Carp;
 use Data::Dumper;
+use Email::MIME;
 use Exporter 'import';
 use POSIX qw(strftime);
 use Term::ANSIColor qw(:constants);
@@ -16,21 +17,26 @@ use constant {
     WARN => 4,
     DONE => 5,
     USAGE => 6,
+    PENDING => 6.5,
     INFO => 7,
     DEBUG => 8,
     TRACE => 9,
 };
 
-our @EXPORT    = qw(log FATAL ALERT ERROR WARN DONE USAGE INFO DEBUG TRACE);
+our @EXPORT    = qw(log FATAL ALERT ERROR WARN DONE USAGE PENDING INFO DEBUG TRACE);
 
 our $display_level = 7;
 our $save_level = 9;
 our $fatal_error = 1;
 our $fatal_warn = 0;
+our $mail_error = 0;
 
 our $log_file = $0.".log";
 my $log_fd;
 
+my $HOSTNAME = `hostname`;
+chomp($HOSTNAME);
+
 sub log
 {
     my $level = shift;
@@ -51,15 +57,47 @@ sub log
 	local $| = 1;
 	print $log_fd strftime("%a %b %e %H:%M:%S %Y", localtime), " ", levelstr($level), " ";
 
-	if ($level >= TRACE) {
+	if ($level == TRACE) {
 	    print $log_fd Dumper(@_);
 	}
 	else {
 	    say $log_fd @_;
 	}
     }
+
+    if ($mail_error && $level <= ERROR)
+    {
+	require "Email::Sender::Simple";
+	my $mail = Email::MIME->create(
+	    header_str => [
+		From    => "Roots assistants <root\@$HOSTNAME.acu.epita.fr>",
+		To      => "Roots assistants <ml-root\@acu.epita.fr>",
+		Subject => "[LERDORF][ERROR] ".join(' ', @_)
+	    ],
+            body_str => "Bonjour,
+
+Une erreur de niveau $level est survenue sur la machine $HOSTNAME.
+
+Cette erreur est survenue lors de l'exécution du script :
+$0.
+
+Voici le contenu du message d'erreur :
+".join(' ', @_)."
+
+Cordialement,
+
+-- 
+The lerdorf project",
+	);
+        Email::Sender::Simple::sendmail($mail);
+    }
+
     if ($level <= $display_level) {
-	say STDERR (leveldisp($level), @_, RESET);
+	if ($level == PENDING) {
+	    print STDERR (leveldisp($level), @_, RESET, "\r");
+	} else {
+	    say STDERR (leveldisp($level), @_, RESET);
+	}
     }
 
     if ($fatal_warn && $level <= WARN){
@@ -80,14 +118,14 @@ sub levelstr($)
 {
     my $level = shift;
 
-    return "FATAL" if ($level == 1);
+    return "FATAL" if ($level <= 1);
-    return "ALERT" if ($level == 2);
+    return "ALERT" if ($level <= 2);
-    return "ERROR" if ($level == 3);
+    return "ERROR" if ($level <= 3);
-    return "WARN " if ($level == 4);
+    return "WARN " if ($level <= 4);
-    return "DONE " if ($level == 5);
+    return "DONE " if ($level <= 5);
-    return "USAGE" if ($level == 6);
+    return "USAGE" if ($level <= 6);
-    return "INFO " if ($level == 7);
+    return "INFO " if ($level <= 7);
-    return "DEBUG" if ($level == 8);
+    return "DEBUG" if ($level <= 8);
     return "TRACE";
 }
 
@@ -95,14 +133,15 @@ sub leveldisp($)
 {
     my $level = shift;
 
-    return BOLD, ON_RED, YELLOW, "/!\\", RESET, " ", BOLD if ($level == 1);
+    return BOLD, ON_RED, YELLOW, "/!\\", RESET, " ", BOLD if ($level <= 1);
-    return BOLD, ON_RED, ">>>", RESET, " ", BOLD if ($level == 2);
+    return BOLD, ON_RED, ">>>", RESET, " ", BOLD if ($level <= 2);
-    return BOLD, RED, ">>>", RESET, " ", BOLD if ($level == 3);
+    return BOLD, RED, ">>>", RESET, " ", BOLD if ($level <= 3);
-    return BOLD, YELLOW, ">>>", RESET, " ", BOLD if ($level == 4);
+    return BOLD, YELLOW, ">>>", RESET, " ", BOLD if ($level <= 4);
-    return BOLD, GREEN, ">>>", RESET, " ", BOLD if ($level == 5);
+    return BOLD, GREEN, ">>>", RESET, " ", BOLD if ($level <= 5);
-    return BOLD, MAGENTA, " * ", RESET, " ", BOLD if ($level == 6);
+    return BOLD, MAGENTA, " * ", RESET, " ", BOLD if ($level <= 6);
+    return BOLD, CYAN, ">>>", RESET, " " if ($level < 7);
     return BOLD, CYAN, " * ", RESET, " " if ($level == 7);
-    return BOLD, BLUE, " % ", RESET, " "  if ($level == 8);
+    return BOLD, BLUE, " % ", RESET, " "  if ($level <= 8);
     return BOLD, BLUE, "#", RESET, "   ";
 }
 

ACU/VCS/Git.pm

@@ -213,7 +213,7 @@ sub user_add
     user_delete($login, 1, $multiple);
 
     # Then, extract user keys
-    my @entries = LDAP::search_dns(undef, "ou=users", "&(uid=$login)(sshPublicKey=*)", [ "uid", "sshPublicKey" ]);
+    my @entries = LDAP::search_dns(undef, "ou=users", "&(uid=$login)(sshPublicKey=*)", "uid", "sshPublicKey");
 
     if ($#entries > 1 && !$multiple) { log WARN, "Found multiple user $login, aborting keys update."; return 0; }
 

commands/first-install.sh

@@ -1,7 +1,7 @@
 #! /bin/bash
 
 # Install missing packages
-DEB_PACKAGES_LIST="screen libnet-ldap-perl libxml-libxml-perl libgearman-client-perl libmailtools-perl libmail-sendmail-perl libdatetime-format-iso8601-perl libnet-ip-perl libsys-gamin-perl libdigest-sha-perl"
+DEB_PACKAGES_LIST="screen libnet-ldap-perl libxml-libxml-perl libgearman-client-perl libmailtools-perl libmail-sendmail-perl libdatetime-format-iso8601-perl libnet-ip-perl libsys-gamin-perl libdigest-sha-perl libemail-mime-perl"
 ARCH_PACKAGES_LIST="screen perl-io-socket-ssl perl-email-simple perl-email-mime perl-term-readkey perl-ldap perl-lwp-protocol-https perl-datetime-format-iso8601 perl-net-ip" # aur/perl-sys-gamin
 GENTOO_PACKAGES_LIST="app-misc/screen dev-perl/IO-Socket-SSL dev-perl/Email-Simple dev-perl/Email-MIME dev-perl/TermReadKey dev-perl/perl-ldap dev-perl/LWP-Protocol-https dev-perl/DateTime-Format-ISO8601 dev-perl/Net-IP"
 FBSD_PACKAGES_LIST="screen p5-IO-Socket-SSL p5-Email-Simple p5-Email-MIME p5-Term-ANSIColor p5-Term-ReadKey p5-LWP-Protocol-https p5-DateTime-Format-ISO8601 p5-Net-IP p5-Sys-Gamin"

hooks/submissions.pl

@@ -16,14 +16,22 @@ use ACU::Log;
 $ACU::Log::log_file = "/var/log/hooks/" . basename($0) . ".log";
 use ACU::Process;
 
-# First, check if the repository is in the YYYY/ directory
-exit 0 if ($ENV{GL_REPO} !~ /^2[0-9]{3}\/.+\/.+/);
-
 my ($ref, $oldsha, $newsha) = @ARGV;
 
-my $promo = $1 if ($ENV{'GL_REPO'} =~ m/([0-9]{4}).*/);
+my $promo;
-my $id_project = $1 if ($ENV{'GL_REPO'} =~ m/.*\/(.*)\//);
+my $id_project;
-my $repo_login = $1 if ($ENV{'GL_REPO'} =~ m/.*\/.*\/(.*)/);
+my $repo_login;
+
+# First, extract information, from config then guess from repository adress
+if (my $tmp = `git config hooks.promo`) { chomp $tmp; $promo = $tmp; }
+if (my $tmp = `git config hooks.idproject`) { chomp $tmp; $id_project = $tmp; }
+if (my $tmp = `git config hooks.login`) { chomp $tmp; $repo_login = $tmp; }
+
+$promo = $1 if (!$promo && $ENV{'GL_REPO'} =~ m/([0-9]{4}).*/);
+$id_project = $1 if (!$id_project && $ENV{'GL_REPO'} =~ m/.*\/(.*)\//);
+$repo_login = $1 if (!$repo_login && $ENV{'GL_REPO'} =~ m/.*\/.*\/(.*)/);
+
+exit(0) if (!$promo || !$id_project || !$repo_login);
 
 if ($ref =~ m<^refs/tags/(.+)$>)
 {
@@ -103,7 +111,7 @@ if ($ref =~ m<^refs/tags/(.+)$>)
 					"id" => $id_project,
 					"rendu" => $tag,
 					"login" => $repo_login,
-					"path" => $ENV{GL_REPO_BASE_ABS}."/".$ENV{GL_REPO},
+					"path" => $ENV{GL_REPO_BASE_ABS}."/".$ENV{GL_REPO}.".git",
 				    });
 	};
 	if ($@) {

process/files/send_git.pl

@@ -2,6 +2,7 @@
 
 use strict;
 use warnings;
+use Carp;
 use v5.10;
 use File::Path qw(remove_tree);
 use File::Temp qw/tempfile tempdir/;
@@ -21,7 +22,7 @@ sub process
 
     my $path = $args->{param}{path} // "/srv/git/repositories/$year/$project_id/$login.git";
 
-    return "$path is not a valid path." if (! -d $path);
+    croak "$path is not a valid path." if (! -d $path);
 
     my $tempdir = tempdir();