#!/usr/bin/perl
# Simple Tk windows proxy client built on POE::Component::Proxy::TCP.
# Andrew Purshottam Oct 2003
# To do:
# - catch interrupt and recovery gracefully from shutdowns
# - recover from remote server and client crashes
# - (speculative) support multiple connections by generating extra
# request/response window pairs (maybe side by side, and with
# kill checkbox for the pair. This might be easy or impossible dependingon what
# toolkit gives.)
# - label output from different connections somehow.
use warnings;
use strict;
use diagnostics;
use Getopt::Std;
use Tk;
use Tk::ProgressBar;
sub POE::Kernel::ASSERT_DEFAULT () { 1 }
use POE;
use POE::Filter::Stream;
use POE::Filter::Line;
use POE::Component::Proxy::TCP;
use Data::Dumper;
use POSIX;
$|++;
# Command line arg processing
my $debug_flag = 1;
my $remote_server_host = "localhost";
my $remote_server_port = 80;
my $local_server_port = 8080;
my %argv;
getopt("dlrshw", \%argv);
$debug_flag = $argv{'d'} unless !exists($argv{'d'});
$remote_server_port = $argv{'r'} unless !exists($argv{'r'});
$local_server_port = $argv{'l'} unless !exists($argv{'l'});
$remote_server_host = $argv{'s'} unless !exists($argv{'s'});
# Create UI session which when started brings up the main frame window
# and listens for events to put text in request and response view
#scrolling text boxes.
my $ui_session = POE::Session->create
( inline_states =>
{ _start => \&ui_start,
ev_post_string => \&ui_post_string_to_widget,
ev_clear => \&ui_clear,
}
);
# Server side of proxy, clients connect to this, and this in turn
# connects to a remote server.
my $proxy_component = POE::Component::Proxy::TCP->new
( Alias => "ProxyServerSessionAlias",
Port => $local_server_port,
OrigPort => $remote_server_port,
OrigAddress => $remote_server_host,
DataFromClient => sub {
my $s = shift;
$poe_kernel->post($ui_session, "ev_post_string",
$s, "to_orig_server_text_widget");
print "**from client $s\n";
},
# In addition to passing data from original server to client,
# also show the data in a text window.
DataFromServer => sub {
my $s = shift;
$poe_kernel->post($ui_session, "ev_post_string",
$s, "from_orig_server_text_widget");
print "**from server $s\n";
},
#ClientFilter =>POE::Filter::Line->new(OutputLiteral => "\n\r")
);
#
# Event loop.
#
# Run the program until it is exited.
$poe_kernel->run();
exit 0;
#
# Event handlers.
#
# Set up main Tk window
sub ui_start {
my ( $kernel, $session, $heap ) = @_[ KERNEL, SESSION, HEAP ];
$poe_main_window->Label( -text => "HTTP Progress Monitor",
-justify => 'left',
)->pack(-expand => 1, -fill => 'x');
$poe_main_window->Button
( -text => "Clear",
-command => $session->postback("ev_clear")
)->pack;
$poe_main_window->Label( -text => "Requests to Server." )->pack;
my $to_orig_server_text_widget = $heap->{to_orig_server_text_widget}
= $poe_main_window->Scrolled(qw/Text -height 6 -scrollbars e/ );
$to_orig_server_text_widget->insert('end', "\n\n\n");
$to_orig_server_text_widget->pack(-side => 'top', -fill => 'both', -expand => 1);
$poe_main_window->Label( -text => "Replies from Server." )->pack;
my $from_orig_server_text_widget = $heap->{from_orig_server_text_widget}
= $poe_main_window->Scrolled(qw/Text -height 6 -scrollbars e/ );
$from_orig_server_text_widget->insert('end', "\n\n\n");
$from_orig_server_text_widget->pack(-side => 'top', -fill => 'both', -expand => 1);
}
# Handle the "ev_post_string" event by appendiong sytring to appropriate
# widget window.
sub ui_post_string_to_widget {
my ( $kernel, $heap, $string, $widget_name ) = @_[ KERNEL, HEAP, ARG0, ARG1 ];
if (defined($heap->{$widget_name})) {
append_line_to_widget($string, $heap->{$widget_name});
}
}
# XXX probably this should get squished in above.
sub append_line_to_widget {
my $line = shift;
my $widget = shift;
$widget->insert('end', $line . "\n");
$widget->yview('end');
}
# Clear text windows and progress meter.
sub ui_clear {
my ( $kernel, $session, $heap ) = @_[ KERNEL, SESSION, HEAP ];
my $from_orig_server_text_widget = $heap->{from_orig_server_text_widget};
$from_orig_server_text_widget->delete('1.0', 'end');
my $to_orig_server_text_widget = $heap->{to_orig_server_text_widget};
$to_orig_server_text_widget->delete('1.0', 'end');
}