#!/usr/bin/perl -w
###############################################################################
# Name: FetchYahoo
# Purpose: retrieves messages from Yahoo! Mail, saving them to a local spool
# Description:  FetchYahoo is a Perl script that downloads mail from a Yahoo! 
#               webmail account to a local mail spool. It is meant to replace
#               fetchmail for people using Yahoo! mail since Yahoo!'s POP service
#               is no longer free. It downloads messages to a local mail spool, 
#               including all parts and attachments . It then deletes messages
#               unless requested not to. It can also forward messages to another
#               e-mail address
# Author:  Ravi Ramkissoon
# Author's E-mail: ravi_ramkissoon@yahoo.com
# License: Gnu Public License
# Created: 04.12.02
# Modified: 05.02.02
# Version: .1.3
# 
# Installation instructions are in the INSTALL file
#
###############################################################################
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
##################################################################################

use strict;

use Getopt::Long ();
use HTML::Entities ();
use HTML::HeadParser ();
use HTML::TokeParser ();
use HTTP::Request::Common qw(GET POST);
use HTTP::Cookies ();
use LWP::UserAgent ();
use LWP::Simple ();
use MIME::Entity ();
use MIME::Head ();
use MIME::Body ();
sub GetRedirectUrl($);
sub PopulateMap();
sub ParseConfigFile();
sub Localize($);
sub Clean($);
sub EmptyTrash();
sub Logout();
		   
# MUST configure these
my $username = 'yahoo-user-name';
my $password = 'yahoo-password';

# mail spool, mbox file and procmail configs
my $useSpool  = 1;                    # set this to 0 to disable outputting to a file
my $spoolName = '/var/spool/mail/local-user-name';
my $spoolMode = 'append';             # either 'append', 'pipe' or 'overwrite'
                                      # use 'pipe' for procmail or other filter
# proxy configs
my $useProxy = 0;                     # set this to 1 to enable use of a web proxy
my $proxyHost = 'proxy.hostname.com';
my $proxyPort = 80;

my $useHTTPS = 0;                     # set this to 1 to use https secure connections
                                      # this may require Crypt::SSLeay
# mail forwarding configs
my $useForward = 0;                      # set this to 1 to enable mail forwarding
my $mailHost = 'outgoing.mail.com';   # set this to your smtp outgoing mail server
my $sendToAddress = 'me@myhost.com';  # the e-mail address you want mail forwarded to
my $sendFromAddress = 'me@myhost.com'; # the e-mail address used as the from address
                                       # this should probably be at the same ISP as
		                       # the outgoing smtp mailhost specified above

# daemon mode config. If this is 0, the program runs only once and terminates.
# Otherwise this is the number of minutes between successive mail checks.
my $repeatInterval = 0;

# the below defaults can be overridden from the commandline
my $newOnly = 0;           # download all (0) or just new (1) messages
my $noDelete = 0;          # to not delete messages set this to 1
my $quiet = 0;             # to suppress regular (non-error) output set this to 1
my $noDownload = 0;        # to delete messages and not download them, set this to 1
my $inlineHTML = 0;        # to inline html messages, set this to 1
my $emptyTrashAfter = 0;   # to empty trash after downloading msgs set this to 1
my $emptyTrashBefore = 0;  # to empty trash before downloading msgs, set this to 1 
my $logout = 0;            # to have fetchyahoo logout at the end, set this to 1

# use LWP::Debug qw(+);              # turn this on for tons of debugging messages


# I may need to edit these in future
my $userAgent= 'FetchYahoo/.1.3';
my $loginURL = 'http://login.yahoo.com/config/login';
my $HTTPSloginURL = 'https://login.yahoo.com/config/login';
my $homesuff = '/ym/ShowFolder?box=Inbox';
my $msgsuff = '/ym/ShowLetter?box=Inbox&PRINT=1&Nhead=f&toc=1&MsgId=';
my $versionString = "FetchYahoo Version .1.3\n";

# other variables used
my $spool;
my $proxyURL;
my $smtp;
my $altConfigFile;

# flag for help and version
my $help = 0;
my $version = 0;

my %map  = ();     # hash for extension->MIMEtype mappings

my $usage = <<EOF
$0 [options] 

Retrieves messages from the inbox of a Yahoo user using the web interface
and stores them in the specified local spool/mbox file. Deletes the messages
downloaded unless requested not to.

Options specified on the commandline take precedence over options specified
in the configuration file, which in turn take precedence over options hardcoded
within the fetchyahoo program file.

--version                      print the version and exit
--help                         give the usage message showing the program options
--newonly                      only download new (i.e. unread) messages
--nodelete                     do not delete messages after downloading them
--configfile=config-file       use config-file as the configuration file
--username=yahoousername       use yahoousername as the login
--password=pass                use pass as the password
--spoolfile=spool-file         use spool-file as the file to spool messages to
--quiet                        suppress regular (non-error) messages
--nodownload                   only delete messages, do not download them
--inlinehtml                   transmit HTML messages inline
--emptytrashbefore             empty trash before downloading messages
--emptytrashafter              empty trash after downloading messages
--logout                       log out of Yahoo! when done
--repeatinterval=N             check for mail every N minutes

At least username and password must be specified somewhere (commandline, config-file 
or in fetchyahoo.pl)

EOF
;

# S T A R T   M A I N   P R O G R A M

# mapping extensions to mime types
PopulateMap();
		   
# parse input options for an alternate config file
Getopt::Long::Configure('pass_through');
Getopt::Long::GetOptions ('configfile=s'  => \$altConfigFile);

# config file options take precedence over hardcoded (within-file)  options
ParseConfigFile();

# get other command-line  input options. These options take precedence over all others
Getopt::Long::Configure('no_pass_through');
Getopt::Long::GetOptions
(
 'newOnly'           => \$newOnly,
 'help'              => \$help,
 'version'           => \$version,
 'noDelete'          => \$noDelete,
 'username=s'        => \$username,
 'password=s'        => \$password,
 'spoolfile=s'       => \$spoolName,
 'quiet'             => \$quiet,
 'nodownload'        => \$noDownload,
 'inlinehtml'        => \$inlineHTML,
 'emptytrashafter'   => \$emptyTrashAfter,
 'emptytrashbefore'  => \$emptyTrashBefore,
 'logout'            => \$logout,
 'repeatinterval=n'  => \$repeatInterval);

# set some required variables
if ($spoolMode eq 'append') {
    $spool = '>>' . $spoolName ; }
elsif ($spoolMode eq 'pipe') {
    $spool = '|' . $spoolName ; }
elsif ($spoolMode eq 'overwrite') {
    $spool = '>' . $spoolName ; }
else { $spool = '>>' . $spoolName ; }     # the default is to append

$proxyURL = 'http://' . $proxyHost . ':' . $proxyPort;
if ($useHTTPS) { 
	$proxyURL = $proxyHost . ':' . $proxyPort;
}

if ($useHTTPS) {
	$loginURL = $HTTPSloginURL;
}

# unbuffer STDOUT
select((select(STDOUT), $| = 1)[0]);

# check if help or version was requested
if ($help) { print $versionString . "\n" . $usage; exit; }
if ($version) { print $versionString; exit; }

# check for common errors (forgot to edit variables)
if ($username eq 'yahoo-user-name')  {
    print "You MUST specify a username " .
	"before using this program.\n\n";
    print $versionString . "\n" . $usage; exit; 
}

if ($username eq 'yahoo-password')  {
    print "You MUST specify a password" .
	"before using this program.\n\n";
    print $versionString . "\n" . $usage; exit; 
}

if ( $useSpool && $spoolName eq "/var/spool/mail/local-user-name") {
    print "If you are sending the messages to a file (use-spool=1), you must " .
	"specify the file or spool or program .\n\n";
    print $versionString . "\n" . $usage; exit; 
}

if ( $useForward && $sendToAddress eq 'me@myhost.com') {
    print "If you are forwarding the messages (use-forward=1), you must " .
	"specify the e-mail address to forward to.\n\n";
    print $versionString . "\n" . $usage; exit; 
}

if ( $useForward && $mailHost eq 'outgoing.mail.com') {
    print "If you are forwarding the messages (use-forward=1), you must " .
	"specify an smtp server (localhost if you have one installed locally).\n\n";
    print $versionString . "\n" . $usage; exit; 
}


if ( $useProxy && $proxyHost eq "proxy.hostname.com") {
    print "If you are using a web proxy (use-proxy=1), you must " .
	"specify the proxy hostname.\n\n";
    print $versionString . "\n" . $usage; exit; 
}

if (!$quiet) {
    if ($useHTTPS) { print "Logging in securely via SSL as $username.\n" }
    else { print "Logging in insecurely via plaintext as $username.\n" }

    if ($useProxy) { print "Using $proxyURL as a webproxy.\n" }
    if ($inlineHTML) { print "Inlining HTML messages\n"; }
    if ($repeatInterval>0) { 
	print "Running in daemon mode. Will check every $repeatInterval minutes.\n"; }
}

startfetch:
if ($useForward) {
    use Net::SMTP;
    $smtp = Net::SMTP->new($mailHost);
    die "Unable to connect to server $mailHost to forward mail. Terminating!\n" 
	unless $smtp; 
}

# grab login cookies
my $ua = LWP::UserAgent->new;
$ua->agent($userAgent);
if ($useProxy) {
    if ($useHTTPS) {
	$ENV{HTTPS_PROXY} = $proxyURL;
    } else {
    	$ua->proxy('http', $proxyURL);
    }
}
my $cookie_jar = HTTP::Cookies->new();
$ua->cookie_jar($cookie_jar);
my $request = POST 'http://login.yahoo.com/config/login',
    [
     '.tries' => '1',
     #'.done'  => 'URL to go to later',
     '.src'   => 'ym',
     '.intl'  => 'us',
     'login'  => $username,
     'passwd' => $password,
     ];

$request->content_type('application/x-www-form-urlencoded');
$request->header('Accept' => '*/*');
$request->header('Allowed' => 'GET HEAD PUT');
my $response = $ua->simple_request($request);
my $url;
while ( $response->is_redirect ) {
    $cookie_jar->extract_cookies($response);
    $url = GetRedirectUrl($response);
    $request = GET $url;
    $response = $ua->simple_request($request);
}


if ( !$response->is_success ) { print "Failed!\n"; die "Couldn't log in\n"; }

if ( ($response->content) =~ /Invalid Password/ ) {
    print "Failed!\n"; die "Wrong password entered for $username\n"; }

if ( ($response->content) =~ /ID does not exist/ ) {
    print "Failed!\n"; die "Yahoo user $username does not exist\n"; }

# Detect country code from url (first 2 chars of url, eg http://us.f116.mail.yahoo.com)
$url=~/http:\/\/(.*?)\./;

if (!$quiet) {
    print "Successfully logged in as $username.\n"; 
    print "Country code : $1\n";
}

# set localization strings
my %strings = Localize($1);

# Find the localized equivalent of "To:"
my $localizedTo = "To:";
foreach (keys %{$strings{"headers"}} ) {
    if ($strings{"headers"}->{$_} eq "To:") {
        $localizedTo = $_;
        last;
    }
}

# setup URLs
$url =~ /(http:\/\/.*?)\// ;
my $baseurl = $1;
my $homeurl = $baseurl . $homesuff ;
my $msgurl = $baseurl . $msgsuff ; 
my $delurl = $homeurl . "\&DEL=Delete";
my $logouturl = $baseurl . "/ym/Logout";
my $emptyurl;

# get all message IDs
my $msgcount = 0;
my $pagecount = 0;
my $numMsgs ;
my $startMsg ;
my $endMsg ;
my @msgids ;
my $crumb;

if ( $newOnly && !$quiet) {
    print "Only retrieving new messages\n";
    $homeurl = $homeurl . "\&Nview=u";
}

# loop over all inbox summary pages
do {
    
    # get summary page
    my $tmpurl = $homeurl . "\&Npos=$pagecount" ; 
    $request = GET  $tmpurl ;
    $response = $ua->simple_request($request);
    while ( $response->is_redirect ) {
	$cookie_jar->extract_cookies($response); # manually extract cookies
	my $url = GetRedirectUrl($response);     # get new page
	$request = GET $url;                     # go to the new page 
	$response = $ua->simple_request($request);
    }

    if ( !$response->is_success ) { 
	if (!$quiet) { print "Failed!\n"; }
	die "Couldn't get Inbox listing.\n"; }

    my $mainPage = $response->content;

    $mainPage =~ /\"((.*?)\?ET=1(.*?))\"/;
    $emptyurl = $baseurl . $1;
    if ($emptyTrashBefore) { EmptyTrash(); }
       
    #parse for number of messages
    if ($mainPage =~ /$strings{'msg_range'}/) { 
	$startMsg = $1 ;
	$endMsg = $2 ;
	$numMsgs = $3;  }
    elsif ($mainPage =~ /$strings{'no_msgs'}/) {
	if (!$quiet) { print "There are no messages to retrieve.\n"; }
	if ($emptyTrashAfter) { EmptyTrash(); }       # if requested, empty trash
	if ($logout) { Logout; }                      # if requested, logout

	# if repeat interval is non-zero, loop after repeatInterval minutes
	if ($repeatInterval > 0) {
	    sleep (60*$repeatInterval);
	    goto startfetch ;
	}
	exit; }
    else { 
	if (!$quiet) { print "Failed!\n"; }
	die "Can't retrieve number of messages.\n"; }
    
    $mainPage =~ /name=\".crumb\" value=\"(.*?)\"/ ;
    $crumb = $1;
    if (!$quiet) { print "Getting Message IDs for messages $startMsg - $endMsg.\n"; }
    
    # parse summary page for message IDs
    foreach my $word (split ' ', $mainPage) {
	if ($word =~ /ShowLetter\?MsgId=([0-9_]+)/ ) { 
	    $msgcount = $msgcount + 1;
	    $msgids[$msgcount-1] = $1 ;
	}
    }
    $pagecount = $pagecount+1 ;            # next summary page
} until $numMsgs == $endMsg ; 


if (!$quiet) { print "Got $msgcount Message IDs\n"; }
my $delCount = 0;
my $downloadCount = 0;

if ($noDownload) {
    if (!$quiet) { print "Not downloading messages\n"; }
    foreach my $msgid (@msgids) { 
	$delurl = $delurl . "\&Mid=$msgid";    # add message to deletion list
	$delCount = $delCount+1;
    }
    goto startDelete;
}

# loop over all Message IDs
foreach my $msgid (@msgids) { 
    my $tmpurl = $msgurl . $msgid ; 
    my $request = GET  $tmpurl ;
    my $response;
    my $dateStr = '';

    if ( ! ($response = $ua->simple_request($request))) {
	print "\nFailed to get body of message $msgid. It will be "
	    . "skipped and not deleted.\n";
	next ; }
    my $msgText = $response->content ;

    if ($msgText =~ /$strings{'p_view'}/) {  # sometimes we get a 
	$tmpurl = $msgurl . $msgid ;            # non-printable view
	$request = GET  $tmpurl ;
	if ( ! ($response = $ua->simple_request($request) )) {
	    print "\nFailed to get body of message $msgid. It will be "
		. "skipped and not deleted.\n";
	    next ; }
	$msgText = $response->content ;
    }
    
    # loop over all the message parts, getting their URLs and filenames
    my $partcount = 0 ; 
    my @parturls;
    my @filenames;
    
    foreach my $word (split ' ', $msgText) {
	if ($word =~ /filename=(.*?)&download=1/ ) {
	    $filenames[$partcount] = $1 ;
	    my $parturl = $word ; 
	    $parturl =~ s/href=\"// ;
	    $parturl =~ s/\">// ;
	    $partcount = $partcount + 1;
	    $parturls[$partcount-1] = $parturl ;
	}
    }

    # Parse all headers in message
    # Here we need a header we will find in every message. 
    # "To:" seemed like a good choice. 
    # Reminder : $localizedTo is the local translation of "To:"
    $msgText =~ /<table[^>]*>(.*?$localizedTo.*?)<\/table>/si;
 
    my $msgLines = $1;

    # All info is stored in $mimeHead
    # The reason we go through the trouble of constructing the header manually 
    # is to preserve multiple Received: headers, since these are lost when using
    # a hash.

    my $fromString = '-1';
    my $mimeHead = new MIME::Head;
    $msgLines =~ s/X-Apparently-To/\n<\/td><td><\/td><\/tr><tr><td>X-Apparently-To/s ; 	
          # ^^ hack to parse 1st field
    while ($msgLines =~ s/<tr[^>]*>\s*<td[^>]*>(.*?)<\/td>\s*<td[^>]*>(.*?)<\/td><\/tr>//si) {
        my $key = $1;
        my $value = $2;      
	# Extract the key as it is defined in the message (possibly translated)
        $key = Clean($1);                                   
	# Translate back to English if necessary
	if (defined $strings{'headers'}->{$key}) {
            $key = $strings{'headers'}->{$key};
        }
        $value = Clean($2);

	if ($key =~ /^From /) { next ; }       # skip the extra From_ line
	if ($key eq '') { next ; }              # skip any blank fields
	if ($key =~ ' ') { next ; }              # skip any bad fields (with a space)

	if ($key eq 'From:') { $fromString = $value; } #to recreate a From_ line later

	$mimeHead->add($key, $value);
    }

    # if we can't parse From: field assume this has failed
    if ( $fromString eq '-1') {
	print "\nCan't find message $msgid. It will be skipped and not deleted.\n";
	next;
    }

    my $msg;
    my $noDelete = 0;

    # for inline html skip file.txt
    if ($inlineHTML && defined($filenames[1]) && $filenames[1] =~ /file.htm/ ) {
	$partcount = $partcount -1;
	shift @filenames ; 
	shift @parturls ;
    }

    if ($partcount>1) {
	# start building a message to spool
	$msg = MIME::Entity->build('Type' => "multipart/mixed" );

	# create the headers from scratch now
	my $tmpDate = scalar localtime;
	$tmpDate =~ s/ /_/g;
	$mimeHead->replace('Content-Type', "multipart/mixed;" . "Boundary=\"" . 
			   'arbitrary_string_Wheee' . $tmpDate . "\"");
	$msg->head($mimeHead);
	
	# loop over all message parts
	for (my $i = 0; $i < $partcount; $i++) {
	    
	    # get one part of the message
	    $tmpurl = $baseurl . $parturls[$i] ; 
	    $request = GET  $tmpurl ;
	    
	    if ( ! ($response = $ua->simple_request($request) ) ) {
		print " \nFailed to get attachment $filenames[$i]. " 
		    . "Skipping attachment, message will not be deleted.\n" ;
		$noDelete = 1;
		next ; 
	    }
	    
	    my $rawPart = $response->content ;
	    
	    if ($rawPart =~ /<head><title>Yahoo\!\s*-\s*404 Not Found<\/title>/s ) {
		print " \nFailed to get attachment $filenames[$i]. " 
		    . "Skipping attachment, message will not be deleted.\n" ;
		$noDelete = 1;
		next ; 
	    }
	    
            # get extension and derive type and disposition from that
	    $filenames[$i] =~ /.*\.(.*)/ ;
	    my $fileExt = "qqq"; 
	    if (defined ($1) ) { $fileExt = $1 ; } 
	    my $type = $map{lc($fileExt)};
	    if ( ! defined ($type) ) { $type = "text/plain" ; } 
	    my $disp ; 
	    if ( $type eq "text/plain"  && !($fileExt =~ "qqq") && $i==0) { 
		$disp = "inline"; }
	    elsif ( $type eq "text/html" && $inlineHTML && $i==0) { 
		$disp = "inline"; }                # for $inlineHTML of file.htm
	    else {
		$disp = "attachment"; }
	    
	    # attach this part to the message
	    attach $msg Data=>$rawPart,
	    Disposition => $disp,
	    Filename =>$filenames[$i],
	    Type => $type;
	    if (!$quiet) {print "." ; }              # output one "." for every part
	}
    }
    else {  # this is a single part message (either text/plain or text/html)

	# get message body
	$tmpurl = $baseurl . $parturls[0] ; 
	$request = GET  $tmpurl ;	

	if ( ! ($response = $ua->simple_request($request) ) ) {
	    print " \nFailed to get message body. " 
		. "Message will be skipped and will not be deleted.\n" ;
	    next ; 
	} 	
	my $msgBody = $response->content ;

	if ($msgBody =~ /<head><title>Yahoo\!\s*-\s*404 Not Found<\/title>/s ) {
	    print " \nFailed to get message body. " 
		. "Message will be skipped and will not be deleted.\n" ;
	    next ; 
	}

	$msg = MIME::Entity->build('Type' => "text/plain" ,
				   'Data' => $msgBody);

	my $contentType;                    # file.txt can be plain or html
        if ( ($msgBody =~ /^\s*<html>/i) or ($msgBody =~ /^\s*<\!DOCTYPE HTML/i) ) {
            $contentType = "text/html"; }
        else { 
            $contentType = "text/plain"; }

	$mimeHead->replace('Content-Type', $contentType);
	$msg->head($mimeHead);
	if (!$quiet) { print "." ; }              # output one "." for every part
    }

    if (! $noDelete) {
	$delurl = $delurl . "\&Mid=$msgid";    # add message to deletion list
	$delCount = $delCount+1;
    }
    # create a proper From_ line
    $fromString =~ s/ /_/g ;
    $fromString = "From " . $fromString . " " . (scalar localtime) . "\n" ; 
    
    if ($useSpool) {
	# send From_line and created multipart message to the specified spool/file
	open SPOOL, "$spool" or
	    die "Can't open output: $spool";
	print SPOOL "\n" ;
	print SPOOL $fromString ; 
	$msg->print(\*SPOOL);
	print SPOOL "\n\n" ;
	close SPOOL;
    }

    # mail fowarding stuff goes here
    if ($useForward) {
	$smtp->mail($sendFromAddress);
	$smtp->to($sendToAddress);	
	$smtp->data();
	$smtp->datasend($msg->stringify);
	$smtp->dataend();	
    }
    
    $downloadCount = $downloadCount +1 ;
    if (!$quiet) { print $downloadCount%10 ; } # output one digit for every completed msg
 
}

if ($useForward) {
    $smtp->quit;  
}

if (!$quiet) { print "\nFinished downloading $downloadCount messages.\n"; }

startDelete:
if ( ! $noDelete) {    
    $delurl = $delurl . "\&.crumb=$crumb";
    $request = GET  $delurl ;
    $response = $ua->simple_request($request) ||
	die "Failed to delete messages.\n";
    
    # if we fail try again once
    if (($response->content) =~ /<head><title>Yahoo\!\s*-\s*404 Not Found<\/title>/s)
    {
	$response = $ua->simple_request($request) ||
	    die "Failed to delete messages.\n";
	
	if (($response->content) 
	    =~ /<head><title>Yahoo\!\s*-\s*404 Not Found<\/title>/s )
	{ die "Failed to delete messages.\n"; }
    }
   
    if (!$quiet) { print $delCount . " message(s) have been deleted.\n"; }
} else { 
    if (!$quiet) { print "Messages have not been deleted.\n"; }
}

if ($emptyTrashAfter) { EmptyTrash(); }
if ($logout) { Logout(); } 

# if repeat interval is non-zero, loop after repeatInterval minutes
if ($repeatInterval > 0) {
    sleep (60*$repeatInterval);
    goto startfetch ;
}

###############################################################################
# Subroutines
###############################################################################

# return the URL we're redirected to
sub GetRedirectUrl($) {
    my $response = $_[0];
    my $url = $response->header('Location') || return undef;
    
    # the Location URL is sometimes non-absolute which is not allowed, fix it
    local $URI::ABS_ALLOW_RELATIVE_SCHEME = 1;
    my $base = $response->base;
    $url = $HTTP::URI_CLASS->new($url, $base)->abs($base);
    
    return $url;
}

sub EmptyTrash() {
    $request = GET  $emptyurl ;
    $response = $ua->simple_request($request);
    while ( $response->is_redirect ) {
	$cookie_jar->extract_cookies($response); # manually extract cookies
	my $url = GetRedirectUrl($response);     # get new page
	$request = GET $url;                     # go to the new page 
	$response = $ua->simple_request($request);
    }
    
    if ( !$response->is_success ) { 
	if (!$quiet) { print "Failed!\n"; }
	die "Couldn't empty trash.\n"; }
    elsif (!$quiet) { print "Trash emptied.\n";}
}

sub Logout() {
    $request = GET  $logouturl ;
    $response = $ua->simple_request($request);
    while ( $response->is_redirect ) {
	$cookie_jar->extract_cookies($response); # manually extract cookies
	my $url = GetRedirectUrl($response);     # get new page
	$request = GET $url;                     # go to the new page 
	$response = $ua->simple_request($request);
    }
    
    if ( !$response->is_success ) { 
	if (!$quiet) { print "Failed!\n"; }
	die "Couldn't logout.\n"; }
    elsif (!$quiet) { print "Logged out.\n";}

}

sub PopulateMap() {

$map{af}  =  "audio/aiff" ;
$map{ai}  =  "application/postscript" ;
$map{aiff}  =  "audio/aiff" ;
$map{asc}  =  "text/plain" ;
$map{au}  =  "audio/basic" ;
$map{au}  =  "audio/x-pn-au" ;
$map{avi}  =  "video/x-msvideo" ;
$map{bcpio}  =  "application/x-bcpio" ;
$map{bin}  =  "application/octet-stream" ;
$map{cdf}  =  "application/x-netcdf" ;
$map{cpio}  =  "application/x-cpio" ;
$map{cpt}  =  "application/mac-compactpro" ;
$map{csh}  =  "application/x-csh" ;
$map{css}  =  "text/css" ;
$map{dcr}  =  "application/x-director" ;
$map{dir}  =  "application/x-director" ;
$map{dms}  =  "application/octet-stream" ;
$map{doc}  =  "application/msword" ;
$map{dvi}  =  "application/x-dvi" ;
$map{dxr}  =  "application/x-director" ;
$map{eps}  =  "application/postscript" ;
$map{etx}  =  "text/x-setext" ;
$map{exe}  =  "application/octet-stream" ;
$map{ez}  =  "application/andrew-inset" ;
$map{gif}  =  "image/gif" ;
$map{gz}  = "application/x-gzip" ;
$map{gtar}  =  "application/x-gtar" ;
$map{hdf}  =  "application/x-hdf" ;
$map{hqx}  =  "application/mac-binhex40" ;
$map{html}  =  "text/html" ;
$map{htm}  =  "text/html" ;
$map{ice}  =  "x-conference/x-cooltalk" ;
$map{ief}  =  "image/ief" ;
$map{iges}  =  "model/iges" ;
$map{igs}  =  "model/iges" ;
$map{jpeg}  =  "image/jpeg" ;
$map{jpe}  =  "image/jpeg" ;
$map{jpg}  =  "image/jpeg" ;
$map{js}  =  "application/x-javascript" ;
$map{kar}  =  "audio/midi" ;
$map{latex}  =  "application/x-latex" ;
$map{lha}  =  "application/octet-stream" ;
$map{lzh}  =  "application/octet-stream" ;
$map{man}  =  "application/x-troff-man" ;
$map{me}  =  "application/x-troff-me" ;
$map{mesh}  =  "model/mesh" ;
$map{mid}  =  "audio/midi" ;
$map{midi}  =  "audio/midi" ;
$map{mif}  =  "application/vnd.mif" ;
$map{movie}  =  "video/x-sgi-movie" ;
$map{mov}  =  "video/quicktime" ;
$map{mp2}  =  "audio/mpeg" ;
$map{mp3}  =  "audio/mpeg" ;
$map{mpeg}  =  "video/mpeg" ;
$map{mpe}  =  "video/mpeg" ;
$map{mpga}  =  "audio/mpeg" ;
$map{mpg}  =  "video/mpeg" ;
$map{ms}  =  "application/x-troff-ms" ;
$map{msh}  =  "model/mesh" ;
$map{nc}  =  "application/x-netcdf" ;
$map{oda}  =  "application/oda" ;
$map{pbm}  =  "image/x-portable-bitmap" ;
$map{pdb}  =  "chemical/x-pdb" ;
$map{pdf}  =  "application/pdf" ;
$map{pgm}  =  "image/x-portable-graymap" ;
$map{pgn}  =  "application/x-chess-pgn" ;
$map{png}  =  "image/png" ;
$map{pnm}  =  "image/x-portable-anymap" ;
$map{ppm}  =  "image/x-portable-pixmap" ;
$map{ppt}  =  "application/vnd.ms-powerpoint" ;
$map{ps}  =  "application/postscript" ;
$map{qt}  =  "video/quicktime" ;
$map{ra}  =  "audio/x-realaudio" ;
$map{ram}  =  "audio/x-pn-realaudio" ;
$map{ras}  =  "image/x-cmu-raster" ;
$map{rf}  =  "image/vnd.rn-realflash" ;
$map{rgb}  =  "image/x-rgb" ;
$map{rm}  =  "application/vnd.rn-realmedia" ;
$map{rmm}  =  "audio/x-pn-realaudio" ;
$map{roff}  =  "application/x-troff" ;
$map{rp}  =  "image/vnd.rn-realpix" ;
$map{rtf}  =  "text/rtf" ;
$map{rt}  =  "text/vnd.rn-realtext" ;
$map{rtx}  =  "text/richtext" ;
$map{rv}  =  "video/vnd.rn-realvideo" ;
$map{sdp}  =  "application/sdp" ;
$map{sgml}  =  "text/sgml" ;
$map{sgm}  =  "text/sgml" ;
$map{sh}  =  "application/x-sh" ;
$map{shar}  =  "application/x-shar" ;
$map{silo}  =  "model/mesh" ;
$map{sit}  =  "application/x-stuffit" ;
$map{skd}  =  "application/x-koan" ;
$map{skm}  =  "application/x-koan" ;
$map{skp}  =  "application/x-koan" ;
$map{skt}  =  "application/x-koan" ;
$map{smi}  =  "application/smil" ;
$map{smil}  =  "application/smil" ;
$map{spl}  =  "application/x-futuresplash" ;
$map{src}  =  "application/x-wais-source" ;
$map{sv4cpio}  =  "application/x-sv4cpio" ;
$map{sv4crc}  =  "application/x-sv4crc" ;
$map{swf}  =  "application/x-shockwave-flash" ;
$map{t}  =  "application/x-troff" ;
$map{tar}  =  "application/x-tar" ;
$map{tcl}  =  "application/x-tcl" ;
$map{tex}  =  "application/x-tex" ;
$map{texi}  =  "application/x-texinfo" ;
$map{texinfo}  =  "application/x-texinfo" ;
$map{tgz}  = "application/x-gzip" ;
$map{tiff}  =  "image/tiff" ;
$map{tif}  =  "image/tiff" ;
$map{tr}  =  "application/x-troff" ;
$map{tsv}  =  "text/tab-separated-values" ;
$map{txt}  =  "text/plain" ;
$map{ustar}  =  "application/x-ustar" ;
$map{vcd}  =  "application/x-cdlink" ;
$map{vrml}  =  "model/vrml" ;
$map{wav}  =  "audio/wav" ;
$map{wdf}  =  "text/x-wdf" ;
$map{wrl}  =  "model/vrml" ;
$map{xbm}  =  "image/x-xbitmap" ;
$map{xml}  =  "text/xml" ;
$map{xpm}  =  "image/x-xpixmap" ;
$map{xwd}  =  "image/x-xwindowdump" ;
$map{xyz}  =  "chemical/x-pdb" ;
$map{zip}  =  "application/zip" ;
}

sub ParseConfigFile() {

    if ($altConfigFile) {
	open(CONFIGFILE,$altConfigFile) || die "Can't open config file $altConfigFile\n" ; 
    }  else {
	open(CONFIGFILE, $ENV{"HOME"} . "/.fetchyahoorc") || 
	    open(CONFIGFILE,"/etc/fetchyahoorc") || return;
    }

    while (<CONFIGFILE>) {
	next if (/^\s*\#/);              # ignore lines with starting with a #

 	if (/username\s*=\s*(.*?)\s*$/i) {
 	    $username = $1;
 	} elsif (/password\s*=\s*(.*?)\s*$/i) {
 	    $password = $1;

 	} elsif (/use-spool\s*=\s*(.*?)\s*$/i) {
 	    $useSpool = $1;
 	} elsif (/spool\s*=\s*(.*?)\s*$/i) {
 	    $spoolName = $1;
	} elsif (/spool-mode\s*=\s*(.*?)\s*$/i) {
 	    $spoolMode = $1;

	} elsif (/use-proxy\s*=\s*(.*?)\s*$/i) {
 	    $useProxy = $1;
 	} elsif (/proxy-host\s*=\s*(.*?)\s*$/i) {
 	    $proxyHost = $1;
	} elsif (/proxy-port\s*=\s*(.*?)\s*$/i) {
 	    $proxyPort = $1;
	
	} elsif (/use-forward\s*=\s*(.*?)\s*$/i) {
 	    $useForward = $1;
 	} elsif (/mail-host\s*=\s*(.*?)\s*$/i) {
 	    $mailHost = $1;
	} elsif (/send-to\s*=\s*(.*?)\s*$/i) {
 	    $sendToAddress = $1;
	} elsif (/send-from\s*=\s*(.*?)\s*$/i) {
 	    $sendFromAddress = $1;
	
 	} elsif (/new-messages-only\s*=\s*(.*?)\s*$/i) {
 	    $newOnly = $1;
 	} elsif (/no-delete\s*=\s*(.*?)\s*$/i) {
 	    $noDelete = $1;
	} elsif (/use-https\s*=\s*(.*?)\s*$/i) {
 	    $useHTTPS = $1;
	} elsif (/quiet\s*=\s*(.*?)\s*$/i) {
 	    $quiet = $1;
	} elsif (/inline-html\s*=\s*(.*?)\s*$/i) {
 	    $inlineHTML = $1;

	} elsif (/empty-trash-after\s*=\s*(.*?)\s*$/i) {
 	    $emptyTrashAfter = $1;
	} elsif (/empty-trash-before\s*=\s*(.*?)\s*$/i) {
 	    $emptyTrashBefore = $1;
	} elsif (/logout\s*=\s*(.*?)\s*$/i) {
 	    $logout = $1;
	} elsif (/repeat-interval\s*=\s*(.*?)\s*$/i) {
 	    $repeatInterval = $1;
	}
	
    }
    close(CONFIGFILE);
}

sub Localize($) {
    my ($cc) = @_;
    my $strings;
    my %localized_strings = ('us' => {'msg_range' => 'showing (\d+)-(\d+) of (\d+)',
                                      'no_msgs'   => 'Folder\s*Inbox\s*has\s*no\s+',
                                      'p_view'    => 'Printable\&nbsp;View',
                                      'headers'   => {'To:'              => 'To:',
                                                      'From:'            => 'From:',
                                                      'Subject:'         => 'Subject:',
                                                      'Date:'            => 'Date:',
                                                      'Reply-To:'        => 'Reply-To:'
                                                     }
				     },
                             'fr' => {'msg_range' => '(\d+)-(\d+) sur (\d+)',
                                      'no_msgs'   => 'Dossier\s*Boîte\s*de\s*réception\s*sans\s*messages',
                                      'p_view'    => 'Version\&nbsp;imprimable',
                                      'headers'   => {'À:'          => 'To:',
                                                      'De:'         => 'From:',
                                                      'Objet:'      => 'Subject:',
                                                      'Répondre à:' => 'Reply-To:',
                                                      'Date:'       => 'Date:'
                                                     }
                                     },
                             'es' => {'msg_range' => 'Mostrando (\d+)-(\d+) de (\d+)',
                                      'no_msgs'   => 'La\s*carpeta\s*Bandeja\s*de\s*entrada\s*está\s*vacía',
                                      'p_view'    => 'Vista para imprimir',
                                      'headers'   => {'Para:'        => 'To:',
                                                      'De:'          => 'From:',
                                                      'Asunto:'      => 'Subject:',
                                                      'Responder a:' => 'Reply-To:',
                                                      'Fecha:'       => 'Date:'
                                                     }
                                      },
                             'de' => {'msg_range' => 'werden (\d+)-(\d+) von (\d+)',
                                      'no_msgs'   => 'Der\s*Ordner\s*Posteingang\s*hat\s*keine\s*Nachrichten',
                                      'p_view'    => 'Druckansicht',
                                      'headers'   => {'An:'                 => 'To:',
                                                      'Von:'                => 'From:',
                                                      'Betreff:'            => 'Subject:',
                                                      'Antwort-an-Adresse:' => 'Reply-To:',
                                                      'Datum:'              => 'Date:'
                                                     }
                                     },
                             'it' => {'msg_range' => 'mostra (\d+)-(\d+) di (\d+)',
                                      'no_msgs'   => 'La\s*cartella\s*In\s*arrivo\s*non\s*contiene\s*messaggi',
                                      'p_view'    => 'Anteprima&nbsp;di&nbsp;stampa',
                                      'headers'   => {'A:'        => 'To:',
                                                      'Da:'       => 'From:',
                                                      'Oggetto:'  => 'Subject:',
                                                      'Rispondi:' => 'Reply-To:',
                                                      'Data:'     => 'Date:'
                                                     }
                                     },
                             'br' => {'msg_range' => 'exibindo (\d+)-(\d+) de (\d+)',
                                      'no_msgs'   => 'A\s*pasta\s*Caixa\s*de\s*entrada\s*não',
                                      'p_view'    => 'Visualizar&nbsp;impressão',
                                      'headers'   => {'Para:'           => 'To:',
                                                      'De:'             => 'From:',
                                                      'Assunto:'        => 'Subject:',
                                                      'Responder-para:' => 'Reply-To:',
                                                      'Data:'           => 'Date:'
                                                     }
                                     }
                            );
			 
    if ($strings = $localized_strings{$cc}) {
        return %$strings;
    } else {
        return 0;
    }
}

sub Clean($) {
    my ($string) = @_;

    $string =~ s/<.*?>//gs ;     # strip all raw html tags
    $string =~ s/\&\#34;/\"/g ;  # convert html character codes 
    $string =~ s/\&\#39;/\'/g ;
    $string =~ s/\&\#147;/\"/g ;
    $string =~ s/\&\#148;/\"/g ;
    $string =~ s/\&\#183;/./g ;
    $string =~ s/\&\#8217;/\'/g ;
    $string =~ s/\&\#8220;/\"/g ;
    $string =~ s/\&\#8221;/\"/g ;
    $string =~ s/\&\#8230;/.../g ;
    $string =~ s/\&nbsp;/ /gi ;
    $string =~ s/\&lt;/</gi ; 
    $string =~ s/\&gt;/>/gi ; 
    $string =~ s/\&amp;/\&/gi ;   
    $string =~ s/\&quot;/\"/gi ;
    $string =~ s/^\s+//g;         # strip leading whitespace
    return $string;
}