package WebTerminal::Dispatcher; use vars qw( $VERSION ); $VERSION = '0.1.0'; use strict; use utf8; # # based on testmsg.pl from "Advanced Perl Programming" # use WebTerminal::Msg; use Exporter; our @ISA = qw( Exporter ); our @EXPORT = qw(send ); our @EXPORT_OK = qw(send ); our %EXPORT_TAGS = ( ALL => [qw( send )], DEFAULT => [], ); sub send { my $id = shift; my $ip = shift; my $cmds = shift; my $host = 'localhost'; my $port = 2057; my $cmd=''; my @cmdlines=split("\n",$cmds); for my $cmdline (reverse @cmdlines) { $cmdline=~/^\s*$/ && next; $cmdline=~/^(pugs|\.\.\.\.)\>\s+/ && do { $cmd=$cmdline; $cmd=~s/^(pugs|\.\.\.\.)\>\s+//; chomp $cmd; last; }; } # We're using PUGS_SAFEMODE=1 instead # if ($cmd=~/\b(system|exec|fork|wait|open|slurp|eval|kill)\b|(\`)/) { # my $offending_command=$1||$2; # return "Sorry, \'$offending_command\' is not allowed.\npugs> "; # } else { my $conn; my $ntries=5; # for (1..$ntries) { $conn = WebTerminal::Msg->connect( $host, $port, \&rcvd_msg_from_server ); # die "Client could not connect to $host:$port ($wd)\n" unless $conn; if (not $conn) { # # Assume server has died #WV: disabled until stable # system("/usr/bin/perl ../bin/termserv.pl"); # sleep 5; # } else {last;} return "Sorry, the pugs server is not running."; } else { my $msg = "$id\n$ip\n" . $cmd; $conn->send_now($msg); ( my $rmesg, my $err ) = $conn->rcv_now(); ( my $rid, my $reply ) = split( "\n", $rmesg, 2 ); $conn->disconnect(); if ( "$id" ne "$rid" ) { # die "Terminal server returned wrong id: $rid, should be $id"; return "Sorry, the pugs session died."; } return $reply; } } sub rcvd_msg_from_server { my ( $conn, $msg, $err ) = @_; if ( defined $msg ) { die "Strange... shouldn't really be coming here\n"; } }