view release on metacpan or  search on metacpan

lib/Clustericious/Admin/Server.pm  view on Meta::CPAN

  #     print out extra diagnostics
  #
  #   version: required number or 'dev'
  #     the client version
  #
  #   require: optional, number or 'dev'
  #     specifies the minimum required server
  #     server should die if requirement isn't met
  #     ignored if set to 'dev'
  #
  #   files: optional list of hashref   [ 1.01 ]
  #     each hashref has:
  #       name: the file basename (no directory)
  #       content: the content of the file
  #       mode: (optional) octal unix permission mode as a string (ie "0755" or "0644")
  #       env: (optional) environment variable to use instead of FILEx
  #
  #   dir: optional hash of hash        [ 1.02 ]
  #     each key is a path
  #       each value is a hash
  #         is_dir
  #         content
  #         mode
  #
  #   stdin: optional scalar            [ 1.04 ]

  if(ref $payload->{command} ne 'ARRAY' || @{ $payload->{command} } == 0)
  {
    print STDERR "Clad Server: Unable to find command\n";
    return 2;
  }
  
  if(defined $payload->{env} && ref $payload->{env} ne 'HASH')
  {
    print STDERR "Clad Server: env is not hash\n";
    return 2;
  }
  
  unless($payload->{version})
  {
    print STDERR "Clad Server: no client version\n";
    return 2;
  }
  
  if($payload->{require} && defined $Clustericious::Admin::Server::VERSION)
  {
    if($payload->{require} ne 'dev' && $payload->{require} > $Clustericious::Admin::Server::VERSION)
    {
      print STDERR "Clad Server: client requested version @{[ $payload->{require} ]} but this is only $Clustericious::Admin::Server::VERSION\n";
      return 2;
    }
  }

  if($payload->{files})
  {
    my $count = 1;
    foreach my $file (@{ $payload->{files} })
    {
      my $path = File::Spec->catfile( tempdir( CLEANUP => 1 ), $file->{name} );
      open my $fh, '>', $path;
      chmod oct($file->{mode}), $path if defined $file->{mode};
      binmode $fh;
      print $fh $file->{content};
      close $fh;
      my $env = $file->{env};
      $env = "FILE@{[ $count++ ]}" unless defined $env;
      $ENV{$env} = $path;
    }
  }
  
  if($payload->{dir})
  {
    my $root = $ENV{DIR} = tempdir( CLEANUP => 1 );
    
    foreach my $name (sort keys %{ $payload->{dir} })
    {
      my $dir = $payload->{dir}->{$name};
      next unless $dir->{is_dir};
      my $path = File::Spec->catdir($root, $name);
      mkdir $path;
      chmod oct($dir->{mode}), $path if defined $dir->{mode};
    }
    
    foreach my $name (sort keys %{ $payload->{dir} })
    {
      my $file = $payload->{dir}->{$name};
      next if $file->{is_dir};
      my $path = File::Spec->catfile($root, $name);
      open my $fh, '>', $path;
      chmod oct($file->{mode}), $fh if defined $file->{mode};
      binmode $fh;
      print $fh $file->{content};
      close $fh;
    }
  }

  $ENV{$_} = $payload->{env}->{$_} for keys %{ $payload->{env} };
  
  if(defined $payload->{stdin})
  {
    my $filename = File::Spec->catfile(tempdir(CLEANUP => 1), 'stdin.txt');
    open OUT, ">$filename"; 
    print OUT $payload->{stdin};
    close OUT;
    open STDIN, "<$filename";
  }
  
  system @{ $payload->{command} };
  
  if($? == -1)
  {
    print STDERR "Clad Server: failed to execute on @{[ hostname ]}\n";
    return 2;
  }
  elsif($? & 127)
  {
    print STDERR "Clad Server: died with signal @{[ $? & 127 ]} on @{[ hostname ]}\n";
    return 2;
  }
  
  return $? >> 8;
}

exit __PACKAGE__->_server(*DATA) unless caller;

1;

=pod

=encoding UTF-8

=head1 NAME

Clustericious::Admin::Server - Parallel SSH client server side code

=head1 VERSION

version 1.11

=head1 SYNOPSIS

 % perldoc clad

=head1 DESCRIPTION

This module provides part of the implementation for the
L<clad> command.  See the L<clad> command for the public
interface.

=head1 SEE ALSO