#!/usr/bin/perl -w
# ptkqotd v0.1
# Copyright Alan Ford <alan@whirlnet.demon.co.uk> 07/04/99
# Distributed with no warranty under the GNU Public License
#
# ptkqotd (Perl/Tk Quote of the Day) will connect to the 
# specified host on the specified port, receive the data 
# given, and display it.
#
# The default port is 17, for Quote of the Day (qotd), but 
# other protocols it could be used for include systat (11) 
# and daytime (13).
# If no host is given, localhost is used


require 5.002;
use IO::Socket;
use Socket;
use English;
use Tk;
use Tk::DialogBox;
sub getdata ;
sub getservice ;

my $MW = MainWindow->new;

$MW->title("Perl/Tk qotd");
$MW->Label(-text => "Version 0.1 - Written by Alan Ford <alan\@whirlnet.demon.co.uk>")->pack(-side => 'bottom');

my $lookup_frame = $MW->Frame()->pack(-expand => '1', -fill => 'both', -side => 'top');

#$MW->Label(-text => "Common Ports:\nqotd: 17\ndaytime: 13\nsystat: 11")->pack(-side => 'left');

$lookup_frame->Label(-text => "Host:")->pack(-side => 'left');
my $lookup_host = $lookup_frame->Entry(-width => '20', -relief => 'sunken')->pack(-side => 'left', -expand => '1', -fill => 'x');
$lookup_frame->Label(-text => "Port:")->pack(-side => 'left');
my $lookup_port = $lookup_frame->Entry(-width => '3', -relief => 'sunken')->pack(-side => 'left', -expand => '1', -fill => 'x');

my $finger = $lookup_frame->Button(-text => 'Get Data',
                                   -command => sub
    		                   {
			            getdata;
			           });
$finger->pack(-side => 'left', -expand => '1', -fill => 'both');

my $getservice = $lookup_frame->Button(-text => 'Lookup Service',
                                       -command => sub
				       {
				        getservice;
				       });
$getservice->pack(-side => 'left', -expand => '1', -fill => 'both');

my $exit = $lookup_frame->Button(-text => 'Exit',
                                 -command => sub
		                 {
		                  exit;
		                 });
$exit->pack(-side => 'left', -expand => '1', -fill => 'both');

my $scroll = $MW->Scrollbar();
$scroll->pack(-side => 'right', -fill => 'y');
my $display = $MW->Text(-height => '12', -width => '80', -yscrollcommand => ['set', $scroll])->pack(-side => 'bottom', -expand => '1', -fill => 'both');
$scroll->configure(-command => ['yview', $display]);

MainLoop;


sub getdata {
$display->delete('1.0', 'end');

my $port = $lookup_port->get;
if (not $port =~ /^[01-9]+$/) {
    $port = getservbyname $port, "tcp" or die "Cannot find service!";
}
if ($port == '0') { 
    $port = '17';
    $lookup_port->delete('0', 'end');
    $lookup_port->insert('0', '17');
}
my $host = $lookup_host->get;
if ($host eq "") { 
    $host = "localhost";
    #$port = '13';
    $lookup_host->delete('0', 'end');
    $lookup_host->insert('0', "localhost");
    #$lookup_port->delete('0', 'end');
    #$lookup_port->insert('0', '13');
}
my $msg;

my $remote = IO::Socket::INET->new(
    	       Proto    => "tcp",
    	       PeerAddr => $host,
    	       PeerPort => $port,
      	      ); 

unless ($remote) { 
    $msg = "Cannot connect to $host : $port\n";
    $display->insert('end', $msg);
    next;
}

$remote->autoflush(1);

while ($_ = <$remote>) {
    #print;
    $_ =~ s/\r$//;  # trim annoying \r line-endings on some output
    $display->insert('end', $_);
}
close($remote)	or sub {
    $msg = "Can't close socket: $!\n";
    $display->insert('end', $msg);
    };
}

sub getservice {
    my $port = $lookup_port->get;
    my $serv;
    my $msg;
    if ($port =~ /^[01-9]+$/) {
        $serv = getservbyport $port, "tcp";
	$msg = "$serv is the service on port $port";
    } else {
        $serv = getservbyname $port, "tcp";
	$msg = "$serv is the port for service $port";
    }
    if ($serv eq "") { 
        $msg = "Cannot find service $port";
    }
    my $dialogbox = $MW->DialogBox( -title   => "Lookup Service",
                                    -buttons => [ "OK" ]);
    $dialogbox->add("Label", -text => $msg)->pack;
    $dialogbox->Show;
}
 