epita-std/ACU
Archived
1
0
Fork 0
Code Releases Activity

New logging system

Browse source
This commit is contained in:
Mercier Pierre-Olivier 2013-09-04 02:56:29 +02:00
commit 495202128e
8 changed files with 260 additions and 165 deletions
Download patch file Download diff file Expand all files Collapse all files

4
ACU/API/Base.pm
View file

@ -56,7 +56,7 @@ sub get($$)
my $url = shift;
my $ua = LWP::UserAgent->new;
ACU::Log::do_debug ('GET Request to ' . API_URL . $url);
log(DEBUG, 'GET Request to ', API_URL, $url);
my $req = GET API_URL . $url;
return parse($next, $ua->request($req)->content);
@ -68,7 +68,7 @@ sub send($$@)
my $url = shift;
my $ua = LWP::UserAgent->new;
ACU::Log::do_debug ('POST Request to ' . API_URL . $url);
log(DEBUG, 'POST Request to ', API_URL, $url);
my $req = POST API_URL . $url, @_;
return parse($next, $ua->request($req)->content);

67
ACU/LDAP.pm
View file

@ -35,10 +35,10 @@ sub ldap_connect()
my $ldap = Net::LDAPS->new($ldaphost) or die ("$@");
my $mesg = $ldap->bind($binddn, password => $bindsecret) or die ("$@");
ACU::Log::do_debug("Connect to LDAP with $binddn");
log(DEBUG, "Connect to LDAP with $binddn");
if ($mesg->code) {
ACU::Log::do_err("An error occurred: " .ldap_error_text($mesg->code));
log(FATAL, "An error occurred: " .ldap_error_text($mesg->code));
}
return $ldap;
@ -49,10 +49,10 @@ sub ldap_connect_anon()
my $ldap = Net::LDAPS->new($ldaphost) or die ("$@");
my $mesg = $ldap->bind or die ("$@");
ACU::Log::do_debug("Connect to LDAP anonymously");
log(DEBUG, "Connect to LDAP anonymously");
if ($mesg->code) {
ACU::Log::do_err("An error occurred: " .ldap_error_text($mesg->code));
log(FATAL, "An error occurred: " .ldap_error_text($mesg->code));
}
return $ldap;
@ -70,7 +70,7 @@ sub add_group($$$;$)
my $dn = "cn=$cn,ou=$year,ou=$ou,ou=groups,dc=acu,dc=epita,dc=fr";
ACU::Log::do_debug("Add group $dn");
log(DEBUG, "Add group $dn");
my $mesg = $ldap->add( $dn,
attrs => [
@ -78,7 +78,7 @@ sub add_group($$$;$)
cn => $cn,
]
);
if ($mesg->code != 0) { ACU::Log::do_warn($mesg->error); return 0; }
if ($mesg->code != 0) { log(WARN, $mesg->error); return 0; }
return $dn;
}
@ -91,19 +91,19 @@ sub delete_group($$;$)
my $ldap = ldap_connect();
ACU::Log::do_debug("Delete group ou=groups,dc=acu,dc=epita,dc=fr");
log(DEBUG, "Delete group ou=groups,dc=acu,dc=epita,dc=fr");
my $mesg = $ldap->search( # search
base => "ou=groups,dc=acu,dc=epita,dc=fr",
filter => "cn=$cn",
scope => "sub"
);
if ($mesg->code != 0) { ACU::Log::do_warn($mesg->error); return 0; }
if ($mesg->count != 1) { ACU::Log::do_warn("$cn not found or multiple entries match"); return 0; }
if ($mesg->code != 0) { log(WARN, $mesg->error); return 0; }
if ($mesg->count != 1) { log(WARN, "$cn not found or multiple entries match"); return 0; }
$ldap->delete( $mesg->entry(0)->dn );
$ldap->unbind or ACU::Log::do_warn ("couldn't disconnect correctly");
$ldap->unbind or log(WARN, "couldn't disconnect correctly");
}
sub get_year(;$)
@ -127,8 +127,8 @@ sub get_dn($$@)
attrs => @_,
scope => "base"
);
if ($mesg->code != 0) { ACU::Log::do_warn($mesg->error); return undef; }
if ($mesg->count != 1) { ACU::Log::do_warn("$dn not found or multiple entries match"); return undef; }
if ($mesg->code != 0) { log(WARN, $mesg->error); return undef; }
if ($mesg->count != 1) { log(WARN, "$dn not found or multiple entries match"); return undef; }
return $mesg->entry(0);
}
@ -148,12 +148,12 @@ sub add_attribute($$$@)
if (! grep { /^\Q$value\E$/ } @data) {
$mod = 1;
ACU::Log::do_debug("Add attribute $value to $dn");
log(DEBUG, "Add attribute $value to $dn");
push @data, $value;
}
else {
ACU::Log::do_warn("Attribute $what with value $value for $dn already exists.");
log(WARN, "Attribute $what with value $value for $dn already exists.");
}
}
@ -162,7 +162,7 @@ sub add_attribute($$$@)
$entry->replace($what => \@data) or die $!;
my $mesg = $entry->update($ldap) or die $!;
if ($mesg->code != 0) { ACU::Log::do_warn($mesg->error); return 0; }
if ($mesg->code != 0) { log(WARN, $mesg->error); return 0; }
return 1;
}
@ -184,13 +184,13 @@ sub delete_attribute($$$@)
for my $value (@_)
{
if (grep { /^\Q$value\E$/ } @data) {
ACU::Log::do_debug("Remove attribute $what ($value) from $dn");
log(DEBUG, "Remove attribute $what ($value) from $dn");
@data = grep { ! /^\Q$value\E$/ } @data;
$mod = 1;
}
else {
ACU::Log::do_warn("No attribute $what with value $value for $dn");
log(WARN, "No attribute $what with value $value for $dn");
}
}
@ -198,7 +198,7 @@ sub delete_attribute($$$@)
{
$entry->replace($what => \@data) or die $!;
my $mesg = $entry->update($ldap) or die $!;
if ($mesg->code != 0) { ACU::Log::do_warn($mesg->error); return 0; }
if ($mesg->code != 0) { log(WARN, $mesg->error); return 0; }
return 1;
}
else {
@ -212,7 +212,7 @@ sub delete_entry($$)
my $mesg = $ldap->delete( shift );
if ($mesg->code != 0) { ACU::Log::do_warn($mesg->error); return 0; }
if ($mesg->code != 0) { log(WARN, $mesg->error); return 0; }
return 1;
}
@ -224,7 +224,7 @@ sub flush_attribute($$@)
my $mesg = $ldap->modify($dn, delete => \@_)->code;
if ($mesg->code != 0) { ACU::Log::do_warn($mesg->error); return 0; }
if ($mesg->code != 0) { log(WARN, $mesg->error); return 0; }
return 1;
}
@ -254,12 +254,33 @@ sub search_dn($$@)
attrs => [ ],
scope => "sub"
);
if ($mesg->code != 0) { ACU::Log::do_warn($mesg->error); return undef; }
if ($mesg->count != 1) { ACU::Log::do_warn("$filter not found or multiple entries match"); return undef; }
if ($mesg->code != 0) { log(WARN, $mesg->error); return undef; }
if ($mesg->count != 1) { log(WARN, "$filter not found or multiple entries match"); return undef; }
return $mesg->entry(0)->dn;
}
sub search_dns($$$@)
{
my $ldap = shift // ldap_connect();
my $base = shift;
my $filter = shift;
if ($base) {
$base .= ","
}
my $mesg = $ldap->search( # search
base => $base."dc=acu,dc=epita,dc=fr",
filter => $filter,
attrs => @_,
scope => "sub"
);
if ($mesg->code != 0) { log(WARN, $mesg->error); return undef; }
return $mesg->entries;
}
sub update_attribute($$$@)
{
my $ldap = shift // ldap_connect();
@ -271,7 +292,7 @@ sub update_attribute($$$@)
my $mesg = $entry->update($ldap);
if ($mesg->code != 0) {
ACU::Log::do_warn($mesg->error);
log(WARN, $mesg->error);
return 0;
}

107
ACU/Log.pm
View file

@ -1,51 +1,100 @@
#! /usr/bin/env perl
package ACU::Log;
use v5.10.1;
use strict;
use warnings;
use Term::ANSIColor qw(:constants);
use Data::Dumper;
use Exporter 'import';
use POSIX qw(strftime);
use Term::ANSIColor qw(:constants);
our $verbosity = 1;
our $debug = 1;
use constant {
FATAL => 1,
ERROR2 => 2,
ERROR => 3,
WARN4 => 4,
WARN => 5,
USAGE => 6,
INFO => 7,
DEBUG => 8,
TRACE => 9,
};
sub do_err(@)
our @EXPORT = qw(log FATAL ERROR2 ERROR WARN4 WARN USAGE INFO DEBUG TRACE);
our $display_level = 7;
our $save_level = 9;
our $fatal_error = 1;
our $fatal_warn = 0;
our $log_file = $0.".log";
my $log_fd;
sub log($@)
{
say BOLD, RED, ">>>", RESET, " ", BOLD, @_, RESET;
exit(1);
}
my $level = shift;
sub do_usage(@)
{
say BOLD, MAGENTA, " * ", RESET, " ", BOLD, @_, RESET;
}
if (!$log_fd && $log_file) {
open ($log_fd, ">>", $log_file) or die("Unable to open log ($log_file) file for writing");
say $log_fd strftime("%a %b %e %H:%M:%S %Y", localtime), " START new logging session ";
}
sub do_warn(@)
{
say BOLD, YELLOW, ">>>", RESET, " ", BOLD, @_, RESET;
}
if ($level <= $save_level and $log_fd) {
print $log_fd strftime("%a %b %e %H:%M:%S %Y", localtime), " ", levelstr($level), " ";
sub do_info(@)
{
if ($verbosity) {
say BOLD, CYAN, " * ", RESET, " ", @_, RESET;
if ($level >= TRACE) {
print $log_fd Dumper(@_);
}
else {
say $log_fd @_;
}
}
if ($level <= $display_level) {
say (leveldisp($level), @_, RESET);
}
if ($fatal_warn && $level <= WARN){
#TODO Thibaut
#log(INFO, "Program stopped due to warning");
exit 125;
}
elsif ($fatal_error && $level <= ERROR) {
#TODO Thibaut
#log(INFO, "Program stopped due to error");
exit 126;
}
elsif ($level <= FATAL) {
#TODO Thibaut
#log(INFO, "Program stopped due to fatal error");
exit 127;
}
}
sub do_debug(@)
sub levelstr($)
{
if ($debug) {
say BOLD, BLUE, " * ", RESET, " ", @_, RESET;
}
my $level = shift;
return "FATAL" if ($level == 1);
return "ERROR" if ($level == 3 or $level == 2);
return "WARN " if ($level == 5 or $level == 4);
return "USAGE" if ($level == 6);
return "INFO " if ($level == 7);
return "DEBUG" if ($level == 8);
return "TRACE";
}
sub do_dump(@)
sub leveldisp($)
{
if ($debug) {
print Dumper(@_);
}
my $level = shift;
return BOLD, ON_RED, YELLOW, "/!\\", RESET, " ", BOLD if ($level == 1);
return BOLD, ON_RED, ">>>", RESET, " ", BOLD if ($level == 2);
return BOLD, RED, ">>>", RESET, " ", BOLD if ($level == 3);
return BOLD, YELLOW, ">>>", RESET, " ", BOLD if ($level == 5 or $level == 4);
return BOLD, MAGENTA, " * ", RESET, " ", BOLD if ($level == 6);
return BOLD, CYAN, " * ", RESET, " " if ($level == 7);
return BOLD, BLUE, " % ", RESET, " " if ($level == 8);
return BOLD, BLUE, "#", RESET, " ";
}
1;

4
ACU/Process.pm
View file

@ -41,8 +41,8 @@ sub do_work ($$$@)
my $given_args = shift;
my $priority = shift;
ACU::Log::do_debug("Starting job");
ACU::Log::do_dump($_[0]);
log(DEBUG, "Starting job");
log(TRACE, $_[0]{argref});
my $old = 0;
# Check the load isn't to high for this process