#!/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 or to an IMAP server.
# Author:  Ravi Ramkissoon
# Author's E-mail: ravi_ramkissoon@yahoo.com
# License: Gnu Public License
# Homepage: http://fetchyahoo.sf.net
# Created: 04.12.02
# Modified: 04.12.12
my $version = "2.14.7";
#
# Installation instructions are in the INSTALL file.

# for the latest version and changes check, in order:
# http://fetchyahoo.sf.net
# http://freshmeat.net/projects/fetchyahoo
###############################################################################
# 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.

# 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.
###############################################################################
# md5_hex modified from Digest::Perl::MD5 module - relevant copyright info
# This library is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#
# Copyright 2000 Christian Lackas, Imperia Software Solutions
# Copyright 1998-1999 Gisle Aas.
# Copyright 1995-1996 Neil Winton.
# Copyright 1991-1992 RSA Data Security, Inc.
#
# Distributed here under the GPL as allowed under the Perl license.
###############################################################################
use strict;
use integer;

use FileHandle ();
use Getopt::Long ();
use HTTP::Request::Common qw(GET POST);
use HTTP::Cookies ();
use LWP::UserAgent ();
use MIME::Head ();
use MIME::Entity ();
use MIME::Parser ();
sub GetRedirectUrl($);
sub GetEmailAddress($);
sub ParseConfigFile();
sub Localize($);
sub EmptyTrash($);
sub EmptyBulk($);
sub Logout();
sub DeleteOrArchive(@);
sub MarkRead(@);
sub MyDie($);
sub MyGet;
sub checkExternal();
sub GetFormInputs();
sub safeSleep;
sub getNewHeaderAndBody(@);
sub Clean($);
sub PopulateMap();

# code generation for md5_hex routine
gen_code();

# Configure these or use the interactive input
my $username = 'yahoo-user-name';
# this can be a password or an md5_hex hashed password
my $password = 'yahoo-password';

# mail spool, mbox file and procmail configs
my $useSpool  = 1;      # set this to 0 to disable outputting to a file/folder
# if spoolName ends with a / we output in maildir format to that directory
my $spoolName = '/var/spool/mail/local-user-name';
my $spoolMode = 'append';       # either 'append', 'pipe' or 'overwrite'
                                # use 'pipe' for procmail or other filter
                                # ignored if spoolName is a maildir directory

# set the below to 1 to remember which messages were downloaded and not
# download them again - especially useful with the leaveUnread option
my $useMsgIDArchive=0;
my $msgIDArchiveFile='/path/to/file-to-store-msg-ids';

# set the below to 1 to move messages to a folder to archive them
# this is very useful with Yahoo's new increased storage limits
my $useArchiveFolder=0;
my $archiveFolder="Archive-Folder-to-Move-Messages-To";

# IMAP configuration
my $useIMAP  = 0;      # set this to 1 to save to IMAP folder
my $secureIMAP = 0;    # set this to 1 to use secure IMAP (IMAPS)
my $imapServer = 'imap.example.com';
my $imapPort = '143';
my $imapUser = 'imap-user-name';
my $imapPass = 'imap-password';
my $imapMailbox = 'INBOX';

# proxy configs
my $useProxy = 0;               # set this to 1 to enable use of a web proxy
my $proxyHost = 'proxy.example.com';
my $proxyPort = 80;
my $proxyUser = 'proxyAuthenicationUserName';
my $proxyPass = 'proxyAuthenicationPassword';

my $useHTTPS = 1;               # set this to 0 to turn off HTTPS and transfer
                                # all information in plaintext (INSECURE)
                                # using HTTPS requires Crypt::SSLeay or
                                # IO::Socket::SSL

# mail forwarding configs
my $useForward = 0;             # set this to 1 to enable mail forwarding
my $mailHost = 'outgoing.example.com'; # your smtp outgoing mail server

# to use SMTP authentication, set these to your SMTP username and password
my $smtpUsername = 'my-smtp-username';
my $smtpPassword = 'my-smtp-password';

# list of e-mail addressess to be forwarded to
my $sendToAddresses = [ 'me@example.com' , 'me2@example.com' ];

# the e-mail address to use as the from address. This is used only if the
# message being forwarded has no From header
my $sendFromAddress = 'me@example.com'; 

# if you want to send msgs using sendmail, set the below 2 parameters
my $useSendmail = 0;
my $sendmail = "/usr/sbin/sendmail"; # Location of sendmail

# 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 $noerrors = 0; # to suppress error output, set this to 1
my $debug = 0;    # to turn on debug output set to 1. unsets quiet and noerrors
my $noDownload = 0;     # to delete msgs and not download them, set this to 1
my $listMsgs = 0;       # to list messages, set this to 1
my $emptyBulk = 0;      # to empty bulk folder (always happens before fetch)
my $emptyTrashAfter = 0;  # to empty trash after downloading msgs set this to 1
my $emptyTrashBefore = 0; # to empty trash b4 downloading msgs, set this to 1 
my $logout = 0;          # to have fetchyahoo logout at the end, set this to 1
my $leaveUnread=0;    # to leave messages as unread on the server,set this to 1
my $noFromLine=0;     # if you use a program/filter which doesn't expect a 
                      # From_ line appended to the message, set this to 1
my $statusOnly=0;     # if you want only the number of messages, set this to 1
my $box = 'Inbox';    # to download from a different folder, set this
                      # eg 'Bulk' will get messages from the Bulk folder
                      # this can also be a comma-separated list of folders
my $getExternal=0;  # if set to 1, messages from external mailboxes
                           # configured on Yahoo will also be retrieved
my @externalMailBoxes=(); # if set get only these external mailboxes

# IMPORTANT Yahoo gives trouble when downloading over 400 messages at a time
# Setting this to more than 400 (or 0 for unlimited) may cause problems.
my $maxMessages = 400; # max number of messages to download in one go
my $maxSize = 0; # skip msgs larger than N kB
my $warningLevel = 0;  # warn if server mailbox usage is >= N% (ignore if 0).
my $cookieFile = undef; # file to read cookies from and write cookies to

# if this is set to 1, then maxMessages is ignored and we will sleep for
# a few seconds before downloading every message. This makes downloading much
# slower but should prevent Yahoo from throttling us.
my $safeDownload = 0;
my $safeSleepTime = 10; # sleep time between messages for safeDownload option

# use LWP::Debug qw(+);        # uncomment this for lots of debugging messages

#### These attributes are user-editable but the defaults should be sufficient
my $retries = 3;       # number of times to retry a failed session
my $retryPause = 5;    # initial time, in seconds, to sleep between retries
                       # time is doubled on each subsequent retry
my $userAgent = 
"Mozilla/5.0 (X11; U; Linux i686; en-US; rv:1.7.8) Gecko/20050512 Firefox/1.5.0.5";
#"Mozilla/5.0 (X11; Linux x86_64) AppleWebKit/535.2 (KHTML, like Gecko) Chrome/15.0.874.120 Safari/535.2";

#### Nothing below here is intended for user configuration
my $loginURL = 'http://login.yahoo.com/config/login?ymv=0&.intl=us&.partner=&.last=&.src=ym&.done=http%3a//edit.yahoo.com/config/mail%3fymv%3d0';
my $HTTPSloginURL = 'https://login.yahoo.com/config/login?ymv=0&.intl=us&.partner=&.last=&.src=ym&.done=http%3a//edit.yahoo.com/config/mail%3fymv%3d0';
my $versionString = "FetchYahoo Version " . $version . "\n" .
  "Homepage: http://fetchyahoo.sourceforge.net\n";
my $maxMidsPerURL = 35;
my $localHostname;
eval ("use Socket");
if ($@) { $localHostname = 'localhost'; }
else {
  eval("use Sys::Hostname");
  if ($@) { $localHostname = 'localhost'; }
  else { ($localHostname) = eval("gethostbyname(hostname)"); }
}

# other variables used
my $overwriteFlag = 0;
my $spool;
my $proxyURL;
my $smtp;
my $altConfigFile;
my $maildirDeliveryCount = 0;
my $exit_code = 0;     # default exit code
my $retryCount = $retries;
my $imap = undef;

# flag for help, version and md5hex
my $helpFlag = 0;
my $versionFlag = 0;
my $getMD5HexFlag = 0;
my $useReadKey=0;
my $yahooVersion = 0;
my $response;
my %extmap  = ();     # hash for extension->MIMEtype mappings

my $help = <<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                         display help showing the program options
--quiet                        suppress regular (non-error) messages
--noerrors                     suppress error messages
--debug                        turn on normal and debugging output
--listmessages                 list messages in mail folder
--onlylistmessages             only list messages in mail folder. This combines
                               --listmessages, --nodownload and --nodelete

--configfile=config-file       use config-file as the configuration file
--username=yahoousername       use yahoousername as the login
--password=pass                use pass as the password. pass can also be an
                               md5_hex hashed password.
--spoolfile=spool-file         use spool-file as the file to spool messages to
                               if spool-file ends with / it is treated as a
                               maildir format directory
--folders=folder1,folder2      download messages from one or more folders instead

--nohttps                      use an insecure plaintext login instead of HTTPS
--newonly                      only download new (i.e. unread) messages
--nodelete                     do not delete messages after downloading them
--nodownload                   do not download messages 
                               (but still delete them/empty trash if requested)
--safedownload                 sleep a few seconds between messages. This
                               disables use of maxmessages and takes much
                               longer to download messages but should prevent
                               throttling by Yahoo

--append                       append messages to spool-file (default)
--overwrite                    overwrite spool-file (instead of appending)
--pipe                         pipe messages to a program instead of
                               a spool-file
--msgidarchivefile=file-name   save message IDs to this file and do not download
                               messages whose IDs have been saved to this file
--archivefolder=folder-name    move messages to this Yahoo folder

--sendto=emailaddress1,email2  list of e-mail address to forward e-mails to
--mailhost=smtp.example.com    smtp outgoing mail server to use to send mail
--sendfrom=fromaddress         e-mail address to use as the from address
--smtpusername=username        username for SMTP authentication
--smtppassword=password        password for SMTP authentication

--emptytrash                   empty trash before downloading messages
--emptytrashbefore             empty trash before downloading messages
--emptytrashafter              empty trash after downloading messages
--emptybulk                    empty bulk mail folder (always before fetch)
--leaveunread                  leave messages unread on the server
--repeatinterval=N             check for mail every N minutes (daemon mode)
--statusonly                   only get number of messages
--getexternal                  retrieve messages from external mailboxes also
--externalmailboxes=boxes,list retrieve messages from only this comma-separated
                               list of external mailboxes
--maxmessages=N                download at most N messages in one run
                               setting this to over 90 may cause problems
                               [DEFAULT 90]
--maxsize=N                    do not download any msg larger than N kB
                               setting to 0 will turn off this check
                               [DEFAULT 0]
--warninglevel=N               warn if the server mailbox is >= N% full
                               setting to 0 will turn off the warning
                               [DEFAULT 0]

--nofromline                   leave out the leading From_ line
--logout                       log out of Yahoo! when done

--md5hex                       print the MD5 hex hash value of a password
                               entered interactively (can be used instead of
                               password in configuration files)

--proxyhost=proxy.host.org     hostname for proxy [ DEFAULT off ]
--proxyport=N                  port for proxy [DEFAULT 80 ]
--proxyuser=proxy-user         username for proxy authentication[ DEFAULT none]
--proxypass=proxy-pass         password for proxy authentication[ DEFAULT none]

--imaphost=imap.host.org       hostname of IMAP sever [ DEFAULT off ]
--imapport=N                   port for IMAP server [DEFAULT 143 ]
--imapuser=imap-user           username for IMAP authentication[ DEFAULT none]
--imappass=imap-pass           password for IMAP authentication[ DEFAULT none]
--imapmailbox=imap-mailbox     IMAP mailbox [ DEFAULT INBOX]
--secureimap                   use secure IMAP (IMAPS) [ DEFAULT off ]

--noquiet                      opposite of --quiet [DEFAULT]
--errors                       opposite of --noerrors [DEFAULT]
--delete                       opposite of --nodelete [DEFAULT]
--nodebug                      opposite of --nodebug [DEFAULT]
--nolistmessages               opposite of --listmessages [DEFAULT]
--nologout                     opposite of --logout [DEFAULT]
--noempty                      do not empty trash or bulk [DEFAULT]
--allmsgs                      get all msgs (not only new ones) [DEFAULT]
--download                     opposite of --nodownload [DEFAULT]
--includefromline              opposite of --nofromline [ DEFAULT ]
--markread                     opposite of --leaveunread [ DEFAULT ]
--nostatusonly                 opposite of --statusonly [ DEFAULT ]
--nogetexternal                opposite of --getexternal [ DEFAULT ]
--nosafedownload               opposite of --safedownload [ DEFAULT ]
--https                        use a secure login via HTTPS [ DEFAULT ]
--cookiefile=filename          read/save cookies from/to file [DEFAULT none]
--nosecureimap                 do not use secure IMAP (IMAPS) [ DEFAULT ]

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

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();

# bugfix, if useForward is 0, reset sendToAddresses
# if sendToAddresses are specified on the commandline, we auto-set useForward
if (!$useForward)
{
  $sendToAddresses = [ 'me@example.com' , 'me2@example.com' ];
}

# get other command-line input options. These take precedence over all others
Getopt::Long::Configure('no_pass_through');
Getopt::Long::GetOptions
(
 'newonly'           => \$newOnly,
 'help'              => \$helpFlag,
 'md5hex'            => \$getMD5HexFlag,
 'version'           => \$versionFlag,
 'nodelete'          => \$noDelete,
 'username=s'        => \$username,
 'password=s'        => \$password,
 'spoolfile=s'       => \$spoolName,
 'quiet!'            => \$quiet,
 'debug!'            => \$debug,
 'noerrors'          => \$noerrors,
 'nodownload'        => \$noDownload,
 'emptybulk'         => \$emptyBulk,
 'emptytrash'        => \$emptyTrashBefore,
 'emptytrashafter'   => \$emptyTrashAfter,
 'emptytrashbefore'  => \$emptyTrashBefore,
 'logout!'           => \$logout,
 'statusonly!'       => \$statusOnly,
 'repeatinterval=i'  => \$repeatInterval,
 'noempty'           => sub {$emptyTrashAfter=0;$emptyTrashBefore=0
                               ;$emptyBulk=0},
 'download'          => sub { $noDownload=0; },
 'allmsgs'           => sub { $newOnly=0; }, 
 'delete'            => sub { $noDelete=0; },
 'leaveunread'       => \$leaveUnread,
 'nofromline'        => \$noFromLine,
 'markread'          => sub { $leaveUnread=0; },
 'includefromline'   => sub { $noFromLine=0; },
 'errors'            => sub { $noerrors=0; },
 'pipe'              => sub { $spoolMode='pipe'; },
 'append'            => sub { $spoolMode='append'; },
 'overwrite'         => sub { $spoolMode='overwrite'; },
 'folder=s'          => \$box ,
 'folders=s'          => \$box ,
 'getexternal!'      => \$getExternal,
 'externalmailboxes:s' => \@externalMailBoxes,
 'proxyhost=s'       => sub { $proxyHost= $_[1] ; $useProxy=1;},
 'proxyport=s'       => \$proxyPort,
 'proxyuser=s'       => \$proxyUser,
 'proxypass=s'       => \$proxyPass,
 'smtpusername=s'       => \$smtpUsername,
 'smtppassword=s'       => \$smtpPassword,
 'imaphost=s'        => sub { $imapServer= $_[1] ; $useIMAP=1;},
 'imapport=s'        => \$imapPort,
 'imapuser=s'        => \$imapUser,
 'imappass=s'        => \$imapPass,
 'imapmailbox=s'     => \$imapMailbox,
 'sendto:s'          => \@$sendToAddresses,
 'mailhost=s'        => \$mailHost,
 'sendfrom=s'        => \$sendFromAddress,
 'https!'            => \$useHTTPS ,
 'maxmessages=i'     => \$maxMessages,
 'maxsize=i'         => \$maxSize,
 'warninglevel=i'    => \$warningLevel,
 'cookiefile=s'      => \$cookieFile,
 'listmessages!'     => \$listMsgs,
 'safedownload!'     => \$safeDownload,
 'secureimap!'       => \$secureIMAP,
 'onlylistmessages!' =>
     sub {$listMsgs=1; $noDownload=1;$noDelete=1;$useArchiveFolder=0;},
 'msgidarchivefile=s'=> sub {$useMsgIDArchive=1 ; $msgIDArchiveFile=$_[1];},
 'nomsgidarchivefile'=> sub {$useMsgIDArchive=0; },
 'archivefolder=s'=> sub {$useArchiveFolder=1 ; $archiveFolder=$_[1];},
 'noarchivefolder'=> sub {$useArchiveFolder=0; }
);

# substitute $username in $spoolname
$spoolName =~ s/\$username/$username/;

# set some required variables

# if $debug is set, unset $quiet and $noerrors
if ($debug) { $quiet = 0 ; $noerrors = 0; }

# if safeDownload is set, disable use of maxMessages
if ($safeDownload) { $maxMessages = 1000000; }

if (scalar(@$sendToAddresses) > 1 &&
    grep(/\@myhost.com$/,@$sendToAddresses) ) {
     splice @$sendToAddresses, 0, 1;
}
if (scalar(@$sendToAddresses) > 2 &&
    grep(/\@example.com$/,@$sendToAddresses) ) {
     splice @$sendToAddresses, 0, 2;
}
   
if (scalar(@$sendToAddresses) &&
    !grep(/\@example.com$/,@$sendToAddresses) &&
    !grep(/\@myhost.com$/,@$sendToAddresses) )  {
  @$sendToAddresses=split(/,/,join(',',@$sendToAddresses));
  $useForward = 1;
  if ($spoolName eq "/var/spool/mail/local-user-name") {
    print "Only forwarding e-mail, local delivery turned off.\n" unless $quiet;
    $useSpool = 0;
  }
}

if ($externalMailBoxes[0]) {
  @externalMailBoxes=split(/,/,join(',',@externalMailBoxes));
}

# Old code supporting only a single mail folder
#
#if ($box eq 'bulk' || $box eq 'Bulk') { $box = "%40B%40Bulk"; }
#if ($box eq 'sent') { $box = "Sent"; }
#if ($box eq 'draft') { $box = "Draft"; }
#if ($box eq 'trash') { $box = "Trash"; }
#if ($box eq 'inbox') { $box = "Inbox"; }

#my $homesuff = '/ym/ShowFolder?ymv=0&box='.$box;
#my $msgsuff = $homesuff.'&PRINT=1&Nhead=f&toc=1&MsgId=';
#$box =~ s/%/%%/g ;                  # fix  for template which is used in printf
#my $bodyPartUrlTemplate = "/ym/ShowLetter?ymv=0&box=".$box."&MsgId=%s&bodyPart=%s";

#Multiple folder support added by sniper11

my @folder=split(/,/,$box);
my @orig_folder=split(/,/,$box);
my $noOfFolders=@folder-1;
my $count=0;
for($count=0;$count<=$noOfFolders;$count++){
  if ($folder[$count] eq 'bulk' || $folder[$count] eq 'Bulk')
  { $folder[$count] = "%40B%40Bulk"; }

  if ($folder[$count] eq 'spam' || $folder[$count] eq 'Spam')
  { $folder[$count] = "%40B%40Bulk"; }

  if ($folder[$count] eq 'sent') { $folder[$count] = "Sent"; }
  if ($folder[$count] eq 'draft') { $folder[$count] = "Draft"; }
  if ($folder[$count] eq 'trash') { $folder[$count] = "Trash"; }
  if ($folder[$count] eq 'inbox') { $folder[$count] = "Inbox"; }

  $folder[$count] =~ s/ /%2520/g;
}

# For a proxy with authentication, create a URL like
# http://user:pass@host:port/
unless ($proxyPass eq 'proxyAuthenicationPassword') {
    $proxyHost = $proxyPass . '@' . $proxyHost; }
unless ($proxyUser eq 'proxyAuthenicationUserName') {
    $proxyHost = $proxyUser . ':' . $proxyHost; }

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

if ( $useProxy && $proxyHost eq "proxy.hostname.com" &&
     exists ($ENV{'HTTP_PROXY'}) ) {
    $proxyURL = $ENV{'HTTP_PROXY'}; 
}

if ( $useProxy && $proxyHost eq "proxy.hostname.com" &&
     exists ($ENV{'http_proxy'}) ) {
    $proxyURL = $ENV{'http_proxy'}; 
}

# if useMsgIDArchive is set, an archive file must be chosen
if ( $useMsgIDArchive && $msgIDArchiveFile eq "/path/to/file-to-store-msg-ids") {
    print "If you are using an archive to store message IDs (useMsgIDArchive=1), you must" .
        " specify a msgIDArchiveFile to store the message IDs in .\n\n";
    print $versionString . "\n" ; exit;
}

# if useArchiveFolder is set, an archive folder must be chosen
if ( $useArchiveFolder && $archiveFolder eq "Archive-Folder-to-Move-Messages-To") {
    print "If you are using a Yahoo folder to archive messages (useArchiveFolder=1), you must" .
        " specify a Yahoo folder to move messages to.\n\n";
    print $versionString . "\n" ; exit;
}

$loginURL = $HTTPSloginURL if ($useHTTPS) ;

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

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

# if --md5hex was requested, do that and exit
if ($getMD5HexFlag) {

  my $password2 = '';

  # check for Term::ReadKey
  eval ("use Term::ReadKey");
  if ($@) {
  print "\n* WARNING * Term::ReadKey is not installed. ".
    "Your password will be displayed on the screen.\n\n".
    "Either Ctrl-C and install Term::ReadKey or ".
    "make sure noone is looking at your screen.\n\n";
  }
  else { $useReadKey = 1; }

  gethash:
  print "Please enter the password to hash: ";
  if ($useReadKey) {
    ReadMode('noecho');          #hide output
    $password = ReadLine(0);     #get input
    ReadMode('normal');          #back to normal mode
  }
  else { $password = <STDIN>; }
  chomp($password);

  print "\nPlease enter the password again: ";
  if ($useReadKey) {
    ReadMode('noecho');          #hide output
    $password2 = ReadLine(0);     #get input
    ReadMode('normal');          #back to normal mode
  }
  else { $password2 = <STDIN>; }
  chomp($password2);

  if ($password ne $password2) {
    print "\n\nPasswords do not match, try again.\n\n";
    goto gethash;
  }

  print "\n\nThe md5hex password hash is " . md5_hex($password) . "\n" .
  "You can use this instead of your password when using FetchYahoo.\n\n";
  exit;
}

# check for common errors (forgot to edit variables)
if ($username eq 'yahoo-user-name')  {
    print "No username specified.\nPlease enter your Yahoo! username: ";
    $username = <STDIN> ;
    chomp($username);
    $password = 'yahoo-password';
}

if ($password eq 'yahoo-password')  {

  # check for Term::ReadKey
  eval ("use Term::ReadKey");
  if ($@) {
  print "\n* WARNING * Term::ReadKey is not installed. ".
    "Your password will be displayed on the screen.\n\n".
    "Either Ctrl-C and install Term::ReadKey or ".
    "make sure noone is looking at your screen.\n\n";
  }
  else { $useReadKey = 1; }

  print "Please enter your Yahoo! password: ";
  if ($useReadKey) {
    ReadMode('noecho');          #hide output
    $password = ReadLine(0);     #get input
    ReadMode('normal');          #back to normal mode
  }
  else { $password = <STDIN>; }
  chomp($password);
}

if ( $useSpool && $spoolName eq "/var/spool/mail/local-user-name") {
    print "No mailbox or mailspool specified.\n";
    print "Please enter the path to and name of your mail spool or mailbox ".
      "(eg /var/spool/mail/username): ";
    $spoolName = <STDIN>;
    chomp($spoolName);
}

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

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" ; exit; 
}

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

    if ($useProxy) { print "Using $proxyURL as a webproxy.\n" }
    if ($repeatInterval>0) { 
      print "Running in daemon mode. Will check every $repeatInterval" . 
      " minutes.\n"; }
    if ($safeDownload)
    {
        print "Using safeDownload, maxMessages disabled. Sleeping " . $safeSleepTime .
          " seconds between messages\n";
    }
}

if ($useForward) {  # check that everything is setup for mailforwarding

  if ( !scalar(@$sendToAddresses) ||
       grep(/\@example.com$/,@$sendToAddresses) ||
       grep(/\@myhost.com$/,@$sendToAddresses) ) {
    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" ; exit; 
  }

  if (  !$useSendmail and
       ( $mailHost eq 'outgoing.example.com' ||
         $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" ; exit; 
  }

  # make sure Net::SMTP is installed for mail-forwarding
  # if (!$useSendmail) { eval ("use Net::SMTP::SSL"); }
  if (!$useSendmail) { eval ("use Net::SMTP"); }
  if ($@) {
    die "Net::SMTP is not installed. It must be installed to use ". 
      "mail-forwarding\n";
  }

  # Try to find the sendmail binary (look in common locations)
  if ($useSendmail && !(-x $sendmail)) {
    if (-x "/usr/sbin/sendmail") {
       $sendmail = "/usr/sbin/sendmail";
    }
    elsif (-x "/usr/lib/sendmail") {
       $sendmail = "/usr/lib/sendmail";
    }
    else {
      die "Couldn't find local sendmail program";
    }
  }

  # we only setup the smtp connection if we find messages
}

if ($useIMAP) {  # check that everything is setup for IMAP forwarding

    if ( $imapServer eq 'imap.example.com') {
  print "If you are saving messsages to an IMAP folder(use-imap=1), " .
      "you must specify an IMAP server" . 
      " (localhost if you have one installed locally).\n\n";
  print $versionString . "\n" ; exit; 
    }

    if ( $imapUser eq 'imap-user-name') {
  print "If you are saving messsages to an IMAP folder(use-imap=1), " .
      "you must specify an IMAP user name.\n\n";
  print $versionString . "\n" ; exit; 
    }

    if ( $imapPass eq 'imap-password') {
  print "If you are saving messsages to an IMAP folder(use-imap=1), " .
      "you must specify an IMAP password.\n\n";
  print $versionString . "\n" ; exit; 
    }

    # make sure Mail::IMAPClient is installed for IMAP-forwarding
    eval ("use Mail::IMAPClient");
    if ($@) {
  die "Mail::IMAPClient is not installed. It must be installed to save ". 
      "messages to an IMAP folder.\n";
    }

}

# make sure the cookie file is valid if it has been specified
if ($cookieFile) {
  open(TEMPCOOKIEFILE, "+>>".$cookieFile) or die "Can't open file $cookieFile : $!";
  print TEMPCOOKIEFILE "#LWP-Cookies-1.0";
  close(TEMPCOOKIEFILE);
}

# if daemon mode is chosen, fork into the background
if ($repeatInterval>0) {
    print "Forking into the background.\n" unless $quiet ;
    $SIG{CHLD} = 'IGNORE';
    my $pid = fork;
    exit if $pid;
    die "Couldn't fork into background: $!" unless defined ($pid) ;
}

$retryCount = $retries ;  # reset the number of retries

startfetch:

$exit_code = 0;   # reset the exit code

# grab login cookies
my $ua = LWP::UserAgent->new;
my $cookie_jar = HTTP::Cookies->new( $cookieFile ? (file=>$cookieFile, autosave=>1) : () );
my $url = "";
my $request;

$ua->cookie_jar($cookie_jar);
$ua->agent($userAgent);
if ($useProxy) {
    if ($useHTTPS) {
      $ua->proxy('http', 'http://' . $proxyHost . ':' . $proxyPort);
      $ENV{HTTPS_PROXY} = $proxyURL;
    } else {
      $ua->proxy('http', $proxyURL);
    }
}

# this does the initial login, we need to get the challenge and send a hash
# of the password and the challenge
my %PROPS = GetFormInputs();
if (!defined $PROPS{'.challenge'}) {
  # we have failed logging in, print a message and continue
  # better luck next time
    MyDie("Failed: Couldn't get challenge to log in. Try again later.\n");
}

$request = POST $loginURL, [ %PROPS ];

$request->content_type('application/x-www-form-urlencoded');
$request->header('Accept' => '*/*');
$request->header('Allowed' => 'GET HEAD PUT');

my $content = MyGet($request, 'log in', 1);

if ( $content =~ /Invalid Password/ ) {
    MyDie("Failed: Wrong password entered for $username\n"); 
}

if ( $content =~ /Invalid\s*ID\s*or\s*password/ ) {
    MyDie("Failed: Invalid ID or password entered (username: $username )\n"); 
}

if ( $content =~ /ID does not exist/ ) {
    MyDie("Failed: Yahoo user $username does not exist\n");
}

# set localization strings
my %strings;
my %englishStrings;
my $language;

if ( $url =~ /https?:\/\/(..)\./ ) {
  $language = $1;
  %strings = Localize($1);
  %englishStrings = Localize('us');
}
else {
  # sometimes yahoo tells us to try again, we pass the message along
  # this occurs so frequently that i'm not treating it as an error
  if ($content =~ /^HTTP\/1.1 999 This page is currently unavailable/ ||
      $content =~ /^HTTP\/1.1 999 Unable to process request at this time/) {
    print "Yahoo! mail is currently unavailable. Please try again later.\n\n"
      unless $quiet;
  }
  else # i'd like to know if this is ever reached and why
  {
    print "$content\n\n$url\n\n",
          "Could not get main Yahoo mail page.\n\n",
          '<<< Please check http://fetchyahoo.sf.net for a version newer ' ,
          " than this version ( $version ) \n",
          'If there is no newer version, please e-mail this output ',
          'to ravi_ramkissoon@yahoo.com >>>'."\n\n"
       unless $noerrors || $retryCount; # suppress error unless the last try
  }
  print $request->uri()."\n" unless $quiet;
  $exit_code=1;
  goto fetch_exit;
}

# Old code supporting only a single mail folder
# 
#if ($box eq '%%40B%%40Bulk') { $box = 'Bulk'; }
#if (!$quiet) {
#    print "Successfully logged in as $username.\n"; 
#    print "Country code : $language\tFolder: $box\tVersion: $version\n";
#}

#Multiple folder support added by sniper11

my $foldernum=-1;
my $homesuff;
my $msgsuff;
my $bodyPartUrlTemplate;

if ($debug) {
    print "\n\nINITIAL LOGIN PAGE\n\n$content\n\nEND INITIAL LOGIN PAGE\n\n";
}

my $baseurl;
if ($content =~ /(http:\/\/[a-z.0-9-]*?)\/mc/ ||
    $url =~ /(http:\/\/[a-z.0-9-]*?)\/neo/) {
    $baseurl = $1;
    if ($debug) { print "Base url is $baseurl\n"; }

    # I do not know why this works.
    $baseurl =~ s/\.mg/\.mc/;

    # us.mc1.mail.yahoo.com doesn't work
    $baseurl =~ s/\.mc1\./\.mc2\./;
    if ($debug) { print "New base url is $baseurl\n\n"; }
}
else {
  # could not get a base url, print debug output on last retry
  print "\n\nINITIAL LOGIN PAGE\n\n$content\n\nEND INITIAL LOGIN PAGE\n\n"
      unless $noerrors || $retryCount || $debug;
  print "$url\n\n",
        "Could not get initial logged-in page for base url.\n\n",
        '<<< Please check http://fetchyahoo.sf.net for a version newer ' ,
        " than this version ( $version ) \n",
        'If there is no newer version, please e-mail this output ',
        'to ravi_ramkissoon@yahoo.com >>>'."\n\n"
     unless $noerrors || $retryCount; # suppress error unless the last try
  $exit_code=5;
  goto fetch_exit;
}

print "Country code : $language\tFetchYahoo! Version: $version\n".
  "Successfully logged in as $username.\n" unless $quiet;

# if requested, print summaries for external mailboxes
if ($getExternal) { checkExternal(); }

if ( $newOnly) {
    print "Only retrieving new messages\n" unless $quiet;
}

if ( $leaveUnread) {
    print "Leaving messages unread on the server\n" unless $quiet;
} else
{
    print "Marking messages read on the server\n" unless $quiet;
}

if ( $useMsgIDArchive) {
     print "Using ".$msgIDArchiveFile." as a message ID archive\n"
       unless $quiet;
}

if ( $useArchiveFolder) {
     print "Moving messages to Yahoo folder: ".$archiveFolder."\n"
       unless $quiet;
}

my $homesuffix = '/ym/ShowFolder?ymv=0&box=' ;
my $bodyPartUrlPrefix = "/ya/download?ymv=0&MsgId=%s&bodyPart=%s&box=";

# This is the loop over selected folders
getDiffFolder:
    $foldernum++;

my $safeName = $folder[$foldernum];
$safeName =~ s/%/%%/g;

$bodyPartUrlTemplate = $bodyPartUrlPrefix.$safeName;
if ($yahooVersion == 1)
{
   $homesuffix = "/mc/showFolder?ymv=0&Npos=0&noFlush&fid=";
   $bodyPartUrlTemplate =
        '/ya/download?clean=0&fid='.$safeName.'&mid=%s&pid=%s&tnef=&ymv=0';
}

$homesuff = $homesuffix . $folder[$foldernum];
$msgsuff = $homesuff.'&PRINT=1&Nhead=f&toc=1&MsgId=';

if ($yahooVersion != 1 ||  $foldernum > 0)
{
  print "\nFetching mail from folder: $orig_folder[$foldernum]\n"
    unless $quiet;
}

# setup URLs
my $homeurl = $baseurl . $homesuff ;
my $msgurl = $baseurl . $msgsuff ;
# my $logouturl = $baseurl . "/ym/Logout"; # old, broken logouturl, doesn't work
my $logouturl = "http://login.yahoo.com/config/login?logout=1&.src=ym";
my $numurls = 0;
my @delurls;
my @delmids;
my @readurls;
my @readmids;
my $emptyurl;

if ( $newOnly) {
    $homeurl = $homeurl . "\&Nview=u\&filterBy=unread";
}

$delurls[0] = $homeurl . "\&DEL=Delete";
$readurls[0] = $homeurl . "\&FLG=1&flags=read";

# get all message IDs
my $msgcount = 0;
my $pagecount = 0;
my $numMsgs ;
my $startMsg ;
my $endMsg = 0 ;
my @msgids ;
my $crumb;
# JWB -- Added @msgnew to keep the original status of a message
my @msgnew;

@msgids = (); # in case we're fetching more than one folder
@msgnew = (); # ditto

# if we are emptying trash or bulk we need a folders listing to get the URL
if ($emptyTrashBefore or $emptyBulk) {
    if ($yahooVersion==1)
    { $request = GET  $baseurl . "/mc/welcome" ; }
    else
    { $request = GET  $baseurl . "/ym/Folders?ymv=0" ; }
    $content = MyGet($request, 'get Folders listing for Empty Bulk/Trash', 0);

    # parses out quota used/limit (by looking for 'xx% ... xxMB')
    # BUG we only do this if EmptyTrashBefore or EmptyBulk is selected
    # doing it everytime would require an extra load of the folder listing,
    # slowing down every fetch
    if ( $content =~ /(\d+(?:\.\d+)?)%.+?(\d+(?:\.\d+)?)([MG]B)/ ) {
      my ($percentUsed, $limitMB, $limitUnit) = ($1, $2, $3);
      if($foldernum==0){
        printf "You are using %s%% of your %s%s limit.\n",
          $percentUsed, $limitMB, $limitUnit unless $quiet;
        if( $warningLevel && $percentUsed >= $warningLevel){
          printf "Warning: You are using %s%% of your %s%s limit ".
              "(warning-level=%d%%).\n", $percentUsed, $limitMB, $limitUnit, $warningLevel
              unless $noerrors;
        }
      }
    }
}

# empty trash before downloading messages, if requested
# parsing the empty trash URL from a parsed inbox summary page does NOT work
# because it changes message IDs so deleting messages would fail
if($foldernum==0){
  if ($emptyTrashBefore and $content ne "FAILED") { EmptyTrash($content); }
  if ($emptyBulk and $content ne "FAILED") { EmptyBulk($content); }
}

# loop over all inbox summary pages
startDownload:
my $mainPage;
my $oldStartMsg = -1;
my $classicHost;

do {

  # get summary page
  my $startMid = $endMsg;
  my $tmpurl = $homeurl .
    "\&Npos=$pagecount&order=down&sort=date&startMid=$startMid" ;

  $request = GET  $tmpurl ;
  $mainPage = MyGet($request, 'get Folder '.$folder[$foldernum].' listing', 0);
  if ($yahooVersion==0 and $mainPage eq 'FAILED')
  {
    $foldernum--;
    $yahooVersion = 1;
    goto getDiffFolder;
  }

  #parse for number of messages
  if ($mainPage =~ /$strings{'msg_range'}/) { 
    $startMsg = $1 ;
    $endMsg = $2 ;
    $numMsgs = $3;  }
  elsif ($mainPage =~ /$strings{'new_msg_range'}/) { 
    $startMsg = $1 ;
    $endMsg = $2 ;
    $numMsgs = $3;  }
  elsif ($mainPage =~ /$englishStrings{'new_msg_range'}/) { 
    $startMsg = $1 ;
    $endMsg = $2 ;
    $numMsgs = $3;  }
  elsif ($mainPage =~ /$englishStrings{'msg_range'}/) { 
    $startMsg = $1 ;
    $endMsg = $2 ;
    $numMsgs = $3;  }
  elsif ($mainPage =~ /"modulecontainer filled nomessages"/ ||
         $mainPage =~ /$strings{'no_msgs'}/ ||
         $mainPage =~ /$strings{'new_no_msgs'}/ ||
         $mainPage =~ /$englishStrings{'new_no_msgs'}/ ||
         $mainPage =~ /$englishStrings{'no_msgs'}/ ||
         (defined $strings{'new_no_msgs_2'} &&
            $mainPage =~ /$strings{'new_no_msgs_2'}/) )
  {
    # workaround bug when downloading multiple pages of unread messages
    if ($msgcount > 0) { $numMsgs = $endMsg ; goto done_msg_ids; }

    print "There are no messages in the $orig_folder[$foldernum] folder.\n"
            unless $quiet;

    # loop if we have more than one folder
    if($foldernum!=$noOfFolders){ goto getDiffFolder;}

    # if requested, empty trash
    if ($emptyTrashAfter) { EmptyTrash($mainPage); }

    goto fetch_exit;

  }
  elsif(($mainPage=~/There\s*was\s*a\s*problem\s*accessing\s*your\s*mailbox/ &&
         ($mainPage =~ /This\s*is\s*most\s*likely\s*a\s*temporary\s*problem/ ||
          $mainPage =~ /We\s*recommend\s*clicking\s*the/)) ||
         $mainPage=~/Are we missing something here\? You don't appear to have a folder with this name/) {
    MyDie "Could not find Yahoo! folder $folder[$foldernum]. Remember that folder names are ".
      "case-sensitive.\n" unless $noerrors;
    # loop if we have more than one folder
    if($foldernum!=$noOfFolders){ goto getDiffFolder;}
  }
  # this error message occurs often enough that I'm not treating it as a
  # failure
  elsif ($mainPage =~ /999\s*This\s*page\s*is\s*currently\s*unavailable/ ||
         $mainPage =~ /999 Unable to process request at this time/) {

    print "Yahoo! mail is currently unavailable. Please try again later.\n\n"
      unless $quiet;

    if ($logout) { Logout; }                    # if requested, logout

    $exit_code=2;
    goto fetch_exit;
  }
  else
  {
   # if we get a redirect page, update the baseurl and homesuffix and try again
    if(
        (
   $mainPage =~ /^<!DOCTYPE HTML PUBLIC "-\/\/W3C\/\/DTD HTML 4.01\/\/EN"/ ||
   $mainPage =~ /^\s*<script>/ ) &&
   $mainPage =~ /<META HTTP-EQUIV=Refresh CONTENT="0; URL='(http:\/\/.*?)\//)
    {
            if ($yahooVersion==0)
            {
              $baseurl = $1;
              $foldernum--;
              $yahooVersion = 1;
              goto getDiffFolder;
            }
            else
            {
              print $mainPage."\n\nGot another redirect from $tmpurl\n";
              exit;
            }
    }
    elsif(
   ( $mainPage =~ /^<!DOCTYPE HTML PUBLIC "-\/\/W3C\/\/DTD HTML/ ||
      $mainPage =~ /^\s*<script>/ ) &&
   $mainPage =~ /<META HTTP-EQUIV=Refresh CONTENT="0; URL='([^']*)'/)
    {
            if ($yahooVersion==0)
            {
              my $newsuf = $1;
              $baseurl =~ s/([^\/])\/[^\/]*$/$1\/$newsuf/;
              $foldernum--;
              $yahooVersion = 1;
              goto getDiffFolder;
            }
            else
            {
              print $mainPage."\n\nGot another redirect from $tmpurl\n";
              exit;
            }
    }
    elsif ($mainPage =~ /href="(optOut\?rs=1&ncrumb=[^&]+&once=true)"/)
    {
      my $newsuf = $1;
      $baseurl =~ s/([^\/])\/[^\/]*$/$1\/$newsuf/;
      $foldernum--;
      $yahooVersion = 1;
      goto getDiffFolder;
    }

    if (!$noerrors && !$retryCount) { # only show error on last try
      print $mainPage . "\n\n",
          "Parsing the main summary web page has failed.\n",
          '<<< Please check http://fetchyahoo.sf.net for a version newer ' ,
          " than this version ( $version ) \n",
          'If there is no newer version, please e-mail this output ',
          'to ravi_ramkissoon@yahoo.com >>>'."\n\n";
    }

    $exit_code=3;
    goto fetch_exit;
  }

  # tw used to have the startMsgs and endMsgs interchanged
  #if ($language eq 'tw' && defined $endMsg && defined $startMsg) {
  #  my $tmp_msgs = $startMsg ;
  #  $startMsg = $endMsg;
  #  $endMsg = $tmp_msgs;
  #}

  # print "\nCurrent page URL is $tmpurl\n";
  # print "mm $maxMessages sm $startMsg em $endMsg nm $numMsgs \n";

  # workaround bug when fetching unread messages only ("showing 1-1 of 2")
  if ($oldStartMsg == $startMsg) { $numMsgs = $endMsg ; goto done_msg_ids; }
  $oldStartMsg = $startMsg;

  if ($statusOnly) {
    print "$numMsgs message".(($numMsgs>1)?"s":"") . " found in the $folder[$foldernum] folder.\n";

  # loop if we have more than one folder
  if($foldernum!=$noOfFolders){ goto getDiffFolder;}

    # if requested, empty trash
    if ($emptyTrashAfter) { EmptyTrash($mainPage); }

    goto fetch_exit;
  }

  if ($yahooVersion == 1 &&
      !($mainPage =~ /classicHost = "(.*?)"/))
  {
      if (!$retryCount) { # only show error on last try
      print $mainPage . "\n\n",
          "Could not find classic host in new Yahoo layout.\n",
          '<<< Please check http://fetchyahoo.sf.net for a version newer ' ,
          " than this version ( $version ) \n",
          'If there is no newer version, please e-mail this output ',
          'to ravi_ramkissoon@yahoo.com >>>'."\n\n";
    }
    $exit_code=4;
    goto fetch_exit;
  }
  else
  {
      $classicHost = $1;
  }

  # Download at most $maxMessages messages
  if ($maxMessages > 0 &&
      ( $endMsg > $maxMessages ||
        ($endMsg == $maxMessages && $numMsgs>$maxMessages))) {
    print "\nOnly the first " . $maxMessages . " of " . $numMsgs .
      " is being downloaded.\n\n" unless $quiet;
    $endMsg = $numMsgs = $maxMessages;
  }

  print "Getting Message ID(s) for message(s) $startMsg - $endMsg.\n" unless
  $quiet;

  # new parsing block by Arvind96
  # this can be later modified to let ppl select which messages to delete
  my $tmpPage = $mainPage;
  my $tmpLine = '';

  if ($debug) {print "\n\nBEGIN SUMMARY PAGE\n$tmpPage\nEND SUMMARY PAGE\n\n";}

  # the long regexp matches and removes a single message
  while ( ($folder[$foldernum] ne 'Draft' &&
                  ($yahooVersion==0||$folder[$foldernum] ne 'Sent') &&
    $tmpPage =~ s/<tr[^>]*><td><b>(Read|Unread)<\/b><\/td><td.*?name="mid".*?value="([^"]+)".*?href="(.*?mid=)([^&]*).*?td\s*title="([^"]*)".*?<a\s*href=.*?title="([^"]*)".*?<td class[^>]*?>([^<]*?)<\/td><td>([^<]*?)<\/td><\/tr>//ms )
     || ($folder[$foldernum] ne 'Draft' &&
                  ($yahooVersion==0||$folder[$foldernum] ne 'Sent') &&
    $tmpPage =~ s/<tr class="(msgnew|msgold)".*?name="mid".*?value="([^"]+)".*?href="(.*?mid=)([^&]*).*?td title="([^"]*)".*?title="([^"]*)".*?<td class[^>]*?>([^<]*?)<\/td><td>([^<]*?)<\/td><\/tr>//ms)
     ||
     ($folder[$foldernum] eq 'Draft' &&
           $tmpPage =~ s/^.*?^[\s]*<tr class=msg(new|old).*?^<td.*?name="Mid".value="([^"]+)".*?^<td>([^<].*?)<.*?^<td>.*?^[\s]*<a.(id="[a-zA-Z0-9]*" )?href=.*?Compose\?DMid=([^&]+)&.*?\n(.*?)\n.*?^[\s]*<td .*?>(.*?)<.*?^[\s]*<td .*?>(.*?)<//ms )
     ||
     ($folder[$foldernum] eq 'Sent' && $yahooVersion==1 &&
          $tmpPage =~ s/<tr[^>]*><td><b>(Read|Unread)<\/b><\/td><td[^>]*><input[^>]*value="([^"]+)"[^>]*>(.*?)(<td><div>)([^<]*)<\/div>.*?\s*title="([^"]+)">.*?<td[^>]*>([^<]*)<\/td><td>([^<]*)<\/td>//ms)
     ||
      ($folder[$foldernum] eq 'Sent' && $yahooVersion==1 &&
           $tmpPage =~ s/<tr\s*class="(msgold|msgnew)"><td>.*?name="mid"\s*value="([^"]*)"(.*?)(<td><div>)([^<]*)<\/div>.*?title="([^"]*)".*?<td[^>]*>([^<]*)<\/td><td>([^<]*)<\/td><\/tr>//ms )
 )
  {
    if (! $2 eq $5 && ($1 eq 'new' || $1 eq 'old')) {
        print "\nWarning: message ID's $2 and $5 don't match.\n" unless $quiet;
    }

    my $name;
    my $subject;
    my $old = $1;
    my $date;
    my $size;
    my $msgid = $2;

    if ($old eq 'new' || $old eq 'old')
    {
      $name = $3;
      $subject = $6;
      $old = $1;
      $date = $7;
      $size = $8;
    }
    else
    {
      $name = $5;
      $subject = $6;
      $old = $1;
      $date = $7;
      $size = $8;
      $old =~ s/msg// ;
      if ($old eq 'Read' || $old eq 'msgold') { $old = 'old'; }
      if ($old eq 'Unread' || $old eq 'msgnew') { $old = 'new'; }
    }

    # replace HTML character entities in summary
    $name =~ s/&amp;/&/;
    $name =~ s/&lt;/</;
    $name =~ s/&gt;/>/;
    $name =~ s/&#39;/'/;
    $name =~ s/&#34;/"/;
    $name =~ s/&quot;/"/;
    $subject =~ s/&amp;/&/;
    $subject =~ s/&lt;/</;
    $subject =~ s/&gt;/>/;
    $subject =~ s/&#39;/'/;
    $subject =~ s/&#34;/"/;
    $subject =~ s/&quot;/"/;

    # to filter on subject do something like
    # next unless $subject =~ m/Search string/;

    # or we can prompt the user before every message here

    if ($old eq 'new') { $msgnew[$msgcount] = 1; }
    else { $msgnew[$msgcount] = 0; }
    $msgids[$msgcount] = $msgid ;
    $msgcount = $msgcount + 1;

    if ($listMsgs) {
        $tmpLine = "$old \"".substr($name, 0, 15)."\" - ".substr($subject, 0, 44).
          " " . substr($date, -7, 7)." $size";
        $tmpLine =~ s/\s+/\ /g;
        if ($newOnly) { $tmpLine =~ s/^(new|old) //; }
        print $msgcount . ". " . $tmpLine . "\n";
    }
  }

  $pagecount = $pagecount+1 ;            # next summary page

  done_msg_ids:
} until $numMsgs == $endMsg ;

# if we don't get any message IDs print debugging output
if ($msgcount==0 && $endMsg>0)
{
  print "Could not get any message IDs, please send this output (v$version) to
  fetchyahoo\@twizzler.org.\n\nMain page is \n$mainPage\n\n
  Could not get any message IDs, please send this output (v$version) to
  fetchyahoo\@twizzler.org.\n";
}

# truncate excess message IDs
if ($msgcount > $maxMessages) {
  $msgcount = $maxMessages ;
  @msgids = @msgids[ 0..($maxMessages-1)] ;
  @msgnew = @msgnew[ 0..($maxMessages-1)] ;
}

if ($mainPage =~ /name=\"mcrumb\" value=\"([^"]+)\"/ ||
    $mainPage =~ /id=\"crumb\" value=\"([^"]+)\"/ ||
    $mainPage =~ /mcrumb *= *([^"&']+)/ ) {
  $crumb = $1; }
elsif (!$noDelete)  {
     print "$mainPage\n\n",
          "Warning: Can't get crumb, deleting messages will not work.\n\n",
          '<<< Please check http://fetchyahoo.sf.net for a version newer ' ,
          " than this version ( $version ) \n",
          'If there is no newer version, please e-mail this output ',
          'to ravi_ramkissoon@yahoo.com >>>'."\n\n"
       unless $noerrors;
   }

# if we need to empty the trash later, save the page so we can parse it later
if ($emptyTrashAfter) { $emptyurl=$mainPage; }

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

# if useMsgIDArchive is chosen, remove message IDs already downloaded and store
# new message IDs
if ($useMsgIDArchive) {

if (!-e $msgIDArchiveFile){
        open MSGIDSPOOL, "> $msgIDArchiveFile";
        print "Creating message ID archive\n" unless $quiet;
        close MSGIDSPOOL;
}
open MSGIDSPOOL, "< $msgIDArchiveFile" or
        die "Can't open output: $msgIDArchiveFile";

my @msgidlist=<MSGIDSPOOL>;
close MSGIDSPOOL;
my $msgidcount=0;
for($msgidcount=0;$msgidcount<@msgids;){
        my $msgidfound=0;
        my $fmsgidcount=0;
        for($fmsgidcount=0;$fmsgidcount<@msgidlist;){
                my $temp=$msgidlist[$fmsgidcount];
                chomp($temp);
                if ($temp eq $msgids[$msgidcount]){
    # delete the message ID from the file if we are deleting the message
                        if(! $noDelete){
                                open MSGIDSPOOL, "+< $msgIDArchiveFile" or
                                        die "Can't open output: $msgIDArchiveFile";
                                splice(@msgidlist,$fmsgidcount,1);
                                seek(MSGIDSPOOL,0,0);
                                print MSGIDSPOOL @msgidlist;
                                truncate(MSGIDSPOOL,tell(MSGIDSPOOL));
                                close MSGIDSPOOL;
# add message to deletion list (because it is being removed from msg ids list)
                                $delurls[$numurls] = $delurls[$numurls] . "\&Mid=$msgids[$msgidcount]";
                                @delmids=(@delmids,$msgids[$msgidcount]);
                                $delCount = $delCount+1;
                                if ($delCount%$maxMidsPerURL == 0) {
                                  $numurls=$numurls+1;
                                  $delurls[$numurls] = $homeurl . "\&DEL=Delete";
                                  $delurls[$numurls-1] = $delurls[$numurls-1] . "\&.crumb=$crumb";
                                }
                        }
                        $msgidfound=1;
                        last;
                }
                else {
                        $fmsgidcount++;
                }
        }
        if($msgidfound==1){
                splice(@msgids,$msgidcount,1);
                splice(@msgnew,$msgidcount,1);
        }
        else{
                if($noDelete){
                        open MSGIDSPOOL, ">> $msgIDArchiveFile" or
                                die "Can't open output: $msgIDArchiveFile";
                        print MSGIDSPOOL "$msgids[$msgidcount]\n";
                        close MSGIDSPOOL;
                }
                $msgidcount++;
        }
}

print "Got $msgidcount new messages \n" unless $quiet; 
}
# msgidSpool code ends

if ($noDownload) {
  if (!$quiet) { print "Not downloading messages\n"; }
  foreach my $msgid (@msgids) { 
    # add message to deletion list
    $delurls[$numurls] = $delurls[$numurls] . "\&Mid=$msgid";
    @delmids=(@delmids,$msgid);
    $delCount = $delCount+1;
    if ($delCount%$maxMidsPerURL == 0) {
      $numurls=$numurls+1;
      $delurls[$numurls] = $homeurl . "\&DEL=Delete";
      $delurls[$numurls-1] = $delurls[$numurls-1] . "\&.crumb=$crumb";
    }
  }
  goto startDelete;
}

@msgids = reverse(@msgids);         # download msg IDs in correct order
@msgnew = reverse(@msgnew);         # JWB -- reverse array of Unread statuses
my $loopcnt = 0;

# loop over all Message IDs
foreach my $msgid (@msgids) { 
  # if safeDownload is set, sleep for a few seconds here
  safeSleep;
  # JWB -- Only add to unread list if the message was originally unread
  # RNR -- Only add to read list if the message was originally unread (so we
  # need to change the state)
  if($msgnew[$loopcnt++])
  {
    # msg was unread so now mark it read by adding it to readlist
    $readurls[$numurls] = $readurls[$numurls] . "\&Mid=$msgid";
    @readmids=(@readmids,$msgid);
    $readCount = $readCount+1;
  }

  my $header;
  my $mimeHead;
  my $fromLine;
  my $message;
  my $rawPart;
  my $rawMsg;

  if ($yahooVersion==1)
  {
    getNewHeaderAndBody($msgid, \$rawPart, \$fromLine, \$mimeHead, \$rawMsg);
  }

  if ($yahooVersion==0)
  {
    my $encMsgid = $msgid;

    # url-encode the message ID
    $encMsgid =~ s/([^\w\-\.\@])/$1 eq " "?"+":sprintf("%%%2.2x",ord($1))/eg;

    my $tmpurl = $baseurl . sprintf($bodyPartUrlTemplate, $encMsgid, "HEADER") ;
    if ($yahooVersion==1)
    {
        $tmpurl =~ s/http:\/\/.*?\//$classicHost/ ;
    }
    else
    {
    $request = GET $tmpurl;
    $header = MyGet($request, "get header of message $msgid. It will be "
                  . "skipped and not deleted", 0, $maxSize);
    if ($header eq "FAILED") { next; }

    # hack to work around corrupt header lines such as:
    # ".142.200.136; Sat, 11 Jun 2005 10:01:18 -0700"
    $header=~s/\n\.\d{1,3}\.\d{1,3}\.\d{1,3};[^\n]+//s;

    # workaround yahoo bug putting in extraneous newlines
    $header =~ s/\n(\S[^:]*\n)/$1/;
    $header =~ s/\n(\S[^:]* .*\n)/$1/;

    my @foo = split /\n/, $header;
    $fromLine = shift @foo;     # save From_ line for later
    $mimeHead = new MIME::Head(\@foo);
    }

    $tmpurl = $baseurl . sprintf($bodyPartUrlTemplate, $encMsgid, "TEXT") ;
    if ($yahooVersion==1) { $tmpurl =~ s/http:\/\/.*?\//$classicHost/ ; }

    $request = GET $tmpurl;
    $rawPart = MyGet($request, "get body of message $msgid.\n"
                      . "Message will be skipped and not deleted.\n", 0);
  }

  if ($rawPart eq "FAILED" ) { next; }
  $rawPart =~ s/^>From />>From /gm ; # slightly extended RFC 822
  $rawPart =~ s/^From />From /gm ;

  my $fromName; my $fromRest;

  # if we can't parse at least To or From or Date assume this has failed
  unless ($mimeHead->get('From') || $mimeHead->get('To')
          || $mimeHead->get('Date') || $mimeHead->get('Return-Path')
          || $mimeHead->get('X-Apparently-To'))  {
    print "Malformed Header:\n\"".$mimeHead->as_string."\"";
    print "\nCan't find message $msgid. It will be skipped and not deleted.".
          "\n" unless $quiet ;
    next;
  }

  # This signals that Yahoo is sending us an error message, not a real header
  if ($mimeHead->get('Connection')
      && $mimeHead->get('Connection')=~ /close/) {
    print "\n\nYahoo has closed the connection. We cannot download\n".
    "any more messages in this session. Stopped at message\n\t\t".
    ( 1 + $downloadCount ) . "\n\n";
    last;
  }

  # Yahoo!'s From_ line is broken, fix it
  my $validEmailPattern =
    '[a-zA-Z\-\.0-9\+\=\_\?]+@[a-zA-Z\-0-9\_]+\.[a-zA-Z\-\.0-9\_]+';
  if (!defined ($fromLine)) {
    # can't parse From_ line, make a new one
    $fromName = '-';
    $fromRest = scalar localtime ;
  }
  else {
    if ( $fromLine =~
        /From .*?($validEmailPattern)>?\s+((Mon|Tue|Wed|Thu|Fri|Sat|Sun).*)$/ )
        {
          $fromName = $1;
          $fromRest = $2;
        }
    else {
      # can't parse From_ line, make a new one
      $fromName = '-';
      $fromRest = scalar localtime;
    }
  }

  # Do we have a better fromName?
  unless ( $fromName =~ /$validEmailPattern/ ) {
    if( defined $mimeHead->get('From') && 
        $mimeHead->get('From') =~ /($validEmailPattern)/ )  {
      $fromName = $1;
    }
    else {
      if ( defined $mimeHead->get('Return-Path') && 
           $mimeHead->get('Return-Path') =~ /($validEmailPattern)/ ) {
           $fromName = $1;
      }
    }
  }

  $fromLine = "From " . $fromName . " " . $fromRest . "\n";

  # add one of 'Received' or 'X-Apparently-To' date
  # if 'Date' tag isn't found [dim0n, 1/8/2005]
  unless ($mimeHead->get('Date')) {
    $mimeHead->add('Date', scalar localtime);
    my @rec = $mimeHead->get('Received');
    push @rec, $mimeHead->get('X-Apparently-To');
    foreach (@rec) {
      if (/((?:Sun|Mon|Tue|Wen|Thu|Fri|Sat), .*)$/) {
        $mimeHead->replace('Date', $1);
        last;
      }
    }
  }

  # Remove Yahoo! Mail's internal headers
  $mimeHead->delete("Content-Length");
  $mimeHead->delete("X-RocketMail");
  $mimeHead->delete("X-RocketUID");
  $mimeHead->delete("X-RocketMIF");
  $mimeHead->delete("X-RocketRCL");
  $mimeHead->delete("X-Track");
  $mimeHead->delete("X-Rocket-Server");
  $mimeHead->delete("X-Rocket-Track");
  # Seen on a Bulk Folder message on Fri Nov 21 14:25:42 2003
  $mimeHead->delete("X-Rocket-Spam");
  # This isn't removed since it is definitely useful to tell
  # that Yahoo has marked this message as Spam
  # $mimeHead->delete("X-YahooFilteredBulk");

  # Mark message unread if it hasn't been read
  $mimeHead->delete("Status");
  $mimeHead->delete("X-Status");
  if (!$msgnew[$loopcnt-1])
  {
    $mimeHead->add('Status',"RO");
    $mimeHead->add('X-Status',"R");
  }

  # Add our own header
  $mimeHead->add('X-FetchYahoo',"version ".$version." MsgId ".$msgid);

  # This fixes a bug affecting non-English latin characters
  # is it ok if we always change CTE from quoted-printable->8bit ?
  if ($mimeHead->get('Content-Transfer-Encoding') &&
      $mimeHead->get('Content-Transfer-Encoding') =~
      /^(quoted-printable|base64)$/i) {
    $mimeHead->add("X-FetchYahoo-Content-Transfer-Encoding-Autoconverted",
                   "from ".$mimeHead->get('Content-Transfer-Encoding').
                   " to 8bit");
    $mimeHead->replace("Content-Transfer-Encoding", "8bit");
  }

  # This fixes a bug affecting non-English characters
  # is it ok if we always change charset to UTF-8 ?
  if ($mimeHead->get('Content-Type') &&
      $mimeHead->get('Content-Type') =~ /charset=([-a-zA-Z0-9"]*)/) {
    $mimeHead->add("X-FetchYahoo-Charset-Autoconverted",
                   "from $1 to UTF-8");
    my $contentType = $mimeHead->get('Content-Type');
    $contentType =~ s/charset=([-a-zA-Z0-9"]*)/charset=UTF-8/;
    $mimeHead->replace("Content-Type", $contentType);
  }

  if ($mimeHead->get('Content-Type') &&
      $mimeHead->get('Content-Type') =~ /text.*boundary/is) {
    my $contentType = $mimeHead->get('Content-Type');
    $contentType =~ s/\s*boundary.*//is;
    $mimeHead->replace("Content-Type", $contentType);
  }


  if (defined $rawMsg)
  {
     my $validMsg = $rawMsg->as_string."\n\n";
     $validMsg =~ s/^>From />>From /gm ; # slightly extended RFC 822
     $validMsg =~ s/^From />From /gm ;
     $message = $validMsg;
  } else
  {
     $message = $mimeHead->as_string."\n"; # message we are constructing
     $message .= $rawPart . "\n\n";
  }

  # add message to deletion list
  $delurls[$numurls] = $delurls[$numurls] . "\&Mid=$msgid";
  @delmids=(@delmids,$msgid);
  $delCount = $delCount+1;
  if ($delCount%$maxMidsPerURL == 0) {
    $numurls=$numurls+1;
    $delurls[$numurls] = $homeurl . "\&DEL=Delete";
    $delurls[$numurls-1] = $delurls[$numurls-1] . "\&.crumb=$crumb";
    $readurls[$numurls] = $homeurl . "\&FLG=1&flags=read";
    $readurls[$numurls-1] = $readurls[$numurls-1] . "\&.crumb=$crumb";
  }

  doneMessageFetch:

  # send the message where requested (mbox or e-mail addresses)
  DeliverMessage( \$message, $fromLine, $mimeHead );

  $downloadCount++;
  # Progress indicator
  if (!$quiet) {
    if ($downloadCount%5) {
      print ".";
    } elsif ($downloadCount%10) {
      print "5";
    } else {
      printf("[%d]\n", $downloadCount);
    }
  }

}

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

# optimization: if $noDelete is false, we are deleting messages so
# we don't have to mark them read, so skip this block
if (!$leaveUnread && $noDelete && $readCount) {
  $readurls[$numurls] = $readurls[$numurls] . "\&.crumb=$crumb";
  MarkRead(@readurls);
}

startDelete:
if ( $useArchiveFolder || ! $noDelete) {
  $delurls[$numurls] = $delurls[$numurls] . "\&.crumb=$crumb";
  DeleteOrArchive(@delurls);
}
else {
  print "Messages have not been deleted.\n" unless $quiet;
}

# loop if we have more than one folder
if($foldernum!=$noOfFolders){ goto getDiffFolder;}

if ($emptyTrashAfter) { EmptyTrash($emptyurl); }

fetch_exit:

# logout, if requested and no errors
if ($logout && !$exit_code) { Logout(); }

 # if this fetch has failed retry up to $retries times
 # else if $repeatInterval is non-zero, loop after $repeatInterval minutes
 if ($retryCount-- > 0 && $exit_code) { # retry request on errors
    sleep($retryPause);
    print "\nRetry #".($retries-$retryCount)." (error $exit_code).\n" unless $quiet;
    $retryPause = $retryPause * 2; # exponentially increase the delay
    goto startfetch;
 }
 elsif ($repeatInterval > 0) {
    sleep (60*$repeatInterval);
    goto startfetch ;
 }

 exit $exit_code;


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

# return the URL we're redirected to
sub GetRedirectUrl($) {
  my $response = $_[0];
  my $url = $response->header('Location');

  if ($url =  $response->header('Location')) {
    # 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);
  }
  elsif (($response->content =~
         /^<html>\s*<head>\s*<script language=\"/ ||
          $response->content =~
         /^<html>\s*<head>\s*<meta[^>]*>\s*<script language=\"/) &&
         #$response->content =~ /<\/html>\s*$/ &&
         $response->content =~
         /<meta http-equiv="Refresh" content="0; url=(http:\/\/.*?)">/) {
    $url = $1;
  }
  else {
    return undef;
  }

  return $url;
}

sub GetEmailAddress($) {
  my $addr = $_[0];

  # first try to match < A @ B > 
  if ($addr =~ /.*<([.0-9a-zA-Z-_]+)@([.0-9a-zA-Z-_]+)>/) { 
    return $1 . "@" . $2; 
  } 
  # next try to match A @ B
  elsif ($addr =~ /([.0-9a-zA-Z-_]+)@([.0-9a-zA-Z-_]+)/) {
     return $1 . "@" . $2;
  }
  else {
    return undef;
  }
}

# parameters (request, action_being_attempted, die_if_failed, max_size_kb)
# if die_if_failed is 0 failure will be denoted by returning "FAILED"
sub MyGet {
  my $request = $_[0];
  my $tries;
  my $max_size = $_[3] || 0;
  $ua->max_size( ($max_size*1024) || undef );
  my $content='';

  for($tries=0;$tries<4;$tries++) {

    # linear backoff. sleep for 0, 1, 3, 5 seconds
    if ($tries) { sleep(2*$tries - 1); safeSleep; }

    if ( $useProxy
         && !($proxyUser eq "proxyAuthenicationUserName")
         && !($proxyPass eq "proxyAuthenicationPassword") ) {
        $request->proxy_authorization_basic($proxyUser, $proxyPass);
    }
    $response = $ua->simple_request($request);

    while ( $response->is_redirect ||
            ( ( $response->content =~ /^<html>\s*<head>\s*<script language=\"/
                    ||
                $response->content =~ /^<html>\s*<head>\s*<meta[^>]*>\s*<script language=\"/)&&
            #$response->content =~ /<\/html>\s*$/ &&
              $response->content =~
              /<meta http-equiv="Refresh" content="0; url=(http:\/\/.*)">/)) {
      $cookie_jar->extract_cookies($response);
      $url = GetRedirectUrl($response);
      if (!$url || !defined ($url)) { next; }
      if ($yahooVersion == 0) { $request = GET $url; }
      else { $request->uri($url); }
      if ( $useProxy
           && !($proxyUser eq "proxyAuthenicationUserName")
           && !($proxyPass eq "proxyAuthenicationPassword") ) {
        $request->proxy_authorization_basic($proxyUser, $proxyPass);
      }
      $response = $ua->simple_request($request);
    }

    # abort if message > max_size. This is a non-fatal error.
    my $clientAborted = $response->header('Client-Aborted') || '';
    if( $max_size && $clientAborted eq 'max_size' ){
    # print $request->uri()."\n".$response->status_line."\n" unless $noerrors;
      print "Warning: Message exceeded $max_size kB. Couldn't " . $_[1] . ".\n"
        unless $noerrors;
      return "FAILED";
    }

    $content =  $response->content;

    # check for broken pages
    if ( $content =~ /^<html><head><title>Yahoo! -\n404/ ||
         ($content=~/^<!--web/ && 
          $content=~/<!-- virus scan content area -->/) ||
         ($content=~/^<!--web/ && 
          $content=~/There was a problem accessing your account/) ||
         ($content=~/^<!--web/ && 
          $content=~/<h2>Sorry for the inconvenience/ &&
          $content=~/<!-- error code:  UNHANDLED_ERROR -->/) ||
         $content =~ /^<html><head><title>Document Error: Data follows/ ||
         ($content=~/^<!--web/ && 
          $content=~
          /he request your browser sent was missing some needed information/)||
         ($content=~/^<html>/ && 
          $content=~
          /<title>Sorry, this page is not currently available<\/title>/ ) ||
         (($content=~/^<HTML>/ || $content=~/^HTTP/)&& 
          ($content=~/999\s*This\s*page\s*is\s*currently\s*unavailable/ ||
          $content=~/999\s*Unable to process request at this time/ )) ||
         ($content=~/^<!--web/ && 
          $content=~
          /Your login session has expired/ )  ||
         ($content=~/^<!--web/ && 
          $content=~
          /Invalid Mailbox State/ ) ||
         ($content=~/^<html>/ &&
          $content=~ /A JavaScript implementation of the RSA Data Security/ &&
          $content=~ /These functions implement the basic operation for each round of the/) )
      {
        print "Found a Yahoo failure page, trying again.\n" unless $noerrors;
        next; }

    if ($content=~/^\s*<!DOCTYPE HTML PUBLIC/ &&
            $content=~/require\s*users\s*to\s*enter\s*a\s*word\s*displayed\s*on\s*this\s*page\s*as/) {
        die "Yahoo! has sent us an image of text. Fetchyahoo cannot proceed.\n\n".
            "Please wait a half day or so and then try FetchYahoo again. Also ensure ".
            "that you are not running Fetchyahoo more than once every 10 minutes.\n\n".
            "You can also try specifying a cookie-file to prevent this from recurring.\n\n".
            'If you find a way around this please e-mail ravi_ramkissoon@yahoo.com'.
            "\nwith your method/solution, thanks.";
    }

    if ( $response->is_success ) { return $content; }
    if ( $yahooVersion==0 && $response->status_line =~ /404 Not Found/ )
    { last; }
    if ($response->status_line =~/unable_to_get_message_info_or_part/)
    { return "NO_SUCH_PART"; }
  }

  if ( $response->is_error
       && $request->url->scheme eq "https"
       && $response->message =~ /LWP::Protocol::https/ )
    {
      die "HTTPS secure login is now turned on by default.\n\n".
        "Unable to login securely with HTTPS. You may need to install ".
        "the Crypt::SSLeay or IO::Socket::SSL perl module. Please ".
        "check the webpage or INSTALL file for information on how to ".
        "install perl modules.\n\n".
        "Alternatively you can turn off HTTPS secure login to use an".
        "insecure plaintext login (-nohttps or edit the config file).\n";
    }

  if ($_[2]) {
    print $content . "\n\n" unless $noerrors;
    print $request->uri().' ' . $response->is_success . "\n" .
      $response->status_line . "\n" unless $noerrors;
    MyDie("Failed: Couldn't " . $_[1] . ".\n");
  }
  else {
    if (!$noerrors && ($yahooVersion!=0 || !($response->status_line =~ /404 Not Found/)))
    {
      print $content . "\n\n";
      print $request->uri()."\n" . $response->is_success . "\n" .
        $response->status_line . "\n";
      print"Warning: Couldn't " . $_[1] . ".\n";
    }
    return "FAILED";
  }

}


sub MyDie($) {
  if ($repeatInterval > 0) {
    sleep (60*$repeatInterval);
    goto startfetch ;
  }

  die shift unless $noerrors ;
  die ;
}

sub GetFormInputs() {
  my $tries;
  my ($i, @PROP_NAME, @PROP_VALUE, %PROPS);
  my $main_page;

  $request = GET  $loginURL ;
  for($tries=0;$tries<3;$tries++) {
    if ($tries) { safeSleep; }
    $main_page = $ua->request($request);
    if ($main_page->is_error && 
        $main_page->status_line  =~ /Crypt::SSLeay not installed/) {
      die "\nYahoo no longer allows regular HTTP logins.\n\n".
        "You will need to install ".
        "the Crypt::SSLeay or IO::Socket::SSL perl module. Please ".
        "check the webpage or INSTALL file for information on how to ".
        "install perl modules.\n\n";
    }
    if ($main_page->is_error) {
      print "Failed to fetch login page: ", $request->uri, ": ", 
        $main_page->status_line, "\n" unless $noerrors;
      next;
    }
    my @main_page = split(/\n/, $main_page->content);
    foreach (@main_page) {
            if (/^.*<input type=\"?hidden\"? ([^>]*>).*$/) {
                    my @TAG = split(/[>\s]/, $1);
                    for ($i = 0; $i <= $#TAG; $i++) {
                            $TAG[$i] =~ s/\"//g;
                            my @PROP = split("=", $TAG[$i]);
                            if ($PROP[0] eq "name") {
                                    push (@PROP_NAME, $PROP[1]);
                            }
                            elsif ($PROP[0] eq "value") {
                                    push (@PROP_VALUE, $PROP[1]);
                            }
                    }
            }
    }
    for ($i = 0; $i <= $#PROP_NAME; $i++) {
            $PROPS{$PROP_NAME[$i]} = $PROP_VALUE[$i];
    }
    if (defined $PROPS{'.challenge'}) { $tries=4; }
  }
  if ($tries == 3) { # we failed, PROPS{challenge} not defined. Die here.
    die "Failed to fetch login page: ", $request->uri, ": ", 
        $main_page->status_line, "\n";
  }
  $PROPS{'.save'} = 1;
  $PROPS{'.js'} = 1;
  $PROPS{'.hash'} = 1;
  $PROPS{'.md5'} = 1;
  $PROPS{'.persistent'} = "";
  $PROPS{'login'} = $username;
  # see if the password is already hashed
  if ($password =~ /[0-9a-f]{32}/)
  { # password is already hashed
    $PROPS{'passwd'} = md5_hex(($password . $PROPS{'.challenge'}));
    print "Using already hashed password.\n" unless $quiet ;
  }
  else
  { # password is not already hashed
    $PROPS{'passwd'} = md5_hex((md5_hex($password) . $PROPS{'.challenge'}));
  }
  return %PROPS;
}

sub DeleteOrArchive(@) {
  my $cnt = $numurls;
  my @lst = @_;
  while ($cnt>=0) {
          # print "url - $cnt " . $lst[$cnt] . "\n";
    if ($yahooVersion==1)
    {
     my $tmpurl = $homeurl;
     $tmpurl =~ s/showFolder/showFolder;_ylt=XXX/;
     if ($useArchiveFolder) {
       $request = POST $tmpurl,[top_move_select => $archiveFolder,
         action_msg_topmove => 'Move...', cmd => 'mask',
         mid=>\@delmids, mcrumb=>$crumb ];
      }
      else {
       $request = POST $tmpurl,[top_bpress_delete => 'Delete',
         top_delete => 'Delete', cmd=>'msg.delete',
         mid=>\@delmids, mcrumb=>$crumb ];
      }
      $cnt = 0;
    }
    else
    {
      $request = GET $lst[$cnt] ;
    }
    $content = MyGet($request, 'delete or archive messages', 1);
    if ( $content =~ /<head><title>Yahoo\!\s*-\s*404 Not Found<\/title>/s)
      {
        $content = MyGet($request, 'delete or archive messages', 1);
        if ($content =~ /<head><title>Yahoo\!\s*-\s*404 Not Found<\/title>/s ){
          MyDie("Failed: Couldn't delete or archive messages\n");
        }
      }
    $cnt = $cnt-1;
  }
  if ($useArchiveFolder) {
    print $delCount . " message(s) have been moved to Yahoo folder: $archiveFolder\n" unless $quiet ;
  }
  else {
    print $delCount . " message(s) have been deleted.\n" unless $quiet ;
  }
}

sub MarkRead(@) {
  my $cnt = $numurls;
  my @lst = @_;
  while ($cnt>=0) {
    if ($yahooVersion==1)
    {
     my $tmpurl = $homeurl;
     $tmpurl =~ s/showFolder/showFolder;_ylt=XXX/;
     $request = POST $tmpurl,[top_bpress_topmark => 'Mark',
       mid=>\@readmids, mcrumb=>$crumb, top_mark_select=>1 ],
       $cnt = 0;
    }
    else
    {
      $request = GET $lst[$cnt] ;
    }
    $content = MyGet($request, 'mark messages read', 1);
    if ( $content =~ /<head><title>Yahoo\!\s*-\s*404 Not Found<\/title>/s)
      {
        $content = MyGet($request, 'mark messages read', 1);
        if ($content =~ /<head><title>Yahoo\!\s*-\s*404 Not Found<\/title>/s ){
          MyDie("Failed: Couldn't mark messages read\n");
        }
      }
    $cnt = $cnt-1;
  }
  print $readCount . " message(s) have been ". "marked read.\n" unless $quiet;
}

sub EmptyTrash($) {
  my ($pagecontent) = @_;

  if ( $pagecontent =~ /href=\"(\/ym\/(.*?)\?ET=1(.*?))\"/ ) {
    $emptyurl = $baseurl . $1; }
  elsif ( $pagecontent =~ /href=\"http:\/\/(.*?)(\/ym\/(.*?)\?ET=1(.*?))\"/ ) {
    $emptyurl = $baseurl . $2; }
  elsif ($pagecontent =~ /url \+= \"(=1\&\.crumb=(.*?))\"\;/) {
    $emptyurl = $baseurl . '/ym/ShowFolder?ET'.$1; }
  elsif ($pagecontent =~ /href="([^"]*Etrash=[^"%]*)"/) {
    $emptyurl = $baseurl . "/mc/" . $1; }
  else {
    print "Warning: Couldn't get empty trash URL, not emptying trash\n"
     unless ($quiet || $noerrors);
    return;
  }

  $request = GET  $emptyurl ;
  $content = MyGet($request, 'empty trash',0);
  print "Trash emptied.\n" unless ($content eq "FAILED" || $quiet);
}

sub EmptyBulk($) {
  my ($pagecontent) = @_;
  if ($pagecontent =~ /href=\"(\/ym\/(.*?)\?EB=1(.*?))\"/) {
    $emptyurl = $baseurl . $1; }
  elsif ($pagecontent =~ /href=\"http:\/\/(.*?)(\/ym\/(.*?)\?EB=1(.*?))\"/) {
    $emptyurl = $baseurl . $2; }
  elsif ($pagecontent =~ /url \+= \"(=1\&\.crumb=(.*?))\"\;/) {
    $emptyurl = $baseurl . '/ym/ShowFolder?EB'.$1; }
  elsif ($pagecontent =~ /href="([^"]*Ebulk=[^"]*)"/) {
    $emptyurl = $baseurl . "/mc/" . $1; }
  else { 
    print "Warning: Couldn't get empty bulk URL, not emptying Bulk folder\n"
      unless ($quiet || $noerrors); 
    return;
  }

  $request = GET  $emptyurl ;
  $content = MyGet($request, 'empty bulk',0);
  print "Bulk emptied.\n" unless ($content eq "FAILED" || $quiet);
}

sub Logout() {
    $request = GET  $logouturl ;
    $content = MyGet($request, 'logout',1);
    print "Logged out.\n" unless $quiet;
}


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 (/^\s*username\s*=\s*(.*?)\s*$/i) {
       $username = $1;
    } elsif (/^\s*password\s*=\s*(.*?)\s*$/i) {
       $password = $1;

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

    } elsif (/^\s*use-proxy\s*=\s*(.*?)\s*$/i) {
       $useProxy = $1;
    } elsif (/^\s*proxy-host\s*=\s*(.*?)\s*$/i) {
       $proxyHost = $1;
    } elsif (/^\s*proxy-port\s*=\s*(.*?)\s*$/i) {
       $proxyPort = $1;
    } elsif (/^\s*proxy-username\s*=\s*(.*?)\s*$/i) {
       $proxyUser = $1;
    } elsif (/^\s*proxy-password\s*=\s*(.*?)\s*$/i) {
       $proxyPass = $1;
    } elsif (/^\s*smtp-username\s*=\s*(.*?)\s*$/i) {
       $smtpUsername = $1;
    } elsif (/^\s*smtp-password\s*=\s*(.*?)\s*$/i) {
       $smtpPassword = $1;

    } elsif (/^\s*use-imap\s*=\s*(.*?)\s*$/i) {
       $useIMAP = $1;
    } elsif (/^\s*imap-host\s*=\s*(.*?)\s*$/i) {
       $imapServer = $1;
    } elsif (/^\s*imap-port\s*=\s*(.*?)\s*$/i) {
       $imapPort = $1;
    } elsif (/^\s*imap-username\s*=\s*(.*?)\s*$/i) {
       $imapUser = $1;
    } elsif (/^\s*imap-password\s*=\s*(.*?)\s*$/i) {
       $imapPass = $1;
    } elsif (/^\s*imap-mailbox\s*=\s*(.*?)\s*$/i) {
       $imapMailbox = $1;

    } elsif (/^\s*use-forward\s*=\s*(.*?)\s*$/i) {
       $useForward = $1;
    } elsif (/^\s*mail-host\s*=\s*(.*?)\s*$/i) {
       $mailHost = $1;
    } elsif (/^\s*send-to\s*=\s*(.*?)\s*$/i) {
       @$sendToAddresses = split /\s*,\s*/, $1;
    } elsif (/^\s*send-from\s*=\s*(.*?)\s*$/i) {
       $sendFromAddress = $1;

    } elsif (/^\s*max-messages\s*=\s*(.*?)\s*$/i) {
       $maxMessages = $1;
    } elsif (/^\s*new-messages-only\s*=\s*(.*?)\s*$/i) {
       $newOnly = $1;
    } elsif (/^\s*no-download\s*=\s*(.*?)\s*$/i) {
       $noDownload = $1;
    } elsif (/^\s*no-delete\s*=\s*(.*?)\s*$/i) {
       $noDelete = $1;
    } elsif (/^\s*use-https\s*=\s*(.*?)\s*$/i) {
       $useHTTPS = $1;
    } elsif (/^\s*quiet\s*=\s*(.*?)\s*$/i) {
       $quiet = $1;
    } elsif (/^\s*get-external\s*=\s*(.*?)\s*$/i) {
       $getExternal = $1;
    } elsif (/^\s*external-mail-boxes\s*=\s*(.*?)\s*$/i) {
       @externalMailBoxes = split(/,/,join(',',$1));

    } elsif (/^\s*empty-bulk\s*=\s*(.*?)\s*$/i) {
       $emptyBulk = $1;
    } elsif (/^\s*empty-trash-after\s*=\s*(.*?)\s*$/i) {
       $emptyTrashAfter = $1;
    } elsif (/^\s*empty-trash-before\s*=\s*(.*?)\s*$/i) {
       $emptyTrashBefore = $1;
    } elsif (/^\s*logout\s*=\s*(.*?)\s*$/i) {
       $logout = $1;
    } elsif (/^\s*repeat-interval\s*=\s*(.*?)\s*$/i) {
       $repeatInterval = $1;
    } elsif (/^\s*no-errors\s*=\s*(.*?)\s*$/i) {
       $noerrors = $1;

    } elsif (/^\s*leave-unread\s*=\s*(.*?)\s*$/i) {
       $leaveUnread = $1;
    } elsif (/^\s*no-from-line\s*=\s*(.*?)\s*$/i) {
       $noFromLine = $1;
    } elsif (/^\s*status-only\s*=\s*(.*?)\s*$/i) {
       $statusOnly = $1;
    } elsif (/^\s*folder\s*=\s*(.*?)\s*$/i) {
       $box = $1;
    } elsif (/^\s*folders\s*=\s*(.*?)\s*$/i) {
       $box = $1;
    } elsif (/^\s*warning-level\s*=\s*(.*?)\s*$/i) {
       $warningLevel = $1;
    } elsif (/^\s*max-size\s*=\s*(.*?)\s*$/i) {
       $maxSize = $1;
    } elsif (/^\s*cookie-file\s*=\s*(.*?)\s*$/i) {
       $cookieFile = $1;
    } elsif (/^\s*use-sendmail\s*=\s*(.*?)\s*$/i) {
       $useSendmail = $1;
    } elsif (/^\s*sendmail\s*=\s*(.*?)\s*$/i) {
       $sendmail = $1;
    }
      elsif (/^\s*list-messages\s*=\s*(.*?)\s*$/i) {
       $listMsgs = $1;
    }
      elsif (/^\s*safe-download\s*=\s*(.*?)\s*$/i) {
       $safeDownload = $1;
    }
      elsif (/^\s*secure-imap\s*=\s*(.*?)\s*$/i) {
       $secureIMAP = $1;
    }
      elsif (/^\s*use-msg-id-archive\s*=\s*(.*?)\s*$/i) {
       $useMsgIDArchive = $1;
    }
      elsif (/^\s*msg-id-archive-file\s*=\s*(.*?)\s*$/i) {
       $msgIDArchiveFile = $1;
    }
      elsif (/^\s*use-archive-folder\s*=\s*(.*?)\s*$/i) {
       $useArchiveFolder = $1;
    }
      elsif (/^\s*archive-folder\s*=\s*(.*?)\s*$/i) {
       $archiveFolder = $1;
    }

  }
  close(CONFIGFILE);
}

sub Localize($) {
  my ($cc) = @_;
  if (not grep /$cc/,
  ('us','fr','es','e1','de','it','br','ca','uk','cf','ar', 'cn', 'tw',
  'se','dk','ru'))
  {
    print "Country Code '$cc' not found. We will try the translation for 'us'.\n"
      unless $quiet;
    $cc='us';
  }
  my $strings;
  my %localized_strings = 
    ('us' => { 'msg_range' => 'showing (\d+)-(\d+) of (\d+)',
               'new_msg_range' => 'Messages (\d+)-(\d+) of (\d+)',
               'no_msgs'   => 'There\s*are\s*no\s*(unread)?\s*messages\s*in\s*your',
     'new_no_msgs' => '[Ff]older[\sa-zA-Z]*has\s*no\s*(unread)?\s*messages',
               'p_view'    => 'Printable\&nbsp;View' },
     'fr' => { 'msg_range' => '(\d+)-(\d+)\s*.*\s*sur (\d+)',
               'new_msg_range' => 'Messages (\d+)-(\d+) sur (\d+)',
               'no_msgs' =>'Le\s+dossier\s+.*\s+ne\s+contient\s+aucun\s+(mail|message)',
               'new_no_msgs'   =>
               'Ce\s*dossier\s*ne\s*contient\s*pas\s*de\s*messages',
               'new_no_msgs_2'   =>
               'Il\s*n\'y\s*a\s*aucun\s*message\s*dans\s*\s*le\s*dossier',
               'p_view'    => 'Version\&nbsp;imprimable' },
     'ru' => { 'msg_range' =>
             '\x{1057}\x{1086}\x{1086}\x{1073}\x{1097}\x{1077}\x{1085}\x{1080}\x{1103} (\d+)-(\d+) \x{1080}\x{1079} (\d+)',
               'no_msgs' =>'\x{1042}\s*\x{1087}\x{1072}\x{1087}\x{1082}\x{1077}\s*\x{1050}\x{1086}\x{1088}\x{1079}\x{1080}\x{1085}\x{1072}\s*\x{1085}\x{1077}\x{1090}\s*\x{1089}\x{1086}\x{1086}\x{1073}\x{1097}\x{1077}\x{1085}\x{1080}\x{1081}'},
     'cn' => { 'msg_range'     => '\x{663E}\x{793A}(\d+)-(\d+)\x{5171}\x{6709}(\d+)',
               'new_msg_range'     => '\x{663E}\x{793A}(\d+)-(\d+)\x{5171}\x{6709}(\d+)',
               'no_msgs'       => '\x{60A8}\x{7684}\x{6536}\x{4EF6}\x{7BB1}\x{4E2D}\x{6CA1}\x{6709}\x{4FE1}\x{606F}',
               'new_no_msgs'   => '\x{60A8}\x{6709}\d+\x{5C01}\x{672A}\x{8BFB}\x{90AE}\x{4EF6}',
               'p_view'        => '\x{6253}\x{5370}\x{753B}\x{9762}' },
     'es' => { 'msg_range' => 'Mostrando (\d+)-(\d+) de (\d+)',
               'new_msg_range' => 'Mensajes (\d+)-(\d+) de (\d+)',
               'no_msgs'   => 
               'La\s*carpeta\s*Bandeja\s*de\s*entrada\s*está\s*vacía',
               'new_no_msgs' =>
               'No\s*hay\s*ningún\s*mensaje\s*sin\s*leer\s*en\s*la\s*carpeta',
               'new_no_msgs_2'   =>
               'No\s*hay\s*mensajes\s*(sin\s*leer)?\s*en\s*la',
               'p_view'    => 'Vista para imprimir' },
     'e1' => { 'msg_range' => 'Mostrando (\d+)-(\d+) de (\d+)',
               'new_msg_range' => 'Mensajes (\d+)-(\d+) de (\d+)',
               'no_msgs'   => 'La\s*carpeta\s*Bandeja\s*de\s*entrada\s*está\s*vacía',
               'new_no_msgs' =>'Esta\s*carpeta\s*no\s*tiene\s*mensajes\s*mensajes\s*no\s*leídos',
               'new_no_msgs_2' =>'No\s*hay\s*mensajes\s*en\s*tu\s*carpeta',
               'p_view'    => 'Vista para imprimir' },
     'de' => { 'msg_range' => 'Nachrichten (\d+)-(\d+) von (\d+)',
               'new_msg_range' => '(\d+)-(\d+) von (\d+)',
               'no_msgs'   => 'Es\s*sind\s*keine.*?\s+Nachrichten\s*in\s*Ihrem\s*Posteingang-Ordner',
               'new_no_msgs'   => 'Dieser\s*Ordner\s*hat\s*keine\s*E-Mails',
               'new_no_msgs_2'   =>
               '((Es\s*sind)|(Sie\s*haben?))\s*keine.*?Mails\s*in\s*Ihrem',
               'p_view'    => 'Druckform' },
    'it' => { 'msg_range' => 'mostra (\d+)-(\d+) di (\d+)',
               'no_msgs'   => 'La\s*cartella\s*In\s*arrivo\s*non\s*contiene\s*messaggi',
              'new_msg_range' => 'Messaggi (\d+)-(\d+) di (\d+)',
              'new_no_msgs'   => 'Non ci sono messaggi non letti nella cartella',
               'p_view'    => 'Anteprima&nbsp;di&nbsp;stampa' },
     'br' => { 'msg_range' => 'exibindo (\d+)-(\d+) de (\d+)',
               'new_msg_range' => 'Mensagens (\d+)-(\d+) de (\d+)',
               'no_msgs'   => 'A\s*pasta\s*Caixa\s*de\s*entrada\s*não',
               'new_no_msgs'  => 'Esta\s*pasta\s*não\s*tem\s*mensagens',
               'new_no_msgs_2'   =>
               'Não\s*há\s*mensagens\s*em\s*sua\s*pasta',
               'p_view'    => 'Visualizar&nbsp;impressão' },
     'ar' => { 'msg_range' => 'Mostrando (\d+)-(\d+) de (\d+)',
               'new_msg_range' => 'Mensajes (\d+)-(\d+) de (\d+)',
              'no_msgs'   => 'No\s*hay\s*mensajes\s*en\s*tu\s*carpeta',
   'new_no_msgs' =>'No\s*hay\s*mensajes\s*sin\s*leer\s*en\s*tu\s*Bandeja\s*de\s*entrada',
               'p_view'    => 'Presentación para imprimir' },
    'tw' => { 'msg_range' => '¦Û (\d+)-(\d+) «Ê«H¥ó ¦b (\d+)',
              'new_msg_range' => '¦Û (\d+)-(\d+) «Ê«H¥ó ¤@¦@¦³ (\d+) «Ê«H',
              'no_msgs'   => '¦b\S+¤º\.',
              'new_no_msgs' => '¦b\S+¤º\.',
              'p_view'    => '¤Íµ½¦C¦L' },
    'se' => { 'msg_range' => '(\d+)-(\d+) of (\d+)',
              'new_msg_range' => 'Messages (\d+)-(\d+) of (\d+)',
              'no_msgs'   => 'Det\s*finns\s*inga\s*(olästa)?\s*meddelanden\s*i\s*mappen',
              'new_no_msgs' => 'Det\s*finns\s*inga\s*(olästa)?\s*meddelanden\s*i\s*mappen',
              'p_view'    => 'Utskrivbar vy' },
    'dk' => {'msg_range' => '(\d+)-r (\d+) of (\d+)',
             'new_msg_range' => 'Meddelelser (\d+)-(\d+) af (\d+)',
             'no_msgs' =>  'Der\s*er\s*ingen\s*(ulæste)?\s*meddelelser\s*i\s*din',
             'new_no_msgs' => 'Der\s*er\s*ingen\s*(ulæste)?\s*meddelelser\s*i\s*din',
             'p_view' => 'Udskriftsvenlig visning'}
       );

  $cc = 'us' if $cc eq 'uk';
  $cc = 'us' if $cc eq 'ca';
  $cc = 'fr' if $cc eq 'cf';

  if ($strings = $localized_strings{$cc}) { return %$strings; } 
  else { return 0; }

}

sub checkExternal() {
  my @content;
  my @extboxen;
  my $tmpurl;
  my $tsrvr;
  print "Checking external boxen..\n" unless $quiet;
  $request = GET $baseurl . "/ym/External";
  $content = MyGet ($request, 'get external mailboxes listing', 0);
  #$content =~ s/Exhref=\"(.*)\"/$1/g;
  @content = split(/\n/, $content);
  @extboxen = grep s/.*href=\"(.*?External\?GET[^"]*)\".*/$1/g,@content;  #" heh

  # just loading the URL for an external mailbox loads the messages from it
  foreach $tmpurl (@extboxen) {
    $_ = $tmpurl;
    s/.*Srvr=(.*?)\&.*/$1/;
    if (not $externalMailBoxes[0]) {
      print $_ . "\n" unless $quiet ;
      $request = GET $baseurl . $tmpurl;
      $content = MyGet ($request, 'get external mailbox messages', 0);
    } else {
      $tsrvr=$_;
      foreach my $tmpmbox (@externalMailBoxes) {
        if ( ($tmpmbox eq $tsrvr) || ($tmpmbox eq "") ) {
          print $tsrvr . "\n" unless $quiet ;
          $request = GET $baseurl . $tmpurl;
          $content = MyGet ($request, 'get external mailbox messages', 0);
        } 
      }
    }
  }
}

sub getNewHeaderAndBody(@)
{
    my $messageId = shift;
    my $messageRef = shift;
    my $fromLineRef = shift;
    my $mimeHeadRef = shift;
    my $rawMsgRef = shift;
    my $safeName = $folder[$foldernum];

    $safeName =~ s/%/%%/g;

    my $messageUrl = $baseurl .
    '/mc/showMessage?fid='.$safeName.'&sort=date&order=down&startMid=0&mid=%s&head=f&pView=1&blockimages=none&f=1&ymv=0&da=0&midIndex=0';
    my ($body,$header);
    # url-encode the message ID
    $messageId =~ s/([^\w\-\.\@])/$1 eq " "?"+":sprintf("%%%2.2x",ord($1))/eg;
    $messageUrl = sprintf($messageUrl, $messageId);

    $request = GET $messageUrl;
    my $message = MyGet($request,"message of $messageId",0);
    my $htmlbody=0;

    if ($debug) {print "\n\nBEGIN MESSAGE ID $messageId PAGE\n$message\nEND MESSAGE ID $messageId PAGE\n\n";}
    if ( $message =~ /<table id="message_view_full_header"[^>]*>(.*?)<\/table>.*?class="undoreset clearfix"><div id=[a-z0-9]*>(.*)<\/div>.*?<script type="text\/javascript">\s*hasEML/ms ||
            $message =~ /<table id="message_view_full_header"[^>]*>(.*?)<\/table>.*?div id="[a-z0-9]*"\s*class="undoreset clearfix">(.*)<script type="text\/javascript">\s*hasEML/ms ||
            $message =~ /<table id="message_view_full_header"[^>]*>(.*?)<\/table>.*?div id="[a-z0-9]*"\s*class="undoreset clearfix"\s*role="main">(.*)<script type="text\/javascript">\s*hasEML/ms ||
    ($message =~ /<table id="message_view_full_header"[^>]*>(.*?)<\/(table)>/ms  &&
     $1 =~ /<td class="headerDetails">\s*multipart/msi)
    )
    {
      # this is an HTML e-mail
      $htmlbody=1;
      $body = $2;
      $header = $1;

      # remove #yivNNNNNNN strings in header
      while ($body =~ /<head>.*#yiv[0-9]{7,}.*<\/head>/s)
      {
          $body =~ s/(<head>.*)(#yiv[0-9]{7,})(.*<\/head>)/$1$3/s;
      }
      if ($debug) {print "\n\nBEGIN MESSAGE ID $messageId HTML BODY\n$body\nEND MESSAGE ID $messageId HTML BODY\n\n";}
      if ($debug) {print "\n\nBEGIN MESSAGE ID $messageId HTML HEADER\n$header\nEND MESSAGE ID $messageId HTML HEADER\n\n";}
    }
    elsif ( $message =~ /<table id="message_view_full_header"[^>]*>(.*?)<\/table>.*?<div class="plainMail">(.*?)<\/div>/ms)
    {
      # this is a plain text mail
      $htmlbody=0;
      $body = $2;
      $header = $1;

      # deHTMLYify body
      $body = Clean($body);
      $body =~ s/^\s+//;
      $body =~ s/\s+$//;
    if ($debug) {print "\n\nBEGIN MESSAGE ID $messageId TEXT BODY\n$body\nEND MESSAGE ID $messageId TEXT BODY\n\n";}
    if ($debug) {print "\n\nBEGIN MESSAGE ID $messageId TEXT HEADER\n$header\nEND MESSAGE ID $messageId TEXT HEADER\n\n";}
    }
    else
    {
      print $message."\n\n" unless $noerrors;
      print "Failed to get body of $messageId, will be skipped\n"
        unless $noerrors ;
      $$messageRef = 'FAILED';
      return;
    }

    $$messageRef = $body;

     # now get header, code from fetchayhoo version 1.3
     my $mimeHead = new MIME::Head;
     while ($header =~ s/<td nowrap class=.label. valign="top">\s*<nobr>\s*(.*?)\s*<\/nobr>.*?<td class="headerDetails">\s*(.*?)\s*<\/td>//si) {
        my $key = $1;
        my $value = $2;

        $key = Clean($1);
        $key =~ s/^\s+//;
        $key =~ s/\s+$//;

        # Translate back to English if necessary
        if (defined $strings{'headers'}->{$key}) {
            $key = $strings{'headers'}->{$key};
        }
        $value = Clean($2);

        # if there are any breaks not followed by a space, insert a space
        $value =~ s/\n[^ ]/\n  /g;

        if ($key eq '') { next ; }       # skip any blank fields
        if ($key =~ ' ') { next ; }      # skip any bad fields (with a space)

        # convert multipart/anything to text/html, safe since we only
        # do single-part messages
        if ($key =~ /content-type/i)
        {
          if ($value =~ /multipart/i)
          {
            $$messageRef = "ATTACHMENTS";
          }
          $value =~ s/multipart\/.*/text\/html/i ;
        }
        $mimeHead->add($key, $value);
    }

    if ($htmlbody && $mimeHead->get('Content-Type') &&
        $mimeHead->get('Content-Type') =~ /text\/plain/i)
    {
      if ($debug) {print "Replacing text/plain content type with text/html\n\n";}
      $mimeHead->replace('Content-Type', "text/html");
    }

    if ($message =~ /<div class="rawfrom">(.*?)<\/div>/)
    { $$fromLineRef = $1; }

    $$mimeHeadRef = $mimeHead;

    if ($header =~ /title="Message contains attachments"/)
    {
       $$messageRef = "ATTACHMENTS";
    }

    if (!($$messageRef eq "ATTACHMENTS")) { return; }

    # this is a message with attachments, fetch each one and reassemble
    if ($debug) {print "\n\nMESSAGE ID $messageId has attachments\n\n";}

    $$rawMsgRef = MIME::Entity->build('Type' => "multipart/mixed" );
    my $boundary = "boundary$messageId".scalar localtime;
    $boundary =~ s/ /_/g;
    $mimeHead->replace('Content-Type',
        "multipart/related;Boundary=\"$boundary\"");
    $$rawMsgRef->head($mimeHead);

    my $plainPart1;

    for (my $partNum = 1; $partNum>0; $partNum++)
    {
       my $tmpurl =
          $baseurl . sprintf($bodyPartUrlTemplate, $messageId, $partNum) ;
       $tmpurl =~ s/http:\/\/.*?\//$classicHost/ ;
       $request = GET $tmpurl;
       my $part = MyGet($request, "get part $partNum of message $messageId.
           It will be skipped and not deleted", 0, $maxSize);
       if ($part eq "NO_SUCH_PART")
       {
           if ($debug) {print "No such part #$partNum\n";}
           if ($htmlbody)
           {
               if ($debug) {print "Attaching text/html message body.\n";}
               attach $$rawMsgRef Data=>$body,
                  Disposition => 'inline', Type => 'text/html';
           }
           else
           {
               if ($debug) {print "Attaching text/plain message body (as html).\n";}
               attach $$rawMsgRef Data=>$body,
                  Disposition => 'inline', Type => 'text/html';
           }
           if (defined($plainPart1))
           {
               if ($debug) {print "Attaching text/plain part.\n";}
               attach $$rawMsgRef Data=>$plainPart1,
                  Disposition => 'inline', Type => 'text/plain';
           }
           return;
       }
       elsif ($part eq "FAILED") {
           $$messageRef = 'FAILED';
           if ($debug) {print "Failed to get part $partNum\n";}
           return;}
       else
       {
         # add this  part to the body
         my $type = $response->header("Content-Type");
         if (! defined($type)) { $type = "text/plain" ; }

         if ($debug) {print "\n\nBEGIN MESSAGE ID $messageId PART #$partNum START\n".$response->as_string.
          "\nEND MESSAGE ID $messageId PART #$partNum\n\n";}

         my $fileName = "attachment".($partNum-1);
         if (defined($response->header("Content-Disposition")) &&
             $response->header("Content-Disposition") =~ /[^']*''([^'"]*)"/)
           { $fileName = $1};

         if ($partNum == 1)
         {
             my $msgBoundary=$response->content;
             my $content = $response->content;
             $msgBoundary =~ s/^\s*//s;
             if ($msgBoundary=~/^--(-*[^-\s]+[^\s]+)\n/s ||
                 $msgBoundary=~/^This is a multi-part message in MIME format.\n\s*--(-*[^-\s]+[^\s]+)\n/ms) {
                 $msgBoundary=$1;
                 # this should be alternative but that doesn't work sometimes
                 $content = "Content-Type: multipart/alternative;Boundary=".
                   "\"$msgBoundary\"\n".
                   "Content-Disposition: inline\n".
                   "Content-Transfer-Encoding: quoted-printable\n\n".$content;

                 my $parser = new MIME::Parser;
                 $parser->output_to_core(1);

                 my $entity = $parser->parse_data($content);
                 $$rawMsgRef->add_part($entity);
        # print "Entity is\n".$entity->as_string."\ncontent is\n$content\n";;
             }
             elsif ($msgBoundary=~/<!DOCTYPE/ || $msgBoundary=~/<html/i)
             {
                attach $$rawMsgRef Data=>$response->content,
                  Disposition => 'inline', Type => 'text/html';
             }
             else
             {
                # check if this might be the plain text alternative
                if ($fileName =~ /^[0-9]+\.txt$/)
                {
                   $plainPart1 = $response->content;
                }
                else
                {
                   attach $$rawMsgRef Data=>$response->content,
                     Disposition => 'inline', Type => 'text/plain';
                }
             }
         }
         else
         {
           my $id = $fileName;
           $id =~ s/\..*//;
           my $ext = $fileName;
           if ($ext =~ /\.([a-zA-Z0-9]*)$/ && $extmap{lc($1)} )
               {$type = $extmap{lc($1)} ; }
           if (defined($plainPart1))
           {
               if ($fileName =~ /^[0-9]+\.html$/)
               {
                   my $multiAlt =
                       MIME::Entity->build('Type' => "multipart/alternative");
                   attach $multiAlt Data=>$plainPart1,
                     Disposition => 'inline', Type => 'text/plain';
                   attach $multiAlt Data=>$response->content,
                     Disposition => 'inline', Type => 'text/html';
                   $$rawMsgRef->add_part($multiAlt);
                   undef($plainPart1);
                   next;
               }
               else
               {
                  attach $$rawMsgRef Data=>$plainPart1,
                     Disposition => 'inline', Type => 'text/plain';
                  undef($plainPart1);
               }
           }
           attach $$rawMsgRef Data=>$response->content,
                Disposition => 'attachment',
                Filename =>$fileName,
                Id=>$id,
                Type => $type;
         }
         print "_" unless $quiet;
       }
    }
}

sub DeliverSendmailMessage
{
    my($destaddr, $email) = @_;

    my($OUT) = new FileHandle "| $sendmail $destaddr";

    if (! defined ($OUT)) {
       MyDie("Failed: Unable to open sendmail");
     }

    # Dump the message to sendmail.
    print $OUT $email;

    $OUT->close();
}

sub DeliverMessage {
  my ( $messageRef, $fromLine, $mimeHead ) = @_;
  if ($useSpool) {
    if ($spoolName !~ /\/$/) {
      # send From_line and message to the specified spool/file
      open SPOOL, "$spool" or
        MyDie("Failed: Couldn't open output: $spool");

      flock SPOOL, 2 unless ($spoolMode eq 'pipe');  # lock the mailbox file

      if (!$noFromLine) {
        print SPOOL $fromLine or 
          MyDie("Failed: Couldn't write to output: $spool");
      }
      print SPOOL $$messageRef or 
        MyDie("Failed: Couldn't write to output: $spool");

      flock SPOOL, 8 unless ($spoolMode eq 'pipe'); # unlock the mailbox file
      close SPOOL;
    }
    else { # this is a maildir directory to write to
      # the below is better but adds a dependency on Socket
      # my ($maildirHostname) = gethostbyname(hostname);
      my ($maildirHostname) = $localHostname ;
      # clean up invalid hostnames
      $maildirHostname =~ s/\//\\057/g;
      $maildirHostname =~ s/:/\\072/g;

      # build the unique filename
      my $maildirMessageName =  time() . ".P" . $$ . "Q" .
        $maildirDeliveryCount++ . "." . $maildirHostname;
      my $maildirTmpFilename = $spoolName . "tmp/" . $maildirMessageName;
      my $maildirNewFilename = $spoolName . "new/" . $maildirMessageName;

      # copy the message to tmp
      # ignores $spoolMode since $maildirMessageName is supposed to be unique
      open SPOOL, ">$maildirTmpFilename" or
        MyDie("Failed: Couldn't open output: $maildirTmpFilename");
      if (!$noFromLine) {
        print SPOOL $fromLine or 
        MyDie("Failed: Couldn't write to output: $maildirTmpFilename");
      }
      print SPOOL "$$messageRef" or 
        MyDie("Failed: Couldn't write to output: $maildirTmpFilename");

      close SPOOL;
      # move the message to new
      unless (rename($maildirTmpFilename, $maildirNewFilename)) {
              MyDie("Failed: Couldn't rename: $maildirNewFilename");
      }
    }
  }
  # if overwrite mode is chosen, we only need to overwrite the first time
  if (!$overwriteFlag and $spoolMode eq "overwrite") {
    $overwriteFlag = 1;
    $spool = '>>' . $spoolName
  }

  # mail fowarding stuff goes here
  if ($useForward && !$useSendmail) {
    # initiate smtp connection once if we are forwarding mail
    # $smtp = Net::SMTP::SSL->new("smtp.mail.yahoo.com", Port => 465);
    $smtp = Net::SMTP->new($mailHost);
    if (!$smtp) {
      MyDie("Failed: Unable to connect to server $mailHost to forward ".
            "mail. $!\n");
    }
    my $fromEmailAddress = $mimeHead->get('From') || '';
    chomp($fromEmailAddress);
    if ($smtpUsername && $smtpUsername ne 'my-smtp-username') {
      $smtp->auth($smtpUsername,$smtpPassword);
    }
    $smtp->mail(GetEmailAddress($fromEmailAddress) || $sendFromAddress);
    $smtp->to( @$sendToAddresses );
    $smtp->data();
    $smtp->datasend($$messageRef);
    $smtp->dataend();
    $smtp->quit();
  }

  if ($useForward && $useSendmail) {
      my $email;
      foreach $email (@$sendToAddresses) {
         DeliverSendmailMessage($email, $$messageRef);
      }
  }

  if ($useIMAP){

       # Need to use IO::Socket::SSL and pass socket to Mail::IMAPClient


       if (!defined $imap) {
               print "Connecting to imap server $imapServer\n";
               # returns a new, authenticated Mail::IMAPClient object
               if($secureIMAP){
                   # this is the old IO::Socket::SSL implementation.
                   # Now just use IMAPClient's SSL implementation.
                   #   eval ("use IO::Socket::SSL");
                   #   if ($@) {
                   #     die("Using secure IMAP requires IO::Socket::SSL ".
                   #             "to be present");
                   #   }
                   #   print "Using secure IMAP\n" unless $quiet;

                   #   my $socket;
                   #   eval
                   #   {
                   #     $socket = IO::Socket::SSL->new(
                   #     PeerAddr => $imapServer,
                   #     PeerPort => $imapPort,);
                   #   };
                   #   if ($@) { die "socket(): $@"; }

                   #   my $greeting = <$socket>;
                   #   my ($id, $answer) = split /\s+/, $greeting;

                        $imap = Mail::IMAPClient->new(
                                       Server   => $imapServer,
                                       Port     => $imapPort,
                                       Ssl      => 1,
                                       User     => $imapUser,
                                       Password => $imapPass,
                               )
                           or die "new(): $@";

                       if (!$imap->IsAuthenticated())
                       {
                         $imap->State(Mail::IMAPClient::Connected());
                         $imap->login() or die 'login(): ' . $imap->LastError();
                       }

               } else
               {
                     print "Using IMAP\n" unless $quiet;
                      $imap = Mail::IMAPClient->new(
                                        Server   => $imapServer,
                                        User     => $imapUser,
                                        Port     => $imapPort,
                                        Password => $imapPass,
                                        Peek     => 1,
                                       ) or die "Cannot connect: $@";
               }
       }

       $imap->select($imapMailbox);

       my $msg = $$messageRef;

       if (!$noFromLine) { $msg = $fromLine . $msg; }

       # X-FetchYahoo: version 2.8.0 MsgId 7768_38951_10786_1209_3560_0_83_11889_2047182648
       #my $fyid = $mimeHead->get('X-FetchYahoo');
       # could then do loop with $imap->parse_headers to look for this so we don't do duplicates

       my $uid = $imap->append($imapMailbox,$msg) or die "Could not append: $@\n";
  } 

}

sub safeSleep
{
        if ($safeDownload) { sleep $safeSleepTime ; }
}

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

    # replace html tags we should keep
    $string =~ s/<BR>/\n/gi ;

    # remove unnecessary html tags
    $string =~ s/<a .*?>//gi;
    $string =~ s/<\/a>//gi;
    $string =~ s/<div .*?>//gi;
    $string =~ s/<\/div>//gi;

    # $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;
}

sub PopulateMap() {

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

##### begin excerpt from Digest-Perl-MD5-1.6 MD5.pm ######

# I-Vektor
sub A() { 0x67_45_23_01 }
sub B() { 0xef_cd_ab_89 }
sub C() { 0x98_ba_dc_fe }
sub D() { 0x10_32_54_76 }

# for internal use
sub MAX() { 0xFFFFFFFF }

# padd a message to a multiple of 64
sub padding {
    my $l = length (my $msg = shift() . chr(128));    
    $msg .= "\0" x (($l%64<=56?56:120)-$l%64);
    $l = ($l-1)*8;
    $msg .= pack 'VV', $l & MAX , ($l >> 16 >> 16);
}


sub rotate_left($$) {
        #$_[0] << $_[1] | $_[0] >> (32 - $_[1]);
        #my $right = $_[0] >> (32 - $_[1]);
        #my $rmask = (1 << $_[1]) - 1;
        ($_[0] << $_[1]) | (( $_[0] >> (32 - $_[1])  )  & ((1 << $_[1]) - 1));
        #$_[0] << $_[1] | (($_[0]>> (32 - $_[1])) & (1 << (32 - $_[1])) - 1);
}

sub gen_code {
  # Discard upper 32 bits on 64 bit archs.
  my $MSK = ((1 << 16) << 16) ? ' & ' . MAX : '';
#        FF => "X0=rotate_left(((X1&X2)|(~X1&X3))+X0+X4+X6$MSK,X5)+X1$MSK;",
#        GG => "X0=rotate_left(((X1&X3)|(X2&(~X3)))+X0+X4+X6$MSK,X5)+X1$MSK;",
  my %f = (
        FF => "X0=rotate_left((X3^(X1&(X2^X3)))+X0+X4+X6$MSK,X5)+X1$MSK;",
        GG => "X0=rotate_left((X2^(X3&(X1^X2)))+X0+X4+X6$MSK,X5)+X1$MSK;",
        HH => "X0=rotate_left((X1^X2^X3)+X0+X4+X6$MSK,X5)+X1$MSK;",
        II => "X0=rotate_left((X2^(X1|(~X3)))+X0+X4+X6$MSK,X5)+X1$MSK;",
  );
  #unless ( (1 << 16) << 16) { %f = %{$CODES{'32bit'}} }
  #else { %f = %{$CODES{'64bit'}} }

  my %s = (  # shift lengths
        S11 => 7, S12 => 12, S13 => 17, S14 => 22, S21 => 5, S22 => 9, S23 => 14,
        S24 => 20, S31 => 4, S32 => 11, S33 => 16, S34 => 23, S41 => 6, S42 => 10,
        S43 => 15, S44 => 21
  );

  my $insert = "";
  while(<DATA>) {
        chomp;
        next unless /^[FGHI]/;
        my ($func,@x) = split /,/;
        my $c = $f{$func};
        $c =~ s/X(\d)/$x[$1]/g;
        $c =~ s/(S\d{2})/$s{$1}/;
        $c =~ s/^(.*)=rotate_left\((.*),(.*)\)\+(.*)$//;

        #my $rotate = "(($2 << $3) || (($2 >> (32 - $3)) & (1 << $2) - 1)))"; 
        $c = "\$r = $2;
        $1 = ((\$r << $3) | ((\$r >> (32 - $3))  & ((1 << $3) - 1))) + $4";
        $insert .= "\t$c\n";
  }
  close DATA;
  
  my $dump = '
  sub round {
        my ($a,$b,$c,$d) = @_[0 .. 3];
        my $r;

        ' . $insert . '
        $_[0]+$a' . $MSK . ', $_[1]+$b ' . $MSK . 
        ', $_[2]+$c' . $MSK . ', $_[3]+$d' . $MSK . ';
  }';
  eval $dump;
  # print "$dump\n";
  # exit 0;
}

#########################################
# Private output converter functions:
sub _encode_hex { unpack 'H*', $_[0] }

sub md5 {
        my $message = padding(join'',@_);
        my ($a,$b,$c,$d) = (A,B,C,D);
        my $i;
        for $i (0 .. (length $message)/64-1) {
                my @X = unpack 'V16', substr $message,$i*64,64;        
                ($a,$b,$c,$d) = round($a,$b,$c,$d,@X);
        }
        pack 'V4',$a,$b,$c,$d;
}
sub md5_hex { _encode_hex &md5 }

##### end excerpt from Digest-Perl-MD5-1.6 MD5.pm ######

__DATA__
FF,$a,$b,$c,$d,$_[4],7,0xd76aa478,/* 1 */
FF,$d,$a,$b,$c,$_[5],12,0xe8c7b756,/* 2 */
FF,$c,$d,$a,$b,$_[6],17,0x242070db,/* 3 */
FF,$b,$c,$d,$a,$_[7],22,0xc1bdceee,/* 4 */
FF,$a,$b,$c,$d,$_[8],7,0xf57c0faf,/* 5 */
FF,$d,$a,$b,$c,$_[9],12,0x4787c62a,/* 6 */
FF,$c,$d,$a,$b,$_[10],17,0xa8304613,/* 7 */
FF,$b,$c,$d,$a,$_[11],22,0xfd469501,/* 8 */
FF,$a,$b,$c,$d,$_[12],7,0x698098d8,/* 9 */
FF,$d,$a,$b,$c,$_[13],12,0x8b44f7af,/* 10 */
FF,$c,$d,$a,$b,$_[14],17,0xffff5bb1,/* 11 */
FF,$b,$c,$d,$a,$_[15],22,0x895cd7be,/* 12 */
FF,$a,$b,$c,$d,$_[16],7,0x6b901122,/* 13 */
FF,$d,$a,$b,$c,$_[17],12,0xfd987193,/* 14 */
FF,$c,$d,$a,$b,$_[18],17,0xa679438e,/* 15 */
FF,$b,$c,$d,$a,$_[19],22,0x49b40821,/* 16 */ 
GG,$a,$b,$c,$d,$_[5],5,0xf61e2562,/* 17 */
GG,$d,$a,$b,$c,$_[10],9,0xc040b340,/* 18 */
GG,$c,$d,$a,$b,$_[15],14,0x265e5a51,/* 19 */
GG,$b,$c,$d,$a,$_[4],20,0xe9b6c7aa,/* 20 */
GG,$a,$b,$c,$d,$_[9],5,0xd62f105d,/* 21 */
GG,$d,$a,$b,$c,$_[14],9,0x2441453,/* 22 */
GG,$c,$d,$a,$b,$_[19],14,0xd8a1e681,/* 23 */
GG,$b,$c,$d,$a,$_[8],20,0xe7d3fbc8,/* 24 */
GG,$a,$b,$c,$d,$_[13],5,0x21e1cde6,/* 25 */
GG,$d,$a,$b,$c,$_[18],9,0xc33707d6,/* 26 */
GG,$c,$d,$a,$b,$_[7],14,0xf4d50d87,/* 27 */
GG,$b,$c,$d,$a,$_[12],20,0x455a14ed,/* 28 */
GG,$a,$b,$c,$d,$_[17],5,0xa9e3e905,/* 29 */
GG,$d,$a,$b,$c,$_[6],9,0xfcefa3f8,/* 30 */
GG,$c,$d,$a,$b,$_[11],14,0x676f02d9,/* 31 */
GG,$b,$c,$d,$a,$_[16],20,0x8d2a4c8a,/* 32 */
HH,$a,$b,$c,$d,$_[9],4,0xfffa3942,/* 33 */
HH,$d,$a,$b,$c,$_[12],11,0x8771f681,/* 34 */
HH,$c,$d,$a,$b,$_[15],16,0x6d9d6122,/* 35 */
HH,$b,$c,$d,$a,$_[18],23,0xfde5380c,/* 36 */
HH,$a,$b,$c,$d,$_[5],4,0xa4beea44,/* 37 */
HH,$d,$a,$b,$c,$_[8],11,0x4bdecfa9,/* 38 */
HH,$c,$d,$a,$b,$_[11],16,0xf6bb4b60,/* 39 */
HH,$b,$c,$d,$a,$_[14],23,0xbebfbc70,/* 40 */
HH,$a,$b,$c,$d,$_[17],4,0x289b7ec6,/* 41 */
HH,$d,$a,$b,$c,$_[4],11,0xeaa127fa,/* 42 */
HH,$c,$d,$a,$b,$_[7],16,0xd4ef3085,/* 43 */
HH,$b,$c,$d,$a,$_[10],23,0x4881d05,/* 44 */
HH,$a,$b,$c,$d,$_[13],4,0xd9d4d039,/* 45 */
HH,$d,$a,$b,$c,$_[16],11,0xe6db99e5,/* 46 */
HH,$c,$d,$a,$b,$_[19],16,0x1fa27cf8,/* 47 */
HH,$b,$c,$d,$a,$_[6],23,0xc4ac5665,/* 48 */
II,$a,$b,$c,$d,$_[4],6,0xf4292244,/* 49 */
II,$d,$a,$b,$c,$_[11],10,0x432aff97,/* 50 */
II,$c,$d,$a,$b,$_[18],15,0xab9423a7,/* 51 */
II,$b,$c,$d,$a,$_[9],21,0xfc93a039,/* 52 */
II,$a,$b,$c,$d,$_[16],6,0x655b59c3,/* 53 */
II,$d,$a,$b,$c,$_[7],10,0x8f0ccc92,/* 54 */
II,$c,$d,$a,$b,$_[14],15,0xffeff47d,/* 55 */
II,$b,$c,$d,$a,$_[5],21,0x85845dd1,/* 56 */
II,$a,$b,$c,$d,$_[12],6,0x6fa87e4f,/* 57 */
II,$d,$a,$b,$c,$_[19],10,0xfe2ce6e0,/* 58 */
II,$c,$d,$a,$b,$_[10],15,0xa3014314,/* 59 */
II,$b,$c,$d,$a,$_[17],21,0x4e0811a1,/* 60 */
II,$a,$b,$c,$d,$_[8],6,0xf7537e82,/* 61 */
II,$d,$a,$b,$c,$_[15],10,0xbd3af235,/* 62 */
II,$c,$d,$a,$b,$_[6],15,0x2ad7d2bb,/* 63 */
II,$b,$c,$d,$a,$_[13],21,0xeb86d391,/* 64 */
