"Fossies" - the Fresh Open Source Software Archive

Member "pandora_server/lib/PandoraFMS/Omnishell.pm" (15 Sep 2021, 19822 Bytes) of package /linux/misc/pandorafms_server-7.0NG.757.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. For more information about "Omnishell.pm" see the Fossies "Dox" file reference documentation.

    1 package PandoraFMS::Omnishell;
    2 ################################################################################
    3 # Pandora FMS Omnishell common functions.
    4 #
    5 # (c) Fco de Borja Sánchez <fborja.sanchez@pandorafms.com>
    6 #
    7 ################################################################################
    8 use strict;
    9 use warnings;
   10 
   11 use File::Copy;
   12 use Scalar::Util qw(looks_like_number);
   13 use lib '/usr/lib/perl5';
   14 use PandoraFMS::PluginTools qw/init read_configuration read_file empty trim/;
   15 
   16 my $YAML = 0;
   17 # Dynamic load. Avoid unwanted behaviour.
   18 eval {
   19   eval 'require YAML::Tiny;1' or die('YAML::Tiny lib not found, commands feature won\'t be available');
   20 };
   21 if ($@) {
   22   $YAML = 0;
   23 } else {
   24   $YAML = 1;
   25 }
   26 
   27 use lib '/usr/lib/perl5';
   28 
   29 our @ISA = ("Exporter");
   30 our %EXPORT_TAGS = ( 'all' => [ qw( ) ] );
   31 our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
   32 our @EXPORT = qw();
   33 
   34 # 2 to the power of 32.
   35 use constant POW232 => 2**32;
   36 
   37 ################################################################################
   38 # Return the MD5 checksum of the given string as a hex string.
   39 # Pseudocode from: http://en.wikipedia.org/wiki/MD5#Pseudocode
   40 ################################################################################
   41 my @S = (
   42     7, 12, 17, 22,  7, 12, 17, 22,  7, 12, 17, 22,  7, 12, 17, 22,
   43     5,  9, 14, 20,  5,  9, 14, 20,  5,  9, 14, 20,  5,  9, 14, 20,
   44     4, 11, 16, 23,  4, 11, 16, 23,  4, 11, 16, 23,  4, 11, 16, 23,
   45     6, 10, 15, 21,  6, 10, 15, 21,  6, 10, 15, 21,  6, 10, 15, 21
   46 );
   47 my @K = (
   48     0xd76aa478, 0xe8c7b756, 0x242070db, 0xc1bdceee,
   49     0xf57c0faf, 0x4787c62a, 0xa8304613, 0xfd469501,
   50     0x698098d8, 0x8b44f7af, 0xffff5bb1, 0x895cd7be,
   51     0x6b901122, 0xfd987193, 0xa679438e, 0x49b40821,
   52     0xf61e2562, 0xc040b340, 0x265e5a51, 0xe9b6c7aa,
   53     0xd62f105d, 0x02441453, 0xd8a1e681, 0xe7d3fbc8,
   54     0x21e1cde6, 0xc33707d6, 0xf4d50d87, 0x455a14ed,
   55     0xa9e3e905, 0xfcefa3f8, 0x676f02d9, 0x8d2a4c8a,
   56     0xfffa3942, 0x8771f681, 0x6d9d6122, 0xfde5380c,
   57     0xa4beea44, 0x4bdecfa9, 0xf6bb4b60, 0xbebfbc70,
   58     0x289b7ec6, 0xeaa127fa, 0xd4ef3085, 0x04881d05,
   59     0xd9d4d039, 0xe6db99e5, 0x1fa27cf8, 0xc4ac5665,
   60     0xf4292244, 0x432aff97, 0xab9423a7, 0xfc93a039,
   61     0x655b59c3, 0x8f0ccc92, 0xffeff47d, 0x85845dd1,
   62     0x6fa87e4f, 0xfe2ce6e0, 0xa3014314, 0x4e0811a1,
   63     0xf7537e82, 0xbd3af235, 0x2ad7d2bb, 0xeb86d391
   64 );
   65 sub md5 {
   66     my $str = shift;
   67 
   68     # No input!
   69     if (!defined($str)) {
   70         return "";
   71     }
   72 
   73     # Note: All variables are unsigned 32 bits and wrap modulo 2^32 when
   74     # calculating.
   75 
   76     # Initialize variables.
   77     my $h0 = 0x67452301;
   78     my $h1 = 0xEFCDAB89;
   79     my $h2 = 0x98BADCFE;
   80     my $h3 = 0x10325476;
   81 
   82     # Pre-processing.
   83     my $msg = unpack ("B*", pack ("A*", $str));
   84     my $bit_len = length ($msg);
   85 
   86     # Append "1" bit to message.
   87     $msg .= '1';
   88 
   89     # Append "0" bits until message length in bits ≡ 448 (mod 512).
   90     $msg .= '0' while ((length ($msg) % 512) != 448);
   91 
   92     # Append bit /* bit, not byte */ length of unpadded message as 64-bit
   93     # little-endian integer to message.
   94     $msg .= unpack ("B32", pack ("V", $bit_len));
   95     $msg .= unpack ("B32", pack ("V", ($bit_len >> 16) >> 16));
   96 
   97     # Process the message in successive 512-bit chunks.
   98     for (my $i = 0; $i < length ($msg); $i += 512) {
   99 
  100         my @w;
  101         my $chunk = substr ($msg, $i, 512);
  102 
  103         # Break chunk into sixteen 32-bit little-endian words w[i], 0 <= i <=
  104         # 15.
  105         for (my $j = 0; $j < length ($chunk); $j += 32) {
  106             push (@w, unpack ("V", pack ("B32", substr ($chunk, $j, 32))));
  107         }
  108 
  109         # Initialize hash value for this chunk.
  110         my $a = $h0;
  111         my $b = $h1;
  112         my $c = $h2;
  113         my $d = $h3;
  114         my $f;
  115         my $g;
  116 
  117         # Main loop.
  118         for (my $y = 0; $y < 64; $y++) {
  119             if ($y <= 15) {
  120                 $f = $d ^ ($b & ($c ^ $d));
  121                 $g = $y;
  122             }
  123             elsif ($y <= 31) {
  124                 $f = $c ^ ($d & ($b ^ $c));
  125                 $g = (5 * $y + 1) % 16;
  126             }
  127             elsif ($y <= 47) {
  128                 $f = $b ^ $c ^ $d;
  129                 $g = (3 * $y + 5) % 16;
  130             }
  131             else {
  132                 $f = $c ^ ($b | (0xFFFFFFFF & (~ $d)));
  133                 $g = (7 * $y) % 16;
  134             }
  135 
  136             my $temp = $d;
  137             $d = $c;
  138             $c = $b;
  139             $b = ($b + leftrotate (($a + $f + $K[$y] + $w[$g]) % POW232, $S[$y])) % POW232;
  140             $a = $temp;
  141         }
  142 
  143         # Add this chunk's hash to result so far.
  144         $h0 = ($h0 + $a) % POW232;
  145         $h1 = ($h1 + $b) % POW232;
  146         $h2 = ($h2 + $c) % POW232;
  147         $h3 = ($h3 + $d) % POW232;
  148     }
  149 
  150     # Digest := h0 append h1 append h2 append h3 #(expressed as little-endian)
  151     return unpack ("H*", pack ("V", $h0)) .
  152            unpack ("H*", pack ("V", $h1)) .
  153            unpack ("H*", pack ("V", $h2)) .
  154            unpack ("H*", pack ("V", $h3));
  155 }
  156 
  157 ################################################################################
  158 # MD5 leftrotate function. See: http://en.wikipedia.org/wiki/MD5#Pseudocode
  159 ################################################################################
  160 sub leftrotate {
  161     my ($x, $c) = @_;
  162 
  163     return (0xFFFFFFFF & ($x << $c)) | ($x >> (32 - $c));
  164 }
  165 
  166 ################################################################################
  167 # return last error.
  168 ################################################################################
  169 sub get_last_error {
  170   my ($self) = @_;
  171 
  172   if (!empty($self->{'last_error'})) {
  173     return $self->{'last_error'};
  174   }
  175 
  176   return '';
  177 }
  178 
  179 ################################################################################
  180 # Update last error.
  181 ################################################################################
  182 sub set_last_error {
  183     my ($self, $error) = @_;
  184 
  185   $self->{'last_error'} = $error;
  186 }
  187 
  188 ################################################################################
  189 # Try to load extra libraries.c
  190 ################################################################################
  191 sub load_libraries {
  192   my $self = shift;
  193 
  194   # Dynamic load. Avoid unwanted behaviour.
  195   eval {eval 'require YAML::Tiny;1' or die('YAML::Tiny lib not found, commands feature won\'t be available');};
  196   if ($@) {
  197     $self->set_last_error($@);
  198     return 0;
  199   } else {
  200     return 1;
  201   }
  202 }
  203 
  204 ################################################################################
  205 # Create new omnishell handler.
  206 ################################################################################
  207 sub new {
  208   my ($class, $args) = @_;
  209 
  210   if (ref($args) ne 'HASH') {
  211     return undef;
  212   }
  213 
  214   my $system = init();
  215   my $self = {
  216     'server_ip' => 'localhost',
  217       'server_path' => '/var/spool/pandora/data_in',
  218       'server_port' => 41121,
  219       'transfer_mode' => 'tentacle',
  220       'transfer_mode_user' => 'apache',
  221       'transfer_timeout' => 30,
  222       'server_user' => 'pandora',
  223       'server_pwd' => '',
  224       'server_ssl' => '0',
  225       'server_opts' => '',
  226       'delayed_startup' => 0,
  227       'pandora_nice' => 10,
  228       'cron_mode' => 0,
  229     'last_error' => undef,
  230     %{$system},
  231     %{$args},
  232   };
  233 
  234   $self->{'temporal'} =~ s/\"|\'//g;
  235   $self = bless($self, $class);
  236   $self->prepare_commands();
  237 
  238   return $self;
  239 }
  240 
  241 ################################################################################
  242 # Run all, output mode 'xml'  will dump to STDOUT and return an array of strings
  243 #, any other option will return an array with all results.
  244 ################################################################################
  245 sub run {
  246   my ($self, $output_mode) = @_;
  247 
  248   my @results;
  249 
  250   foreach my $ref (keys %{$self->{'commands'}}) {
  251     my $rs = $self->runCommand($ref, $output_mode);
  252     if ($rs) {
  253       push @results, $rs;
  254     }
  255   }
  256 
  257   if ($output_mode eq 'xml') {
  258     print join("\n",@results);
  259   }
  260 
  261   return \@results;
  262 }
  263 
  264 ################################################################################
  265 # Run command, output mode 'xml'  will dump to STDOUT, other will return a hash
  266 # with all results.
  267 ################################################################################
  268 sub runCommand {
  269   my ($self, $ref, $output_mode) = @_;
  270 
  271   if($self->load_libraries()) {
  272     # Functionality possible.
  273     my $command = $self->{'commands'}->{$ref};
  274     my $result = $self->evaluate_command($ref);
  275     if (ref($result) eq "HASH") {
  276       # Process command result.
  277       if (defined($output_mode) && $output_mode eq 'xml') {
  278         my $output = '';
  279         $output .= "<cmd_report>\n";
  280         $output .= "  <cmd_response>\n";
  281         $output .= "    <cmd_name><![CDATA[".$result->{'name'}."]]></cmd_name>\n";
  282         $output .= "    <cmd_key><![CDATA[".$ref."]]></cmd_key>\n";
  283         $output .= "    <cmd_errorlevel><![CDATA[".$result->{'error_level'}."]]></cmd_errorlevel>\n";
  284         $output .= "    <cmd_stdout><![CDATA[".$result->{'stdout'}."]]></cmd_stdout>\n";
  285         $output .= "    <cmd_stderr><![CDATA[".$result->{'stderr'}."]]></cmd_stderr>\n";
  286         $output .= "  </cmd_response>\n";
  287         $output .= "</cmd_report>\n";
  288 
  289         return $output;
  290       }
  291       return $result;
  292     } else {
  293       $self->set_last_error('Failed to process ['.$ref.']: '.$result);
  294     }
  295   }
  296 
  297   return undef;
  298 }
  299 
  300 ################################################################################
  301 # Check for remote commands defined.
  302 ################################################################################
  303 sub prepare_commands {
  304   my ($self) = @_;
  305 
  306   if ($YAML == 0) {
  307     $self->set_last_error('Cannot use commands without YAML dependency, please install it.');
  308     return;
  309   }
  310 
  311   # Force configuration file read.
  312   my $commands = $self->{'commands'};  
  313 
  314   if (empty($commands)) {
  315     $self->{'commands'} = {};
  316   } else {
  317     foreach my $rcmd (keys %{$commands}) {
  318       $self->{'commands'}->{trim($rcmd)} = {};
  319     }
  320   }
  321 
  322   # Cleanup old commands. Not registered.
  323   $self->cleanup_old_commands();
  324 
  325   foreach my $ref (keys %{$self->{'commands'}}) {
  326     my $file_content;
  327     my $download = 0;
  328     my $rcmd_file = $self->{'ConfDir'}.'/commands/'.$ref.'.rcmd';
  329 
  330     # Search for local .rcmd file
  331     if (-e $rcmd_file) {
  332       my $remote_md5_file = $self->{'temporal'}.'/'.$ref.'.md5';
  333 
  334       $file_content = read_file($rcmd_file);
  335       if ($self->recv_file($ref.'.md5', $remote_md5_file) != 0) {
  336         # Remote file could not be retrieved, skip.
  337         delete $self->{'commands'}->{$ref};
  338         next;
  339       }
  340 
  341       my $local_md5 = md5($file_content);
  342       my $remote_md5 = md5(read_file($remote_md5_file));
  343 
  344       if ($local_md5 ne $remote_md5) {
  345         # Must be downloaded again.
  346         $download = 1;
  347       }
  348     } else {
  349       $download = 1;
  350     }
  351     
  352     # Search for remote .rcmd file
  353     if ($download == 1) {
  354       # Download .rcmd file
  355       if ($self->recv_file($ref.'.rcmd') != 0) {
  356         # Remote file could not be retrieved, skip.
  357         delete $self->{'commands'}->{$ref};
  358         next;
  359       } else {
  360         # Success
  361         move($self->{'temporal'}.'/'.$ref.'.rcmd', $rcmd_file);
  362       }
  363     }
  364     
  365     # Parse and prepare in memory skel.
  366     eval {
  367       $self->{'commands'}->{$ref} = YAML::Tiny->read($rcmd_file);
  368     };
  369     if ($@) {
  370       # Failed.
  371       $self->set_last_error('Failed to decode command. ' . "\n".$@);
  372       delete $self->{'commands'}->{$ref};
  373       next;
  374     }
  375 
  376   }
  377 }
  378 
  379 ################################################################################
  380 # Command report.
  381 ################################################################################
  382 sub report_command {
  383   my ($self, $ref, $err_level) = @_;
  384 
  385   # Retrieve content from .stdout and .stderr
  386   my $stdout_file = $self->{'temporal'}.'/'.$ref.'.stdout';
  387   my $stderr_file = $self->{'temporal'}.'/'.$ref.'.stderr';
  388 
  389   my $return;
  390   eval {
  391     $return = {
  392       'error_level' => $err_level,
  393       'stdout' => read_file($stdout_file),
  394       'stderr' => read_file($stderr_file),
  395     };
  396 
  397     $return->{'name'} = $self->{'commands'}->{$ref}->[0]->{'name'};
  398   };
  399   if ($@) {
  400     $self->set_last_error('Failed to report command output. ' . $@);
  401   }
  402 
  403   # Cleanup
  404   unlink($stdout_file) if (-e $stdout_file);
  405   unlink($stderr_file) if (-e $stderr_file);
  406 
  407   # Mark command as done.
  408   open (my $R_FILE, '> '.$self->{'ConfDir'}.'/commands/'.$ref.'.rcmd.done');
  409   print $R_FILE $err_level;
  410   close($R_FILE);
  411 
  412 
  413   $return->{'stdout'} = '' unless defined ($return->{'stdout'});
  414   $return->{'stderr'} = '' unless defined ($return->{'stderr'});
  415 
  416   return $return;
  417 }
  418 
  419 ################################################################################
  420 # Cleanup unreferenced rcmd and rcmd.done files.
  421 ################################################################################
  422 sub cleanup_old_commands {
  423   my ($self) = @_;
  424 
  425   # Cleanup old .rcmd and .rcmd.done files.
  426   my %registered = map { $_.'.rcmd' => 1 } keys %{$self->{'commands'}};
  427   if(opendir(my $dir, $self->{'ConfDir'}.'/commands/')) {
  428     while (my $item = readdir($dir)) {
  429 
  430       # Skip other files.
  431       next if ($item !~ /\.rcmd$/);
  432 
  433       # Clean .rcmd.done file if its command is not referenced in conf.
  434       if (!defined($registered{$item})) {
  435         if (-e $self->{'ConfDir'}.'/commands/'.$item) {
  436           unlink($self->{'ConfDir'}.'/commands/'.$item);
  437         }
  438         if (-e $self->{'ConfDir'}.'/commands/'.$item.'.done') {
  439           unlink($self->{'ConfDir'}.'/commands/'.$item.'.done');
  440         }
  441       }
  442     }
  443 
  444     # Close dir.
  445     closedir($dir);
  446   }
  447 
  448 }
  449 
  450 ################################################################################
  451 # Executes a command using defined timeout.
  452 ################################################################################
  453 sub execute_command_timeout {
  454   my ($self, $cmd, $timeout) = @_;
  455 
  456   if (!defined($timeout)
  457     || !looks_like_number($timeout)
  458     || $timeout <= 0
  459   ) {
  460     `$cmd`;
  461     return $?>>8;
  462   }
  463 
  464   my $remaining_timeout = $timeout;
  465 
  466   my $RET;
  467   my $output;
  468 
  469   my $pid = open ($RET, "-|");
  470   if (!defined($pid)) {
  471     # Failed to fork.
  472     $self->set_last_error('[command] Failed to fork.');
  473     return undef;
  474   }
  475   if ($pid == 0) {
  476     # Child.
  477     my $ret;
  478     eval {
  479       local $SIG{ALRM} = sub { die "timeout\n" };
  480       alarm $timeout;
  481       `$cmd`;
  482       alarm 0;
  483     };
  484 
  485     my $result = ($?>>8);
  486     return $result;
  487 
  488     # Exit child.
  489     # Child finishes.
  490     exit;
  491 
  492   } else {
  493     # Parent waiting.
  494     while( --$remaining_timeout > 0 ){
  495       if (wait == -1) {
  496         last;
  497       }
  498       # Wait child up to timeout seconds.
  499       sleep 1;
  500     }
  501   }
  502 
  503   if ($remaining_timeout > 0) {
  504     # Retrieve output from child.
  505     $output = do { local $/; <$RET> };
  506     $output = $output>>8;
  507   }
  508   else {
  509     # Timeout expired.
  510     return 124;
  511   }
  512 
  513   close($RET);
  514 
  515   return $output;
  516 }
  517 
  518 ################################################################################
  519 # Executes a block of commands, returns error level, leaves output in 
  520 # redirection set by $std_files. E.g:
  521 # $std_files = ' >>  /tmp/stdout 2>> /tmp/stderr
  522 ################################################################################
  523 sub execute_command_block {
  524   my ($self, $commands, $std_files, $timeout, $retry) = @_;
  525 
  526   return 0 unless defined($commands);
  527 
  528   my $retries = $retry;
  529 
  530   $retries = 1 unless looks_like_number($retries) && $retries > 0;
  531 
  532   my $err_level = 0;
  533   $std_files = '' unless defined ($std_files);
  534 
  535   if (ref($commands) ne "ARRAY") {
  536     return 0 if $commands eq '';
  537 
  538     do {
  539       $err_level = $self->execute_command_timeout(
  540         "($commands) $std_files",
  541         $timeout
  542       );
  543 
  544       # Do not retry if success.
  545       last if looks_like_number($err_level) && $err_level == 0;
  546     } while ((--$retries) > 0);
  547 
  548   } else {
  549     foreach my $comm (@{$commands}) {
  550       next unless defined($comm);
  551       $retries = $retry;
  552       $retries = 1 unless looks_like_number($retries) && $retries > 0;
  553 
  554       do {
  555         $err_level = $self->execute_command_timeout(
  556           "($comm) $std_files",
  557           $timeout
  558         );
  559 
  560         # Do not retry if success.
  561         $retries = 0 if looks_like_number($err_level) && $err_level == 0;
  562 
  563       } while ((--$retries) > 0);
  564 
  565       # Do not continue evaluating block if failed.
  566       last unless ($err_level == 0);
  567     }
  568   }
  569 
  570   return $err_level;
  571 }
  572 
  573 ################################################################################
  574 # Evalate given command.
  575 ################################################################################
  576 sub evaluate_command {
  577   my ($self, $ref) = @_;
  578 
  579   # Not found.
  580   return "undefined command" unless defined $self->{'commands'}->{$ref};
  581 
  582   # Already completed.
  583   return "already executed" if (-e $self->{'ConfDir'}.'/commands/'.$ref.'.rcmd.done');
  584 
  585   # [0] because how library works.
  586   my $cmd = $self->{'commands'}->{$ref}->[0];
  587 
  588   my $std_files = ' >> "'.$self->{'temporal'}.'/'.$ref.'.stdout" ';
  589   $std_files .= ' 2>> "'.$self->{'temporal'}.'/'.$ref.'.stderr" ';
  590 
  591   # Check preconditions
  592   my $err_level;
  593   
  594   $err_level = $self->execute_command_block(
  595     $cmd->{'preconditions'},
  596     $std_files,
  597     $cmd->{'timeout'}
  598   );
  599 
  600   # Precondition not satisfied.
  601   return $self->report_command($ref, $err_level) unless ($err_level == 0);
  602 
  603   # Main run.
  604   $err_level = $self->execute_command_block(
  605     $cmd->{'script'},
  606     $std_files,
  607     $cmd->{'timeout'}
  608   );
  609 
  610   # Script not success.
  611   return $self->report_command($ref, $err_level) unless ($err_level == 0);
  612 
  613   # Check postconditions
  614   $err_level = $self->execute_command_block(
  615     $cmd->{'postconditions'},
  616     $std_files,
  617     $cmd->{'timeout'}
  618   );
  619 
  620   # Return results.
  621   return $self->report_command($ref, $err_level);
  622 }
  623 
  624 ################################################################################
  625 # File transference and imported methods
  626 ################################################################################
  627 ################################################################################
  628 ## Remove any trailing / from directory names.
  629 ################################################################################
  630 sub fix_directory ($) {
  631     my $dir = shift;
  632 
  633     my $char = chop($dir);
  634     return $dir if ($char eq '/');
  635     return $dir . $char;
  636 }
  637 
  638 ################################################################################
  639 # Receive a file from the server.
  640 ################################################################################
  641 sub recv_file {
  642   my ($self, $file, $relative) = @_;
  643   my $output;
  644 
  645   my $DevNull = $self->{'__system'}->{'devnull'};
  646   my $CmdSep = $self->{'__system'}->{'cmdsep'};
  647   
  648   my $pid = fork();
  649     return 1 unless defined $pid;
  650 
  651   # Fix remote dir to some transfer mode
  652   my $remote_dir = $self->{'server_path'};
  653   $remote_dir .= "/" . fix_directory($relative) if defined($relative);
  654 
  655   if ($pid == 0) {
  656     # execute the transfer program by child process.
  657     eval {
  658       local $SIG{'ALRM'} = sub {die};
  659       alarm ($self->{'transfer_timeout'});
  660       if ($self->{'transfer_mode'} eq 'tentacle') {
  661          $output = `cd "$self->{'temporal'}"$CmdSep tentacle_client -v -g -a $self->{'server_ip'} -p $self->{'server_port'} $self->{'server_opts'} $file 2>&1 >$DevNull`
  662       } elsif ($self->{'transfer_mode'} eq 'ssh') {
  663          $output = `scp -P $self->{'server_port'} pandora@"$self->{'server_ip'}:$self->{'server_path'}/$file" $self->{'temporal'} 2>&1 >$DevNull`;
  664       } elsif ($self->{'transfer_mode'} eq 'ftp') {
  665         my $base = basename ($file);
  666         my $dir = dirname ($file);
  667 
  668         $output = `ftp -n $self->{'server_opts'} $self->{'server_ip'} $self->{'server_port'} 2>&1 >$DevNull <<FEOF1
  669         quote USER $self->{'server_user'}
  670         quote PASS $self->{'server_pwd'}
  671         lcd "$self->{'temporal'}"
  672         cd "$self->{'server_path'}"
  673         get "$file"
  674         quit
  675         FEOF1`
  676       } elsif ($self->{'transfer_mode'} eq 'local') {
  677         $output = `cp "$remote_dir/$file" $self->{'temporal'} 2>&1 >$DevNull`;
  678       }
  679       alarm (0);
  680     };
  681 
  682     if ($@) {
  683       $self->set_last_error("Error retrieving file: '.$file.' File transfer command is not responding.");
  684       exit 1;
  685     }
  686 
  687     # Get the errorlevel
  688     my $rc = $? >> 8;
  689     if ($rc != 0) {
  690       $self->set_last_error("Error retrieving file: '$file' $output");
  691     }
  692     exit $rc;
  693   }
  694 
  695   # Wait the child process termination and get the errorlevel
  696   waitpid ($pid, 0);
  697   my $rc = $? >> 8;
  698 
  699   return $rc;
  700 }
  701 
  702 
  703 1;