eval 'exec perl $0 ${1+"$@"}' # -*- Perl -*-
  if (0);


########################################################################
# file      : echelon
# language  : perl, with Tk extension
# version   :
$version = "0.1.0";
# author    : Patrice KARATCHENTZEFF
# mailto    : p.karatchentzeff@free.fr
# license   : GNU General Public License, version 2.0 and older
# target    : This program aimed to let easier the ppp connexion and
#           : the deconnexion on a Debian  GNU/Linux system and to
#           : fetch mail and follows log files.
# requier.  : a ppp connexion, a fonctionnal systeme for MTA, an access
#           : for users to ppp and log file. You will also need perl/Tk
#
########################################################################

####################################
#
# Perl requierments
#
####################################

use Tk;
use IO::File;
use Tk::ROText;
use Tk::NoteBook;
use Tk::LabFrame;
use Tk::BrowseEntry;
use Tk::Dialog;

####################################
#
# Variables
#
####################################

$user             = $ENV{"USER"};               # username
$hostname         = (split(/\./,`hostname`))[0];# short hostname
$ppp0_pid         = '/var/run/ppp0.pid';        # ppp0.pid place
$ppp1_pid         = '/var/run/ppp1.pid';        # ppp1.pid place
$connection_start = "no";                       # yes or no
$connection_state = "" ;                        # live, dead or attempt
$flag             = 0;                          # for printing interface time 
                                                # connection
$long             = 0;                          # connection time by default
$already          = 0;                          # 0, never connecting; 1, one
                                                # or more
$color            = 'black';                    # color font by default
$state            = 'normal';                   # default button state
$number           = "-1";                       # for mail-in check
$size             = "";                         # for mail-in check
$flag_end         = 0 ;                         # for mail-in check
$disconnectStatus = "no";                       # for disconnect action
$version_debian   = `cat /etc/debian_version`;  # fixing a perl version feature
$echelonPath      = "$ENV{HOME}/.echelonrc";    # personal preference location
$PeerScript       = '/etc/ppp/peers';           # chatscript location
#$PeerScript       = './peers';           # chatscript location (local debug)
$numberPOPaccountCheck = 0;                     # for testing the number of POP account
$WarningFirstTime = 0;                          # non 0 if first echelon lauching
$statisticStorage = "";                         # filename of the statistic connection storage
$currentDate      = "";                         # date year/month/day format

# default variables
$default_MTA       = 'Exim';                         # default MTA 
$default_peers     = 'provider';                     # default peers script
$default_POPnumber = '1';                            # default POP account number 
$default_fetchmail = "/home/$ENV{USER}/.fetchmailrc";# default fetchmailrc location

####################################
#
# let's go
#
####################################

# system setup
#

$date     = Date();
&Setup;


# graphic part
#
$top = MainWindow->new;
$top -> title("echelon");

# Top menus printing
#
&menu;

# Color
# 
$top ->setPalette
  (
#   "font"                => '-*-courier-bold-*-*-*-12-*-*-*-*-*-iso8859-1',
   "background"          => 'LightSlateGrey',
   "foreground"          => 'black',
   "activeBackground"    => 'LightSlateGrey',
   "activeForeground"    => 'red',
   );

# main window, top level, definition
#
$top_frame = $top -> Frame
  (
   -relief      => 'groove',
   -borderwidth => '2',
   -width       => '360',
   -height      => '120',
  );
# main window, bottom level, definition
#
$bottom_frame = $top -> Frame
  (
   -relief      => 'groove',
   -borderwidth => '2',
   -width       => '240',
   -height      => '120'
  );
$top_frame -> pack
  (
   -fill   => 'x',
   -expand => '0'
  );
$bottom_frame -> pack
  (
   -fill   => 'both',
   -expand => '1'
  );


# top level GUI printing
#
&PrintHeaders;
&CurrentTime;
$ctime = CTime();
$dtime = DTime();

# bottom level GUI printing
#
&PrintNoteBook;

# log files viewer
#
&log_viewer;
&TestConnection;

# warning dialog box if first lauching
#
&WarningFirstTime() if ($WarningFirstTime != 0);

MainLoop;


####################################
#
# subprograms
#
####################################


# Return the current date
#
sub Date
  {
    my ($date, $sec, $min, $hours, $day, $month, $year, $wday, $realyear, $realmonth) ;
    ($sec, $min, $hours, $mday, $month, $year, $wday)= localtime(time);
    %Wday = 
      (
       0 => "Dimanche",  4 => "Jeudi",   
       1 => "Lundi",	 5 => "Vendredi",
       2 => "Mardi",     6 => "Samedi",    
       3 => "Mercredi",
      );
    %Month =
      (
       0  => "janvier" , 6  => "juillet", 
       1  => "fvrier",	 7  => "aot",    
       2  => "mars",	 8  => "septembre",
       3  => "avril",	 9  => "octobre", 
       4  => "mai",	 10 => "novembre",
       5  => "juin",	 11 => "dcembre",
      );
    $date             = "$Wday{$wday} $mday $Month{$month}";
    $realyear         = 1900 + $year;
    $realmonth        = 1 + $month; 
    $statisticStorage = "$realyear"."_"."$realmonth";
    $currentDate      = "$realyear"."/"."$realmonth"."/"."$mday";
    return $date;
  }

# System setup
#
sub Setup
  {
    my ($var);
    if (-e $echelonPath)
      {
	&LoadSetup;
      }
    else
      {
	# default preference setting
	$MTA               = $default_MTA;
	$peers             = $default_peers;     
	$numberPOPaccount  = $default_POPnumber; 
	$FETCHMAILRC       = $default_fetchmail;
	# creating file
	&CreateSetup;
	&LoadSetup;
	++$WarningFirstTime; 
      }
  }

# Creating a system setup environment
#
sub CreateSetup
  {
    my ($date) =`date`;
    mkdir("$echelonPath", 0700) 
      || die "Impossible de crer le rpertoire $echelonPath: $!\n";
    mkdir("$echelonPath/statistic", 0700) 
      || die "Impossible de crer le rpertoire $echelonPath/statistic: $!\n";    
    open (VERSION, "> $echelonPath/version") 
      || die "Impossible de crer le fichier $echelonPath/version: $!\n";
    print VERSION "$version";
    close (VERSION);
    &CreatePrefFile;
  }

# Create preference file
#
sub CreatePrefFile
  {
    open (PREFERENCES, "> $echelonPath/preferences") 
      || die "Impossible de crer le fichier $echelonPath/preferences: $!\n";
    print PREFERENCES  "#####################################################################\n";
    print PREFERENCES  "# Preference file: generated by seelog $version\n";
    print PREFERENCES  "#\n";
    print PREFERENCES  "# do NOT edit this file by hand if you don't know EXACTLY what you do\n";
    print PREFERENCES  "#\n";
    print PREFERENCES  "# If you want to modify something, click on the menu preference in seelog\n";
    print PREFERENCES  "#\n";
    print PREFERENCES  "#####################################################################\n";
    print PREFERENCES  "\n";
    print PREFERENCES  "# LAST MODIFIED on $date\n";
    print PREFERENCES  "\n";
    print PREFERENCES  "# System log files\n";
#    print PREFERENCES  "\$MESSAGE_log  = './log/messages';\n";# local debug
    print PREFERENCES  "\$MESSAGE_log  = '/var/log/messages';\n"; 
#    print PREFERENCES  "\$MAIL_IN_log = './log/mail.log';\n";# local debug
    print PREFERENCES  "\$MAIL_IN_log = '/var/log/mail.log';\n";
    print PREFERENCES  "\n";
    print PREFERENCES  "# System mail data\n";
    print PREFERENCES  "\$MTA = \"$MTA\";\n";
#    print PREFERENCES  "\$MAIL_OUT_log ='./log/exim.log';\n";# local debug
    print PREFERENCES  "\$MAIL_OUT_log ='/var/log/exim/mainlog' if (\$MTA eq 'Exim');\n";
    print PREFERENCES  "\$MAIL_OUT_log ='/var/log/smail/logfile' if (\$MTA eq 'Smail');\n";
    print PREFERENCES  "\n";
    print PREFERENCES  "# System connection data\n";
    print PREFERENCES  "\$numberPOPaccount = \"$numberPOPaccount\";\n";
    print PREFERENCES  "\$peers = \"$peers\";\n";
    print PREFERENCES  "\$PON  = \"/usr/bin/pon  \$peers\";\n";  
    print PREFERENCES  "\$POFF = \"/usr/bin/poff \$peers\";\n";  
    print PREFERENCES  "\n";
    print PREFERENCES  "\$FETCHMAILRC =\"$FETCHMAILRC\";\n";
    print PREFERENCES  "\$FETCHMAIL   = \"LC_ALL=C;/usr/bin/fetchmail -v -f \$FETCHMAILRC > /dev/null 2>&1\""; 
    close (PREFERENCES);
  }

# Load setup configuration
#
sub LoadSetup
  {
    my ($return);
    unless ($return = do "$echelonPath/preferences")
      {
	warn "impossible de parser le fichier $echelonPath/preferences: $@" 
	  if $@;
	warn "impossible d'appliquer le 'do' au fichier $echelonPath/preferences: $!" 
	  unless defined $return;
	warn "impossible d'excuter le fichier $echelonPath/preferences"
	  unless $return;  
      }
    @default = ($MTA, $numberPOPaccount, $peers, $FETCHMAILRC);
  }

# Warnig Dialog box in case of first lauching echelon
#
sub WarningFirstTime
  {
    $WarningDialogFirstTime = &SimpleDialogWidget
      (
       $WarningDialogFirstTime,
       $top,
       "Mise en garde...",
       "Bienvenue dans echelon.\n\n C'est la premire fois que vous lancez ce logiciel. Vous devez le configurer. Vous pouvez le faire aisment  partir du menu  prfrence  situ en haut et  gauche de la fentre principale.\n"
      );
  }

# loop for printing time
#

sub CurrentTime
  {
    $current_time= PrintTime();
    after(500, sub {&CurrentTime});
  }

# Time when connection
#
sub CTime
  {
    if ($connection_state eq "live")
      {
	$ctimeEpoch = time;
	$ctime = PrintTime();
      }
    else
      {
	$ctime = "-";
      };
    return $ctime;
  }

# Time when disconnection
#
sub DTime
  {
    if ($connection_state eq "dead")
      {
	$dtimeEpoch = time;
	$dtime = PrintTime();
      }
    else
      {
	$dtime = "-";
      };
    return $dtime;
  }



# return the current time
#
sub PrintTime
  {
    my ($time, $date, $sec, $min, $hours, $day, $month, $year, $wday) ;
    ($sec, $min, $hours, $mday, $month, $year, $wday)= localtime(time);
    $sec = "0$sec" if ($sec < 10);
    $min = "0$min" if ($min < 10);
    $time = "$hours:$min:$sec";
    return $time;    
  }

# Print environment  if living connection
#
sub TestConnection
  {
    &TestLiveConnection;
    if ($connection_state eq "live")
      {
	$ctime      = CTime() if ($flag == 0);
	$dtime      = "-";
	$flag       = 1;
	$already    = 1;    # for still printing lenght time connection
	$ltimeEpoch = time; # current time
	$format     = $ltimeEpoch - $ctimeEpoch;
	$long       = Format($format);
	$connexion  = "Connexion active"; 
	$signal                        -> configure(-background => 'green4');
	$Connect_button{connect}[0]    -> configure(-state => 'disabled');
	$Connect_button{disconnect}[0] -> configure(-state => 'normal');
 	$Connect_button{disconnect}[0] -> flash();
	$button                        -> configure(-state => 'normal');
      }
    elsif ($connection_state eq "attempt")
      {
	$connexion = "En cours de connexion"; 
	$signal                        -> configure(-background => 'yellow');
	$Connect_button{connect}[0]    -> configure(-state => 'disabled');
	$Connect_button{disconnect}[0] -> configure(-state => 'normal'); 
	$button                        -> configure(-state => 'disabled');
      }
    else
      {
	$dtime     = DTime() if ($flag == 1);
	$ctime     = "-";
	if (($flag == 1)||($already == 1))
	  {
	    $long = Format($dtimeEpoch - $ctimeEpoch);
	  }
	else
	  {
	    $long = "-";
	  };
	$connexion = "Connexion inactive";  
	$signal                        -> configure(-background => 'red');
	$Connect_button{connect}[0]    -> configure(-state => 'normal');
	$Connect_button{disconnect}[0] -> configure(-state => 'disabled');
	$button                        -> configure(-state => 'disabled');
	$flag      = 0;
      }
    after (500, sub {&TestConnection});
  }

# Format integer into readeable time 
#
sub Format
  {
    my ($Time, $time, $sec, $min, $hour);
    $time = $_[0];
    $hour = ($time - ($time % 3600))/3600; 
    $hour = "0"."$hour" if ($hour < 10); # nice printing out
    $min  =  (($time % 3600) - (($time % 3600) % 60)) / 60;
    $min  = "0"."$min" if ($min < 10);   # nice printing out
    $sec  = $time - (( 3600 * $hour ) + ( 60 * $min ));
    $sec  = "0"."$sec" if ($sec < 10);
    $Time = "$hour:"."$min:"."$sec";
    return $Time;
  }


# test if living connection
#
sub TestLiveConnection
  {
    if ((-e "$ppp0_pid")||(-e "$ppp1_pid"))
      {
	$connection_state = "live";
      }
    else
      {
	if ($connection_start eq "yes")
	  {
	    $connection_state = "attempt";
	  }
	else
	  {
	    $connection_state = "dead";
	  }
      }
  }

# Quit ptkdesk
#
sub Quit
  {
    &QuitLog(MESSAGE, MAILIN, MAILOUT);
    exit;
  }

# Menus
#
sub menu
  {
    $MenuB_Frame = $top -> Frame
      (
       -relief => 'ridge',
      );
    $MenuB_Frame -> pack
      (
       -expand => '0',
       -fill   => 'x',
      );
    %Menu = 
      (
       qquit    => ["quit",    "Quitter",           "Quit", '   (Alt-q)'],
       ppref    => ["pref",    "Prfrence",        "Pref", '   (Alt-p)'],
       aabout   => ["about",   "Au sujet de...",    "About",'   (Alt-a)'],
       hhelp    => ["help",    "Aide",              "Help", '   (Alt-h)'],
       vversion => ["vers",    "Version",           "Rev",  '   (Alt-v)'],
       bbug     => ["bug",     "Rapport de bogues", "BugTo",            ]
      );
    $side = 'left';
    foreach $menu (qw/qquit ppref hhelp/)
      {
	if ($menu eq "hhelp")
	  {
	    $side = 'right'; 
 	    $MenuB_{$Menu{$menu}[0]} = $MenuB_Frame -> Menubutton
	      (
	       -underline => '0',
	       -text      => "$Menu{$menu}[1]",
	       -menuitems => [['command'    => "$Menu{$menu}[1]",
			       -command     => \&{"$Menu{$menu}[2]"}, 
			       -accelerator => "$Menu{$menu}[3]"],
			      ['command'    => "$Menu{vversion}[1]",
			       -command     => \&{"$Menu{vversion}[2]"}, 
			       -accelerator => "$Menu{vversion}[3]"],
			      ['command'    => "$Menu{aabout}[1]",
			       -command     => \&{"$Menu{aabout}[2]"}, 
			       -accelerator => "$Menu{aabout}[3]",
			       -accelerator => "$Menu{vversion}[3]"],
			      ['command'    => "$Menu{bbug}[1]",
			       -command     => \&{"$Menu{bbug}[2]"}],
			     ]
	      );
	  }
	else
	  {
	    $MenuB_{$Menu{$menu}[0]} = $MenuB_Frame -> Menubutton
	      (
	       -underline => '0',
	       -text      => "$Menu{$menu}[1]",
	       -menuitems => [['command'    => "$Menu{$menu}[1]",
			       -command     => \&{"$Menu{$menu}[2]"}, 
			       -accelerator => "$Menu{$menu}[3]"],
			     ]
	      );
	  };
	$MenuB_{$Menu{$menu}[0]} -> pack
	  (
	   -side   => "$side",
	   -expand => '0',
	  );
      }
  };

# Generic simple dialog widet
#
sub SimpleDialogWidget
  {
    my ($dialog, $father, $title, $text) = @_;
    my ($quit) = "quitter";
    my ($buttons);
    if (not Exists($dialog))
      {
	$dialog = $father -> Dialog
	  (
	   -font           => "-adobe-helvetica-bold-r-normal-*-*-120-*-*-p-*-iso8859-1",
	   -title          => "$title",
	   -wraplength     => '6i',
	   -text           => "$text",
	   -bitmap         => 'info',
	   -default_button => $quit,
	   -buttons        => [$quit],	       
	  );
	$buttons = $dialog -> Show('-global');
      };
    if ($buttons eq $quit)
      {
	$dialog -> destroy();
      };
    return ($dialog);
  }


# Help dialog widget
#
sub Help
  {
    $HelpDialog = &SimpleDialogWidget
      (
       $HelpDialog,
       $MenuB_{$Menu{qquit}[0]},
       "Aide en ligne",
       "L\'aide en ligne sera disponible dans la version 0.2",
      );
  }

# Version dialog widget
#
sub Rev
  {
    $VersionDialog = &SimpleDialogWidget
      (
       $VersionDialog,
       $MenuB_{$Menu{qquit}[0]},
       "Numro de version",
       "La version de echelon est $version",
      );
  }

# About dialog widget
#
sub About
  {
    $AboutDialog = &SimpleDialogWidget
      (
       $AboutDialog,
       $MenuB_{$Menu{qquit}[0]},
       "Au sujet de...",
       "Echelon (version $version) est un logiciel libre sous licence GPL.\n\n Echelon permet sous Debian de se connecter, dconnecter, calculer le temps de connexion, visualiser le rapatriement et l'mission de vos courriels.\n\nL'auteur (Patrice Karatchentzeff, p.karatchentzeff\@free.fr) dcline toute responsabilit quant  ... etc ... etc... Lire la General Public License pour les conditions.\n\n Prire de me transmettre directement les bogues et les injures via mon adresse lectronique.\n\n Bonne utilisation...",
      );
  }

# Bug report dialog widget
#
sub BugTo
  {
    $VersionDialog = &SimpleDialogWidget
      (
       $VersionDialog,
       $MenuB_{$Menu{qquit}[0]},
       "Rapport de bogue",
       "Veuillez envoyer vos rapports de bogues  p.karatchentzeff\@free.fr.\n Donnez le numro de version de echelon, la version de Debian ainsi que des explications dtailles du problme. Vous pouvez joindre votre fichier de prfrences. Vous pouvez aussi joindre un tar de l'ensemble des fichiers (n'oubliez pas de ziper) si l'ensemble fait moins de 300 ko (avec les journaux de bord par exemple).",
      );
  }



# preference menu
#
sub Pref
  {
    if (! Exists($pref))
      {
	$pref = $top -> Toplevel();
	$pref -> title("echelon: prfrences");
	$pref -> resizable(0,0);
	&PrefWidget;
      }
    else
      {
	$pref -> deiconify();
	$pref -> raise();
      }
  }

# preference widget print
#
sub PrefWidget
  {
    $prefFrameTop = $pref -> Frame();
    $prefFrameTop -> pack
      (
       -side   => 'top',
       -expand => '1',
       -fill   => 'both',       
      );
    $prefFrameBottom = $pref -> Frame();
    $prefFrameBottom -> pack
      (
       -side   => 'bottom',
       -expand => '0',
       -fill   => 'x',
      );
    # Notebook
    &PrintPrefNoteBook;
    # Bottom buttons
    &PrintPrefButtons;
  }

# print preference top NoteBook
#
sub PrintPrefNoteBook
  {
    $notebookPref = $pref -> NoteBook();
    %PrefNoteBook =
      (
       connectionPref => [PrefConnect, "Connexion",     0],
       popPref        => [PrefPOP,     "Courriel",      1],
       MTAPref        => [PrefMTA,     "MTA",           0],
       accountPref    => [PrefAccount, "Dcompte",      0],
       formPref       => [PrefForm,    "Apparence",     0],
       fetchPref      => [FetchForm,   "Rapatriement",  0],
      );
    foreach $note (keys %PrefNoteBook)
      {
	$page_{$PrefNoteBook{$note}[0]} = $notebookPref -> add
	   (
	    "$PrefNoteBook{$note}[1]",
	    -label      => "$PrefNoteBook{$note}[1]",
	    -underline  => "$PrefNoteBook{$note}[2]",
	   );
      }
    $notebookPref -> pack
      (
	-expand => '1',
	-fill   => 'both'
      );
    &PrefNoteBook_1;
    &PrefNoteBook_2;
    &PrefNoteBook_3;
    &PrefNoteBook_4;
    &PrefNoteBook_5;
    &PrefNoteBook_6;
  }

# First NoteBook reference page (connection)
#
sub PrefNoteBook_1
  {
    # top labFrame
    ($ConnectionPref_frame, $ConnectionPrefLabFrame) = PrintMainLabFramePref
      (
       $page_{$PrefNoteBook{connectionPref}[0]},
       "Scripts de connexion",
      );
    # Peers Entry 
    $BrowseEntryPref = PrefEntryPeers
      (
       $BrowseEntryPref, 
       $ConnectionPrefLabFrame
      );
    # Help buttons
    %PrefButtonConnection =
      (
       help    => [HelpConnection,   "Aide",                 0],
       search  => [SearchConnection, "Recherche automatique",0],
      );
    $ConnectionPrefLabFrame2 = PrefPrintHelpButton
      (
       $ConnectionPref_frame, 
       $ConnectionPrefLabFrame2,
       %PrefButtonConnection,
      );
  }

# First Notebook reference entry 
#
sub PrefEntryPeers
  {
    my ($Entry, $LabFrame) = @_;
    my ($script);
    $Entry = $LabFrame -> BrowseEntry
	(
	 -label      => "Scripts utiliss par pon et poff:",
	 -variable   => \$peers,
	);
    foreach $script (`ls $PeerScript`)
      {
	 chomp($script);
	 if (!(($script =~ ".*~")||($script =~ '.*.bak'))) # remove backup files
	   {
	     $Entry -> insert('end',$script);
	   }
      }
    $Entry -> pack();
    return ($Entry);
  }

# Help menu preference connection dialog box
#
sub HelpConnection 
  {
    $HelpConnectionDialog = &SimpleDialogWidget
      (
       $HelpConnectionDialog,
       $ConnectionPref_frame,
       "Aide en ligne",
       "Vous devez slectionner le script de connection utilis par pon ou poff pour vous connecter  Internet.\n La valeur par dfaut est  provider .\n",
      );
  }

# Search menu preference connection dialog box
#
sub SearchConnection 
  {
    $SearchConnectionDialog = &SimpleDialogWidget
      (
       $HelpConnectionDialog,
       $ConnectionPref_frame,
       "Aide en ligne",
       "Patience...\n Pas avant la version 0.2\n"
      );
  }

# Second NoteBook reference page (POP)
#
sub PrefNoteBook_2
  {
    my ($printOutMenu, $ValueMenu, @list);
    # top labFrame
    ($POPPref_frame, $POPPrefLabFrame) = PrintMainLabFramePref
      (
       $page_{$PrefNoteBook{popPref}[0]},
       "Rapatriement du courrier",
      );
    $POPOptionLabel = $POPPrefLabFrame -> Label
      (
       -text => "Nombre de compte POP:"
      );
    $POPOptionLabel -> pack
      (
       -side => 'left',
      );
    $POPOptionEntry = $POPPrefLabFrame -> Entry
      (
       -textvariable => \$numberPOPaccount,
       -background   => 'linen',
       -foreground   => 'black',
      );
    $POPOptionEntry -> pack
      (
       -side   => 'left',
       -expand => '1',
       -fill   => 'x'
      );
    $POPOptionMenu = $POPPrefLabFrame -> Optionmenu
      (
       -textvariable => \$numberPOPaccount,
       -variable     => \$numberPOPaccount,
       -options      => [["1", 1],
			 ["2", 2],
			 ["3", 3],
			 ["4", 4],
			 ["5", 5],
			 ["6", 6],
			],
      );
    $POPOptionMenu -> pack
      (
       -side => 'left',
      );
    # on-line help
    %PrefButtonPOP =
      (
       help    => [HelpPOP,   "Aide",                 0],
       search  => [SearchPOP, "Recherche automatique",0],
       default => [DefaultPOP,"Valeurs par dfaut",   0],
      );
    $POPPref_frame = PrefPrintHelpButton
      (
       $POPPref_frame, 
       $POPPrefLabFrame2,
       %PrefButtonPOP,
      );
    $POPnumber = $ValueMenu;
  }

# preference help POP menu
#
sub HelpPOP 
  {
    $HelpPOPDialog = &SimpleDialogWidget
      (
       $HelpPOPDialog,
       $POPPref_frame,
       "Aide en ligne",
       "Vous devez mettre ici le nombre de compte POP que vous allez vider lors du rapatriement du courrier.\n Cette option n'est pas indispensable mais permet d'avoir un dialogue cohrent lors du rapatriement de la dernire bote (phrase de fin et signal sonore).\n La valeur par dfaut est  1 .\n",
      );
  }

# Search help POP menu
#
sub SearchPOP 
  {
    $SearchPOPDialog = &SimpleDialogWidget
      (
       $HelpPOPDialog,
       $POPPref_frame,
       "Aide en ligne",
       "Patience...\n Pas avant la version 0.2\n"
      );
  }

# default POP preference menu
# 
sub DefaultPOP
  {
    $numberPOPaccount = $default_POPnumber;
  }

# Third NoteBook reference page (MTA)
#
sub PrefNoteBook_3
  {
    my ($printOutMenu, $ValueMenu);
    ($MTAPref_frame, $MTAPrefLabFrame) = PrintMainLabFramePref
      (
       $page_{$PrefNoteBook{MTAPref}[0]},
       "Agent de transport du courriel",
      );
    $MTAOptionLabel = $MTAPrefLabFrame -> Label
      (
       -text => "Nom de l'agent:"
      );
    $MTAOptionLabel -> pack
      (
       -side => 'left',
      );
    $MTAOptionEntry = $MTAPrefLabFrame -> Entry
      (
       -textvariable => \$MTA,
       -background   => 'linen',
       -foreground   => 'black',
      );
    $MTAOptionEntry -> pack
      (
       -side   => 'left',
       -expand => '1',
       -fill   => 'x'
      );
    $MTAOptionMenu = $MTAPrefLabFrame -> Optionmenu
      (
       -textvariable => \$MTA,
       -variable     => \$MTA,
       -options      => [["exim",  'Exim' ],
			 ["smail", 'Smail'],
			],
      );
    $MTAOptionMenu -> pack
      (
       -side => 'left',
      );
    # on-line help
    %PrefButtonMTA =
      (
       help    => [HelpMTA,   "Aide",                 0],
       search  => [SearchMTA, "Recherche automatique",0],
       default => [DefaultMTA,"Valeurs par dfaut",   0],
      );
    $MTAPref_frame = PrefPrintHelpButton
      (
       $MTAPref_frame, 
       $MTAPrefLabFrame2,
       %PrefButtonMTA,
      );
  }

# preference help MTA menu
#
sub HelpMTA 
  {
    $HelpMTADialog = &SimpleDialogWidget
      (
       $HelpMTADialog,
       $MTAPref_frame,
       "Aide en ligne",
       "Vous devez mettre ici le nom de votre transporteur de courriel interne (MTA). Seuls Exim et Smail sont  ce jour supports. \nLa valeur par dfaut est  Exim .\n ATTENTION, modifier cette valeur demander OBLIGATOIREMENT de relancer echelon pour tre pris en compte\n",
      );
  }

# Search help MTA menu
#
sub SearchMTA 
  {
    $SearchMTADialog = &SimpleDialogWidget
      (
       $HelpMTADialog,
       $MTAPref_frame,
       "Aide en ligne",
       "Patience...\n Pas avant la version 0.2\n"
      );
  }

# Default MTA preference menu
#
sub DefaultMTA
  {
    $MTA = $default_MTA;
  }

# Fourth NoteBook reference page (Time account)
#
sub PrefNoteBook_4
  {
    ($AccountPref_frame, $AccountPrefLabFrame) = PrintMainLabFramePref
      (
       $page_{$PrefNoteBook{accountPref}[0]},
       "Gestion du temps",
      );
  }

# Fifth NoteBook reference page (form preference)
#
sub PrefNoteBook_5
  {
    ($formPref_frame, $formPrefLabFrame) = PrintMainLabFramePref
      (
       $page_{$PrefNoteBook{formPref}[0]},
       "Ergonomie",
      );
  }

# Sixth NoteBook reference page (fetchmail preference)
#
sub PrefNoteBook_6
  {
    my ($fetch, $ValueVar);
    ($fetchPref_frame, $fetchPrefLabFrame) = PrintMainLabFramePref
      (
       $page_{$PrefNoteBook{fetchPref}[0]},
       "Rapatriement du courrier via fetchmail",
      );
    %RadioButtonFetch =
      (
       radiofetch1 => ["~/.fetchmailrc",   "/home/$ENV{USER}/.fetchmailrc"],
       radiofetch2 => ["/etc/fetchmailrc", "/etc/fetchmailrc"             ],
      );
    foreach $fetch (keys %RadioButtonFetch)
      {
	$radio_{$fetch} = $fetchPrefLabFrame -> Radiobutton
	  (
	   -text        => $RadioButtonFetch{$fetch}[0],
	   -value       => $RadioButtonFetch{$fetch}[1],
	   -variable    => \$FETCHMAILRC,
	   -justify     => 'left',
	   -selectcolor => 'green',
	  );
	$radio_{$fetch} -> pack
	  (
	   -anchor => 'w',
	  );
      };
    # on-line help
    %PrefButtonFetch =
      (
	help    => [HelpFetch,   "Aide",                 0],
	search  => [SearchFetch, "Recherche automatique",0],
	default => [DefaultFetch,"Valeurs par dfaut",   0],
      );
    $fetchPref_frame = PrefPrintHelpButton
      (
	$fetchPref_frame, 
	$fetchPrefLabFrame2,
	%PrefButtonFetch,
      );
  }

# fetch preference menu help dialog
#
sub HelpFetch 
  {
    $HelpFetchDialog = &SimpleDialogWidget
      (
       $HelpFetchDialog,
       $fetchPref_frame,
       "Aide en ligne",
       "Vous devez slectionner l\'emplacement du fichier de configuration de fetchmail.\n Par dfaut, il est choisi  la racine de votre compte.\n "
      );
  }

# Search Fetch preference menu
#
sub SearchFetch 
  {
    $SearchFecthDialog = &SimpleDialogWidget
      (
       $HelpFetchDialog,
       $fetchPref_frame,
       "Aide en ligne",
       "Patience...\n Pas avant la version 0.2\n"
      );  
  }

# Default Fetch preference menu
#
sub DefaultFetch 
  {
    $FETCHMAILRC = $default_fetchmail;
  }

# Main LabFrame Print for preference widget
#
sub PrintMainLabFramePref
  {
    my ($RefFrame,$label) = @_;
    my ($NewFrame, $NewLabFrame);
    $NewFrame = $RefFrame -> Frame
      (
       -relief    => 'groove',
      );
    $NewFrame -> pack
      (
       -expand => '1',
       -fill => 'both'
      );
    $NewLabFrame = $NewFrame -> LabFrame
      (
	-label     => "$label",
	-labelside => "acrosstop",
      );
    $NewLabFrame -> pack
      (
       -expand => '1',
       -fill => 'both'
      );
    return ($NewFrame, $NewLabFrame);
  }

# print preference bottom buttons
#
sub PrintPrefButtons
  {
    %prefBottomButtons =
      (
       save     => [PrefSave,     "Sauver",            0],
       quit     => [PrefQuit,     "Quitter",           0],       
      );
    *pBB = *prefBottomButtons; # for short print
    foreach $button (qw/save quit/)
      {
	$butt_{$pBB{$button}[0]} = $prefFrameBottom -> Button
	  (
	    -text      => "$pBB{$button}[1]",
	    -command   => \&{$pBB{$button}[0]},
	    -underline => "$pBB{$button}[2]",
	  );
	$butt_{$pBB{$button}[0]} -> pack
	  (
	   -side   => 'left',
	   -expand => '1',
	   -fill   => 'x',
	  );
      }
  }

# Print the help button of each notebook
#
sub PrefPrintHelpButton
  {
    my ($RefFrame, $LabFrame, %PrefButton) = @_;
    my (@button) = keys(%PrefButton);
    my ($button);
    $LabFrame = $RefFrame -> LabFrame
      (
	-label     => "Aide en ligne",
	-labelside => "acrosstop",
      );
    $LabFrame -> pack
      (
       -expand => '1',
       -fill => 'both'
      );
    foreach $button (@button)
      {
	$BUTTON_{$PrefButton{$button}[0]} = $LabFrame -> Button
	  (
	   -text      => "$PrefButton{$button}[1]",
	   -underline => "$PrefButton{$button}[2]",
	   -command   => \&{$PrefButton{$button}[0]}, 
	  );
	$BUTTON_{$PrefButton{$button}[0]} -> pack
	  (
	   -side   => 'left',
	   -expand => '1',
	   -fill   => 'x'
	  ); 
      }   
    return ($RefFrame);
  }

# save modification from preference widget and reruns echelon
#
sub PrefSave 
  {
    &CreatePrefFile;
    &LoadSetup;
  }

# Quit the preference widget and save modifications if any
#
sub PrefQuit 
  {
    my (@tempVar, $incr, $diff, $length, $buttons);
    my ($ok, $cancel) = ('Sauvegarder', 'Annuler');
    # check if a variable has changed
    $diff = 0;
    @tempVar = ($MTA, $numberPOPaccount, $peers, $FETCHMAILRC);
    $length  = @tempVar;
    for ($incr = 0; $incr < $length; $incr++)
      {
	if ($tempVar[$incr] ne $default[$incr])
	  {
	    ++$diff; 
	    last;
	  }
      };
    if ($diff ne "0") # preference has changed
      {
	if (not Exists($PrefDialogQuit))
	  {
	    $PrefDialogQuit = $pref -> Dialog
	      (
	       -font           => "-adobe-helvetica-bold-r-normal-*-*-120-*-*-p-*-iso8859-1",
	       -title          => 'Configuration diffrente !',
	       -wraplength     => '6i',
	       -text           => "Vous avez modifi votre environnement: cliquez sur SAUVEGARDER pour conserver vos modification.\n\n Si vous ne le voulez pas, cliquez sur ANNULER: attention, dans ce cas, vous perdrez toutes les modifications apportes...\n",
	       -bitmap         => 'question',
	       -default_button => $ok,
	       -buttons        => [$ok, $cancel],	       
	      );
	    $buttons = $PrefDialogQuit -> Show('-global');
	  };
	if ($buttons eq $ok)
	  {
	    &PrefSave;
	    &Quit;
	  }
	else
	  {
	    $pref -> destroy();
	  };
      }
    else
      {
	$pref -> destroy() if (Exists($pref));
      }
  }

# print GUI Headers
#
sub PrintHeaders
  {
    # declarations
    #
    $top_frame_top = $top_frame -> Scrolled
      (
       "ROText",
       -width      => '79',
       -scrollbars => 'osoe',
       -height     => '4',
       -wrap       => 'none'
      );
    $top_frame_top -> pack
      (
       -expand => '1',
       -fill   => 'both'
      );
    %field =
      (
       user => ["user",         "Utilisateur:"],
       host => ["hostname",     "Machine:"    ],
       date => ["date",         "Date:"       ],
       time => ["current_time", "Heure:"      ],       
      );
    # two first floors
    #
    foreach $common (qw/user host date time/)
      {
	 $label_{$field{$common}[0]} = $top_frame_top -> Label
	   (
	    -text   => "$field{$common}[1]",
	    -relief => 'groove',
	    -width  => '13'
	   );
	 $top_frame_top -> windowCreate
	   (
	    'end', 
	    -window => $label_{$field{$common}[0]}
	   );
	 $label_{$field{$common}[0]}  = $top_frame_top -> Label
	   (
	    -textvariable => \${$field{$common}[0]},
	    -width        => '25',
	    -relief       => 'sunken',
	    -background   => 'linen',
	    -foreground   => 'black',
	   );
	$top_frame_top -> windowCreate
	  (
	   'end', 
	   -window => $label_{$field{$common}[0]},
	  );
	 if (($common eq "host")||($common eq "time"))
	   {
	     $top_frame_top -> insert('end', "\n");
	   }
      }
    # third floor
    #
    $label_syst = $top_frame_top -> Label
      (
       -text   => "tat du systme ",
       -relief => 'groove',
       -width  => '45'
      );
    $top_frame_top -> windowCreate
      (
       'end', 
       -window => $label_syst
      );
    $connect = $top_frame_top -> Label
      (
       -textvariable => \$connexion,
       -width        => '25',
       -background   => 'white',
       -foreground   => 'black',
       -relief       => 'sunken',
      );
    $top_frame_top -> windowCreate
      (
       'end', -window => $connect
      );
    $signal  = $top_frame_top -> Label
      (
       -width      => '7',
       -relief     => 'raised',
       -background => 'red'
      );
    $top_frame_top -> windowCreate
      (
       'end', -window => $signal
      );    
  }


# Print the GUI bottom forms
#
sub PrintNoteBook
  {
    $notebook = $bottom_frame -> NoteBook
      (
       -width      => '79',
      );
    %NoteBook =
      (
       connection => [COnnection, "Connexion",         0],
       mail       => [Mail,       "Courriel",          1],
       log        => [Log,        "Journaux de bord",  0],
      );
    foreach $note (qw/connection mail log/)
      {
	$page_{$NoteBook{$note}[0]} = $notebook -> add
	  (
	   "$NoteBook{$note}[1]",
	   -label      => "$NoteBook{$note}[1]",
	   -underline  => "$NoteBook{$note}[2]",
	  );
      }
    $notebook -> pack
      (
	-expand => '1',
	-fill   => 'both'
      );
    &print_Connection; # First NoteBook page
    &print_Mail;       # Secund NoteBook page
    &print_Log;        # third NoteBokk page
  } 

# First NoteBook page
#
sub print_Connection
  {
    $Connection_frame = $page_{$NoteBook{connection}[0]} -> Frame
      (
       -relief => 'sunken',
      );
    $Connection_frame -> pack
      (
       -expand => '1',
       -fill => 'both'
      );
    # two first floor
    #
    foreach $Connect (qw/connect1 connect2/)
      {
	($relief, $expand, $height, $background) = ('sunken', '1', '15', 'linen');
	($relief, $expand, $height, $background) = ('raised', '0', '5','LightSlateGrey')
	  if ($Connect eq connect1);
	${"$Connect"}  = $Connection_frame -> Scrolled
	  (
	   "ROText",
	   -relief     => "$relief",
	   -width      => '79',
	   -scrollbars => 'osoe',
	   -height     => "$height",
	   -wrap       => 'none',
	   -background => "$background",
	  );
	${"$Connect"} -> pack
	  (
	   -expand => "$expand",
	   -fill   => 'both'
	  );
      };

    # third floor
    #
    $Connect_button = $Connection_frame -> Frame
     (
      -relief => 'sunken',
     );
    $Connect_button -> pack
      (
       -expand => '0',
       -side   => 'left',
      );
    %Connect_button =
      (
       connect    => [Connect,    "Connexion" ],
       disconnect => [Disconnect, "Dconnexion"],
      );
    foreach $button (qw/connect disconnect/)
      {
	$state = StateButton($button);
	$Connect_button{$button}[0] = $Connect_button -> Button
	  (
	   -text    => "$Connect_button{$button}[1]",
	   -command => \&{$Connect_button{$button}[0]},
	   -state   => "$state",
	  );
	$Connect_button{$button}[0] -> pack
	  (
	   -side => 'left',
	  );
      }    
    # first floor: print screen (state)
    #
    &PrintConnectionState;
    # second floor: print screen (log)
    #
    &PrintConnectionLog;
  }

# Connect button command
#
sub Connect
  {
    $disconnectStatus = "no";
    $connection_start = "yes";
    system($PON);
  }

# Disconnect button command
#
sub Disconnect
  {
    system($POFF);
    $connection_start = "no";
    $disconnectStatus = "yes";
    &printStatisticConnect();
  }

# state button: disable or active if active connection
#
sub StateButton
  {
    my ($button) = @_;
    $state = "normal" 
      if (($connection_state eq "dead")&&($button eq "connect"));
    $state = "disabled" 
      if ((($connection_state eq "alive")
	   ||($connection_state eq "attempt"))
	  &&($button eq "connect"));
    $state = "normal" 
      if ((($connection_state eq "alive")
	   ||($connection_state eq "attempt"))
	  &&($button eq "disconnect"));
    $state = "disabled" 
      if (($connection_state eq "dead")&&($button eq "disconnect"));
    return $state;
  }

# first NoteBook page: State connection print
#
sub PrintConnectionState
  {
    %StateConnect =
      (
       state          => [\$connexion, "tat du systme:"      ],
       connectTime    => [\$ctime,     "Heure de connexion:"   ],
       disconnectTime => [\$dtime,     "Heure de dconnexion:" ],
       connectLong    => [\$long,      "Dure de connexion:"   ],
      );
    *S = *StateConnect; # for short print...
    # System statistic informations print
    #
    foreach $item (qw/state connectTime disconnectTime connectLong/)
      {

	$State_{$S{$item}[0]} = $connect1 -> Label
	  (
	   -text   => "$S{$item}[1]",
	   -relief => 'groove',
	   -width  => '30',
	  );
	$connect1 -> windowCreate
	  (
	   'end', 
	   -window => $State_{$S{$item}[0]},
	  );
	$State_{$S{$item}[0]}  = $connect1 -> Label
	  (
	   -textvariable => $S{$item}[0],
	   -width        => '30',
	   -relief       => 'flat',
	   -wraplength   => '150',
	  );
	$connect1 -> windowCreate
	  (
	   'end', 
	   -window => $State_{$S{$item}[0]},
	  );
	$connect1 -> insert('end', "\n") if !($item eq "connectLong"); 
      }
  }

# statistic conection taping
#
sub printStatisticConnect
  {
    my ($disconectTime);
    my ($file) = "$echelonPath/statistic/$statisticStorage";
    $disconnectTime =  PrintTime();
    open (STATISTIC, ">>$file") || die "Impossible de crer le fichier $file: $!\n";
    # Date User ConnectionTime DisconectionTime TimeConnection
    print STATISTIC "$currentDate $user $ctime $disconnectTime $long \n";
    close (STATISTIC)|| die "Impossible de fermer $file: $!\n";
  }

# first NoteBook page: Log connection print
#
sub PrintConnectionLog
  {
    $ConnectionLogVar = $connect2 -> Scrolled
      (
       "ROText",
#       -width      => 78,
       -scrollbars => 'osoe',
#       -height     => 5,
       -wrap       => 'none',
       -background => "linen"
      );
    $connect2 -> pack
      (
      );
  }

# Second NoteBook page
#
sub print_Mail
  {
    my ($state) ='disabled';
    # The two both LabFrames
    #
    foreach $lab (qw/LabFrameTop LabFrameBottom/)
      {
	$label = "Rception";
	$label = "mission" if ($lab eq "LabFrameBottom");
	${"$lab"} = $page_{$NoteBook{mail}[0]} -> LabFrame
	  (
	   -label     => "$label",
	   -labelside => "acrosstop",
	  );
        ${"$lab"} -> pack
          (
	   -expand => '1',
	   -fill   => 'both',
	  );
        $text_{"$lab"} = ${"$lab"}  -> Scrolled
	   (
	    "ROText",
	    -width      => 78,
	    -scrollbars => 'osoe',
	    -height     => 5,
	    -wrap       => 'none',
	    -background => "linen"
	   );
	 $text_{"$lab"} -> pack
	   (
	    -expand => '1',
	    -fill   => 'both',
	   );
       }
     # The fetchmail button 
     #	
     $button_frame = $page_{$NoteBook{mail}[0]} -> Frame
	(
	 -relief => 'flat',
	);
     $button_frame -> pack
	(
	 -expand => '0',
	 -fill   => 'x',
	);
     $state = 'active' 
       if ($connection_state eq 'live');
     $state = 'disabled' 
       if (($connection_state eq 'dead')||($connection_state eq 'attempt'));
     $button = $button_frame -> Button
	(
	 -text    => "Rapatrier le courrier",
	 -command => \&fetchmail,
	 -state   => "$state",
	);
       $button -> pack
	(
	 -expand => '0',
	 -fill   => 'x',
	);
   }

# fetchmail button.
# Forks, in order not to stop the event loop and for printing in live
# the analyse of arriving mails
#
sub fetchmail
  {
    $print = "Tentative de rapatriement du courrier:\n",
    $text_{LabFrameTop} -> insert('end',"$print", 'DarkViolet');
  Fork: 
    {
      if ($pid = fork)
        {
	  exec "$FETCHMAIL";
	}
      elsif (defined $pid)
        {
        }
      elsif ($! =~ /No more process/)
        {
          sleep 5;
          redo FORK;
        }
      else 
        {
          die "can't fork: $!\n";
        }      
    }
  }

# Third NoteBook page
#
sub print_Log
  {
    foreach $lab (qw/LabFrame1 LabFrame2 LabFrame3/)
      {
	$label = "$MESSAGE_log";
	$label = "$MAIL_IN_log"  if ($lab eq "LabFrame2");
	$label = "$MAIL_OUT_log" if ($lab eq "LabFrame3");
	${"$lab"} = $page_{$NoteBook{log}[0]} -> LabFrame
	  (
	   -label     => "$label",
	   -labelside => "acrosstop",
	  );
        ${"$lab"} -> pack
          (
	   -expand => '1',
	   -fill   => 'both',
	  );
        $text_{"$lab"} = ${"$lab"}  -> Scrolled
	   (
	    "ROText",
	    -width      => 78,
	    -scrollbars => 'osoe',
	    -height     => 5,
	    -wrap       => 'none',
	    -background => "linen"
	   );
	$text_{"$lab"} -> pack
	   (
	    -expand => '1',
	    -fill   => 'both',
	    );
       }
  }


# view the log file
#
sub log_viewer
  {
    my ($varlog);
    %LOG =
      (
       syst_log => [$MESSAGE_log,  $text_{LabFrame1}, MESSAGE],
       in_log   => [$MAIL_IN_log,  $text_{LabFrame2}, MAILIN ],
       out_log  => [$MAIL_OUT_log, $text_{LabFrame3}, MAILOUT],
      );
    foreach $varlog (qw/syst_log in_log out_log/)
      {
	open($LOG{$varlog}[2], "$LOG{$varlog}[0]") 
	  || die "Ouverture de $LOG{$varlog}[2] impossible: $!";
	seek($LOG{$varlog}[2], 0, SEEK_END) # end of file for the mail
	  if (($varlog eq 'in_log')||($varlog eq 'out_log'));
	ReadFile($LOG{$varlog}[2], $LOG{$varlog}[1]);
      }
  }

# tail simulation
# 
sub ReadFile
  {
    my ($LOG, $win)= @_;
    &AllTag($win);
    while (<$LOG>)
      {
	&ColorLog($LOG, $win, $_);
	$win -> see('end');
      }
    seek($LOG,0,1);
    after(500, sub {&ReadFile($LOG, $win)});
  }

# Colors supports for log file print
#
sub ColorLog
  {
    my ($LOG, $win, $currentLine)= @_;
    if ($LOG eq "MESSAGE")
      {
	&ColorMessage($win, $currentLine);
	&AnalyseMessageLogAfterConnect($currentLine) 
	  if (($connection_start eq "yes")||($disconnectStatus eq "yes"));
      }
    elsif ($LOG eq "MAILIN")
      {
	&ColorMailIn($win, $currentLine);
	&AnalyseMailIn($currentLine);
      }
    elsif ($LOG eq "MAILOUT")
      {
	if ($MTA eq 'Smail')
	  {
	    &ColorMailOut_smail($win, $currentLine);
	    &AnalyseMailOut_smail($currentLine);
	  };
	if ($MTA eq 'Exim')
	  {
	    &ColorMailOut_exim($win, $currentLine);
	    &AnalyseMailOut_exim($currentLine);
	  };
	
      }
    else
      {
	print "WARNING: no log file specified\n";
      }
  }

# Colors support for messages log file
# (standard file for Linux system)
#
sub ColorMessage
  {
    my ($win, $currentLine)=@_;
    my ($currentLength, $pos, @word);
    @word = split(/ +/, $currentLine);
    $currentLength = @word;
    for ($pos=1; $pos <= ($currentLength-1); $pos++)
      {
	$word[$pos]="$word[$pos] ";
      };
    $win -> insert('end', "$word[0] $word[1]", 'blue')
      if ($currentLength >= 2);
    $win -> insert('end', "$word[2]", 'LightSlateBlue')
      if ($currentLength >= 3);
    $win -> insert('end', "$word[3]", 'navy')
      if ($currentLength >= 4);
    if ($currentLength >= 5)
      {
	for ($pos = 4; $pos <= ($currentLength-1); $pos++)
	  {
	    if ($word[4] =~ /pppd/)
	      {
		$win -> insert('end', "$word[$pos]", 'red');
	      }
	    elsif ($word[4] =~ /chat/)
	      {
		$win -> insert('end', "$word[$pos]", 'orange');	    
	      }
	    else
	      {
		$win -> insert('end', "$word[$pos]", 'green4');	    
	      }
	  }
      }
  }

# Colors support for mail-in log file
# (Standard file for Linux system)
#
sub ColorMailIn
  {
    my ($win, $currentLine)= @_;
    my ($currentLength, $pos, @word);
    @word = split(/ +/, $currentLine);
    $currentLength = @word;
    for ($pos=1; $pos <= ($currentLength-1); $pos++)
      {
	$word[$pos]="$word[$pos] ";
      };
    $win -> insert('end', "$word[0] $word[1]", 'blue')
      if ($currentLength >= 2);
    $win -> insert('end', "$word[2]", 'LightSlateBlue')
      if ($currentLength >= 3);
    $win -> insert('end', "$word[3]", 'navy')
      if ($currentLength >= 4);
    if ($currentLength >= 5)
      {
	for ($pos = 4; $pos <= ($currentLength-1); $pos++)
	  {
	    if ($word[$pos] =~ /fetchmail/)
	      {
		$win -> insert('end', "$word[$pos]", 'red');
	      }
	    elsif ($word[4] =~ /fetchmail/)
	      {
		if ($word[5] =~ /POP/)
		  {
		    $win -> insert('end', "$word[$pos]", 'orange');
		  }
		elsif ($word[5] =~ /SMTP/)
		  {
		    $win -> insert('end', "$word[$pos]", 'green4');
		  }
		else
		  {
		    $win -> insert('end', "$word[$pos]", 'DarkViolet');
		  }
	      }
	    else
	      {
		$win -> insert('end', "$word[$pos]", 'black');
	      }
	  }
      }
  }

# Colors support for mail-out log file
# non-standard file: depend of your MDA
#
#  FOR SMAIL ONLY
#
sub ColorMailOut_smail
  {
    my ($win, $currentLine)= @_;
    my ($currentLength, $pos, @word);
    @word = split(/ +/, $currentLine);
    $currentLength = @word;
    for ($pos=1; $pos <= ($currentLength-1); $pos++)
      {
	$word[$pos]="$word[$pos] ";
      };
    $win -> insert('end', "$word[0] ", 'blue')
      if ($currentLength >= 1);
    $win -> insert('end', "$word[1]", 'LightSlateBlue')
      if ($currentLength >= 2);
    $win -> insert('end', "$word[2]", 'navy')
      if ($currentLength >= 3);
    if ($currentLength >= 4)
      {
	for ($pos = 3; $pos <= ($currentLength-1); $pos++)
	  {
	    # delivering mails
	    if ($word[$pos] =~ /Completed/)
	      {
		$win -> insert('end', "$word[$pos]", 'red');
	      };
	    if ($word[$pos] =~ /Delivered/)
	      {
		$win -> insert('end', "$word[$pos]", 'red');
	      }
	    elsif ($word[3] =~ /Delivered/)
	      {
		if ($word[$pos] =~ /VIA/) # !!! dlivrance !!!!
		  {
		    $win -> insert('end', "$word[$pos]", 'DarkViolet');
		  }
		elsif ($word[$pos] =~ /^TO|DIRECTOR/)
		  {
		    $win -> insert('end', "$word[$pos]", 'orange');
		  }
		elsif ($word[$pos] =~ /ORIG|TRANSPORT/)
		  {
		    $win -> insert('end', "$word[$pos]", 'green4');
		  }
	        else
		  {
		    $win -> insert('end', "$word[$pos]", 'black');
		  }
	      };
	    # incoming mails
	    if ($word[$pos] =~ /Received/)
	      {
		$win -> insert('end', "$word[$pos]", 'yellow3');
	      }
	    elsif ($word[3] =~ /Received/)
	       {
		 if ($word[$pos] =~ /FROM/) 
		  {
		    $win -> insert('end', "$word[$pos]", 'DarkViolet');
		  }
		elsif ($word[$pos] =~ /HOST|PROGRAM|SIZE|ID-METHOD/)
		  {
		    $win -> insert('end', "$word[$pos]", 'orange');
		  }
		elsif ($word[$pos] =~ /PROTOCOL|ORIG|IDENT/)
		  {
		    $win -> insert('end', "$word[$pos]", 'green4');
		  }
	        else
		  {
		    $win -> insert('end', "$word[$pos]", 'black');
		  }
	       };
	    if (!(  ($word[3] =~ /Delivered|Received|Completed/)))
		{
		  $win -> insert('end', "$word[$pos]", 'black');
		};
	      }
	  }
      }

# Colors support for mail-out log file
# non-standard file: depend of your MTA
#
#  FOR EXIM ONLY
#
sub ColorMailOut_exim
  {
    my ($win, $currentLine)= @_;
    my ($currentLength, $pos, @word);
    @word = split(/ +/, $currentLine);
    $currentLength = @word;
    for ($pos=1; $pos <= ($currentLength-1); $pos++)
      {
	$word[$pos]="$word[$pos] ";
      };
    $win -> insert('end', "$word[0] ", 'blue')
      if ($currentLength >= 1);
    $win -> insert('end', "$word[1]", 'LightSlateBlue')
      if ($currentLength >= 2);
    $win -> insert('end', "$word[2]", 'navy')
      if ($currentLength >= 3);
    if ($currentLength >= 4)
      {
	for ($pos = 3; $pos <= ($currentLength-1); $pos++)
	  {
	    # exim talking
	    if ($word[$pos] =~ /queue|run:|pid|-qf/)
	      {
		$win -> insert('end', "$word[$pos]", 'navy');
	      }
	    # delivering mails
	    elsif ($word[3] =~ /\<=/)
	      {
		if ($word[$pos] =~ /\<=/)
		  {
		    $win -> insert('end', "$word[$pos]", 'green4');
		  }
		elsif (($word[$pos] =~ /@/)&&(!($word[$pos] =~ /^id=/)))
		  {
		    $win -> insert('end', "$word[$pos]", 'DarkViolet');
		  }
		elsif ($word[$pos] =~ /H=.*|U=.*|S=.*/)
		  {
		    $win -> insert('end', "$word[$pos]", 'orange');
		  }
		else
		  {
		    $win -> insert('end', "$word[$pos]", 'green4');
		  }		  
	      }
	    # incoming mails
	    elsif ($word[3] =~ /=\>/)
	      {
		if ($word[$pos] =~ /=\>/)
		  {
		    $win -> insert('end', "$word[$pos]", 'red');
		  }
		elsif (($word[$pos] =~ /@/)&&(!($word[$pos] =~ /^id=/)))
		  {
		    $win -> insert('end', "$word[$pos]", 'red');
		  }
		elsif ($word[$pos] =~ /R=|H=/)
		  {
		    $win -> insert('end', "$word[$pos]", 'orange');
		  }
		else
		  {
		    $win -> insert('end', "$word[$pos]", 'green4');
		  }
	      }
	    elsif ($word[$pos] =~ /Completed/)
	      {
		$win -> insert('end', "$word[$pos]", 'red');
	      }
	    else
	      {
		$win -> insert('end', "$word[$pos]", 'green4');
	      }
	  }
      }
  }

# All colors tag
#
sub AllTag
  {
    my ($win) = @_;
    foreach $color (qw/black red blue orange green4 yellow3
		        DarkViolet LightSlateBlue navy/)
      {
	$win -> tagConfigure
	  (
	   "$color",
	   -font       => '-*-fixed-medium-*-*-*-13-*-75-*-*-*-*-1',
	   -foreground => "$color",
	  );
      };
  }

# Analyse the mail-in log file
#
sub AnalyseMailIn
  {
    my ($line)= @_;
    my (@word, $print, $user, $message, $byte);
    AllTag($text_{LabFrameTop});
    if ($line =~ /POP3\> USER/)
      {
	@word  = split(/ +/,$line);
	chop($word[7]);chop($word[7]);
	chop($word[7]) if ($version_debian < 2.1); # remove \n, ^ et M
	$text_{LabFrameTop} -> insert('end',"\n$word[7]: ", 'red');
	$print = "identification russie  $word[2], le $word[1] $word[0]\n",
	$text_{LabFrameTop} -> insert('end',"$print", 'navy');
      };
    if ($line =~ /POP3\< \+OK [0-9]+ [0-9]+/)
      {
	@word    = split(/ +/,$line);
	chomp($word[8]);
	$size    = $word[8];
	$number  = $word[7];
	$message = "courriels" if ($word[7] >  1);
	$message = "courriel"  if ($word[7] <= 1);
	$byte    = "octets"    if ($word[7] >  0);
	$byte    = "octet"     if ($word[7] == 0);
	$print   = "   Vous avez $number $message ($size $byte)\n";
	$text_{LabFrameTop} -> insert('end',"$print", 'black');
	++$numberPOPaccountCheck if ($number == 0);
      };
    if ((!($number eq "-1"))&&($number > 0))
      {
	if ($line =~ /POP3\> DELE [0-9]+/)
	  {
	    @word    = split(/ +/,$line);
	    chop($word[7]);chop($word[7]);
	    chop($word[7])  if ($version_debian < 2.1); # Why ?
	    # may be a perl version problem on chop...
	    $print = "       * tlchargement en cours ($word[7]/$number)\n";
	     if ($word[7] == 1)
	       {
		 $text_{LabFrameTop} -> insert('end',"$print", 'green4');
	       }
	     else
	       {
		 $text_{LabFrameTop} -> delete("end - 2 lines", 'end');
		 $text_{LabFrameTop} -> insert('end',"\n$print", 'green4');
	       };
	    if ($word[7] == $number)
	      {
		$print = "       * tlchargement termin.\n";
		$text_{LabFrameTop} -> insert('end',"$print", 'green4'); 
		$flag_end = 1;
		++$numberPOPaccountCheck;
	      };
	  };
      };
    if ((($flag_end == 1)||($number == 0))&&($numberPOPaccountCheck == $numberPOPaccount))
      {
	$print = "   Vous pouvez maintenant vous dconnecter\n";
	$text_{LabFrameTop} -> insert('end',"$print", 'DarkViolet');	
	$text_{LabFrameTop} -> bell();
	$flag_end              = 0;
	$numberPOPaccountCheck = 0;
	$number                = "-1";
      };
    $text_{LabFrameTop} -> see('end');
  }

# Analyse the mail-out log file
# Depends of your MTA
#  
#  SMAIL ONLY
#
sub AnalyseMailOut_smail
  {
    my ($line)= @_;
    my (@word, $print, @date);
    AllTag($text_{LabFrameBottom});
    if ($line =~ /Delivered VIA/) # outside delivery only
      {
	@word    = split(/ +/,$line);
	$word[5] =~ s/TO://;
	@date    = split(/\//,$word[0]);
	$print   = "Le courriel destin  ";
	$text_{LabFrameBottom} -> insert('end',"$print", 'black');
	$print   = "$word[5] ";
	$text_{LabFrameBottom} -> insert('end',"$print", 'red');
	$print   = "a bien t achemin \n";
	$text_{LabFrameBottom} -> insert('end',"$print", 'black');
	$print   = "     $word[1] ";
	$text_{LabFrameBottom} -> insert('end',"$print", 'DarkViolet');
	$print   = " la date du ";
	$text_{LabFrameBottom} -> insert('end',"$print", 'black');
	$print = "$date[1]/$date[0]/$date[2]\n";	
	$text_{LabFrameBottom} -> insert('end',"$print", 'DarkViolet');
      }
  }

# Analyse the mail-out log file
# Depends of your MTA
#  
#  EXIM ONLY
#
sub AnalyseMailOut_exim
  {
    my ($line)= @_;
    my (@word, $print, @date);
    AllTag($text_{LabFrameBottom});
    if ($line =~ /=>/)
      {
	@word    = split(/ +/,$line);
	if ($word[4] =~ /@/) # for filtering local delivery
	  {
	    @date    = split(/-/,$word[0]);
	    $print   = "Le courriel destin  ";
	    $text_{LabFrameBottom} -> insert('end',"$print", 'black');
	    $print   = "$word[4] ";
	    $text_{LabFrameBottom} -> insert('end',"$print", 'red');
	    $print   = "a bien t achemin \n";
	    $text_{LabFrameBottom} -> insert('end',"$print", 'black');
	    $print   = "     $word[1] ";
	    $text_{LabFrameBottom} -> insert('end',"$print", 'DarkViolet');
	    $print   = " la date du ";
	    $text_{LabFrameBottom} -> insert('end',"$print", 'black');
	    $print = "$date[1]/$date[0]/$date[2]\n";	
	    $text_{LabFrameBottom} -> insert('end',"$print", 'DarkViolet');
	  }
      }
  }

# For checking a sig-up signal on ppp if connection attempt fails
#
sub AnalyseMessageLogAfterConnect
  {
    my ($line)=@_;
    my (@word);
    AllTag($connect2);
    @word    = split(/ +/,$line);
    if (($line =~ /chat/)&&($line =~ /abort/i)&&($line =~ /busy/i))
      {
	$ConnectionLogVar ="Tentative de connexion  votre fournisseur d'accs...\n";
	$connect2 -> insert('end', "$ConnectionLogVar", 'DarkViolet');
      }
    elsif ($word[6])
      {
	if (($word[6] =~ /[0-9]{10}/)&&($line =~ /send/i)&&($line =~ /chat/i))
	  {
	    $ConnectionLogVar = "    + numrotation du modem\n";
	    $connect2 -> insert('end', "$ConnectionLogVar", 'navy');
	  }      
	elsif ($line =~ /Serial connection established/i)
	  {
	    $ConnectionLogVar = "    + connexion au fournisseur russie\n";
	    $connect2 -> insert('end', "$ConnectionLogVar", 'navy');
	  }
	elsif ($line =~ /Remote IP/i)
	  {
	    $ConnectionLogVar = "    + connexion ppp active\n";
	    $connect2 -> insert('end', "$ConnectionLogVar", 'navy');
	    $ConnectionLogVar = " Vous tes maintenant connect(e) au rseau:\n";
	    $connect2 -> insert('end', "$ConnectionLogVar", 'green4');
	    $ConnectionLogVar = " vous pouvez allez rapatrier votre courrier.\n";
	    $connect2 -> insert('end', "$ConnectionLogVar", 'green4');
	  }
      }
    elsif (($line =~ /chat/)&&($line =~ /Failed/i))
      {
	$ConnectionLogVar = "    + connexion au fournisseur perdue\n";
	$connect2 -> insert('end', "$ConnectionLogVar", 'navy');
	$ConnectionLogVar = " Votre tentative de connexion a chou: recommencez.\n";
	$connect2 -> insert('end', "$ConnectionLogVar", 'red');
	$connection_start = 'no';
      }
    elsif (($line =~ /pppd/)&&($line =~ /Exit/i))
      {
	$ConnectionLogVar = "\n Vous n'tes plus connect(e).\n\n";
	$connect2 -> insert('end', "$ConnectionLogVar", 'orange');
	$disconnectStatus = "no";
      }
  }


# close properly the "log" file handle
#
# 
sub QuitLog
  {
    my (@LOG)= @_;
    my $log;
    foreach $log (@LOG)
      {
	close($log) or die "Fermeture impossible de $log: $!";
      };
  }
