#!/usr/bin/perl -w

#
# rawpop3.pl
#
# Manages a POP3 account at a low level
#
# Sébastien Millet, March 2002, March 2003.
# Copyright Sébastien Millet.
#
# Developed and tested under Perl 5.6.0 - Tk800.024
# under RedHat 7.1 (Kernel 2.4.2-2) and Windows XP.
#

use strict;

use Tk;
use Socket;

my $VERSION = 0.1;



# ***************************************************************
# ***           *************************************************
# ***    POD    *************************************************
# ***           *************************************************
# ***************************************************************


=head1 NAME

RAWPOP3 - A Tk based script that enables raw POP3 account access.

=head1 DESCRIPTION

This script is to be used to access a POP3 account for those who want
to control exactly what is done between the client and the server. For
example you can delete messages before they are downloaded.

=head1 README

This script is to be used to access a POP3 account for those who want
to control exactly what is done between the client and the server. For
example you can delete messages before they are downloaded.

=head1 PREREQUISITES

This script requires the C<strict> module, the C<Tk> module and the C<Socket> module.

=pod OSNAMES

any

=pod SCRIPT CATEGORIES

Mail

=cut



# ***************************************************************
# ***                 *******************************************
# ***    CONSTANTS    *******************************************
# ***                 *******************************************
# ***************************************************************


  # Name of configuration file
my $CONFIG_FILENAME = \".rawpop3-cf";
  # First line of config file
my $FV = \"RAWPOP_CFGFILE_VERSION";
  # Version of current CFG file
my $CFG_CUR_VERSION = \"1.0";

  # File name when a message is saved
my $MSG_RECORD_FILE = \"message";

  # End Of Line sequence when dealing with a SOCK filehandler (=> TCP connection)
my $EOL = \"\015\012";

  # Thousand separator
my $THOUSAND_SEPARATOR = \" ";

  # Month list
my %months_list = ("Jan" => 0, "Feb" => 1, "Mar" => 2, "Apr" => 3, "May" => 4, "Mai" => 4, "Jun" => 5,
					"Jul" => 6, "Aug" => 7, "Sep" => 8, "Oct" => 9, "Nov" => 10, "Dec" => 11);
my %weekdays_list = ("Mon" => 0, "Tue" => 1, "Wed" => 2, "Thu" => 3, "Fri" => 4, "Sat" => 5, "Sun" => 6);

  # Possible log levels
my $LL_NONE = \0;
my $LL_ERROR = \1;
my $LL_WARNING = \2;
my $LL_NORMAL = \3;
my $LL_VERBOSE = \4;
my $LL_DEBUG = \5;

  # Possible states of the message list
my $ML_EMPTY = \0;
my $ML_FILLED = \1;

  # Possible state of a given message in the message list
my $MSG_SIZEONLY = \0;
my $MSG_DETAILED = \1;
my $MSG_DOWNLOADED = \2;

  # Possible actions when reading a message
my $ACTION_DETAIL = \0;
my $ACTION_DOWNLOAD = \1;

  # Size of columns in the list
my $CS_NUMBER = \6;
my $CS_SIZE = \12;

my $CT_SIZE = \5;
my $CT_DATE = \5;
my $CT_FROM = \40;
my $CT_SUBJECT = \40;

  # When a message is older than 6 months ago, then display only its year in
  # the "posted date" field of the message list. Otherwise display the day and month.
my $NB_MONTHS_DETAIL = \6;



# ****************************************************************
# ***                  *******************************************
# ***    UI OBJECTS    *******************************************
# ***                  *******************************************
# ****************************************************************


  # Main window
my $t_mw;
my $menu_bar;
my $mb1;
my $mb2;
my $mb3;

  # A few frames in the main window
my $t_f0;
my $t_f1;
my $t_f3;
my $t_f4;

  # Control that gets focus at program start-up
my $t_focus_ctrl;
  # List of messages
my $t_mlb;
  # Font of messages list
my $t_mlb_font;
  # Detail of a given message
my $t_msg;
  # Display status of POP3 connection state
my $t_conn_status;
  # Display status line (bottom of main window)
my $t_status;
  # Log window
my $t_ml;
  # Log frame (inside log window)
my $t_fl;
  # Log text (inside log frame of the log window)
my $t_log_text;



# **********************************************************************
# ***                        *******************************************
# ***    GLOBAL VARIABLES    *******************************************
# ***                        *******************************************
# **********************************************************************


  # Used to to do one shot actions at program start-up
my $g_program_is_starting = 1;

  # Current log level
my $g_cur_log_level = $$LL_DEBUG;

  # Is the log window displayed ?
my $g_disp_log = 1;

  # Default POP3 account informations (server, port, user, password)
my $g_pop3_server = "";
my $g_pop3_port = 110;
my $g_pop3_username = "";
my $g_pop3_password = "";
my $g_curconn_server;
my $g_curconn_port;

  # Some configuration check boxes
my $g_getlist_when_connect = 0;
my $g_detail_all_when_connect = 0;

  # State of the POP3 connection
my $g_pop3_is_connected = 0;

  # List of messages read from the POP3 server
my @g_ml;
  # State of this list
my $g_mlstate = $$ML_EMPTY;
  # Number of elements in the list
my $g_nbelems;



# *********************************************************************
# ***                       *******************************************
# ***    UI CONSTRUCTION    *******************************************
# ***                       *******************************************
# *********************************************************************


  # Create main window
$t_mw=MainWindow->new;
$t_mw->title("POP3 Low Level Account Manager");
$t_mw->bind("<Visibility>", [\&e_visibility, Ev('s')]);
$t_mw->OnDestroy(\&e_destroy);

  # Create menu
$menu_bar = $t_mw->Menu(-type => "menubar");

$mb1 = $t_mw->Menu(-type => "normal");
$mb1->add("checkbutton",
		-label => "Display log window",
		-variable => \$g_disp_log,
		-command => \&c_change_disp_log_window);
$mb1->add("command",
		-label => "Connect / Disconnect",
		-command => \&c_switch_pop3_connect);
$mb1->add("separator");
$mb1->add("command",
		-label => "Exit",
		-command => sub { exit; });

$mb2 = $t_mw->Menu(-type => "normal");
$mb2->add("command",
		-label => "Get Message List",
		-command => \&c_get_list);
$mb2->add("command",
		-label => "Select all",
		-command => \&c_select_all);
$mb2->add("separator");
$mb2->add("command",
		-label => "Detail selected messages",
		-command => sub { &c_detail_or_download_selected_messages($$ACTION_DETAIL); });
$mb2->add("command",
		-label => "Download selected messages",
		-command => sub { &c_detail_or_download_selected_messages($$ACTION_DOWNLOAD); });
$mb2->add("command",
		-label => "Display",
		-command => \&c_display_msg);
$mb2->add("command",
		-label => "Save",
		-command => \&c_save_msg);
$mb2->add("command",
		-label => "Delete selected messages",
		-command => \&c_delete_selected_messages);
$mb3 = $t_mw->Menu(-type => "normal");
$mb3->add("command",
		-label => "Eubahoute...",
		-command => \&c_about);

$menu_bar->add("cascade",
		-menu => $mb1,
		-label => "File");
$menu_bar->add("cascade",
		-menu => $mb2,
		-label => "Message");
$menu_bar->add("cascade",
		-menu => $mb3,
		-label => "help");
$t_mw->configure(-menu => $menu_bar);

  # Create frames in main window
$t_f0 = $t_mw->Frame(-relief => "ridge",
		-borderwidth => 2)
	->pack(-fill => "x");
$t_f1 = $t_mw->Frame(-relief => "ridge",
		-borderwidth => 2)
	->pack(-fill => "x");
$t_f3 = $t_mw->Frame(-relief => "ridge",
		-borderwidth => 2)
	->pack(-fill => "x");
$t_f4 = $t_mw->Frame(-relief => "flat",
		-borderwidth => 2)
	->pack(-fill => "both",
		-expand => 1);

  # Populate frames
$t_f0->Checkbutton(-text => "Display log window",
		-variable => \$g_disp_log,
		-command => \&c_change_disp_log_window)
	->pack(-side => "left",
		-padx => 2,
		-pady => 2);
$t_f0->Checkbutton(-text => "Get message list upon connection",
		-variable => \$g_getlist_when_connect)
	->pack(-side => "left",
		-padx => 2,
		-pady => 2);
$t_f0->Checkbutton(-text => "Detail all messages upon connection",
		-variable => \$g_detail_all_when_connect)
	->pack(-side => "left",
		-padx => 2,
		-pady => 2);

$t_f1->Label(-text => "POP3 server")
	->pack(-side => "left",
		-padx => 8,
		-pady => 2);
$t_focus_ctrl = $t_f1->Entry(-textvariable => \$g_pop3_server,
		-background => "white",
		-relief => "flat")
	->pack(-side => "left",
		-expand => 1,
		-fill => "x",
		-padx => 8,
		-pady => 2);

$t_f1->Label(-text => "POP3 port")
	->pack(-side => "left",
		-padx => 8,
		-pady => 2);
$t_f1->Entry(-textvariable => \$g_pop3_port,
		-background => "white",
		-width => 5,
		-justify => "right",
		-relief => "flat")
	->pack(-side => "left",
		-padx => 8,
		-pady => 2);

$t_f1->Label(-text => "User name")
	->pack(-side => "left",
		-padx => 8,
		-pady => 2);
$t_f1->Entry(-textvariable => \$g_pop3_username,
		-background => "white",
		-relief => "flat")
	->pack(-side => "left",
		-expand => 1,
		-fill => "x",
		-padx => 8,
		-pady => 2);

$t_f1->Label(-text => "Password")
	->pack(-side => "left",
		-padx => 8,
		-pady => 2);
$t_f1->Entry(-textvariable => \$g_pop3_password,
		-background => "white",
		-width => 8,
		-relief => "flat",
		-show => "*")
	->pack(-side => "left",
		-padx => 8,
		-pady => 2);

$t_f3->Button(-text => "Connect / Disconnect",
		-command => \&c_switch_pop3_connect)
	->pack(-side => "left",
		-padx => 8,
		-pady => 2);

$t_f3->Button(-text => "Get message list",
		-command => \&c_get_list)
	->pack(-side => "left",
		-padx => 8,
		-pady => 2);

$t_f3->Button(-text => "Select all",
		-command => \&c_select_all)
	->pack(-side => "left",
		-padx => 8,
		-pady => 2);

$t_f3->Button(-text => "Detail",
		-command => sub { &c_detail_or_download_selected_messages($$ACTION_DETAIL); })
	->pack(-side => "left",
		-padx => 8,
		-pady => 2);

$t_f3->Button(-text => "Download",
		-command => sub { &c_detail_or_download_selected_messages($$ACTION_DOWNLOAD); })
	->pack(-side => "left",
		-padx => 8,
		-pady => 2);

$t_f3->Button(-text => "Display",
		-command => \&c_display_msg)
	->pack(-side => "left",
		-padx => 8,
		-pady => 2);

$t_f3->Button(-text => "Save",
		-command => \&c_save_msg)
	->pack(-side => "left",
		-padx => 8,
		-pady => 2);

$t_f3->Button(-text => "Delete",
		-command => \&c_delete_selected_messages)
	->pack(-side => "left",
		-padx => 8,
		-pady => 2);

$t_f3->Button(-text => "Exit",
		-command => sub { exit; })
	->pack(-side => "right",
		-padx => 8,
		-pady => 2);

$t_conn_status = $t_mw->Label(-width => 15,
		-background => "darkblue",
		-foreground => "white")
	->pack(-side => "left",
		-padx => 2,
		-pady => 2);

$t_status = $t_mw->Label
	->pack(-side => "left",
		-padx => 2,
		-pady => 2);

$t_mlb = $t_f4->Scrolled('Listbox', -scrollbars => "e")
	->pack(-side => "top",
		-padx => 2,
		-pady => 2,
		-fill => "both");

$t_mlb_font = $t_mw->fontCreate(-size => 8,
		-family => "courier");
$t_mlb->configure(-relief => "ridge",
	-selectmode => "extended",
	-font => $t_mlb_font,
	-height => 8);

$t_msg = $t_f4->Scrolled('Text', -scrollbars => "se")
	->pack(-side => "bottom",
		-padx => 2,
		-pady => 2,
		-fill => "both",
		-expand => 1);
$t_msg->configure(-relief => "ridge",
		-height => 8);

  # We're not connected at the beginning
&pop3_switch_conn_state(0);

  # Read current POP3 server, port, account name and password, whenever the config file exists
&read_config;

  # Focus starts on POP3 server name
$t_focus_ctrl->focus();
$t_focus_ctrl->icursor('end');
$t_focus_ctrl->selectionRange(0, 'end');

  # Looping...
MainLoop;

exit;



# *********************************************************************
# ***                       *******************************************
# ***    EVENTS HANDLERS    *******************************************
# ***                       *******************************************
# *********************************************************************


  #
  # Display ABOUT window
  # Usage: called by UI
  #
  # -> If someone can explain me how to easily make a given window be MODAL, I'm interested.
  #
sub c_about {
	my $w;

	$w = $t_mw->Toplevel;
	$w->title("About rawpop3.pl");
	$w->Label(-text => "\nrawpop3.pl version $VERSION\n\nAccess a POP3 account at a low level.\n" .
			"Enable deletion of messages before they are downloaded.\n\n" .
			"Copyright 2002, 2003 Sébastien Millet, sebastien.millet2\@libertysurf.fr\n\n")
		->pack(-side => "top",
			-padx => 8);
	$w->Button(-text => "Ok",
			-command => sub { $w->destroy; })
		->pack(-side => "bottom",
			-pady => 8);
	$w->resizable(0, 0);
}


  #
  # Display the content of a given message
  # Usage: called by UI
  #
sub c_display_msg {
	my @sel;
	my $idx;

	@sel = $t_mlb->curselection;

	if ($#sel == 0) {
		$idx = $sel[0];
		&msg_display($idx);
	}
}


  #
  # Save the selected message's content
  # Usage: called by UI
  #
sub c_save_msg {
	my @sel;
	my $idx;

	@sel = $t_mlb->curselection;

	if ($#sel == 0) {
		$idx = $sel[0];
		&save_msg($idx);
	}
}


  #
  # Let the log window appear (if checked) at program start-up
  # Usage: called by EV
  #
sub e_visibility {
	my ($w, $h, $x, $y);
	
	if ($_[0] == $t_mw) {
		if ($g_program_is_starting) {
			($w, $h, $x, $y) = $t_mw->geometry =~ m/^(\d+)x(\d+)\+(\d+)\+(\d+)$/;
			$t_mw->geometry("+$x" . '+0');
			&switch_disp_log_window($g_disp_log);
			$g_program_is_starting = 0;
		}
	}
}


  #
  # Manage the destruction of the main window (close the POP3 connection, if so).
  # Usage: called by EV
  #
sub e_destroy {
	my $err_str;

	if ($g_pop3_is_connected) {
		&pop3_disconnect($err_str);
	}

	&write_config;
}


  #
  # Display the log window or make it disappear.
  # Usage: called by UI
  #
sub c_change_disp_log_window {
	&switch_disp_log_window($g_disp_log);
}


  #
  # Connect to the POP3 server and get list of messages (get only index and size informations).
  # Usage: called by UI
  #
sub c_get_list {
	my $e;
	my $err_str;

	if (!$g_pop3_is_connected) {
		&my_log("unable to get list of messages: no POP3 connection is established", $$LL_ERROR);
		return;
	}

	&empty_mlb;
	$t_mw->idletasks;
	if ($e = &pop3_update_msg_list($err_str)) {
		&my_log($err_str, $$LL_ERROR);
	} else {
		&update_mlb_from_msg_list;
	}
}


  #
  # Select all elements in the list.
  # Usage: called by UI
  #
sub c_select_all {
	$t_mlb->selectionSet(0, "end");
}


  #
  # Connect (if not connected) or disconnect (if connected) to/from the POP3 server,
  # using pop3_connect or pop3_disconnect procedure.
  # Usage: called by UI
  #
sub c_switch_pop3_connect {
	my $e;
	my $err_str;

	if (!$g_pop3_is_connected) {
		$g_pop3_server = "" if !defined($g_pop3_server);
		$g_pop3_port = 0 if !defined($g_pop3_port);
		$g_pop3_username = "" if !defined($g_pop3_username);
		$g_pop3_password = "" if !defined($g_pop3_password);

		if ($e = pop3_connect($g_pop3_server, $g_pop3_port, $g_pop3_username, $g_pop3_password, $err_str)) {
			&my_log($err_str, $$LL_ERROR);
			return;
		}
		&pop3_switch_conn_state(1);
		if ($g_getlist_when_connect || $g_detail_all_when_connect) {
			c_get_list;
		}
		if ($g_detail_all_when_connect) {
			&c_select_all;
			&c_detail_or_download_selected_messages($$ACTION_DETAIL);
		}
	} else {
		if ($e = &pop3_disconnect($err_str)) {
			&my_log($err_str, $$LL_ERROR);

			  # don't return here since we consider there is no POP3 connection any longer

		} else {
			&my_log("disconnected from $g_curconn_server:$g_curconn_port", $$LL_NORMAL);
		}
		&pop3_switch_conn_state(0);
	}
}


  #
  # Detail selected messages.
  # Usage: called by UI
  #
sub c_detail_or_download_selected_messages {
	my $action = $_[0];
	my @sel;
	my $msgi;
	my $i;

	@sel = $t_mlb->curselection;
	foreach $i (@sel) {
		$msgi = $g_ml[$i][1];
		&msg_detail_or_download($i, $msgi, $action);

		  # Update visible list
		$t_mlb->delete($i);
		$t_mlb->insert($i, &get_formatted_line(@{$g_ml[$i]}));
		$t_mw->idletasks;
	}
}


  #
  # Delete selected messages
  # Usage: called by UI
  #
sub c_delete_selected_messages {
	my @sel;
	my $msgi;
	my $i;
	my $shift;
	my $err_str;
	my $e;

	@sel = $t_mlb->curselection;
	$shift = 0;
	foreach $i (@sel) {
		$msgi = $g_ml[$i - $shift][1];
		&my_log("will delete message \#$msgi", $$LL_VERBOSE);
		if ($e = &msg_delete($i - $shift, $msgi, $err_str)) {
			&my_log("unable to delete message \#$msgi: $err_str", $$LL_ERROR);
		} else {
			&my_log("deleted message \#$msgi", $$LL_NORMAL);

			  # Update internal list
			splice(@g_ml, $i - $shift, 1);

			  # Update visible list
			$t_mlb->delete($i - $shift);
			$t_mw->idletasks;

			  # Because of message deletion, everything in lists is shifted by one
			$shift++;
		}
	}
}



# ****************************************************************
# ***                  *******************************************
# ***    PROCEDURES    *******************************************
# ***                  *******************************************
# ****************************************************************


  #
  # Read configuration file.
  # This function sets values of GLOBAL variables.
  # Usage:
  #
  #		&read_config;
  #
sub read_config {
	my $l;
	my $v;

	open(CFG, "<$$CONFIG_FILENAME") or return;
	$l = <CFG>;
	if (($v) = $l =~ m/^$$FV\s?=\s?(.*)$/i) {
		if ($v eq $$CFG_CUR_VERSION) {
			$g_pop3_server = <CFG>;
			$g_pop3_port = <CFG>;
			$g_pop3_username = <CFG>;
			$g_pop3_password = <CFG>;
			$g_getlist_when_connect = <CFG>;
			$g_detail_all_when_connect = <CFG>;
			chomp $g_pop3_server if defined($g_pop3_server);
			chomp $g_pop3_port if defined($g_pop3_port);
			chomp $g_pop3_username if defined($g_pop3_username);
			chomp $g_pop3_password if defined($g_pop3_password);
			chomp $g_getlist_when_connect if defined($g_getlist_when_connect);
			chomp $g_detail_all_when_connect if defined($g_detail_all_when_connect);
		}
	}
	close CFG;
}


  #
  # Write the configuration file.
  # This function uses values of GLOBAL variables.
  # Usage:
  #
  #		&write_config;
  #
sub write_config {
	open(CFG, ">$$CONFIG_FILENAME") or return;
	$g_pop3_server = "" if !defined($g_pop3_server);
	$g_pop3_port = "" if !defined($g_pop3_port);
	$g_pop3_username = "" if !defined($g_pop3_username);
	$g_pop3_password = "" if !defined($g_pop3_password);
	print(CFG "$$FV=$$CFG_CUR_VERSION\n$g_pop3_server\n$g_pop3_port\n$g_pop3_username\n$g_pop3_password\n" .
			"$g_getlist_when_connect\n$g_detail_all_when_connect\n");
	close CFG;
}


  #
  # Make a message display in the text control
  # Usage:
  #
  #		&msg_display($g_ml_indice);
  #
sub msg_display {
	my $i = $_[0];
	my $s;

	$t_msg->delete("0.0", "end");
	if ($g_ml[$i][0] == $$MSG_SIZEONLY) {
		$t_msg->insert("0.0", "");
	} elsif ($g_ml[$i][0] == $$MSG_DETAILED) {
		$t_msg->insert("0.0", $g_ml[$i][6]);
	} elsif($g_ml[$i][0] == $$MSG_DOWNLOADED) {
		$t_msg->insert("0.0", $g_ml[$i][6] . "\n" . $g_ml[$i][7]);
	}
}


  #
  # Save a message
  # Usage:
  #
  #		&save_msg($g_ml_indice);
  #
sub save_msg {
	my $idx = $_[0];

	&my_log("will save message #$idx into \"$$MSG_RECORD_FILE\"", $$LL_NORMAL);

	if ($g_ml[$idx][0] == $$MSG_SIZEONLY) {
		&my_log("At least message headers should be downloaded", $$LL_ERROR);
		return;
	}
	open(MSG, ">$$MSG_RECORD_FILE") or &my_log("unable to open file $$MSG_RECORD_FILE: $!", $$LL_ERROR), return;

	if ($g_ml[$idx][0] == $$MSG_DETAILED) {
		print(MSG $g_ml[$idx][6]);
	} elsif ($g_ml[$idx][0] == $$MSG_DOWNLOADED) {
		print(MSG $g_ml[$idx][6] . "\n" . $g_ml[$idx][7]);
	}
	close MSG;

	&my_log("Message #$idx successfully saved into \"$$MSG_RECORD_FILE\"", $$LL_NORMAL);
}


  #
  # Delete a given message, identified by its POP3 number.
  # Usage:
  #
  #		$errno = msg_delete($g_ml_indice, $msg_pop3_number, $err_str);
  #
sub msg_delete {
	my $i = $_[0];
	my $msgi = $_[1];
	my $e;

	$e = &pop3_send_recv_and_ctrl("DELE $msgi", "+OK", $_[2]);

	return 0;
}


  #
  # Detail or download a given message, identified by its POP3 number.
  # Usage:
  #
  #		&msg_detail_or_download($g_ml_indice, $msg_pop3_number, $action);
  #
sub msg_detail_or_download {
	my $i = $_[0];
	my $msgi = $_[1];
	my $action = $_[2];

	my $v1;
	my $v2;
	my $instr;

	my $e;
	my $cont;
	my $line1;
	my $err_str;
	my $l;
	my $is_in_body;
	my $last_is_in_body;
	my ($fld_from, $fld_sender, $fld_return_path, $fld_subject, $fld_date);
	my ($displayed_from, $displayed_date);
	my $msg_headers;
	my $msg_body;
	my (@parsed_date, @cur_date);
	my ($cur_y, $cur_m, $msg_y, $msg_m);

	$v1 = $action == $$ACTION_DETAIL ? "gather informations of" : "download";
	$v2 = $action == $$ACTION_DETAIL ? "detailed": "downloaded";
	$instr = $action == $$ACTION_DETAIL ? "TOP $msgi 0" : "RETR $msgi";

	&my_log("will $v1 message \#$msgi", $$LL_VERBOSE);
	if ($e = &pop3_send_recv_and_ctrl($instr, "+OK", $err_str)) {
		&my_log("unable to $v1 message \#$msgi: $err_str", $$LL_ERROR);
		return;
	}

	$cont = 1;
	$line1 = "";
	$fld_from = "";
	$fld_return_path = "";
	$fld_sender = "";
	$fld_subject = "";
	$fld_date = "";
	$msg_headers = "";
	$is_in_body = 0;

	  # The following loop analyzes a given line only after concatenation (lines beginning with
	  # a space (or tab) character are merged with the preceeding line).
	while ($cont) {
		if ($e = &sock_recv($l, $err_str)) {
			&my_log($err_str, $$LL_ERROR);
			$cont = 0;
		} else {
			$cont = 0 if $l =~ m/^\.$/;
			$last_is_in_body = $is_in_body;
			$is_in_body = 1 if $l eq "";

			  # Remove trailing spaces
			$l =~ s/\s+$// if !$is_in_body;

			$msg_headers .= "$l\n" if $cont && !$is_in_body;
			$msg_body .= "$l\n" if $cont && $is_in_body && $last_is_in_body;

			if (!$is_in_body || (!$last_is_in_body && $is_in_body)) {
				if ((!$cont || $l =~ m/^\S/ || $l eq "") && $line1 ne "") {
					  # Identify fields
					$fld_from = $1 if $line1 =~ m/^From:\s+(.*)$/i;
					$fld_return_path = $1 if $line1 =~ m/^Return-path:\s+(.*)$/i;
					$fld_sender = $1 if $line1 =~ m/^Sender:\s+(.*)$/i;
					$fld_subject = $1 if $line1 =~ m/^Subject:\s+(.*)$/i;
					$fld_date = $1 if $line1 =~ m/^Date:\s+(.*)$/i;
					$line1 = "";
				}
				  # Replace leading space or tab sequences with a single space character
				$l =~ s/^\s+/ /;
				$line1 .= $l;
			}
		}
	}
	$displayed_from = $fld_sender if $fld_sender ne "";
	$displayed_from = $fld_return_path if $fld_return_path ne "";
	$displayed_from = $fld_from if $fld_from ne "";
	$displayed_from =~ s/[^<]*<([^>]+)>/$1/;

	@parsed_date = &parse_rfc822_date($fld_date);

	@cur_date = localtime();
	$cur_y = $cur_date[5] + 1900;
	$cur_m = $cur_date[4];
	$msg_y = $parsed_date[1];
	$msg_m = $parsed_date[2];

	if ($parsed_date[1] == -1) {
		$displayed_date = "n/a";
	} elsif (12 * $msg_y + $msg_m + $$NB_MONTHS_DETAIL >= 12 * $cur_y + $cur_m) {
		$displayed_date = sprintf("%02d/%02d", $parsed_date[3], $parsed_date[2] + 1);
	} else {
		$displayed_date = sprintf("%04d", $parsed_date[1]);
	}

	$g_ml[$i][3] = $displayed_date;
	$g_ml[$i][4] = $displayed_from;
	$g_ml[$i][5] = $fld_subject;
	$g_ml[$i][6] = $msg_headers;
	$g_ml[$i][7] = $msg_body if $action == $$ACTION_DOWNLOAD;
	$g_ml[$i][0] = $action == $$ACTION_DETAIL ? $$MSG_DETAILED : $$MSG_DOWNLOADED;

	&my_log("$v2 message \#$msgi", $$LL_NORMAL);
}


  #
  # Analyze the date as written in RFC822 message headers.
  # Usage:
  #
  #		@d = &parse_rfc822_date($the_string);
  #
  # Return a list of eight elements: (weekday, year, month, day, hour, minute, second, zone).
  # zone is a decimal indicating the shift from GMT.
  # month belongs to [0..11], where 0 = January, 1 = February, ...
  # weekday belongs to [0..6], where 0 = monday, 1 = Tuesday, ...
  # day belongs to [1..31].
  #
sub parse_rfc822_date {
	my ($wd, $d, $mo, $y, $y1, $h, $mi, $s, $z);
	my ($sign, $sh, $sm);

	if (($wd, $d, $mo, $y, $y1, $h, $mi, $s, $z) = $_[0] =~ m/^(\w\w\w)?\s*,?\s*(\d\d?)\s+(\w\w\w)\s+((\d\d)?\d\d)\s+(\d\d?):(\d\d?):(\d\d?)\s+((\+|-)?\d\d\d\d)?/) {
		$y += 2000 if $y < 100;
		$wd = $weekdays_list{$wd} if defined($wd);
		$wd = "n/a" if !defined($wd);
		$wd = -1 if !defined($wd);
		$mo = $months_list{$mo};
		$mo = -1 if !defined($mo);
		if (defined($z)) {
			$z = "+" . $z if $z =~ m/^\d/;
			($sign, $sh, $sm) = $z =~ m/(\+|-)(\d\d)(\d\d)/;
			$z = $sh + $sm / 60;
			$z = -$z if $sign eq "-";
		}
	} else {
		$wd = -1;
		$d = -1;
		$mo = -1;
		$y = -1;
		$h = -1;
		$mi = -1;
		$s = -1;
		$z = "";
	}

	return ($wd, $y, $mo, $d, $h, $mi, $s, $z);
}


  #
  # Format a number with a separator each 3 digits.
  # Usage:
  #
  #		$s = &fnb($number);
  #
sub fnb {
	my $n = $_[0];

	$n =~ s/(\d)(?=(\d\d\d)+(\D|$))/$1$$THOUSAND_SEPARATOR/g;
	return $n;
}


  #
  # Right-justify a text for a given total length.
  # Usage:
  #
  #		$s = &right_justify($length, $string);
  #
sub right_justify {
	return sprintf("%" . $_[0] . "s", $_[1]);
}


  #
  # Left-justify a text for a given total length.
  # Usage:
  #
  #		$s = &left_justify($length, $string);
  #
sub left_justify {
	my $r;
	my $p;
	my $s;

	$p = "";
	$p = $_[0] if defined($_[0]);

	$s = "";
	$s = $_[1] if defined($_[1]);

	$r = sprintf("%-" . $p . "s", $s);
	return substr($r, 0, $p);
}


  #
  # Empty all elements of the message list, in the window
  # Usage:
  #
  #		&empty_mlb;
  #
sub empty_mlb {
	@g_ml = ();
	$g_mlstate = $$ML_EMPTY;
	$t_mlb->delete(0, "end");
}


  #
  # Update the main window's list control according to the content of
  # g_ml() array.
  # Usage:
  #
  #		&update_mlb_from_msg_list;
  #
sub update_mlb_from_msg_list {
	my $i;

	for ($i = 0; $i <= $g_nbelems - 1; $i++) {
		$t_mlb->insert("end", &get_formatted_line(@{$g_ml[$i]}));
	}
}


  #
  # Format an element of the messages list (@g_ml) so it can be displayed.
  # Usage:
  #
  #		$formatted_string = &get_formatted_line(@{$g_ml[$a_given_indice]});
  #
sub get_formatted_line {
	my $s;
	my $c;
	my $a;

	$s = $_[0];
	$c = "- unknown state -";
	if ($s == $$MSG_SIZEONLY) {
		$c = &right_justify($$CS_NUMBER, $_[1]) . " " . &right_justify($$CS_SIZE, &fnb($_[2]));
	} elsif ($s == $$MSG_DETAILED || $s == $$MSG_DOWNLOADED) {
		$a = " ";
		$a = "L" if $s == $$MSG_DOWNLOADED;
		$c = &right_justify($$CT_SIZE, &human_size($_[2])) . " " . $a . " " . &left_justify($$CT_DATE, $_[3]) . " " .
				&left_justify($$CT_FROM, $_[4]) . " " . &left_justify($$CT_SUBJECT, $_[5])
	}
	return $c;
}


  #
  # Return the size printed in a human way (followed by b when less than 1024 bytes, followed by k when
  # less than 1024^2 bytes, followed by m when less than 1024^3, followed by g when less than 1024^4.
  # Usage:
  #
  #		$the_string = &human_size($the_size);
  #
sub human_size {
	my $n = $_[0];
	my $factor = "b";

	while ($n >= 1024) {
		$n = int($n / 1024);
		$factor = "g" if $factor eq "m";
		$factor = "m" if $factor eq "k";
		$factor = "k" if $factor eq "b";
	}

	return "$n$factor";
}


  #
  # Create the log window or delete it, depending on $new_value.
  # Usage:
  #
  #		&switch_disp_log_window($new_value)
  #
  # If $new_value is non null, make the log window appear, otherwise make it disappear.
  #
sub switch_disp_log_window {
	my $new_value = $_[0];
	my $h;
	my $x;
	my $y;
	my $z;

	if ($new_value) {
		  # Create log window
		$t_ml = $t_mw->Toplevel;
		$x = $t_mw->rootx;
		$y = $t_mw->rooty;
		$h = $t_mw->height;
		$z = $y + $h;
		$t_ml->geometry("+$x+$z");
		$t_ml->title("Log");

		  # Create frame
		$t_fl = $t_ml->Frame(-relief => "ridge",
				-borderwidth => 2)
			->pack(-expand => 1,
				-fill => "both");

		  # Create text widget in the frame
		$t_log_text = $t_fl->Scrolled('Text', -scrollbars => "e")
			->pack(-expand => 1,
				-fill => "both");
		$t_log_text->configure(-height => 12);

		  # Make the log window appear behind main window
		$t_ml->lower($t_mw);
		  # Whenever the log window is closed, update $g_disp_log accordingly
		$t_ml->OnDestroy(sub { $g_disp_log = 0; });
	} else {
		$t_ml->destroy;
	}
	$g_disp_log = $new_value;
}


  #
  # Change the state of the variable $g_pop3_is_connected. Update UI accordingly.
  # Usage:
  #
  #		&pop3_switch_conn_state($new_state);
  #
sub pop3_switch_conn_state {
	my $new_value = $_[0];

	$g_pop3_is_connected = $new_value;
	$t_conn_status->configure(-text =>  $new_value ? "Connected" : "Disconnected");
}


  #
  # Update the list of server messages.
  # Usage:
  #
  #		$errno = &pop3_update_msg_list($err_str);
  #
  # This proc assumes the connection with the POP3 server has been established.
  # Return 0 if the connection was successful.
  # Return a non-zero value if the connection failed. In that case, $err_str contains a
  # description of the error.
  #
sub pop3_update_msg_list {
	my $e;
	my $nb;
	my $cont;
	my $l;
	my $msg_idx;
	my $msg_size;
	my $total_size = 0;

	@g_ml = ();
	$g_mlstate = $$ML_EMPTY;

	if (!$g_pop3_is_connected) {
		$_[0] = "unable to get list of messages: no POP3 conenction is established";
		return 1997;
	}

	return $e if $e = &pop3_send_recv_and_ctrl("LIST", "+OK", $_[0]);

	$cont = 1;
	$nb = 0;
	while ($cont) {
		return $e if $e = &sock_recv($l, $_[0]);
		if (($msg_idx, $msg_size) = $l =~ m/(\d+)\s+(\d+)/) {
			$nb++;
			push(@g_ml, [$$MSG_SIZEONLY, $msg_idx, $msg_size]);
			$total_size += $msg_size;
		} elsif ($l =~ m/^\.$/) {
			$cont = 0;
			$g_mlstate = $$ML_FILLED;
			$g_nbelems = $nb;
			&my_log("$g_nbelems message(s) of " . &fnb($total_size) . " byte(s)", $$LL_NORMAL);
		} else {
			$_[0] = "unable to parse answer from server, answer = \"$l\"";
			return 1999;
		}
	}
}


  #
  # Connect to a POP3 server.
  # Usage:
  #
  #		  $errno = pop3_connect($remote, $port, $user_name, $user_password, $err_str);
  #
  # Return 0 if the connection was successful.
  # Return a non-zero value if the connection failed. In that case, $err_str contains a
  # description of the error.
  #
sub pop3_connect {
	my $remote = $_[0];
	my $port = $_[1];
	my $uname = $_[2];
	my $upwd = $_[3];

	my $e;
	my $nb_messages;
	my $answer;
	my $is_ok = 0;

	&my_log("will attempt to connect to $remote:$port", $$LL_VERBOSE);
	return $e if $e = &tcp_connect($remote, $port, $_[4]);
	&my_log("connected to $remote:$port", $$LL_NORMAL);
	$g_curconn_server = $remote;
	$g_curconn_port = $port;

	if (!($e = &pop3_recv_and_ctrl("+OK", $_[4]))) {
		if (!($e = &pop3_send_recv_and_ctrl("USER $uname", "+OK", $_[4]))) {
			if (!($e = &pop3_send_recv_and_ctrl("PASS $upwd", "+OK", $_[4], $answer, "PASS xxxxxxxx"))) {
				if (($nb_messages) = $answer =~ m/^\+OK\s+(\d+)/i) {
					&my_log("$nb_messages message(s) on the server", $$LL_NORMAL);
				} else {
					&my_log("unknown message count on the server", $$LL_NORMAL);
				}
				$is_ok = 1;
			}
		}
	}
	if (!$is_ok) {
		&tcp_close;
	}
	return $e;
}


  #
  # Close the current POP3 connection.
  # Usage:
  #
  #		$errno = &pop3_disconnect($err_str);
  #
  # Return 0 if it is OK.
  # Return a non-zero value otherwise, and write an error message in $err_str.
  #
sub pop3_disconnect {
	my $e;

	$e = &pop3_send_recv_and_ctrl("QUIT", "+OK", $_[0]);
	&tcp_close;

	return $e;
}


  #
  # Receive a string from the server and control the server response.
  # Usage:
  #
  #		$errno = &pop3_recv_and_ctrl($expected_answer, $err_str [, $answer]);
  #
  # Return 0 if it is OK.
  # Return a non-zero value otherwise, and write an error message in $err_str.
  # $answer is optional, if specified, it gives the string returned by the server.
  #
sub pop3_recv_and_ctrl {
	my $expected_answer = $_[0];
	my $l;
	my $e;

	return $e if $e = &sock_recv($l, $_[1]);
	$_[2] = $l;
	return $e if $e = &pop3_ctrl($expected_answer, $l, $_[1]);
}


  #
  # Send a string, receive the answer and control whether the answer is correct.
  # Usage:
  #
  #		$errno = &pop3_send_recv_and_ctrl($sent_str, $expected_answer, $err_str [, $answer] [, $log_string]);
  #
  # Return 0 if it is OK.
  # Return a non-zero value otherwise, and write an error message in $err_str.
  #
sub pop3_send_recv_and_ctrl {
	my ($sent_str, $expected_answer) = @_;
	my $e;

	return $e if $e = &sock_send($sent_str, $_[2], $_[4]);
	return $e if $e = &pop3_recv_and_ctrl($expected_answer, $_[2], $_[3]);
}


  #
  # Control whether the response of the POP3 server is the one requested.
  # Usage:
  #
  #		$errno = $pop3_ctrl($expected_answer, $answer, $err_str);
  #
  # Return 0 if it is OK.
  # Return a non-zero value otherwise, and write an error message in $err_str.
  #
sub pop3_ctrl {
	my ($expected_answer, $answer) = @_;

	if ($answer =~ m/^\Q$expected_answer\E/i) {
		return 0;
	} else {
		$_[2] = "Expected \"$expected_answer\" from remote but received \"$answer\"";
		return 1;
	}
}


  #
  # Log a line into the log window.
  # Usage:
  #
  # 		 &my_log($line, $log_level);
  #
sub my_log {
	my ($l, $level) = @_;
	my $prefixe = "";
	my @when = localtime();
	my $header;

	if ($g_disp_log) {
		$header = sprintf("%02d/%02d/%04d %02d:%02d:%02d",
			$when[3], $when[4] + 1, $when[5] + 1900, $when[2], $when[1], $when[0]);

		if ($level <= $g_cur_log_level) {
			$prefixe = "**  ERROR: " if $level == $$LL_ERROR;
			$prefixe = "**  WARNING: " if $level == $$LL_WARNING;
			$t_log_text->insert("end", "$header  $prefixe$l\n");
			$t_log_text->see("end");
			$t_ml->idletasks;
		}
	}

	if ($level <= $$LL_NORMAL) {
		$t_status->configure(-text => "$prefixe$l");
		$t_mw->idletasks;
	}
}


#
# Close the current established TCP connection.
# Usage:
  #
  #		&tcp_close()
  #
sub tcp_close {
	close SOCK;
}


  #
  # Connect to a remote host.
  # Usage:
  #
  # 	 $errno = &tcp_connect($remote, $port, $err_str)
  #
  # Return 0 if connection succeeds.
  # Return a non-zero value otherwise, and if so, $err_str is the error description.
  #
sub tcp_connect {
	my ($remote, $port) = @_;

	my $iaddr;
	my $paddr;
	my $proto;
	my $oldfh;

	$iaddr = inet_aton($remote) or $_[2] = "no host: \"$remote\"", return 1;
	$paddr = sockaddr_in($port, $iaddr);

	$proto = getprotobyname('tcp');
	socket(SOCK, PF_INET, SOCK_STREAM, $proto) or $_[2] = "socket: $!", return 2;
	connect(SOCK, $paddr) or $_[2] = "connect: $!", return 3;

	$oldfh = select(SOCK); $| = 1; $/ = $$EOL; select($oldfh);

	$_[2] = "";
	return 0;
}


  #
  # Send a line to the SOCK fh. Do NOT include final newline sequence in the parameter.
  # Usage:
  #
  # 	 $errno = &sock_send($l, $err_str [, $log_string]);
  #
  # If write is successful, return 0.
  # If write fails, return a non-zero value and $err_str contains an error description.
  #
sub sock_send {
	my $l = $_[0];

	print(SOCK "$l$$EOL") or $_[1] = $!, return 1;

	$l = $_[2] if defined($_[2]);
	&my_log("\>\>\> $l", $$LL_DEBUG);

	return 0;
}


  #
  # Receive a line from the SOCK fh. Strips final newline sequence from the return value.
  # Usage:
  #
  # 	 $errno = &sock_recv($l, $err_str));
  #
  # If reading is successful, return 0 and $l contains the line.
  # If reading fails, return a non-zero value and $err_str contains an error description.
  #
sub sock_recv {
	my $l;

	$l = <SOCK>;
	defined($l) or $_[1] = $!, return 1;
	chomp $l;

	&my_log("\<\<\< $l", $$LL_DEBUG);

	$_[0] = $l;
	return 0;
}