perfsonar development work

Author: dfn.calim
Date: 2011-03-07 10:14:02 +0000 (Mon, 07 Mar 2011)
New Revision: 687

Added:
   trunk/lib/perfSONAR/MA/Hades.pm
Modified:
   trunk/bin/oppd.pl
Log:
merged branches/perfsonar-oppd-new-architect and trunk

Modified: trunk/bin/oppd.pl
===================================================================
--- trunk/bin/oppd.pl   2011-03-07 10:09:39 UTC (rev 686)
+++ trunk/bin/oppd.pl   2011-03-07 10:14:02 UTC (rev 687)
@@ -63,6 +63,12 @@
 #  }
 #}
 
+
+#Added new
+use Log::Log4perl qw(:easy);
+
+
+
 # Modules for this daemon:
 use File::Spec;
 use Socket;
@@ -74,9 +80,10 @@
 
 use NMWG;
 use perfSONAR;
-use perfSONAR::Echo;
+#use perfSONAR::Echo;
 use perfSONAR::SOAP::Message;
 use perfSONAR::Client::LS;
+use perfSONAR::DataStruct;
 
 use vars qw($VERSION);
 $VERSION     = 0.51;
@@ -124,7 +131,7 @@
   $ssl_verify_client, $ssl_trusted_webserver_cn,
 );
 
-my %services;
+our %services;
 my %messages;
 my %lsKeys;
 
@@ -217,7 +224,7 @@
   get_opt($syslog_ident,    $Config{'syslog-ident'},    "oppd");
 $syslog_facility =
   get_opt($syslog_facility, $Config{'syslog-facility'}, "daemon");
-$loglevel     = get_opt($loglevel,    $Config{loglevel},    "notice");
+$loglevel     = get_opt($loglevel,    $Config{loglevel},    "info");
 $verbose      = get_opt($verbose,     0); # No verbose entry in config file!
 if ($verbose) {
   $loglevel = "info";
@@ -314,112 +321,108 @@
   }
 }
 
-unless (
-  defined($Config{service}) && ref($Config{service}) eq "HASH"
-  && %{$Config{service}}
-) {
-  pod2usage(
-    "No services specified in config file"
-  );
-}
-%services = %{$Config{service}};
+###################################################################################################################
+#Begin new include for LOG4Perl
+##################################################################################################################
+# Defined loglevel in config file
+# 0. trace
+# 1. debug
+# 2. = info
+# 3. = warning
+# 4. error
+# 5. fatal
+# Define this for Log4Perl
 
+if (defined $logfile) {
 
-#
-# Start logging ($log already initialised above)
-#
+    #check if $logfile is an absolute path, and add current path if not
+    if (!File::Spec->file_name_is_absolute($logfile)){
+        $logfile = File::Spec->rel2abs($logfile);
+    }
+}
+    
+my %L4P_loglevels = (
+       trace => $TRACE,
+       debug => $DEBUG,
+       info => $INFO,
+       warning => $WARN,
+       error => $ERROR,
+       fatal => $FATAL
+);
 
-$perfSONAR::log = $log;
+#Set layout
+my $log_layout;
+if ($loglevel eq "debug"){
+       $log_layout = '%d (%P) <%p> %F{1}:%L %M - %m%n';
+}else{
+       $log_layout = '%d <%p> %c - %m%n';
+}
 
-if (defined $logfile) {
+# Set options for L4P
+my %logger_opts = (
+    level  => $L4P_loglevels{$loglevel},
+    file => "STDERR",
+    layout => $log_layout,
+);
 
-  #check if $logfile is an absolute path, and add current path if not
-  if (!File::Spec->file_name_is_absolute($logfile)){
-    $logfile = File::Spec->rel2abs($logfile);
-  }
-
-  eval {
-    use locale;
-    use POSIX qw(locale_h strftime);
-    # "use locale", POSIX::strftime and localtime faster than DateTime
-    # and this has quite an impact on debug loging. Detected via SmokePing:
-    # http://perfsonar.acad.bg/smokeping
-    #use DateTime;
-    #use DateTime::Locale;
-    #BEGIN {
-    #  if (DateTime::Locale->load(setlocale(LC_TIME))) {
-    #    DateTime->DefaultLocale(setlocale(LC_TIME));
-    #  }
-    #}
-    $log->add(
-      Log::Dispatch::File->new(
-        name => 'file',
-        min_level => $loglevel,
-        filename => $logfile,
-        mode => 'append', close_after_write => 1, autoflush => 1,
-        callbacks => sub {
-          my 
%p=@_;
-          $p{message} = "$log_prefix: $p{message}" if $log_prefix;
-          $p{message} = strftime("%FT%T",localtime) . " $p{level} 
$p{message}";
-            #DateTime->now(time_zone=>"local")->strftime("%c") .
-          return "$p{message}\n";
-        },
-      )
-    );
-  };
-  die "Cannot write to log file '$logfile': 
$@\n"
 if $@;
+#log file defined
+if ($logfile) {
+    $logger_opts{file} = ">>$logfile"; #Append mode
 }
+# If detach mode log to screen
+unless ($detach) {
+    $logger_opts{file} = "STDERR"; 
+}
+Log::Log4perl->easy_init( \%logger_opts );
+my $logger = get_logger( "perSONAR-oppd" );
+
 if ($syslog) {
-  eval {
-    my $syslog_socket = 'unix';
-    if ($syslog_host) {
-      $Sys::Syslog::host = $syslog_host;
-      $syslog_socket = 'inet';
-    }
-    $log->add(
-      Log::Dispatch::Syslog->new(
-        name => 'syslog',
-        min_level => $loglevel,
-        ident => "$syslog_ident",
-        facility => "$syslog_facility",
-        socket => "$syslog_socket",
-        logopt => "ndelay",
-        callbacks => sub {
-          my 
%p=@_;
-          $p{message} = "$log_prefix: $p{message}" if $log_prefix;
-          #TODO Not nice! How can we change this?
-          # callback for SD stuff
-          if ($p{service}) {
-            $p{service} =~ s/\//\_/g;
-            $p{service} .= ".";
-          } else {
-            $p{service} = "";
-          }
-          $p{message} = "OPPD." . $p{service} . uc($p{level}) . "% 
$p{message}";
-          #/TODO
-          return "$p{message}\n";
-        },
-        #mode => 'append', close_after_write => 0, autoflush => 1,
-      )
-    );
-  };
+    eval {
+        my $syslog_socket = 'unix';
+        if ($syslog_host) {
+            $Sys::Syslog::host = $syslog_host;
+            $syslog_socket = 'inet';
+        }
+        my $appender = Log::Log4perl::Appender->new(        
+            "Log::Dispatch::Syslog",
+                name => 'syslog',
+                min_level => $loglevel,
+                ident => "$syslog_ident",
+                facility => "$syslog_facility",
+                socket => "$syslog_socket",
+                logopt => "ndelay",
+                callbacks => sub {
+                        my 
%p=@_;
+                        $p{message} = "$log_prefix: $p{message}" if 
$log_prefix;
+                        #TODO Not nice! How can we change this?
+                        # callback for SD stuff
+                        if ($p{service}) {
+                            $p{service} =~ s/\//\_/g;
+                            $p{service} .= ".";
+                        }else {
+                            $p{service} = "";
+                        }
+                        $p{message} = "OPPD." . $p{service} . uc($p{level}) 
. "% $p{message}";
+                        #/TODO
+                        return "$p{message}\n";
+                    }, #End callback sub
+                ); #End Appender-New'
+        $logger->add_appender($appender);
+    }; # End eval
   die "Cannot write to syslog: 
$@\n"
 if $@;
 }
-unless ($detach) {
-  $log->add(
-    Log::Dispatch::Screen->new(
-      name => 'screen',
-      min_level => $loglevel,
-      stderr    => 1,
-      callbacks => sub {
-        my 
%p=@_;
-        $p{message} = "$log_prefix: $p{message}" if $log_prefix;
-        $p{message} = "$p{level}: $p{message}";
-        return "$p{message}\n";
-      },
-    )
+############################################################################################
+# Look if a service in config is available
+############################################################################################
+unless (
+  defined($Config{service}) && ref($Config{service}) eq "HASH"
+  && %{$Config{service}}
+) {
+  pod2usage(
+    "No services specified in config file"
   );
 }
+%services = %{$Config{service}};
 
 # More flexible die:
 # Put error into Log and afterwards die with same message.
@@ -431,7 +434,7 @@
   chomp $logmsg; # No new line for Log::Dispatch !
   # We should only be called with initialised $log, but we can be a bit
   # more friendly by only using it if it was initialised:
-  $log->error($logmsg) if defined $log && 
UNIVERSAL::isa($log,'Log::Dispatch');
+  $logger->error($logmsg) if defined $logger && 
UNIVERSAL::isa($logger,'Log::Log4perl');
   die @_;
 };
 
@@ -442,8 +445,8 @@
   chomp $logmsg; # No new line for Log::Dispatch !
   # We should only be called with initialised $log, but we can be a bit
   # more friendly by only using it if it was initialised:
-  $log->warning($logmsg)
-    if defined $log && UNIVERSAL::isa($log,'Log::Dispatch');
+  $logger->warn($logmsg)
+    if defined $logger && UNIVERSAL::isa($logger,'Log::Log4perl');
   warn @_;
 };
 
@@ -468,7 +471,7 @@
 
 foreach my $service (keys %services){
   my $module = $services{$service}->{module};
-  eval "require perfSONAR::$module";
+  eval "use perfSONAR::$module";
   if ($@){
     die "Error loading module perfSONAR::$module: 
$@\n";
   }
@@ -476,9 +479,6 @@
     "perfSONAR::$module"->new(%{$services{$service}->{module_param}});
 }
 
-# Set modules in dispatch module/class:
-%perfSONAR::services = %services;
-
 #
 # Daemonize
 #
@@ -536,27 +536,27 @@
 
 # die on typical signals
 $SIG{INT} = $SIG{TERM} = sub {
-  $log->notice("Caught SIG$_[0] - initiating shutdown");
+  $logger->info("Caught SIG$_[0] - initiating shutdown");
   $shutdown_gracefully = 0;
   exit 1;
   # See END {} for shutdown sequence
 };
 $SIG{USR1} = sub {
   # Gracefull shutdown with timeout
-  $log->notice("Caught SIGUSR1 - initiating gracefull shutdown");
+  $logger->info("Caught SIGUSR1 - initiating gracefull shutdown");
   $shutdown_gracefully = $gracetime;
   exit 1;
   # See END {} for shutdown sequence
 };
 $SIG{USR2} = sub {
   # Gracefull shutdown WITHOUT timeout -> Possibly blocking forever!
-  $log->notice("Caught SIGUSR2 - initiating gracefull shutdown");
+  $logger->info("Caught SIGUSR2 - initiating gracefull shutdown");
   $shutdown_gracefully = -1;
   exit 1;
   # See END {} for shutdown sequence
 };
 $SIG{HUP} = sub {
-  $log->warning("Caught SIGHUP - NO RELOAD SUPPORTED AT THE MOMENT");
+  $logger->warn("Caught SIGHUP - NO RELOAD SUPPORTED AT THE MOMENT");
   #TODO
 };
 $SIG{PIPE} = 'IGNORE';
@@ -567,16 +567,15 @@
 # Inform that everything looks good
 #
 
-$log->notice("oppd service started");
-$log->info("available services: " . join(",", sort keys(%services)));
-$log->info("PID $$ written to $pidfile") if defined $pidfile;
+$logger->info("oppd service started");
+$logger->info("available services: " . join(",", sort keys(%services)));
+$logger->info("PID $$ written to $pidfile") if defined $pidfile;
 
 #
 # Start "daemon", the network side of the job ;-)
 # 
 
 #TODO: enable tracing output for our own SOAP implementation
-#      Use Log::Dispatcher for debug/error handling somehow?
 
 my $http_daemon;
 my $errno = 0;
@@ -634,7 +633,7 @@
 my $ls_reg_respawn_threshold = 60; # Respawn threshold for registration 
process
 if ($ls_register){
   if 
(!@ls_url){
-    $log->notice(
+    $logger->error(
       "No URL for LS registration - Continuing without registration"
     );
   } else {
@@ -642,62 +641,7 @@
   }
 }
 
-
 #
-# start process for selftest functionality
-#
-
-#TODO rework fork code completely!!
-#TODO add more messages and checks
-
-#selftesting functions are defined in plugin modules and
-#can be configured in oppd.conf per service
-=cut
-my @testservices;
-
-foreach my $service (keys %services){
-  if ($services{$service}{"selftest"}){
-    push @testservices, $service;
-  } else {
-    $log->log(
-      level => "notice", service => $service,
-      message => "No selftests specified for $service."
-    );
-  }
-}
-
-while (my $service = pop @testservices){ 
-  foreach my $test (keys %{$services{$service}{"selftest"}}){      
-    my $pid = fork();
-    defined($pid) or $log->log(
-      level => "warning", service => $service,
-      message => "Could not fork selftest process $test for module $service: 
$!"
-    );
-    #last if ($pid!=0);
-    if ($pid==0){ #child process, do selftest
-      $SIG{INT} = $SIG{TERM} = sub {
-        $log->log(
-          level => "notice", service => $service,
-          message => "Signal caught - exiting selftest process $test for 
$service"
-        );
-        exit 1;
-      };
-      # do not call REAPER on SIGCHLD and avoid zombie children
-      $SIG{CHLD} = 'IGNORE';
-      while (1){
-        my $result = $services{$service}->{handler}->selftest($test);
-        $log->log(
-          level => "notice", service => $service,
-          message => "selftesting service $service: $test returned $result"
-        );
-        sleep($services{$service}{"selftest"}{$test});
-      }
-    }
-  }
-}
-=cut
-
-#
 # Accept connections
 #
 
@@ -715,12 +659,12 @@
       # Just ignore if accept() returned because a signal (most likely 
SIGCHLD)
       # was received. See 'man perlipc'.
     if ($!) {
-      $log->info("Error in incoming connection: $!");
+      $logger->error("Error in incoming connection: $!");
     } elsif (my $errstr = IO::Socket::SSL->errstr()) {
       # SSL stuff is obviously not setting $! ...
-      $log->info("SSL error in incoming connection: $errstr");
+      $logger->error("SSL error in incoming connection: $errstr");
     } else {
-      $log->info("Unknown error in incoming connection");
+      $logger->error("Unknown error in incoming connection");
     }
     next;
   }
@@ -729,10 +673,10 @@
     my ($port, $iaddr) = sockaddr_in($peer);
     $peer_str = inet_ntoa($iaddr) . ":" . $port;
   }
-  $log->info("Incoming connection from $peer_str");
+  $logger->info("Incoming connection from $peer_str");
   if (scalar(keys %connections)+1 > $max_conn) {
     my $msg = "Too many connections";
-    $log->notice("$msg - closing connection to $peer_str");
+    $logger->error("$msg - closing connection to $peer_str");
     $conn->send_error(503, $msg); #RC_SERVICE_NOT_AVAILABLE
     close_socket($conn, "Error closing rejected connection");
     next;
@@ -744,11 +688,11 @@
     close_socket($conn, "Error closing rejected connection");
     next;
   }
-  $log->debug("Forking connection process for $peer_str");
+  $logger->debug("Forking connection process for $peer_str");
   my $pid = fork();
   unless (defined $pid) {
     # The fork failed
-    $log->error("Forking connection process failed: $!");
+    $logger->error("Forking connection process failed: $!");
     # Close the connection, because we have no process to care for it
     close_socket($conn, "Error closing incoming connection after failed 
fork");
     next;
@@ -759,9 +703,9 @@
     #
     # Child cares about the connection -> We can close it
     close_socket($conn, "Error closing incoming connection in parent");
-    $log->debug("Connection process $pid/$peer_str started");
+    $logger->debug("Connection process $pid/$peer_str started");
     $connections{$pid} = $peer_str; # We care about our children!
-    $log->debug(
+    $logger->debug(
       "Number of connections increased to " . scalar(keys %connections)
     );
     next;
@@ -774,7 +718,7 @@
   $proc_type = "connection";
   $log_prefix = "$$/$peer_str";
 
-  $log->debug("Connection process running");
+  $logger->debug("Connection process running");
 
   #
   # Signal handlers (if different from parent)
@@ -788,34 +732,53 @@
   #
   # Handle requests as they come in
   #
-  $log->debug("Setting connection timeout to $conn_timeout");
+  $logger->debug("Setting connection timeout to $conn_timeout");
   # TODO: timeout() is broken with HTTP::Daemon::SSL
   # http://rt.cpan.org/Public/Bug/Display.html?id=45625
   # http://www.perlmonks.org/?node_id=761270
   $conn->timeout($conn_timeout) unless($ssl);
   while (my $request = $conn->get_request) {
-    $log->info("Incoming request");
-    $log->debug("Disabling connection timeout");
+    $logger->info("Incoming request");
+    $logger->debug("Disabling connection timeout");
     # TODO: timeout() is broken with HTTP::Daemon::SSL
     $conn->timeout(0) unless($ssl);
     my $response = new HTTP::Response;
     eval {
+      #TODO At the moment we only get NMWG messages
+      #but we need more undependency from it
       my $soap_message =
         perfSONAR::SOAP::Message->from_http_request($request);
-
+      
+      #Use the new DataStruct
+      #At the moment NMWG parse to DS
       my $nmwg_message = NMWG::Message->new( ($soap_message->body)[0] );
+      #$logger->info(Dumper($nmwg_message->as_string()));
       #TODO: Auth
       if ($auth){
         perfSONAR::Auth::authenticate($soap_message, $nmwg_message, $as_url);
       }
-      my $nmwg_response = perfSONAR->handle_request(
-        $soap_message->uri, $nmwg_message
-      );
+         
+      #Create a DataStruct
+      my $ds = perfSONAR::DataStruct->new($soap_message->uri,   
$nmwg_message);
+      my $nmwg_response;
+      if ($ds->{ERROROCCUR}){
+       #Do here response on error
+       $logger->error("A error occured in creating data struct");
+      }else{
+        $ds->{SERVICES} = \%services;
+        #Run $ds
+        perfSONAR->handle_request($ds);
+      } 
+      
+      $nmwg_response = $ds->{REQUESTMSG};
+      #We dont need ds 
+      $ds = undef;
+      #$logger->info($nmwg_response->as_string());
       #TODO $nmwg_message <-> $nmwg_response? clone?
       #TODO what about header?
       $soap_message->body($nmwg_response->as_dom()->documentElement);
       $response->content($soap_message->as_string);
-    };
+    }; #End eval 
     if (my $eval_err = $@) {
       $log->info("Processing SOAP request failed: $eval_err");
       $response->content(
@@ -826,19 +789,18 @@
         )->as_string
       );
     }
-    $log->debug("Sending response");
-    $log->debug("Response:\n".$response->content());
+    $logger->debug("Sending response:\n".$response->content());
     $conn->send_response($response);
-    $log->debug("Setting connection timeout to $conn_timeout");
+    $logger->debug("Setting connection timeout to $conn_timeout");
     # TODO: timeout() is broken with HTTP::Daemon::SSL
     $conn->timeout($conn_timeout) unless ($ssl);
   }
   if (my $reason = $conn->reason) {
-    $log->info("Connection terminated: $reason");
+    $logger->warn("Connection terminated: $reason");
   }
   # Cleanup -> close connection
   close_socket($conn, "Closing connection failed");
-  $log->debug("Exiting connection process");
+  $logger->debug("Exiting connection process");
   exit 0; # We are the child and have done our job -> exit
 }
 
@@ -872,12 +834,12 @@
   return if $proc_type eq "dummy"; # Do not execute anything below
   my $exitcode = $?; # Save $?
   if ($proc_type eq "main") {
-    $log->info("Starting shutdown sequence");
+    $logger->info("Starting shutdown sequence");
 
     my @pids = sort keys %connections;
     push @pids, $ls_reg_pid if $ls_reg_pid;
     if ($shutdown_gracefully && @pids) {
-      $log->info("Trying to terminate all known children gracefully");
+      $logger->info("Trying to terminate all known children gracefully");
       my $signal = $shutdown_gracefully > 0 ? "USR1" : "USR2";
       my @pids_new = ();
       foreach my $pid (@pids) {
@@ -888,11 +850,11 @@
       @pids = @pids_new; @pids_new = ();
       if (@pids) {
         # Some processes were signaled
-        $log->debug("Sent SIG$signal to " . join(', ', @pids));
+        $logger->debug("Sent SIG$signal to " . join(', ', @pids));
         # Wait till processes have ended or timeout is reached.
         # $shutdown_gracefully < 0 => Wait possibly forever!!
         my $timeout = $shutdown_gracefully < 0 ? 0 : $shutdown_gracefully;
-        $log->debug("Waiting for childern to exit" .
+        $logger->debug("Waiting for childern to exit" .
           ($timeout ? " with timeout of $timeout s" : " WITHOUT timeout")
         );
         eval {
@@ -904,7 +866,7 @@
             }
             @pids = @pids_new; @pids_new = ();
             if (@pids) {
-              $log->debug("Processes alive: " . join(', ', @pids));
+              $logger->debug("Processes alive: " . join(', ', @pids));
               sleep 1;
             }
           } until ! @pids;
@@ -916,7 +878,7 @@
     while (waitpid(-1,WNOHANG) > 0) {} # wait on all possibly exited children
     if (waitpid(-1, WNOHANG) >= 0) {
       # There are childern alive
-      $log->info("Trying to terminate all children using SIGTERM");
+      $logger->info("Trying to terminate all children using SIGTERM");
       local $SIG{TERM} = 'IGNORE';
       kill TERM => -$$;
       sleep 1; # Give everyone at least one second!
@@ -925,11 +887,11 @@
       # Clean up PID file
       unlink $pidfile or $log->warning("Cannot delete pid file: $!");
     }
-    $log->notice("Exiting");
+    $logger->info("Exiting");
     while (waitpid(-1,WNOHANG) > 0) {} # wait on all possibly exited children
     if (waitpid(-1, WNOHANG) >= 0) {
       # There is still someone alive! -> Take the axe and cut our branch
-      $log->warning("Not all children exited on SIGTERM -> KILLING 
EVERYTHING");
+      $logger->warn("Not all children exited on SIGTERM -> KILLING 
EVERYTHING");
       kill KILL => -$$;
     }
   } elsif ($proc_type eq "connection") {
@@ -940,16 +902,16 @@
     # case correctly, though.
     close_socket($conn, "Closing connection failed");
   } elsif ($proc_type eq "lsreg") {
-    $log->info("Starting shutdown sequence");
+    $logger->info("Starting shutdown sequence");
     if ($shutdown_gracefully) {
-      $log->info("Deregistering services");
+      $logger->info("Deregistering services");
       perfSONAR::Client::LS::deregister();
     } else {
       #TODO Change this? Perhaps a deregistration with a small timeout?
-      $log->info("Not deregistering services. Not a graceful shutdown.");
+      $logger->warn("Not deregistering services. Not a graceful shutdown.");
       #TODO Quit reg/dereg (close conn) somehow if they are running?
     }
-    $log->notice("Exiting");
+    $logger->info("Exiting");
   } else {
     warn "Internal error: END block executed with unknown process type: " .
       "\"$proc_type\"\n";
@@ -979,20 +941,22 @@
 # - Respawn LS registration process.
 #
 sub REAPER { # see also 'man perlipc'
-  local $!;   # waitpid() and others may overwrite current error
-  while ((my $pid = waitpid(-1,WNOHANG)) > 0) {
-    my $reason = $? ? " with exit code $?" : "";
-    if (exists $connections{$pid}) {
-      $log->debug(
+    # don't change $! and $? outside handler
+    local ($!,$?);
+    
+    while ((my $pid = waitpid(-1,WNOHANG)) > 0) {
+        my $reason = $? ? " with exit code $?" : "";
+        if (exists $connections{$pid}) {
+        $logger->info(
         "Connection process $pid for connection $connections{$pid} exited"
         . $reason
       );
       delete $connections{$pid};
-      $log->debug(
+      $logger->debug(
         "Number of connections decreased to " . scalar(keys %connections)
       );
     } elsif ($pid == $ls_reg_pid) {
-      $log->debug("LS registration process $pid exited" . $reason);
+      $logger->debug("LS registration process $pid exited" . $reason);
       $ls_reg_pid = undef;
       fork_ls_reg() unless $shutting_down;
     } else {
@@ -1012,18 +976,18 @@
   return 1 unless $socket->opened; # Handle already closed sockets "silently"
   if (UNIVERSAL::isa($socket, "IO::Socket::SSL")) {
     unless ($socket->close(SSL_no_shutdown => 1)) {
-      $log->warning("$err_msg: $?");
+      $logger->warn("$err_msg: $?");
       return;
     }
     if(my $errstr = $socket->errstr()) {
-      $log->warning("$err_msg: $errstr");
+      $logger->warn("$err_msg: $errstr");
       return;
     }
     return 1;
   }
   if (UNIVERSAL::isa($socket, "IO::Socket")) {
     unless ($socket->close) {
-      $log->warning("$err_msg: $!");
+      $logger->warn("$err_msg: $!");
       return;
     }
     return 1;
@@ -1037,14 +1001,14 @@
 #
 sub fork_ls_reg {
   my $ppid = $$; # Give our pid to the child
-  $log->info("Starting LS registration process");
+  $logger->info("Starting LS registration process");
   my $pid = fork();
   if (!defined($pid)) {
     #
     # Fork failed
     #
-    $log->warning("Could not fork LS registration process: $!");
-    $log->warning("Continuing without registration");
+    $logger->warn("Could not fork LS registration process: $!");
+    $logger->warn("Continuing without registration");
     return;
   }
   if ($pid != 0) {
@@ -1066,7 +1030,7 @@
   # First try to prevent lots of respawns of ls registration process:
   if ($ls_reg_starttime+$ls_reg_respawn_threshold > time) {
       # Our $ls_reg_starttime is still the start time of our predecessor!
-    $log->notice(
+    $logger->info(
       "LS registration process respawning too fast" . 
       " - delayed for $ls_reg_respawn_threshold s"
     );
@@ -1076,7 +1040,7 @@
   unless (getppid == $ppid) {
     die "Internal error: Got wrong ppid from getppid!\n";
   }
-  $log->info("LS Registration process started");
+  $logger->info("LS Registration process started");
 
   #
   # Signal handlers (if different from parent)
@@ -1091,14 +1055,14 @@
     services => \%services, ls_url => 
\@ls_url,
     hostname => $hostname, port => $port,
     organization => $organization, contact => $contact,
-    log => $log
+    log => $logger
   );
   while (1) {
     sleep $keepalive;
     # Our parent may have died without being able to send us a signal. So 
take
     # a look whether it's already there and exit if not:
     unless (getppid == $ppid) {
-      $log->notice("Parent died - initiating shutdown");
+      $logger->info("Parent died - initiating shutdown");
       exit 1;
     }
     perfSONAR::Client::LS::heartbeat();

Added: trunk/lib/perfSONAR/MA/Hades.pm
===================================================================
--- trunk/lib/perfSONAR/MA/Hades.pm                             (rev 0)
+++ trunk/lib/perfSONAR/MA/Hades.pm     2011-03-07 10:14:02 UTC (rev 687)
@@ -0,0 +1,238 @@
+package perfSONAR::MA::Hades;
+#  
+#  Copyright 2010 Verein zur Foerderung eines Deutschen Forschungsnetzes e. 
V.
+#  
+#  Licensed under the Apache License, Version 2.0 (the "License");
+#  you may not use this file except in compliance with the License.
+#  You may obtain a copy of the License at
+#  
+#       http://www.apache.org/licenses/LICENSE-2.0
+#  
+#  Unless required by applicable law or agreed to in writing, software
+#  distributed under the License is distributed on an "AS IS" BASIS,
+#  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+#  See the License for the specific language governing permissions and
+#  limitations under the License.
+#  
+#  
+
+#DEBUG
+use Data::Dumper;
+#/DEBUG
+
+use strict;
+use warnings;
+
+use Log::Log4perl qw(get_logger);
+use base  qw(perfSONAR::MA);
+
+use Hades;
+use Hades::Config;
+use Hades::Data::Finder_SQL;
+use Hades::Data::Finder;
+
+sub new{
+       my ($class,%module_param) = @_;
+       my $self = $class->SUPER::new(%module_param);
+        
+       
+       # Now create config and initialise everything
+    $Hades::configfile = undef;
+    $Hades::config = undef;
+    my $config = Hades::Config->new(
+        configfile => $module_param{config},
+        use_argv => 0,
+    );
+    $config->init() or die;
+    @{$config->{config}}{keys %module_param} = values %module_param;
+    $self->{CONFIG} = $config;
+    
+    return $self;
+}
+
+
+sub run{
+    my ($self, $ds) = @_;
+    my $et = "error.ma.parameters";
+    
+    $self->{DS} = $ds;
+    my $data = $$ds->{SERVICE}->{DATA};
+    $self->{FINDER} = Hades::Data::Finder_SQL->new(
+        config => $self->{CONFIG},
+    );
+    #At teh moment all MA steps happen here
+    #We have no other MA services
+    foreach my $id (keys %{$data}){
+        my %params = %{$data->{$id}->{PARAMS}};
+        my $startTime = $params{startTime};
+        my $endTime = $params{endTime};
+        my $currentTime = time;
+                       
+       if ($endTime > $currentTime){
+            $endTime = $currentTime;
+            my @errmsg;
+            my $warnmsg = "WARN: endTime value lies ahead!";
+            push @errmsg, $warnmsg;
+            push @errmsg, $et;
+            $$ds->{SERVICE}->{DATA}->{$id}->{WARN}->{MSG} = 
\@errmsg;
+            $$ds->{SERVICE}->{DATA}->{$id}->{WARN}->{OCCUR} = 1;
+            $self->{LOGGER}->warn($warnmsg);
+        }
+
+       my $src = $params{src};
+       my $dst = $params{dst};
+       my $mid = $params{mid};
+
+       $self->{FINDER}->reset;
+       if (! $self->{FINDER}->set_time_epoch($startTime,$endTime)){ 
+                $$ds->{ERROROCCUR} = 1;
+               my @errmsg;
+               push @errmsg,  "Invalid date format";
+               $self->{LOGGER}->error("@errmsg");
+               push @errmsg,  $et;
+               $$ds->{SERVICE}->{DATA}->{$id}->{MRESULT} = 
\@errmsg;
+               return;
+       }
+       $self->{FINDER}->set_route($src,$dst); # set_route understands 
"undef"!!!               
+       if (defined $$ds->{$$ds->{DSTYPE}}->{HADES}->{ACTION}->{TYPE}){
+               
$self->{FINDER}->set_type($$ds->{$$ds->{DSTYPE}}->{HADES}->{ACTION}->{TYPE});
+       }
+       else{
+               
$self->{FINDER}->set_type($$ds->{$$ds->{DSTYPE}}->{HADES}->{ACTION}->{EVENTYPE}
 );      
+       }
+       
#$self->{LOGGER}->error(Dumper($$ds->{$$ds->{DSTYPE}}->{HADES}->{FILTER}));
+       $self->{FINDER}->set_mid($mid); # ignores "undef"
+       
$self->{FINDER}->set_filter($$ds->{$$ds->{DSTYPE}}->{HADES}->{FILTER}); # 
filter with metadata
+       my @results = $self->{FINDER}->find;
+       
+        unless (@results) {
+           my @errmsg;
+           push @errmsg, "No data found for id: $id";
+           $self->{LOGGER}->error("@errmsg");
+           push @errmsg,  "error.ma.data";
+           $$ds->{SERVICE}->{DATA}->{$id}->{MRESULT} = 
\@errmsg;
+           $$ds->{ERROROCCUR} = 1;
+           return;
+        } 
+
+        my @result_params;
+       #$self->{LOGGER}->info(Dumper(@results));
+        if ($#results > 0){ #More than one measurment result found matching 
the request pattern
+           #get_meta_info($msg);
+           my $output = "";
+           my $count = 0;
+           foreach my $result (@results){
+              my $info = $result->{meta};
+              my %par;
+              foreach my $key (keys %{$info}){
+                    next if ($key eq "sender_port" || $key eq 
"receiver_port");
+                 if ($key eq "interval"){
+                    $par{"interval"} = $info->{"interval"} / 1000000;
+                 } else {
+                    $par{$key} = $info->{$key};
+                 }
+              }#End foreach my $key  
+              
+              $par{"sender"} = $result->{"sender"};
+              $par{"receiver"} = $result->{"receiver"};
+              $par{"mid"} = $result->{"mid"};
+              $par{"metadataIdRef"} = "result$count";
+              $count++;
+
+              push @result_params, \%par;
+              $output = $output . "$result->{sender} to $result->{receiver} "
+                        . $result->type2string() . ", mid: $result->{mid}\n";
+           }#End foreach my $result
+           my $message = "More than one measurement result found";
+           $self->{LOGGER}->warn($message);
+           $self->{LOGGER}->debug("Measurements:\n$output");
+           #Strore params for return msg
+           $$ds->{$$ds->{DSTYPE}}->{HADES}->{$id}->{RESPARAMS}->{OCCURARRAY} 
= 1;
+           $$ds->{$$ds->{DSTYPE}}->{HADES}->{$id}->{RESPARAMS}->{DATA} = 
\@result_params;
+            
+           $self->{LOGGER}->debug($message);
+           $$ds->{ERROROCCUR} = 1;
+           my @errmsg;
+           push @errmsg, $message;
+           push @errmsg, "warning.ma.parameters";
+           $$ds->{SERVICE}->{DATA}->{$id}->{MRESULT} = 
\@errmsg;
+           return;
+       }#iEnd if ($#results > 0
+
+       my $warnings = $self->{FINDER}->{warnings}->get_string();
+       if ($warnings) {
+          #TODO is that right/useful???
+          my @errmsg;
+          push @errmsg, "Warnings from data modules:\n$warnings";
+          $self->{LOGGER}->error("@errmsg");
+          push @errmsg,  "error.ma.data";
+          $$ds->{SERVICE}->{DATA}->{$id}->{MRESULT} = 
\@errmsg;
+          $$ds->{ERROROCCUR} = 1;
+          return;
+       }
+       
+       my $data_obj = $results[0];
+       my $info = $data_obj->{meta};
+       my %par;
+
+       foreach my $key (keys %{$info}){
+             next if ($key eq "sender_port" || $key eq "receiver_port");
+          if ($key eq "interval"){
+             $par{"interval"} = $info->{"interval"} / 1000000;
+          } else {
+             $par{$key} = $info->{$key};
+          }    
+     } #End foreach my $key
+     
+     $par{"sender"} = $data_obj->{"sender"};
+     $par{"mid"} = $data_obj->{"mid"};
+     $par{"receiver"} = $data_obj->{"receiver"};
+     $$ds->{$$ds->{DSTYPE}}->{HADES}->{$id}->{RESPARAMS}->{OCCURHASH} = 1;
+     $$ds->{$$ds->{DSTYPE}}->{HADES}->{$id}->{RESPARAMS}->{DATA} = \%par;
+     if(!(exists $data_obj->{meta})) {
+        my @errmsg;
+        push @errmsg, "No meta data found";
+        push @errmsg,  "error.ma.data";
+        $self->{LOGGER}->error("@errmsg");
+        $$ds->{SERVICE}->{DATA}->{$id}->{MRESULT} = 
\@errmsg;
+        $$ds->{ERROROCCUR} = 1;
+        return;
+     }
+                          
+     $self->{LOGGER}->info("Meta data retrieval seems to be successful");
+
+     $data_obj->extract_data();
+     $warnings = $self->{FINDER}->{warnings}->get_string();
+     if ($warnings) {
+        #TODO is that right/useful???
+        $$ds->{ERROROCCUR} = 1;
+        my @errmsg;
+        push @errmsg,"Warnings from data modules:\n$warnings";
+        $self->{LOGGER}->error("@errmsg");
+        push @errmsg,  "error.ma.data";
+        $$ds->{SERVICE}->{DATA}->{$id}->{MRESULT} = 
\@errmsg;
+        return;
+     }
+     
+     my $data = $data_obj->get_data;
+     unless (defined $data) {
+        $$ds->{ERROROCCUR} = 1;
+        my @errmsg;
+        push @errmsg,"No data found";
+        $self->{LOGGER}->error("@errmsg");
+        push @errmsg,  "error.ma.data";
+        $$ds->{SERVICE}->{DATA}->{$id}->{MRESULT} = 
\@errmsg;
+        return;
+     }
+    
+     $self->{LOGGER}->info("Data retrieval seems to be successful");
+  
+     $$ds->{SERVICE}->{DATA}->{$id}->{MRESULT} = \$data_obj; 
+   }#End foreach my $id (keys
+    
+   return;
+    
+    
+}
+
+1;