#!/usr/bin/perl 

=head1 NAME

ppppanel.pl             
=head1 SYNOPSIS

# chmod +x ppppanel.pl
# pppppanel.pl

or 

# perl ppppanel.pl

=head1 DESCRIPTION

- Simple PerlTk script to turn a PPP connection on
and off, and to monitor the logfile.

At present, the script uses the Debian PPP file names 
for the command to turn PPP on and off, and the 
syslog file.  These can be modified below.  

Normally PPP can only be started by root, and only root
can read the syslog.  Therefore, you must be root to 
run this script.  Because Linux doesn't allow SUID scripts,
you need to have suidperl installed if you want to run
this script as a normal user.  Please refer to the
perlsec manual page for the details.  

=head1 AUTHOR

Robert Kiesling, rkiesling@mainmatter.com

=head1 COPYRIGTH

This script is copyrighted under the same license as Perl.  
Please refer to www.cpan.org.

=cut

use Tk;
use Tk::Event;
use Tk::Event;
use IO::Handle;

my $frame;
my $onbutton;
my $offbutton;
my $quitbutton;
my $buttonpane;
my $logbox;

# Commands for PPP scripts on the system.
#
# These are the PPP defaults for Debian
#
# Modify for your system.
# 
my @connect_command = ( "pon" );
my @disconnect_command = ( "poff" );
my $logfile = "/var/log/syslog";

my $defaulttextfont="*-courier-medium-r-*-*-12-*";
my $menufont="*-helvetica-medium-r-*-*-12-*";


sub init_widgets {
    $frame = new MainWindow;
    $buttonpane = $frame -> Frame( -container => 0 ,
				   -borderwidth => 1 ) 
	-> pack( side => 'top' ) ;
    $onbutton = $buttonpane -> Button( -text => 'Connect',
				       -font => $menufont, 
				       -command => sub{&connect});
    $offbutton = $buttonpane -> Button( -text => 'Disconnect',
					-font => $menufont, 
					-command => sub{&disconnect});
    $quitbutton = $buttonpane -> Button( -text => 'Quit',
					 -font => $menufont,
					 -command => sub{&exit_nicely});

    $onbutton -> pack( -side => 'left' );
    $offbutton -> pack(  -side => 'left' );
    $quitbutton -> pack( -side => 'left' );

    $logbox = $frame -> Listbox ( -font => $defaulttextfont,
				  -height => 3,
				  -width => 80 ) -> pack;
}

sub connect {
    system( @connect_command );
}

sub disconnect {
    system( @disconnect_command );
}

sub exit_nicely {
    exit;
}

sub tail_log {
# re-creates an event of itself in the background.
    my $line;
    if ( $line = <LFILE> ) {
	$logbox -> insert( 'end', $line );
	$logbox -> yview( 'moveto', 100 );
    } 
    else {
	$frame -> fileevent( LFILE, 'readable', "" );
    }
}

init_widgets();
open( LFILE, "tail -f -n 25 $logfile|" ) 
    or die "Can't open syslog!\n";
$frame -> fileevent( LFILE, 'readable', [\&tail_log] );
MainLoop;