fetchyahoo-2.14.7/0000755000175000017500000000000011741610265014447 5ustar chakravirchakravirfetchyahoo-2.14.7/version0000644000175000017500000000000711741610265016054 0ustar chakravirchakravir2.14.7 fetchyahoo-2.14.7/fetchyahoo0000755000175000017500000033751011741610265016537 0ustar chakravirchakravir#!/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 = <= 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 = ; } 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 = ; } 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 = ; 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 = ; } 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 = ; 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 =~ /^/ ) && $mainPage =~ // ) && $mainPage =~ />>'."\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/]*>(Read|Unread)<\/b><\/td>]*?>([^<]*?)<\/td>([^<]*?)<\/td><\/tr>//ms ) || ($folder[$foldernum] ne 'Draft' && ($yahooVersion==0||$folder[$foldernum] ne 'Sent') && $tmpPage =~ s/]*?>([^<]*?)<\/td>([^<]*?)<\/td><\/tr>//ms) || ($folder[$foldernum] eq 'Draft' && $tmpPage =~ s/^.*?^[\s]*([^<].*?)<.*?^.*?^[\s]*(.*?)<.*?^[\s]*(.*?)]*>(Read|Unread)<\/b><\/td>]*>]*value="([^"]+)"[^>]*>(.*?)(
)([^<]*)<\/div>.*?\s*title="([^"]+)">.*?]*>([^<]*)<\/td>([^<]*)<\/td>//ms) || ($folder[$foldernum] eq 'Sent' && $yahooVersion==1 && $tmpPage =~ s/.*?name="mid"\s*value="([^"]*)"(.*?)(
)([^<]*)<\/div>.*?title="([^"]*)".*?]*>([^<]*)<\/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/&/&/; $name =~ s/<//; $name =~ s/'/'/; $name =~ s/"/"/; $name =~ s/"/"/; $subject =~ s/&/&/; $subject =~ s/<//; $subject =~ s/'/'/; $subject =~ s/"/"/; $subject =~ s/"/"/; # 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=; 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 =~ /^\s*\s*