# sputnik.pm - the Y(aho)o!Sucker project
#
# Version: Prototype 37
#
# Copyright Dirk Diggler & Som One 1996-2002. All rides reserved.
# Coded by Som One and Pierrot Lunaire (French version)
# Redistribution and use, with or without modification,
# is permitted in the sense of GDWYWL
# (GeneralDoWhateverYouWantLicense).
# -z3r0-


###################################
# PACKAGE SUCKER
##########################

package Sucker;

use strict;
no utf8;

BEGIN {
  eval "use IO::Socket";
  if ($@) {
  print "Sputnik: Cannot find IO::Socket perl module.\n\n".
	"You need to have this module installed in order to run YoSucker.\n".
	"See README for more info on how to install the module.\n\n";
  die "\n";
  }
  eval "use Digest::MD5";
  if ($@) {
  print "Sputnik: Cannot find Digest::MD5 perl module.\n\n".
	"You need to have this module installed in order to run YoSucker.\n".
	"See README for more info on how to install the module.\n\n";
  die "\n";
  }
}

# A class constructor
sub new {
  my $class = shift;
  my $YS_path = shift;
  my $lockfile = shift;
  my $self  = {};
  $YS_path =~ s/bin\/$//g;
  $self->{YS_path} = $YS_path;
  $self->{lockfile} = $lockfile;
  $self->{config}     = {};
  $self->{cookiez}    = [];
  $self->{headtrans}  = {};
  bless $self, $class;           # but see below
  return $self;
}

# Remove the filelock and die
sub die3 {
  my $class = shift;
  my $str = shift;

  unlink "$class->{lockfile}" if (-e "$class->{lockfile}");
  die $str;
}

# Reads configuration from file
sub load_config {
  my $class = shift;
  my $CONFIG = shift;

  # Let's set the defaults...
  # crumb and warning are internals used 4 quota warning 
  # and erase function
  $class->{config} = {
		crumb => "",
		warning => "",
		HOST => "mail.yahoo.com",
                PORT => "80",
                BOX => "Inbox",
                LEAVE => "1",
		TRASH => "0",
		BULK => "0",
		LIMIT => "25",
		SSL => "1",
		PIPE => "0",
		FASTCHECK => "0",
		CLEAN => "0",
		PROXY_PROTO => "i_ve_been_lazy_to_recode",
		NOFROM => "0",
		UNCHANGED => "0"
                };

  # Store the lockfile variable again.
  $class->{config}{LOCKFILE} = $class->{lockfile};

  # Now overwrite it by the config file values
  open(CONFILE,"< $CONFIG") or $class->die3("Can\'t open the config file\!\n");
  while (<CONFILE>) {
    $| = 1;
    chomp;
    (my $param, my $value) = (split(/\=/))[0,1];
    next unless $param;
    $class->{config}{$param} = $value 
	unless ($param =~ /^\#/ || $param =~ /^\</ || $param =~ /^\ /);
  }
  close(CONFILE);

  # Bulk mail has a weird Yahoo internal name...
  if ($class->{config}{BOX} =~ /^Bulk$/i) { $class->{config}{BOX} = "%40B%40Bulk" }

  if ($class->{config}{SSL} == 1) {
	eval "require IO::Socket::SSL";
	if ($@) {
	print "YoSucker: Cannot find IO::Socket::SSL perl module.\n\nYou need to have this ".
	      "module installed to be able to login using secure connection.\n".
	      "See README for more info on how to install the module.\n\n";
	$class->die3("Please install the module or set SSL=0 in you .conf file.\n");
	}
  }

  ($class->{config}{LOGINHOST} = $class->{config}{HOST}) =~ s/^mail/login/g ;
  ($class->{config}{REPOSIT} = $CONFIG) =~ s/\.conf$/\.repository/g;
  
  $_ = `basename $CONFIG`;
  chomp;
  print "Using ".$_."\n" if $class->{config}{DEBUG};			# DEBUG

  # If the repository doesn't exist or is empty, create it and switch
  # to a "download all messages" mode. LIMIT from conf file will be ignored.
  if (!(-f $class->{config}{REPOSIT}) || (-z $class->{config}{REPOSIT})) {
	print "Creating repository (ignore LIMIT)...\n" if $class->{config}{DEBUG};    # DEBUG
	system("touch $class->{config}{REPOSIT} 2>/dev/null") == 0
		or $class->die3("Cannot create REPOSITORY\!\n");
	$class->{config}{LIMIT} = 20000;	# Put some reasonably high number
  }

  # If LIMIT is set to 0 (ie. "download all messages" mode) we need to change
  # the LIMIT for later use
  $class->{config}{LIMIT} = 20000 if $class->{config}{LIMIT} == 0;

  # Now lets see if we should append the output to a file or send it to a pipe
  # Note: we can examine {config}{PIPE} and change it's value for later use!
  if ($class->{config}{PIPE} == 1) {
	$class->{config}{PIPE} = "|";
  }
  else {
	$class->{config}{PIPE} = ">>";
  }

  # PROXY support implementation
  # Check the config for proxy...
  if ($class->{config}{PROXY}) {
	$class->die3("YoSucker: You must specify also PROXY_PORT when using proxy.\n") 
		if (! $class->{config}{PROXY_PORT});

	# Now, to simplify things up, lets assume that when we use proxy,
	# the PORT (of HOST not PROXY_PORT!!!) will always be 80 so we don't
	# have to care about it any more ;-) and we can store PROXY_PORT
	# in PORT for later use and code simplification... Ha haaaa!
	$class->{config}{PORT} = $class->{config}{PROXY_PORT};
	
	# And, to simplify things up once again, lets say we can't connect 
	# to proxy using SSL but, maybe the proxy can handle https requests?
	if ($class->{config}{SSL} == 1) {
	  $class->{config}{PROXY_PROTO} = "https:\/\/";
	  $class->{config}{SSL} = 0;
	}
	else {
	  $class->{config}{PROXY_PROTO} = "http:\/\/";
	}
  }

  # Lets check for the perl version - this is because the FastCheck won't work
  # with the old Perl 
  eval "require 5.006";
  if ($@) { 
	print "\nOld version of Perl detected. Will not use FastCheck.\n";
	$class->{config}{FASTCHECK} = 0;
  }

  # FastCheck implementation
  # Lets see if it's on...
  if ($class->{config}{FASTCHECK} == 1) {
	# We'll need to use the haiku.pm to do the Yahoo Messenger stuff...
        eval "require haiku";
        if ($@) {
        print "\nYoSucker: Problems loading haiku.pm.\n\nThis is very likely caused by ".
	      "missing MIME::Base64 perl module. Install MIME::Base64\nto solve this problem. ".
              "See README for more information on how to install the module.\n\n";
        $class->die3("Please install the module or set FASTCHECK=0 in you .conf file.\n");
        }
	
	# Do we have both encoded password values?
 	$class->die3("YoSucker: You must specify both FASTPASS1 and FASTPASS2 in order to use FastChek.\n") if ((! $class->{config}{FASTPASS1}) && (! $class->{config}{FASTPASS2}));
  }

  # Let's get rid of the starting and trailing " or ' in ON_NO/NEW_MAIL if it's set...
  if ($class->{config}{ON_NEWMAIL}) {
	$class->{config}{ON_NEWMAIL} =~ s/^[\"\']//g;
	$class->{config}{ON_NEWMAIL} =~ s/[\"\']$//g;
  }
  if ($class->{config}{ON_NO_MAIL}) {
	$class->{config}{ON_NO_MAIL} =~ s/^[\"\']//g;
	$class->{config}{ON_NO_MAIL} =~ s/[\"\']$//g;
  }
  
  # OK, I'll give you the last chance...
  if ($class->{config}{CLEAN} eq "KillEmAll") {
	print "THE DEADLY CLEAN MODE IS SET ON!\n".
		"Your messages will NOT be FETCHED but DELETED!!!\n".
		"You have 10 seconds to press Ctrl-C to terminate the process!\n".
		"The destruction starts in T-10";

	for (my $deathc = 10; $deathc > 0; $deathc--) {
		sleep 1;
		print "\b\b";
		print "0".($deathc-1);
	}
	
	print "\b\b\b\b\b\b\bNOW!!! \n";	  
	print "IT'S GONNA HURT!!!\n";
  }
  else {
	$class->{config}{CLEAN} = 0;
  }

  # Switch read/unread mark restoration off if LEAVE=0...
  if ($class->{config}{LEAVE} == 0) { $class->{config}{UNCHANGED} = 0 }
}


# The following sub, loads local Yahoo Mail header variation pairs for 
# later use (translating headers)
sub load_head_translations {  
  my $class = shift;
  my $path = shift;

  my $thf = $path."/header-translation";
  my $thf2 = $class->{YS_path}."conf/header-translation";
  (open(THFILE,"< $thf") || open(THFILE,"< $thf2")) 
		or $class->die3("Can\'t find the translate-headers file\!\n");
  while (<THFILE>) {
    $| = 1;
    chomp;
    (my $param, my $value) = (split(/:/))[0,1];
    next unless $param;
    $class->{headtrans}{$param.":"} = $value.":" 
	unless ($param =~ /^\#/ || $param =~ /^\</ || $param =~ /^\ /);
  }
  close(THFILE);
}


# Although called "login", this is the main body of YoSucker
# First I load a home page and get necessary values (challenge, u)
# Then there's a three step login redirect before we actually log in...
sub login {
  my $class = shift;
  my $host;
  my $what;
  my %flagz;

  ###
  # PRE-STEP 0
  ##
  
  # Lets see if we use FastCheck...
  if ($class->{config}{FASTCHECK} == 1) {
    if (! YoFastMess::Check4NewMail($class->{config}{USERNAME}, 
	$class->{config}{FASTPASS1}, $class->{config}{FASTPASS2}))
     {
	print "No new messages.\n\n" if $class->{config}{DEBUG};      # DEBUG
	if ($class->{config}{ON_NO_MAIL}) {
	  my @exec_args = split(/ /, $class->{config}{ON_NO_MAIL});
 	  system (@exec_args) == 0
		 or warn "Problems executing your ON_NO_MAIL command\!\n\n" if $class->{config}{DEBUG};       # DEBUG
	}
	return 1;
     }
  }

  ###
  # STEP 0
  ##

  print "Login" if $class->{config}{DEBUG};			# DEBUG
  
  # Reads the Yahoo Mail Homepage;
  # Returns challenge and u values in \%valuez
  # See if we should use a secure connection...
  my $homepage;
  if ($class->{config}{SSL}) {
  	$homepage = SSLHomePage->new(\$class->{config}, \$class->{cookiez});
  }
  else {
  	$homepage = HomePage->new(\$class->{config}, \$class->{cookiez});
  }
  my $valuez = $homepage->load($class->{config}{HOST}, "\/");
  $class->die3("\nYoSucker: Abnormal Yahoo Mail behavior (01)\! Exiting - please retry...\n") 
	if ((! $valuez->{"challenge"}) || (! $valuez->{"u"}));

  $what = "/config\/login?";

  my $username = \$class->{config}{USERNAME};
  my $passwd = \$class->{config}{PASSWD};
  my $box = \$class->{config}{BOX};
  my $reposit = \$class->{config}{REPOSIT};

  my $challenge = $valuez->{"challenge"};
  my $U = $valuez->{"u"};
  my $V = "0";

  my $ctx = Digest::MD5->new;
  $ctx->add($$passwd.$challenge);
  my $hash = $ctx->hexdigest;
  
  print "." if $class->{config}{DEBUG};			# DEBUG

  ###
  # STEP 1
  ##

  $what = $what."\.tries=\&\.src=ym\&\.last=\&promo=\&\.intl=us\&\.bypass=".
	  "\&\.partner=\&\.u=".$U."\&\.v=".$V."\&\.challenge=".$challenge.
          "\&\.emailCode=\&hasMsgr=0\&\.chkP=Y\&\.done=\&login=".$$username.
 	  "\&passwd=".$hash."\&\.persistent=\&\.save=1\&\.hash=1\&\.js=1".
	  "\&\.md5=1";

  # Sends login information to login server;
  # Returns first redirect location
  # See if we should use a secure connection...
  my $page1;
  if ($class->{config}{SSL}) {
	$page1 = SSLShortPage->new(\$class->{config}, \$class->{cookiez});
  } 
  else {
	$page1 = ShortPage->new(\$class->{config}, \$class->{cookiez});
  }
  my $location = $page1->load($class->{config}{LOGINHOST}, $what);


  print "." if $class->{config}{DEBUG};			# DEBUG

  # No more secure connection, so...
  $class->{config}{PROXY_PROTO} = "http:\/\/";

  ###
  # STEP 2
  ##
  $host = (split("\/",$location))[0];
  $location =~ s/$host//g;
  $what = $location;
  chomp($what);

  # First login redirect
  # Returns 2nd redirect address   
  my $page2 = ShortPage->new(\$class->{config}, \$class->{cookiez});
  $location=$page2->load($host, $what);

  print "." if $class->{config}{DEBUG};			# DEBUG

  ###
  # STEP 3
  ##

  $host = (split("\/",$location))[0];
  $location =~ s/$host//g;
  $what = $location;
  chomp($what);

  # Third login redirect
  my $page3 = ShortPage->new(\$class->{config}, \$class->{cookiez});
  $location=$page3->load($host, $what);
 
  print "." if $class->{config}{DEBUG};                 # DEBUG

  ###
  # STEP 4
  ##

  $host = (split("\/",$location))[0];
  $location =~ s/$host//g;
  $what = $location;
  chomp($what);

  # Third login redirect;
  # Logs in and returns a YY session identifier
  my $thirdpage = ThirdPage->new(\$class->{config}, \$class->{cookiez});
  my $YY = $thirdpage->load($host, $what);
  
  $class->die3("\nYoSucker: Abnormal Yahoo Mail behavior (02)\! Exiting - please retry...\n") 
	if (! $YY);

  print "\b\b\b\b OK.\n" if $class->{config}{DEBUG};			# DEBUG

  ###
  # STEP 4
  ##

  $what = "\/ym\/ShowFolder?Norder=down\&Search=\&reset=1\&YY=".$YY."\&inc=25\&order=up\&sort=date\&pos=0\&view=a\&head=b\&box=".$$box;
#  $what = "\/ym\/ShowFolder?rb=".$$box."\&YY=".$YY."\&YN=1";
#  $what = "\/ym\/ShowFolder?box=".$$box."\&YY=".$YY."\&inc=200\&YN=1";

  print "Reading list of messages..." if $class->{config}{DEBUG};	# DEBUG

  # Loads list of messages (message IDs) from requested BOX
  my $inbox = InboxPage->new(\$class->{config}, \$class->{cookiez});
  my $messgz = $inbox->load($host, $what);
 
  $class->die3("\nYoSucker: Abnormal Yahoo Mail behavior (03)\! Exiting - please retry...\n") 
	if (! $class->{config}{crumb});
  
  # Repository basically stores a list of already downloaded messages
  # Read repository...

  my %repoz;
  my @new_msgz;
  
  # See if it's a CLEAN run or a normal session...
  if ($class->{config}{CLEAN} ne "KillEmAll") {
  	open(FILE, "< $$reposit") or $class->die3("\nCannot open REPOSITORY!!!\n");
	while (<FILE>) {
		chomp;
	
		# Now,... Yahoo tends to change some parts of message id,
		# for unknown reasons. Therefore I compare just some parts
		# of MesgId that tend to remain the same, though should suffice
		# for message unique identification.
	
		my (@idexp) = (split("_",$_));
		$repoz{$idexp[0].$idexp[5].$idexp[6]} = 1;
	}
	close(FILE);

	print "\n" if $class->{config}{DEBUG};          			# DEBUG

	print "Matching repository...\n" if $class->{config}{DEBUG};		# DEBUG

	# Match stored IDs against new downloaded IDs
	foreach my $item (@{$messgz}) {
		
		# See if message was marked as unread...
		if ($item =~ /VLAD0$/) {
		    $item =~ s/VLAD0//g;
		    $flagz{$item} = 1;
		}

		my (@idexp) = (split("_",$item));
		unless ($repoz{$idexp[0].$idexp[5].$idexp[6]}) {
			push(@new_msgz, $item);
		}
	}
  }
  # ou, a CLEAN is set to KillEmAll, lets ignore the repository...
  else {
	print "\n";
	print "Ignoring repository...\n" if $class->{config}{DEBUG};            # DEBUG
	push(@new_msgz, @{$messgz});
  }

  if (@new_msgz == 0) {
	print "No new messages.\n" if $class->{config}{DEBUG};		# DEBUG
	if ($class->{config}{ON_NO_MAIL}) {
	  my @exec_args = split(/ /, $class->{config}{ON_NO_MAIL});
 	  system (@exec_args) == 0
		 or warn "\nProblems executing your ON_NO_MAIL command\!\n\n" if $class->{config}{DEBUG};       # DEBUG
	}
  }
  else {
    my %problematic;

    # See if it's a CLEAN run or a normal session...
    if ($class->{config}{CLEAN} ne "KillEmAll") {

	print "You've got ".@new_msgz." new message(s)!\n" if $class->{config}{DEBUG};
	print "Fetching [" if $class->{config}{DEBUG};			# DEBUG

 	open(FILE, ">> $$reposit") or $class->die3("\nCannot write to REPOSITORY!!!\n");

	# Download new messages
  	foreach my $item (@new_msgz) {
   	  $what = "\/ym\/ShowLetter\?box=".$$box."\&MsgId=".$item.
	  	  "\&Search=\&Nhead=f\&YY=".$YY."\&order=down\&sort=date\&pos=0";

	  # Download headers
	  print "." if $class->{config}{DEBUG};
	  my $headz = HeadersPage->new(\$class->{config}, \$class->{cookiez}, $class->{headtrans});
	  my $headeritmz = $headz->load($host, $what);
   
	  #   $what = "\/ym\/ShowLetter\?box=Inbox\&MsgId=".$item.
	  #	   "\&toc=1\&Search=\&YY=".$YY."\&order=down\&sort=date\&pos=0";

	  $what = "\/ym\/ShowLetter\/file\.txt\?box=".$$box."\&MsgId=".$item.
		  "\&bodyPart=TEXT\&filename=file\.txt\&download=1\&YY=".$YY.
		  "\&order=down\&sort=date\&pos=0";
	  
	  print "\bo" if $class->{config}{DEBUG};		# DEBUG

	  # Parse headers/Download message body
	  my $bodyz = BodyPage->new(\$class->{config}, \$class->{cookiez});
	  my $fetched = $bodyz->load($host, $what, $headeritmz);

	  print "\b#" if $class->{config}{DEBUG};		# DEBUG

	  # Lets restore the unread flags immediately if the UNCHANGED is set to 2...
	  if ($class->{config}{UNCHANGED} == 2 && $flagz{$item}) {
		$what = "\/ym\/ShowFolder\?\.crumb=".$class->{config}{crumb}."\&FLG=1\&flags=unread\&destBox=Move+to+folder...".
			"\&Mid=".$item."\&flags2=unread\&destBox2=Move+to+folder...";
		my $deletepg = ErasePage->new(\$class->{config}, \$class->{cookiez});
		$deletepg->load($host, $what);
	  }
	  
          # See if everything went all right...
	  if (! $fetched) {
	     # The hash PROBLEMATIC is a work around; it would be much better if 
	     # the @new_msgz was a hash instead of an array - like that we could have
	     # avoided a possible duplication of the data in %problematic
	     # On the other hand, @new_msgz is sorted like we want it to be, a thing
	     # you can't easily achieve while using a hash.
	     #
	     # If the message was not fetched properly we create an entry for it in
	     # %problematic, so it won't be deleted and stored in repository
	     $problematic{$item} = 1;
	  }
	  else {
	     # Save downloaded message ID in the repository
	     print FILE $item."\n" or $class->die3("\nCannot write to REPOSITORY!!! Disk full?\n");
	  }
  	}

	close(FILE) or $class->die3("\nCannot close the REPOSITORY file!!! Disk full?\n");
	print "] Done.\n" if $class->{config}{DEBUG};			# DEBUG
	if ($class->{config}{ON_NEWMAIL}) {
          my @exec_args = split(/ /, $class->{config}{ON_NEWMAIL});
          system (@exec_args) == 0
		 or warn "Problems executing your ON_NEWMAIL command\!\n\n" if $class->{config}{DEBUG};        # DEBUG
	}

	# Now if we earlier identified on Inbox Page sign of Yahoo Mail
	# warning about your storage quota, lets create a message that will
	# be placed in your OUTFILE informing about it
	# Note: Hey, we dont want to flood your inbox so note that this will be
	# done only if you have some new messages...
	if ($class->{config}{warning}) {
	  my @warn_msg;
	  my $tn = localtime;
	  my @tm = (split(" ", $tn));

	  # Create headers
	  push(@warn_msg, "From YoSucker ".$tn."\n");
	  push(@warn_msg, "Date: $tm[0], $tm[2] $tm[1] $tm[4] $tm[3]\n");
	  push(@warn_msg, "From: YoSucker Warning System\n");
	  push(@warn_msg, "To: You, my dear user\n");
	  push(@warn_msg, "Subject: Mail Storage Quota Warning\n\n");
	  # Message body
	  push(@warn_msg, "Hey man,\n\n");
	  push(@warn_msg, "Watch out!!! You are approaching your storage quota on Yahoo Mail.\n\n");
	  push(@warn_msg, "Yours,\n\tMr Som One \& YoSucker Olympics Team\n\n\n");

	  # Write the message
	  my $actfile = $class->{config}{PIPE}.$class->{config}{OUTFILE};
	  open(WARN, "$actfile") or $class->die3("\nCannot write to OUTFILE\!\n");
	  if ($class->{config}{PIPE} ne "|") {
		# Get exclusive filelock
		flock(WARN, 2) or $class->die3("\nCannot get an exclusive lock of OUTFILE!\n");
		seek(WARN, 0, 2);
	  }
	  print WARN @warn_msg or $class->die3("\nCannot write to OUTFILE!!! Disk full?\n");
	  close(WARN) or $class->die3("\nCannot close the OUTFILE!!! Disk full?\n"); 
	}
    }		# end of KillEmAll if-statement
    else {
	print "Your ".@new_msgz." message(s) will be deleted!\n" if $class->{config}{DEBUG};
    }

    ###
    # RESTORE READ/UNREAD MARKS
    ###
    if ($class->{config}{UNCHANGED} == 1) {
	$what = "\/ym\/ShowFolder\?\.crumb=".$class->{config}{crumb}."\&FLG=1\&flags=unread\&destBox=Move+to+folder...";
	foreach (@new_msgz) { 
		$what .= "\&Mid=".$_ if $flagz{$_};
	}
	$what .= "\&flags2=unread\&destBox2=Move+to+folder...";
	print "Restoring message flags..." if $class->{config}{DEBUG};			# DEBUG
	my $deletepg = ErasePage->new(\$class->{config}, \$class->{cookiez});
	$deletepg->load($host, $what);
	print "\n" if $class->{config}{DEBUG};
    }

    ###
    # ERASE
    ##

    # Erase function implementation. If the LEAVE (on server) is set to 0, 
    # YoSucker will launch the "delete" on all previously downloaded messages
    if (($class->{config}{LEAVE} == 0) || ($class->{config}{CLEAN} eq "KillEmAll")) {
	$what = "\/ym\/ShowFolder\?\.crumb=".$class->{config}{crumb}."\&DEL=1\&rb=".$class->{config}{BOX};
	foreach (@new_msgz) {
		$what = $what."\&Mid=".$_ unless $problematic{$_};
	}
	print "Moving to Trash..." if $class->{config}{DEBUG};				# DEBUG
	my $deletepg = ErasePage->new(\$class->{config}, \$class->{cookiez});
	$deletepg->load($host, $what);
	print " Done.\n" if $class->{config}{DEBUG};
    }
  }	# end of else statement

  ###
  # EMPTY BULK
  ##

  # Here we check if we should empty the bulk folder...
  if ($class->{config}{BULK} == 1) {
	$what = "\/ym\/ShowFolder\?EB=1\&\.crumb=".$class->{config}{crumb}."\&YY=".$YY;

  	print "Emptying bulk folder..." if $class->{config}{DEBUG};
	my $bulk = Page->new(\$class->{config}, \$class->{cookiez});
	$bulk->load($host, $what);
	print " OK.\n" if $class->{config}{DEBUG};
  }

  ###
  # EMPTY TRASH
  ##

  # Here we check if we should empty the trash...
  if ($class->{config}{TRASH} == 1) {
	$what = "\/ym\/ShowFolder\?ET=1\&\.crumb=".$class->{config}{crumb}."\&YY=".$YY;

  	print "Emptying trash..." if $class->{config}{DEBUG};
	my $trash = Page->new(\$class->{config}, \$class->{cookiez});
	$trash->load($host, $what);
	print " OK.\n" if $class->{config}{DEBUG};
  }

  ###
  # LOGOUT
  ##

  $what = "\/ym\/Logout\?YY=".$YY;

  # All done, lets logout!
  print "Logout" if $class->{config}{DEBUG};
  my $logout = Page->new(\$class->{config}, \$class->{cookiez});
  $logout->load($host, $what);
  print " OK.\n\n" if $class->{config}{DEBUG};
}



###################################
# PACKAGE PAGE
##########################

package Page;

sub new {
  my $class = shift;
  my $config = shift;
  my $self  = {};
  $self->{HOST} = $$config->{HOST};
  $self->{PORT} = $$config->{PORT};
  $self->{LOGINHOST} = $$config->{LOGINHOST};
  $self->{USERNAME} = $$config->{USERNAME};
  $self->{PASSWD} = $$config->{PASSWD};
  $self->{OUTFILE} = $$config->{OUTFILE};
  $self->{PIPE} = $$config->{PIPE};
  $self->{LIMIT} = $$config->{LIMIT};
  $self->{PROXY} = $$config->{PROXY};
  $self->{PROXY_PROTO} = $$config->{PROXY_PROTO};
  $self->{PROXY_PASS} = $$config->{PROXY_PASS};
  $self->{DEBUG} = $$config->{DEBUG};
  $self->{NOFROM} = $$config->{NOFROM};
  $self->{UNCHANGED} = $$config->{UNCHANGED};
  $self->{lockfile} = $$config->{LOCKFILE};
  $self->{crumb} = \$$config->{crumb};
  $self->{warning} = \$$config->{warning};
  $self->{cookiez} = shift;
  bless $self, $class;
  return $self;
}

# Subroutine CONNECT - used to connect to the server
# Two parameters - host name and port number
# Returns connection handle

sub connect {
  my $class = shift;
  my $host = shift;
  my $port = shift;
  my $real_host;

  $real_host = $host if ($class->{PROXY_PROTO} eq "https://");
  $host = $class->{PROXY} if ($class->{PROXY});

  my $handle = IO::Socket::INET->new (Proto       => "tcp",
                                   PeerAddr     => $host,
                                   PeerPort     => $port)
        or Sucker::die3($class,"\nCan't connect to the server!\n");

  $handle->autoflush(1);

  if ($class->{PROXY_PROTO} eq "https://") {
      my $https_line;
      
      # Do we have proxy with authorisation?
      if ($class->{PROXY_PASS}) { 
	$https_line = "CONNECT $real_host:443 HTTP/1.1\nHost: $real_host\nProxy-authorization: Basic $class->{PROXY_PASS}\n\n";
      }
      else { $https_line = "CONNECT $real_host:443 HTTP/1.1\nHost: $real_host\n\n" }
      print $handle $https_line;
      sysread($handle,my $byte,50);
      IO::Socket::SSL::socket_to_SSL($handle, SSL_use_cert => 0, SSL_verify_mode => 0x00) 
		or Sucker::die3($class,"\nCan't SSLize the socket!\n");
  }

  return $handle;
}


# Function REQUEST sends request of a specific document to the server
# Has three params - connection handle, what should be fetched 
# and a host name
# Returns ???

sub request {
  my $class = shift;
  my $handle = shift;
  my $host = shift;
  my $what = shift;
  my $cookiez = ${$class->{cookiez}};
  my $line;
  my $cookz_str;
 
  if (! ($class->{PROXY_PROTO} eq "https://")) {
      $what = $class->{PROXY_PROTO}.$host.$what if ($class->{PROXY});
  }

  if (@{$cookiez} > 0) {
	for (my $ii = 0; $ii < @{$cookiez}; $ii++) {
          if ($ii > 0) { $cookz_str = $cookz_str."\; " }

          # FreeBSD unitialized-value warning hack
          if ($cookz_str) { $cookz_str = $cookz_str.$cookiez->[$ii] }
          else { $cookz_str = $cookiez->[$ii] }
	}
	$line = "GET $what HTTP\/1\.1\nCookie: $cookz_str\nHost: $host\n";
  } 
  else {
	$line = "GET $what HTTP\/1\.1\nHost: $host\n";
  }

  # See if we have to authorise ourselves to proxy...
  if ($class->{PROXY} && $class->{PROXY_PASS}) { $line = $line."Proxy-authorization: Basic $class->{PROXY_PASS}\n\n" }
  else { $line = $line."\n" }

  print $handle $line or Sucker::die3($class,"\nCannot write to the socket!\n");
}

# Sub PARSE parses the request output. Retrieves sent cookies and Location header info.
# One param - connection handle

sub parse {
  # BOGUS - defined in each child
}

# LOAD - requests a page and retrieves what we need

sub load {
  my $class = shift;
  my $host = shift;
  my $what = shift;
  my $port = $class->{PORT};

  my $handle = $class->connect($host, $port);
  $class->request($handle, $host, $what);
  my $location = $class->parse($handle);

  return $location;
}


###################################
# PACKAGE HOME PAGE
##########################

package HomePage;
use vars qw(@ISA);
@ISA = "Page";

sub parse {
  my $class = shift;
  my $handle = shift;
  my $cookiez = ${$class->{cookiez}};
  my %valuez;

  while (<$handle>){
          if (/name=\"\.challenge\"/) {
		chomp;
                $_ = (split("value=\""))[1];
		$_ = (split("\""))[0];
                $valuez{"challenge"} = $_;
		last;
          }
          elsif (/name=\"\.u\"/) {
		chomp;
                $_ = (split("value=\""))[1];
		$_ = (split("\""))[0];
                $valuez{"u"} = $_;
          }
  }
  return \%valuez;
}


###################################
# PACKAGE SSL HOME PAGE
##########################

package SSLHomePage;
use vars qw(@ISA);
@ISA = "HomePage";

sub connect {
  my $class = shift;
  my $host = shift;
  my $port = shift;

  my $handle = IO::Socket::SSL->new( PeerAddr => $host,
                                   PeerPort => "443",
                                   Proto    => "tcp",
                                   SSL_use_cert => 0,
                                   SSL_verify_mode => 0x00,
                                 )
        or Sucker::die3($class,"\nCan't connect to the server!\n");

  $handle->autoflush(1);
  return $handle;
}


###################################
# PACKAGE SHORT PAGE
##########################

package ShortPage;
use vars qw(@ISA);
@ISA = "Page";

sub request {
  my $class = shift;
  my $handle = shift;
  my $host = shift;
  my $what = shift;
  my $cookiez = ${$class->{cookiez}};
  my $line;
  my $cookz_str;

  if (! ($class->{PROXY_PROTO} eq "https://")) {
      $what = $class->{PROXY_PROTO}.$host.$what if ($class->{PROXY});
  }

  if (@{$cookiez} > 0) {
	for (my $ii = 0; $ii < @{$cookiez}; $ii++) {
          if ($ii > 0) { $cookz_str = $cookz_str."\; " }
	  
	  # FreeBSD unitialized-value warning hack
	  if ($cookz_str) { $cookz_str = $cookz_str.$cookiez->[$ii] }
	  else { $cookz_str = $cookiez->[$ii] }
	}
	$line = "HEAD $what HTTP\/1\.1\nCookie: $cookz_str\nHost: $host\n";
  } 
  else {
	$line = "HEAD $what HTTP\/1\.1\nHost: $host\n";
  }

  # See if we have to authorise ourselves to proxy...
  if ($class->{PROXY} && $class->{PROXY_PASS}) { $line = $line."Proxy-authorization: Basic $class->{PROXY_PASS}\n\n" }
  else { $line = $line."\n" }

  print $handle $line or Sucker::die3($class,"\nCannot write to the socket!\n");

  return $handle;
}

sub parse {
  my $class = shift;
  my $handle = shift;
  my $cookiez = ${$class->{cookiez}};
  my $location;
  my $count = 0;

  while (<$handle>) {
	  last if /Proxy-Connection: keep-alive/;
	  last if /^$/; 
          if (/^Set-Cookie: +/) {
                $_ = (split(";"))[0];
                s/Set-Cookie: //g;
		s/\&ym9=(10|25|50|100|200)/\&ym9=$class->{LIMIT}/g;
                $cookiez->[@{$cookiez}] = $_;
		$count++;
		# last if $count == 3;
          }
          elsif (/^Location: +/) {
		chomp;
                s/Location: (http|https):\/\///g;
                $location = $_;
          }
  }
  if (! $location) { 
	Sucker::die3($class," Failed!!! Check your username and password!\n");
  }
  return $location;
}


###################################
# PACKAGE SSL SHORT PAGE
##########################

package SSLShortPage;
use vars qw(@ISA);
@ISA = "ShortPage";

sub connect {
  my $class = shift;
  my $host = shift;
  my $port = shift;

  my $handle = IO::Socket::SSL->new( PeerAddr => $host,
                                   PeerPort => "443",
                                   Proto    => "tcp",
                                   SSL_use_cert => 0,
                                   SSL_verify_mode => 0x00,
                                 )
        or Sucker::die3($class,"\nCan't connect to the server!\n");

  $handle->autoflush(1);
  return $handle;
}


###################################
# PACKAGE INBOX PAGE
##########################

package InboxPage;
use vars qw(@ISA);
@ISA = "Page";

sub parse {
  my $class = shift;
  my $handle = shift;
  my $messgz = shift;
  my $continue = shift;
  my $counter;
  my $nextcount = 0;
  my $cookiez = ${$class->{cookiez}};
  my $lastmsg = -1;

  # New yahoo feature; we must rerun parse to get more then DEFAULT messages per page! Lets see how many messages
  # we have so far...
  if (@{$messgz}) { $counter = @{$messgz} }
  else { $counter = 0 }

  while (<$handle>) {
          if (/name=\"Mid\"/) {
		last if ($$continue eq "done");
		$counter++;
		chomp;
                $_ = (split("value=\""))[1];
		$_ = (split("\""))[0];
		
		# Store the message possition - we'll need it for guessing message unread mark...
		$lastmsg = @{$messgz} if ($class->{UNCHANGED} != 0);

                $$messgz[@{$messgz}] = $_;
		if ($counter == $class->{LIMIT}) {
		    $$continue = "done";
		}
          }
	  elsif (/\<b\>/i) {
		# Message is most likely marked as UNREAD, lets remember it... 
                $$messgz[$lastmsg] .= "VLAD0" if ($lastmsg != -1);
	  }
	  elsif (/\>Next\<\/a\>/) {
		last if ($$continue eq "done");
		$nextcount++;

		$_ = (split("href=\""),1)[1];
		$_ = (split("\""))[0];
		
		# This is the address for the Next messages 
		$$continue = $_;

		last if ($nextcount == 2);
	  }
#	  elsif (/name=\"\.crumb\"/) {
#		chomp;
#		$_ = (split("value=\""))[1];
#		$_ = (split("\""))[0];
#		${$class->{crumb}} = $_;
#	  }
	  elsif (/\?ET=1/) {
		chomp;
		$_ = (split(".crumb="))[1];
		$_ = (split("&"))[0];
		${$class->{crumb}} = $_;
	  }
	  elsif (/Mail Storage Quota Warning/){
		${$class->{warning}} = 1;
	  }
  }

  # See if we the number of messages remaining in Inbox isn't lower then
  # our limit. If it is, game over...
  $$continue = "done" if ($$continue eq "bogus");

  return $messgz;
}

# COME HERE - LOAD - requests a page and retrieves what we need

sub load {
  my $class = shift;
  my $host = shift;
  my $what = shift;
  my $port = $class->{PORT};
  my @messgz;
  my $try = \@messgz;
  my $location;
  my $continue;

  do {
    my $handle = $class->connect($host, $port);
    $class->request($handle, $host, $what);
    $continue = "bogus";
    $try = $class->parse($handle,$try,\$continue);
    $what = $continue;
  } until ($continue eq "done");

  my @temp = reverse @messgz;		# Put older messages first!!!

  return \@temp;
}



###################################
# PACKAGE THIRD PAGE
##########################

package ThirdPage;
use vars qw(@ISA);
@ISA = "Page";

sub parse {
  my $class = shift;
  my $handle = shift;
  my $cookiez = ${$class->{cookiez}};
  my $yycode;

  while (<$handle>) {
          if (/^Set-Cookie: +/) {
                $_ = (split(";"))[0];
                s/Set-Cookie: //g;
		s/\&ym9=(10|25|50|100|200)/\&ym9=$class->{LIMIT}/g;
                $cookiez->[@{$cookiez}] = $_;
          }
#         if (/Check Mail/) {
          elsif (/rb\=Inbox/) {
		chomp;
                $_ = (split("YY="))[1];
		$_ = (split("\&"))[0];
                $yycode = $_;
		last;
          }
  }
  return $yycode;
}


###################################
# PACKAGE HEADERS PAGE
##########################

package HeadersPage;
use vars qw(@ISA);
@ISA = "Page";

sub new {
  my $class = shift;
  my $config = shift;
  my $self  = {};
  $self->{HOST} = $$config->{HOST};
  $self->{PORT} = $$config->{PORT};
  $self->{LOGINHOST} = $$config->{LOGINHOST};
  $self->{USERNAME} = $$config->{USERNAME};
  $self->{PASSWD} = $$config->{PASSWD};
  $self->{OUTFILE} = $$config->{OUTFILE};
  $self->{PIPE} = $$config->{PIPE};
  $self->{LIMIT} = $$config->{LIMIT};
  $self->{PROXY} = $$config->{PROXY};
  $self->{PROXY_PROTO} = $$config->{PROXY_PROTO};
  $self->{PROXY_PASS} = $$config->{PROXY_PASS};
  $self->{DEBUG} = $$config->{DEBUG};
  $self->{lockfile} = $$config->{LOCKFILE};
  $self->{crumb} = \$$config->{crumb};
  $self->{warning} = \$$config->{warning};
  $self->{cookiez} = shift;
  $self->{headtrans} = shift;
  bless $self, $class;
  return $self;
}

sub parse {
  my $class = shift;
  my $handle = shift;
  my $cookiez = ${$class->{cookiez}};
  my @messgz;
  my $timenow = localtime;
  my @headeritmz;
  my $headers_fetched;
  my $ddate;
  my $ffrom;
  my $tto;
  my %monthz = ("Jan"	=> 1,
		"Feb"	=> 1,
		"Mar"	=> 1,
		"Apr"	=> 1,
		"May"	=> 1,
		"Jun"	=> 1,
		"Jul"	=> 1,
		"Aug"	=> 1,
		"Sep"	=> 1,
		"Oct"	=> 1,
		"Nov"	=> 1,
		"Dec"	=> 1
 	);
  my %weekdayz = ("Sun"	=> 1,
		  "Mon"	=> 1,
		  "Tue"	=> 1,
		  "Wed"	=> 1,
		  "Thu"	=> 1,
		  "Fri"	=> 1,
		  "Sat"	=> 1
	);

  $headeritmz[@headeritmz] = "From YoSucker ".$timenow."\n";

  my $folded = 0;

  while (<$handle>) {
        # chomp;
#        if (/\:<\/b><\/td>/) {
	if ($folded) {
		$folded = 0 if /<\/small>/;
		s/<[^>]*>//gs;
		s/\&lt\;/</gs;
		s/\&gt\;/>/gs;
		s/\&#34\;/"/gs;
		s/\&#39\;/'/gs;
		s/\&amp\;/\&/gs;
		s/\&nbsp\;\|\&nbsp\;Block Address//gis;
		s/\&nbsp\;\|\&nbsp\;This is Spam\&nbsp\;\|\&nbsp\;Add to Address Book//gis;
		s/\&nbsp\;\|\&nbsp\;This is Spam//gis;
		s/\&nbsp\;\|\&nbsp\;Diese Mail ist Spam\&nbsp\;\|\&nbsp\;Zum Adressbuch hinzufügen//gis;
		s/\&nbsp\;\|\&nbsp\;Diese Mail ist Spam//gis;
		s/\&nbsp\;\|\&nbsp\;Questo è Spam\&nbsp\;\|\&nbsp\;Aggiungi alla Rubrica//gis;
		s/\&nbsp\;\|\&nbsp\;Questo è Spam//gis;
		s/\&nbsp\;\|\&nbsp\;Detta är ett massmail\&nbsp\;\|\&nbsp\;Lägg till i adressboken//gis;
		s/\&nbsp\;\|\&nbsp\;Detta är ett massmail//gis;
		s/\&nbsp\;\|\&nbsp\;Detta är inte ett massmail\&nbsp\;\|\&nbsp\;Lägg till i adressboken//gis;
		s/\&nbsp\;\|\&nbsp\;Detta är inte ett massmail\&nbsp//gis;
		s/\&nbsp\;\|\&nbsp\;This is not spam\&nbsp\;\|\&nbsp\;Add to Address Book//gis;
		s/\&nbsp\;\|\&nbsp\;This is not spam//gis;
		s/\&nbsp\;/ /gs;
		$headeritmz[@headeritmz-1] .= $_;
	}
	elsif (/:(<\/small><\/b><\/td>|<\/b><\/td>)/) {
		$headers_fetched = 'yes';
		$folded = 1 unless /<\/small><\/td><\/tr>$/;
                s/<[^>]*>//gs;
                s/\&lt\;/</gs;
                s/\&gt\;/>/gs;
                s/\&#34\;/"/gs;
		s/\&#39\;/'/gs;
		s/\&amp\;/\&/gs;
                s/\&nbsp\;\|\&nbsp\;Block Address//gis;
                s/\&nbsp\;\|\&nbsp\;This is Spam\&nbsp\;\|\&nbsp\;Add to Address Book//gis;
		s/\&nbsp\;\|\&nbsp\;This is Spam//gis;
		s/\&nbsp\;\|\&nbsp\;Diese Mail ist Spam\&nbsp\;\|\&nbsp\;Zum Adressbuch hinzufügen//gis;
		s/\&nbsp\;\|\&nbsp\;Diese Mail ist Spam//gis;
		s/\&nbsp\;\|\&nbsp\;Questo è Spam\&nbsp\;\|\&nbsp\;Aggiungi alla Rubrica//gis;
		s/\&nbsp\;\|\&nbsp\;Questo è Spam//gis;
		s/\&nbsp\;\|\&nbsp\;Detta är ett massmail\&nbsp\;\|\&nbsp\;Lägg till i adressboken//gis;
		s/\&nbsp\;\|\&nbsp\;Detta är ett massmail//gis;
		s/\&nbsp\;\|\&nbsp\;Detta är inte ett massmail\&nbsp\;\|\&nbsp\;Lägg till i adressboken//gis;
		s/\&nbsp\;\|\&nbsp\;Detta är inte ett massmail\&nbsp//gis;
		s/\&nbsp\;\|\&nbsp\;This is not spam\&nbsp\;\|\&nbsp\;Add to Address Book//gis;
		s/\&nbsp\;\|\&nbsp\;This is not spam//gis;
                s/\&nbsp\;/ /gs;

		# Fix quoted-printable encoding problem
		s/^Content-Transfer-Encoding: quoted-printable/Content-Transfer-Encoding: 8bit/gi;
  		
		# translate headers
  		foreach my $key ( keys %{$class->{headtrans}}) {
			s/^$key/$class->{headtrans}{$key}/g;
		}

		# Fix the From: header malbehaviour...
		if (/^From:/) {
			if (! /^From: /) {
			  s/^From://g;
			  $_ = "From: ".$_;
			}
			$ffrom = $_;		
		}

		# Fix the To: header malbehaviour...
		if (/^To:/) {
			if (! /^To: /) {
			  s/^To://g;
			  $_ = "To: ".$_;
			}
			$tto = $_;
		}

		# Fix the Date: header malbehaviour...
		if (/^Date:/) {
			if (! /^Date: /) {
			  s/^Date://g;
			  $_ = "Date: ".$_;
			}
			$ddate = $_;
		}

		$headeritmz[@headeritmz] = $_ if (! /^From /);
        } 
	 
	# stop on the first form found (after fetching headers)
	last if ($headers_fetched && /form (name|action)/);
  }
  
  Sucker::die3($class,"\nEmpty message header. Something is wrong. Bye!\n")
	if (@headeritmz == 0);

  # Lets put the real "From " message start if it's possible
  if ($ffrom && $ddate) {
	chomp($ffrom);
	chomp($ddate);
	$ffrom =~ s/^From: //g;
	$ddate =~ s/^Date: //g;

	# Change date format...	
	my @date_arr = split(/\s/,$ddate);
	$date_arr[0] =~ s/,//g;

	# Lets check if the date is in an expected format - otherwise use $timenow

	$ddate = $timenow;

	if ($weekdayz{$date_arr[0]} && $monthz{$date_arr[2]} && 
	    ($date_arr[1] =~ /^[0-9]$/ || $date_arr[1] =~ /^[0-9][0-9]$/) && 
	    $date_arr[4] =~ /^[0-9][0-9]:[0-9][0-9]:[0-9][0-9]$/ && 
            $date_arr[3] =~ /^[0-9][0-9][0-9][0-9]$/) {
		$date_arr[1] = " ".$date_arr[1] if (length($date_arr[1]) == 1);
		$ddate = $date_arr[0]." ".$date_arr[2]." ".$date_arr[1].
						" ".$date_arr[4]." ".$date_arr[3];
	}

	# Get the e-mail address from "From: " header...
	if ($ffrom =~ /\</) {
          $ffrom =~ s/.*<//g;
          $ffrom =~ s/>.*//g;
	}
	else {
          $ffrom =~ s/ .*//g;
	}
	
	# Change the first header item if everything went OK...
	$headeritmz[0] = "From ".$ffrom." ".$ddate."\n" if ($ffrom && $ddate);
  }

  # Lets see if we have at least on of these headers Date:, From:, To:
  # If not - there's something very strange going on - notify the Body
  # package
  $headeritmz[0] = "---".$headeritmz[0] if (! ($ddate || $ffrom || $tto));
 
  return \@headeritmz;
}

###################################
# PACKAGE BODY PAGE
##########################

package BodyPage;
use vars qw(@ISA);
@ISA = "Page";

# Unlike all the other packages, this "request" return an array of content
# not a socket handle (speed issues). I thought it is OK even if a whole message 
# is stored in memory, as the free Yahoo Mail storage limit is 6MB and therefore
# a maximum theoretical message size is 6MB.
# It should be easy enough though to lets say write message to a temp file 
# for later processing, if you don't like my solution.
sub request {
  my $class = shift;
  my $handle = shift;
  my $host = shift;
  my $what = shift;
  my $cookiez = ${$class->{cookiez}};
  my $line;
  my $cookz_str;

  $what = $class->{PROXY_PROTO}.$host.$what if ($class->{PROXY});

  if (@{$cookiez} > 0) {
        for (my $ii = 0; $ii < @{$cookiez}; $ii++) {
          if ($ii > 0) { $cookz_str = $cookz_str."\; " }

          # FreeBSD unitialized-value warning hack
          if ($cookz_str) { $cookz_str = $cookz_str.$cookiez->[$ii] }
          else { $cookz_str = $cookiez->[$ii] }
        }
        $line = "GET $what HTTP\/1\.0\nCookie: $cookz_str\nHost: $host\n";
  }
  else {
        $line = "GET $what HTTP\/1\.0\nHost: $host\n";
  }

  # See if we have to authorise ourselves to proxy...
  if ($class->{PROXY} && $class->{PROXY_PASS}) { $line = $line."Proxy-authorization: Basic $class->{PROXY_PASS}\n\n" }
  else { $line = $line."\n" }

  print $handle $line or Sucker::die3($class,"\nCannot write to socket!\n");
  my @content = <$handle>;

  return \@content;
}


# LOAD - requests a page and retrieves what we need

sub load {
  my $class = shift;
  my $host = shift;
  my $what = shift;
  my $headeritmz = shift;
  my $port = $class->{PORT};

  my $handle = $class->connect($host, $port);
  my $content = $class->request($handle, $host, $what);
  my $fetched = $class->parse($content, $headeritmz);

  return $fetched;
}

# As Yahoo returns a incomplete Content Type: multipart/... parameter
# I had to come up with this scary looking workaround
# First three who understand the following code 
# are about to win a "Laden Air"(tm) flight tickets to NY
# It's been simplified recently
sub parse {
  my $class = shift;
  my $content = shift;
  my $headeritmz = shift;
  my $cookiez = ${$class->{cookiez}};
  my @messgz;
  my $outfile = $class->{OUTFILE};
  my $pipe = $class->{PIPE};
  my $alarm = 0;
  my $fetched = 1;

  # Check for missing all of From:, Date: or To: headers
  if ($$headeritmz[0] =~ /^---/) {
	$fetched = 0;
	$$headeritmz[0] =~ s/^---//g;
	print "Header structure corruption! ".
		"Message won\'t be saved correctly!\n ".
		"Message won\'t be deleted and/or stored in repository.";
  }

  # Check for incomplete multipart
  for (my $c = 0; $c < @{$headeritmz}; $c++) {
	if ((($$headeritmz[$c] =~ /^Content\-Type\: multipart/i) && 
	   ($$headeritmz[$c] !~ /boundary/i)) && 
           ($$headeritmz[$c+1] !~ /boundary/i)) {
	  
	  $alarm = $c;
        }
  }

  # Lets get rid of HTTP headers
  do {
  	$_ = shift(@{$content}); 
	if (! defined) {
		print "Header structure corruption! Message won\'t be saved correctly!\n Message won\'t be deleted and/or stored in repository.";
		$fetched = 0;
		last;
	}
  } until ($_ eq "\cM\n" );

  # Now process the body to find a missing boundary parameter
  if ($alarm > 0) {
	foreach (@{$content}) {
	  if (/^--/) {
		my $linee = $_;
		chomp($$headeritmz[$alarm]);
		chomp($linee);
		$linee =~ s/^--//g;
		$$headeritmz[$alarm] = $$headeritmz[$alarm]." boundary=\"".$linee."\"\n";
		last;
	  }
	}
  }

  # Join headers and body so we can write it together
  push(@{$headeritmz}, "\n");
  push(@{$content}, "\n\n");
  push(@{$headeritmz}, @{$content});

  # Do we want "From " delimiter?
  my $rubbish = shift(@{$headeritmz}) if ($class->{NOFROM});

  # Flush the join result to OUTFILE
  my $actfile = $pipe.$outfile;
  open(FILE, "$actfile") or Sucker::die3($class,"\nCannot open OUTFILE!!!\n");
 
  # If the OUFILE is a file ane not a pipe, get an exclusive lock on the file
  if ($pipe ne "|") {
	print "\bO" if $class->{DEBUG};			# DEBUG
	# wait for an exclusive lock of the OUTFILE
	flock(FILE, 2) or Sucker::die3($class,"\nCannot get exclusive lock on OUTFILE!!!\n"); 
	# rewind to the EOF just in case someone wrote to the file while we waited...
	seek(FILE, 0, 2);
	print "\bo" if $class->{DEBUG};			# DEBUG
  }
  
  print FILE @{$headeritmz} or Sucker::die3($class,"\nCannot write to OUTFILE!!! Disk full?\n");
  close(FILE) or Sucker::die3($class,"\nCannot close the OUTFILE!!! Disk full?\n");

  return $fetched;
}

###################################
# PACKAGE ERASE PAGE
##########################

package ErasePage;
use vars qw(@ISA);
@ISA = "Page";

sub request {
  my $class = shift;
  my $handle = shift;
  my $host = shift;
  my $what = shift;
  my $cookiez = ${$class->{cookiez}};
  my $line;
  my $cookz_str;
  my $post;
  my $post_size;

  ($what,$post) = split(/\?/,$what);
  $post_size = length($post);
  $what = $class->{PROXY_PROTO}.$host.$what if ($class->{PROXY});

  if (@{$cookiez} > 0) {
	for (my $ii = 0; $ii < @{$cookiez}; $ii++) {
          if ($ii > 0) { $cookz_str = $cookz_str."\; " }

          # FreeBSD unitialized-value warning hack
          if ($cookz_str) { $cookz_str = $cookz_str.$cookiez->[$ii] }
          else { $cookz_str = $cookiez->[$ii] }
	}

	$line = "POST $what HTTP\/1\.1\nCookie: $cookz_str\nHost: $host\n";
  
	# See if we have to authorise ourselves to proxy...
	if ($class->{PROXY} && $class->{PROXY_PASS}) { $line = $line."Proxy-authorization: Basic $class->{PROXY_PASS}\n" }
	
	$line = $line."Content-Type: application/x-www-form-urlencoded\n".
		"Content-Length: $post_size\n\n$post";
  } 
  else {
	$line = "POST $what HTTP\/1\.1\nHost: $host\n";

	# See if we have to authorise ourselves to proxy...
	if ($class->{PROXY} && $class->{PROXY_PASS}) { $line = $line."Proxy-authorization: Basic $class->{PROXY_PASS}\n" }

	$line = $line."Content-Type: application/x-www-form-urlencoded\n".
		"Content-Length: $post_size\n\n$post";
  }

  print $handle $line or Sucker::die3($class,"\nCannot write to the socket!\n");

  return $handle;
}

1; # End of it all
