Hello Perl Monks,

i'm new to perl and trying to build a webserver that executes commands on multiple remote devices. I'm using Expect.pm to establish the ssh connection, send the commands and retrieve the results. For each connection a subprocess is started as required (tainted). The code works as expected when executed in the console but when the sub is invoked via the html interface, the Expect.pm subroutines do not retrieve the response from the remote device. I'm assuming some right issue, but i don't know how to address it ... Any help is appreciated!

Friendly Regards,

Phil

Remote Class - builds upon Expect.pm to establish a ssh connection.

#!/usr/bin/perl -wT

use lib "/daten/http/toolbox_dev/cgi-bin/bambi/pw/server";      # add 
+source folder to path.
use warnings;
use strict;
use config;                                                     # load
+ configuration.
use Expect;                                                     # load
+ expect routines.
use process;                                                    # load
+ multi process routines.
use tools;                                                      #
use Data::Dumper;                                               #

######################################
# The Remote Class is used to execute commands on hosts.
######################################

package Remote;

my $user = "XXX";
my $pass = "XXX";
my $prompt = '^\w+#';           # regular expression that matches the 
+command prompt (currently rough).
my $timeout = 10;               # seconds before the connection is abo
+rted.

# start a ssh connection and handle login dialog.
# :param 0:     host to connect to.
# :return:      established ssh connection.
sub open_ssh {
    my ($host) = @_;
    my $ssh_cmd = "ssh ".$user."@".$host;
    Debug::dlog("connecting to $host");
    my $exp = Expect->spawn($ssh_cmd) or return;
    Debug::dlog("$exp spawned ssh");
    $exp->restart_timeout_upon_receive(1);
    $exp->log_stdout(0);
    $exp->expect($timeout,
                ["yes/no", \&send_yes, $exp],
                ["assword", \&send_pass, $exp],
                [$prompt]);
    return $exp;
}

# send the user name to a host.
# :param 0:     established ssh connection.
# :return:
sub send_user {
    my ($exp) = @_;
    $exp->send("$user\n");
    Debug::dlog("$exp send user");
    $exp->exp_continue;
}

# send the password to the host.
# :param 0:     established ssh connection.
# :return:
sub send_pass {
    my ($exp) = @_;
    $exp->send("$pass\n");
    Debug::dlog("$exp send password");
    $exp->exp_continue;
}

# send yes to the host.
# :param 0:     established ssh connection.
# :return:
sub send_yes {
    my ($exp) = @_;
    $exp->send("yes\n");
    Debug::dlog("$exp send yes");
    $exp->exp_continue;
}

# execute a command on the host and retrieve its response..
# :param 0:     established ssh connection.
# :param 1:     command to execute.
# :return:      response of the host.
sub exec_cmd {
    my ($exp, $cmd) = @_;
    $exp->send("$cmd\n");
    await_prompt($exp);
    my $response = $exp->before();
    Debug::dlog("$exp executed $cmd, retrieved ".length($response)." c
+hars");
    return $response;
}

# wait for acknowlegment of the host (currently rough)
# :param 0:     established ssh connection.
# :return:
sub await_prompt {
    my ($exp) = @_;
    $exp->expect($timeout,
                [$prompt]);
}

# disconnect from the host.
# :param 0:     established ssh connection.
# :return:
sub quit {
    my ($exp) = @_;
    $exp->send("exit\n");
    $exp->soft_close();
    Debug::dlog("$exp disconnected");
}

# executes multiple commands on a host and retrieve the responses.
# :param 0:     array of commands to execute.
# :param 1:     host to connect to.
# :return:      dictionary with the commands as keys and the responses
+ as values.
sub exec_on {
    my ($cmds, $host) = @_;
    my $ssh = open_ssh($host);
    if($ssh) {
        my %cmd_resp = ();
        foreach my $cmd (@$cmds) {
            $cmd_resp{$cmd} = exec_cmd($ssh, $cmd);
        }
        quit($ssh);
        return \%cmd_resp;
    } else {
        Debug::dlog("failed to connect to $host");
        return "Couldn't start SSH";
    }
}

# executes multiple commands on multiple hosts and retrieve the respon
+ses.
# :param 0:     array of commands to execute.
# :param 1:     array of hosts to connect to.
# :return:      dictionary with the host names as keys and the command
+ dictionary as value.
sub exec_on_each {
    my ($cmds, $hosts) = @_;
    my %host_resp = ();
    foreach my $host (@$hosts) {
        $host_resp{$host} = exec_on($cmds, $host);
    }
    return \%host_resp;
}
[download]

Dispatcher Class - starts a subprocess and retrieves the return of a function via a pipe.

#!/usr/bin/perl -wT

######################################
# The Dispatcher Class can execute a function in a sub process.
# Pipes are used for IPC. The result of the function is serialized
# in order to be transmitted as a string message.
######################################

package Dispatcher;


use lib "/daten/http/toolbox_dev/cgi-bin/bambi/pw/server";      # add 
+source folder to path.
use strict;
use warnings;
use Data::Dumper;                                               # seri
+alization routines
use tools;                                                      #

$Data::Dumper::Indent = 0;      #
$Data::Dumper::Maxdepth = 3;    #
$Data::Dumper::Purity = 0;      #
$Data::Dumper::Deepcopy = 1;    #

@Dispatcher::workers = ();              # array that holds all worker 
+objects currently running.
@Dispatcher::jobs = ();         # array that holds all jobs to execute
+.

# appends multiple jobs to the dispatchers query.
# :param 0:     array of jobs.
# :return:
sub query_jobs {
    my ($jobs) = @_;
    push(@Dispatcher::jobs, @$jobs);
}

# appends a job to the dispatchers query.
# :param 0:     job
# :return:
sub query_job {
    my ($job) = @_;
    push(@Dispatcher::jobs, $job);
}

# executes all jobs in the query.
# :return:      the data returned from the workers.
sub execute_jobs {
    foreach my $job (@Dispatcher::jobs) {
        assign_job($job);               # assign a worker process to t
+he job.
    }
    @Dispatcher::jobs = ();             # clear list of jobs.
    return join_jobs();
}
# assigns a job to a worker process.
# :param 0:     job.
# :return:
sub assign_job {
    my ($job) = @_;
    my $pid = open my $pipe => "-|";                    # create worke
+r process and connect it using a pipe.
    Debug::dlog("spawned process : $pid");
    die "Failed to fork: $!" unless defined $pid;       # check that c
+reation was successfull.
    my $routine = $job->get_routine();                  # get routine 
+to execute.
    my $params = $job->get_params();                    # get paramete
+rs to pass.
    unless ($pid) {                                     # the followin
+g code is only executed in the worker process:
        $ENV{"PATH"} = "/usr/bin";                      # delete conte
+xt.
        my $return = $routine->(@$params);              # execute rout
+ine.
        my $dump = Dumper($return);                     # serialize th
+e returned object.
        print($dump);                                   # print data s
+tring to pipe.
        Debug::dlog("process ".$$." dumped ".length($dump)." chars");
        exit;                                           # terminate pr
+ocess.
    } else {                                            # only in pare
+nt process:
        my $worker = new Worker($pipe, $pid);           # construct ne
+w worker object.
        push(@Dispatcher::workers, $worker);            # save worker 
+object.
    }
}

# waits till all workers are finished and returns the generated data.
# :return:      data returned from workers.
sub join_jobs {
    my @output;
    foreach my $worker (@Dispatcher::workers) {
        waitpid($worker->get_pid(), 0);                               
+  # wait till worker is done.
        Debug::dlog("process ".$worker->get_pid()." exited");
        my $data = receive_data($worker->get_pipe());                 
+  # receive the data.
        Debug::dlog("received $data from process ".$worker->get_pid())
+;
        push(@output, $data);                                         
+  # save data.
    }
    @Dispatcher::workers = ();                                        
+  # clear list of workers.
    return @output;
}

# receives the serialized data and recreate the original data structur
+e.
# :param 0:     pipe to receive from.
# :return:      the original data structure.
sub receive_data {
    my ($pipe) = @_;
    my @lines = <$pipe>;
    my $data_str = join('', @lines);
    my $sec_str = Tools::untaint($data_str);
    Debug::dlog("received ".length($sec_str)." chars");;
    my $VAR1 = "";
    eval $sec_str;
    return $VAR1;
}

######################################
# The Job class encapsulates a routine and its parameters
######################################

package Job;

# the constructor is passed the routine reference and the parameter ar
+ray.
# :param 0:     the object name (passed automatically).
# :param 1:     the routine to execute.
# :param 2:     the parameters to pass to it.
# :return:      job object.
sub new {
    my $class = shift;
    my $self = {
        _routine => shift,
        _params => shift
    };
    bless $self, $class;
    return $self;
}

# returns the routine reference.
# :return:      routine reference.
sub get_routine {
    my ($self) = @_;
    return $self->{_routine};
}


# returns the parameter array.
# :return:      parameters array.
sub get_params {
    my ($self) = @_;
    return $self->{_params};
}

######################################
# The Worker class holds the data of the spawned subprocess.
######################################

package Worker;

# the constructor is passed the pipe reference and the pid.
# :param 0:     the object name (passed automatically).
# :param 1:     the pipe object.
# :param 2      the pid of the corresponding prcoess.
# :return:      worker object.
sub new {
    my $class = shift;
    my $self = {
        _pipe => shift,
        _pid => shift
    };
    bless $self, $class;
    return $self;
}

# returns the pipe reference.
# :return:      pipe.
sub get_pipe {
    my ($self) = @_;
    return $self->{_pipe};
}

# returns the pid.
# :return:      pid.
sub get_pid {
    my ($self) = @_;
    return $self->{_pid};
}
[download]