#!/usr/bin/perl -w
#    GotMail - perl script to get mail from hotmail mailboxes.
#    Copyright (C) 2000 Peter Hawkins <peterhawkins@ozemail.com.au>
#
#    This program is free software; you can redistribute it and/or modify
#    it under the terms of the GNU General Public License as published by
#    the Free Software Foundation; either version 2 of the License, or
#    (at your option) any later version.
#
#    This program is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU General Public License for more details.
#
#    You should have received a copy of the GNU General Public License
#    along with this program; if not, write to the Free Software
#    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

#    Please forgive my obvious lack of perl expertise.

use English;
use URI::Escape;
use POSIX qw(tmpnam);
use FileHandle;
use strict;

# Hide command line in a "ps" listing;
$0 = '[ gotmail getting new messages ]';
# FIXME: This is, however, completely futile, because curl displays the username and password anyway.  Any suggestions on how to tell curl to hide it's command line? The perl FAQ also reliably informs us that this isn't particularly wonderful security anyway.

# Constants...
# FIXME: This may have race conditions but do I look like I care? It's better than just /tmp/blah =)
my($tmp_headers) = tmpnam()."gotmail_headers";
my($tmp_cookies) = tmpnam()."gotmail_cookies";


my($log) = "/tmp/gotmail_log";
my($gotmail_version) = "0.6.6";
my($gotmail_date) = "2001-07-24";

# Blacklisted hosts. These hosts have known problems with the &raw=0 option.
# If we are told to use this host, we will disregard the request and instead
# use the whitelist host below. If you are having problems getting mail, try
# adding your host to the blacklist. If this improves matters, email me and
# I'll add it to defaults.
my(@host_blacklist) = ("lw3fd.law3.hotmail.msn.com", "lw8fd.law8.hotmail.msn.com");
my($host_known_good) = "lc2.law5.hotmail.com";

# Some option dependant variables
my($conf_proxy)="";
my($conf_proxy_auth)="";
my($login) = "";
my($password) = "";
my($resend_address) = "";
my($conf_folders) = "";
my($conf_folder_directory) = "";
my($conf_only_get_new_messages) = 0;
my($conf_mark_messages_as_read) = 0;
my($conf_delete_messages_after_download) = 0;
my($conf_sendmail) = "";
my($conf_curl) = "";
my($conf_speed_limit) = 0;
my($conf_retry_limit) = 2;
my($conf_verbosity) = 0;  # -1 = silent; 0 = normal; 1 = verbose; 2 = debug spew

# Global variables...
my($host) = ""; # The name of the hotmail server we are talking to...
my($gotconfig) = 0; # Have we found a config file?
my(@cookies) = ();

# Various utility functions
sub dispIntroText()
{
    if ($conf_verbosity >= 0)
    {
        print "Gotmail v".$gotmail_version."    Copyright (C) 2000 Peter Hawkins\n";
	print "Gotmail comes with ABSOLUTELY NO WARRANTY.\n";
	print "This is free software, and you are welcome to redistribute it\n";
	print "under certain conditions; see the file COPYING for details.\n\n";
    }
}

sub dispVersionText()
{
    print "Version information: Gotmail v".$gotmail_version."   Date: ".$gotmail_date."\n";
}

sub dispUsageAndExit()
{
	# We are about to quit, so we want to show the user everything.
	$conf_verbosity = 0;
	dispIntroText();

	print "Usage:\ngotmail [OPTIONS...]\n";

	print "\nOptions:\n";
	print "  -?, --help, --usage         Display this screen\n";
	print "  --version                   Display version information\n";
	print "  -u, --username              Specify your hotmail username (REQUIRED)\n";
	print "  -p, --password              Specify your hotmail password (REQUIRED)\n";
	print "  --proxy host:port           Specify an HTTP proxy to use. Format is\n" .     "                              host:port - eg: localhost:3128\n";
	print "  --proxy-auth user:password  Specify authentification details for the HTTP\n" . "                              proxy.\n";
	print "  -f, --forwarding-email      Specify an email address to forward to. If a\n". "                              forwarding address is not given, messages will\n"."                              be saved to disk\n";
	print "  --folders \"folders\"         Only get these folders (list of folders in quotes)\n";
	print "  --folder-directory /my/dir  Download messages into this directory\n";
	print "  --only-new-messages         Only unread messages will be retrieved\n";
	print "  --mark-messages-as-read     Messages will be marked as read once downloaded\n";
	print "  --delete-messages           Messages will be deleted after download\n";
	print "  --retry-limit max_tries     Maximum number of attempts to download a message\n";
	print "  --speed-limit               Throttle back rate of giving messages to sendmail\n";
	print "  --silent                    Do not print messages\n";
	print "  -v, --verbose               Verbosely print messages\n";
	print "  --debug                     Print debug output\n";
	exit();
}

# Display some text to the screen, and log it, if we are in debug mode.
sub dispText($)
{
    my($text) = @_;

    if ($conf_verbosity >= 0) {
	print $text;
    }

    if ($conf_verbosity > 1) {
	my($out) = new FileHandle ">> $log" || return;
	print $out $text;
	close $out;
    }
}

#
# Parse ~/.gotmailrc
#
# Inserted code to parse ~/.gotmailrc
# This *should* hopefully be a little secure than specifying your
# username and password on the command line.
# parseArgs() is called afterwards, so you can override any settings.
# Thanks to Patrick Froede
sub parseConfig {
	# Open the config file, otherwise bail out of this subroutine
	open(RCFILE, $ENV{"HOME"} . "/.gotmailrc") || return;

	# Parse the file
	while (<RCFILE>) {
		next if ($_ =~ /^#/);
		if ($_ =~ /user=(.+)/i) {
			$login = $1;
		} elsif ($_ =~ /pass=(.+)/i) {
			$password = $1;
		} elsif ($_ =~ /proxy=(.+)/i) {
			if ($1 !~ /^no$/i) {
				$conf_proxy = $1;
			}
		} elsif ($_ =~ /proxy_auth=(.+)/i) {
			if ($1 !~ /^no$/i) {
				$conf_proxy_auth = $1;
			}
		} elsif ($_ =~ /forward=(.+)/i) {
			if ($1 !~ /^no$/i) {
				$resend_address = $1;
			}
		} elsif ($_ =~ /folders=(.+)/i) {
				$conf_folders = $1;
		} elsif ($_ =~ /folder_directory=(.+)/i) {
				$conf_folder_directory = $1;
				if ($conf_folder_directory !~ /\/$/) {
					# Make sure it has a trailing slash
	                        	$conf_folder_directory.="/";
				}
		} elsif ($_ =~ /markread=(.+)/i) {
			if ($1 !~ /^no$/i) {
				$conf_mark_messages_as_read = 1;
			}
		} elsif ($_ =~ /delete=(.+)/i) {
			if ($1 !~ /^no$/i) {
				$conf_delete_messages_after_download = 1;
			}
		} elsif ($_ =~ /onlynew=(.+)/i) {
			if ($1 !~ /^no$/i) {
				$conf_only_get_new_messages = 1;
			}
		} elsif ($_ =~ /speedlimit=(.+)/i) {
			if ($1 !~ /^no$/i) {
				$conf_speed_limit = 1;
			}
		} elsif ($_ =~ /retrylimit=([0-9]+)/i) {
				$conf_retry_limit=$1;
		} elsif ($_ =~ /silent=(.+)/i) {
			if ($1 !~ /^no$/i) {
				$conf_verbosity = -1;
                        }
                }
	}

	# Make a note that we obtained some configs from the options file
	$gotconfig = 1;
	close(RCFILE);
}

# Parse the command line
sub parseArgs()
{
	if (!@ARGV && ($gotconfig == 0))  # If we have a config file, we don't care if there aren't any arguments...
	{
		dispUsageAndExit();
	}
	while(@ARGV) { 
		my($element)=shift(@ARGV);
		if (($element =~ /-\?/i) || ($element =~ /--help/i) || ($element =~ /--usage/i))
		{
			dispUsageAndExit();
			exit();
		}
		elsif ($element =~ /--version/) {
			dispVersionText();
			exit();
		}
		elsif (($element =~ /^-u$/i) || ($element =~ /--username/i))
		{
			if (@ARGV) {
				$login = shift(@ARGV);
			} else {
				dispUsageAndExit();
			}
		}
		elsif (($element =~ /^-p$/i) || ($element =~ /--password/i))
		{
			if (@ARGV) {
				$password = shift(@ARGV);
			} else {
				dispUsageAndExit();
			}
		}
		elsif ($element =~ /--proxy/i)
		{
			if(@ARGV) {
				$conf_proxy = shift(@ARGV);
			} else {
				dispUsageAndExit();
			}
		}
		elsif ($element =~ /--proxy-auth/i)
		{
			if(@ARGV) {
				$conf_proxy_auth = shift(@ARGV);
			} else {
				dispUsageAndExit();
			}
		}
		elsif ($element =~ /--folder-directory/i)
		{
			if(@ARGV) {
				$conf_folder_directory = shift(@ARGV);
			} else {
				dispUsageAndExit();
			}
			if ($conf_folder_directory !~ /\/$/) {
				# Make sure it has a trailing slash
                        	$conf_folder_directory.="/";
			}
		}
		elsif (($element =~ /^-f$/i) || ($element =~ /--forwarding-email/i)) {
			if (@ARGV) {
				$resend_address = shift(@ARGV);
			} else {
				dispUsageAndExit();
				exit;
			}
		}
		elsif ($element =~ /^--folders$/i) {
			if (@ARGV) {
				$conf_folders = shift(@ARGV);
			} else {
				dispUsageAndExit();
				exit;
			}
		}
		elsif ($element =~ /^--retry-limit$/i) {
			if (@ARGV) {
				$conf_retry_limit = shift(@ARGV);
			} else {
				dispUsageAndExit();
				exit;
			}
		}
		elsif ($element =~ /--only-new-messages/i) {
			$conf_only_get_new_messages = 1;
		}
		elsif ($element =~ /--mark-messages-as-read/i) {
			$conf_mark_messages_as_read = 1;
		}
		elsif ($element =~ /--delete-messages/i) {
			$conf_delete_messages_after_download = 1;
		}
		elsif ($element =~ /--speed-limit/i) {
			$conf_speed_limit = 1;
		}
		elsif ($element =~ /--silent/i) {
			$conf_verbosity = -1;
		}
		elsif ($element =~ /--debug/i) {
			$conf_verbosity = 2;
		}
		elsif (($element =~ /--verbose/i) || ($element =~ /^-v$/i)) {
			$conf_verbosity = 1;
		}
		else {
			dispText("Unrecognised option $element\n");
			dispUsageAndExit();
		}
	}

	if (($login eq "") || ($password eq ""))
	{
		dispText("A username and password are REQUIRED.\n");
		dispUsageAndExit();
	}
}

# Clean up any temporary files
sub doCleanTempFiles()
{
	if (-e $tmp_headers) { unlink($tmp_headers); }
	if (-e $tmp_cookies) { unlink($tmp_cookies); }
}

sub doCleanOtherFiles()
{
	if (-e $log) 	     { unlink($log); }
}

# Check all the required programs are installed.
sub doCheckPrograms()
{
	if ($conf_verbosity > 1) {
		dispText("System version is: ".$OSNAME."\n");
		dispText("Perl version is:   ".$PERL_VERSION."\n");
	}


	if (-x "./curl") { $conf_curl = "./curl"; }
	else { $conf_curl = "curl"; }
	if ($conf_verbosity > 1) { dispText("Curl version is:   ".`$conf_curl --version`."\n"); }

	# Try looking for sendmail in a few common places.
	$conf_sendmail = "sendmail";
	if (-x "/usr/sbin/sendmail") { $conf_sendmail = "/usr/sbin/sendmail" }
	elsif (-x "/usr/lib/sendmail") { $conf_sendmail = "/usr/lib/sendmail" }
}

# Grep any cookies from the header file into the cookies file.
sub getCookies()
{
	my($in) = new FileHandle "< $tmp_headers" || return;
	while (<$in>)
	{
		if (m/^Set-Cookie: ([A-Za-z0-9]*)=/i) {
			# Remove any previous setting for this cookie
			@cookies = grep { !/$1/ } @cookies;

			# Make cookies globally applicable. Evil. =)
			s/domain=([^\;]+)\;/domain=.com\;/;

			push(@cookies, $_);
		}
	}
	close($in);

	# Dump the cookie list into a file so curl can read it.
	my($out) = new FileHandle "> $tmp_cookies" || return;
	my $cookiestr = join "", @cookies;
	print $out $cookiestr;
	if ($conf_verbosity > 1)
	{
		dispText("Cookies are $cookiestr\n");
	}
	close($out);
}


# Fetch a given page using curl
# The parameters taken are the URL, any data to be posted in a POST,
# whether we are to follow HTTP redirects, and whether we should send and receive
# cookies, whether we should only get the headers for this page and not the body.
sub getPage($$$$$)
{
	my($url, $params, $follow_forward, $cookies, $headers_only) = @_;

	if ($conf_verbosity > 0) {
		dispText "FETCH: $url\n";
	}
	
	# Set up the options string...
	my($options) = "";
	if ($conf_proxy) { $options .= "--proxy ". $conf_proxy . " "; }
	if ($conf_proxy_auth) { $options .= "--proxy-user ". $conf_proxy_auth . " "; }
	if ($cookies != 0) { $options .= "-b $tmp_cookies " }
	if ($params ne "") { $options .= "--data \"$params\" " }
	if ($headers_only) { $options .= "-I " }
	if ($conf_verbosity <= 0) { $options .= "-s -S " }
	# Get rid of any trailing space on options.. Just for neatness.
	$options =~ s/ $//;

	my($cmdline) = "$conf_curl \"$url\" $options -i -m 600 -D $tmp_headers -A \"Mozilla/4.73 [en] (Win98; I)\"";
	if ($conf_verbosity > 1) {
	 	$cmdline .= "| tee -a $log"; # Copy output to the logfile
		dispText("command line: $cmdline\n");
	}
	my $tries = 1;
	my(@tmp_page) =  `$cmdline`;

	# Retry at most $conf_retry_limit times if we fail.
	while (!@tmp_page && !$headers_only && $tries++ <= $conf_retry_limit) {
		dispText("An error was encountered getting the page, retrying [$tries/$conf_retry_limit]...\n");
		@tmp_page = `$cmdline`;
	}
	if (!@tmp_page && !$headers_only && $tries > $conf_retry_limit) {
		die("An error was encountered getting the page. Command was $cmdline"); 
	}

	if ($cookies != 0) { getCookies(); }

	# If we have been asked to follow Location: headers
	if ($follow_forward)
	{
		$_ = join("", grep { /^Location:/ } @tmp_page);
		if (m/Location: (\S+)\s/)
		{
			if ($conf_verbosity > 1) { dispText("Following redirect to $1\n"); }
			return getPage($1, "", $follow_forward, $cookies, $headers_only);
		}
	}

	if ($conf_verbosity > 0) { dispText "\n"; }

	return @tmp_page;
}

# Do the HotMail login process - log in until we have the URL of the inbox.
sub doLogin()
{
	dispText("Getting hotmail index page...\n");
	my(@index_page) = getPage("http://www.hotmail.com/", "", 1, 0, 0);

	# Find the form "ACTION" parameter...
	my($login_script) = "";

	my $page = join "", @index_page;
	if ($page =~ m/<form(.*)action=\"(\S+)\"(.*)>/i) {
		$login_script = $2;
	}

	my($params) = "login=". uri_escape($login, "^A-Za-z"). "\&passwd=" . uri_escape($password, "^A-Za-z");
	dispText("Logging in...\n");
	my(@login_page) = getPage($login_script, $params, 0, 1, 0);

	# Find where they are sending us now... 
	my($redirect_location) = "";
	$page = join "", @login_page;
	
	if ($page =~ m/<meta(.*)content=\"(.*)url=(\S+)\">/i) {
		$redirect_location = $3;
	} elsif ($page =~ m/\w+\.location\.replace\s*\(\"([^\"]+)\"/i) {
		$redirect_location = $1;
	}

	if ($redirect_location eq "")
	{
		die("Hotmail's page structure has changed!\n");
	} elsif ($redirect_location =~ /loginerr/i)
	{
		die("There was an error logging in. Please check your username and password are correct.\n");
	}
	
	if ($redirect_location =~ m/http:\/\/(\S+)\/cgi(\S+)/i)
	{
		$host = $1;
	} else {
		die ("Could not parse redirect location");	
	}
	
	dispText("Following redirect...\n");
	my(@redirect_page) = getPage($redirect_location, "", 0, 1, 0);

	# Find where the inbox is located... 
	my($inbox_location) = "";
	$page = join "", @redirect_page;
	if ($page =~ m/Location: (\S+)/i) {
		$inbox_location = $1;
	}
	elsif ($page =~ /unavailable/i) {
		die("Hotmail is reporting that your account is temporarily unavailable. Please try again later.");
	}
	if ($inbox_location eq "")
	{
		die("Hotmail's page structure has changed!\n");
	}
	return $inbox_location;
}


sub doSaveEmail($$)
{
	my ($output, $email) = @_;

	my($OUT) = new FileHandle ">> $output";

	if (! defined ($OUT))
	{
		die("Unable to open $output.");
	}

	print $OUT $email;

	$OUT->close();
}

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

	my($OUT) = new FileHandle "| $conf_sendmail $destaddr";
	if (! defined ($OUT))
	{
		die("Unable to open sendmail - was using $conf_sendmail $destaddr.");
	}
	# Dump the message to sendmail.
	print $OUT $email;

	$OUT->close();
	if ($conf_speed_limit) { sleep(1); }
}

sub getEmail($$)
{
	my($url, $stripmboxheader ) = @_;
	my(@output) = ();

	dispText("Getting email messages...\n");

	# If the host is blacklisted, go through the hotmail cookie redirection maze to get a raw message
	# Check for blacklisted host. Work around for dud hosts.
	if (grep(/$host/i, @host_blacklist))
	{
            my $saferd_url = "http://$host/cgi-bin/saferd?_lang=\&hm___tg=".uri_escape("http://$host_known_good/cgi-bin/getmsg", "^A-Za-z0-9")."\&hm___qs=".uri_escape($url."\&raw=0", "^A-Za-z0-9")."\&hm___fl=attrd";
  	    my @saferd_page = getPage($saferd_url,"",0,1,0);
	    my $mail_url = join "", grep(/<frame name=\"attachment\"/, @saferd_page);
	    $mail_url =~ m/<frame(.*)src=\"(\S+)\"/i;
	    $url = $2;

	    if ($url eq "")
	    {
	    	    die("Error in email redirection - ".join("",@saferd_page));
	    }
	}
	else
	{
		$url = "http://$host/cgi-bin/getmsg?".$url."\&raw=0";
	}
	
	my(@email_page) = getPage($url, "", 1, 1, 0);

 	my $emailstr = join "", @email_page;
	if ($emailstr !~ /pre/) {
  	    die("Unable to download email message - $emailstr\n");
	}

	# Get everything between the <pre> </pre> tags 
 	@email_page = split(/<pre>|<\/pre>/, $emailstr);
	if (@email_page!=3)
	{
	    die("Unable to download email message - $emailstr\n");
	}
        $_ = $email_page[1];

	s/^(\s*)//;
	if ($stripmboxheader)
	{
 	    s/^From (.*)\n//;
	}
	else
	{
	    s/^From\s+(\S+)\s+(\w+),\s+(\d+)\s+(\w+)\s+(\d+)\s+(\d+:\d+:\d+)/From $1 $2 $4 $3 $6 $5/;
	}

	# Strip any HTML artifacts from the message body.
	s/&amp;/&/g;
	s/&lt;/</g;
	s/&gt;/>/g;
	s/&quot;/\"/g;
	return $_;
}

# Get the messages from a folder called $foldername at $url
sub getFolder($$$)
{
	my($foldername, $url, $page) = @_;

	# Get the folder in newest first order
	dispText("Loading folder \"$foldername\" page $page...\n");
        # "sort=rNew" = newest first 
	my(@folder) = getPage("http://$host/cgi-bin/HoTMaiL?$url\&sort=rNew", "", 1, 1, 0);

	# Find the location of the "Next page" link
	my $next_page_str = join("", grep(/Next Page/i, @folder));

	# Redo the list on a table row by table row basis
	my @messages = split(/<tr[^>]*>|<\/tr>/i, join("",@folder)); 
	@messages = grep(/<a href=\"\/cgi-bin\/getmsg\?/i, @messages);

	# Get the messages in this folder...
	foreach my $item (@messages)
	{
		if ($item =~ m/<a href=\"\/cgi-bin\/getmsg\?(\S+)\">/i) {
			my $msg_url = $1;
			# Since the folder is in newest first order, if we are only getting new messages, and this is not a new message, we can stop here.
			if ($conf_only_get_new_messages && ($item !~ /newmail/i)) {
				return;
			}

			# Are we resending or saving?
			if ($resend_address eq "")
			{
				my($output) = getEmail($msg_url, 0);
				doSaveEmail($conf_folder_directory.$foldername, $output);
			} else {
				my($output) = getEmail($msg_url, 1);
				doResendEmail($resend_address, $output);
			}

			if ($conf_delete_messages_after_download)
			{
				dispText("Deleting message...\n");
				getPage("http://$host/cgi-bin/nextprev?".$msg_url."\&action=move\&tobox=trAsH", "", 0, 1, 1);
			}
			elsif ($conf_mark_messages_as_read)
			{
				dispText("Marking message as read...\n");
				getPage("http://$host/cgi-bin/getmsg?".$msg_url, "", 0, 1, 1);
			}
		}	
	}

	
	# If a "next page" exists, let's go there...
	if ($next_page_str =~ m/<a href=\"\/cgi-bin\/HoTMaiL\?(\S+)\">Next Page<\/a>/) {
		getFolder($foldername, $1, $page + 1);
	}
}

# Get a list of the folders we have to deal with and parse them one by one.
sub doGetFolders($)
{
	my ($inbox_location) = @_;
	dispText("Loading main display...\n");
	if ($inbox_location !~ m/^http/)
	{
	    $inbox_location = "http://$host/cgi-bin/".$inbox_location;
	}
	my(@inbox_page) = getPage($inbox_location, "", 0, 1, 0);

	# Ok, we have the location of the inbox. Where's the master list of folders?
	my($folder_index_url) = "";
	foreach my $item (@inbox_page)
	{
		if ($item =~ m/<a(.*)href=\".*\/cgi-bin\/folders\?(\S+)\"/i)
		{
			$folder_index_url = $2;
		}
	}

	if ($folder_index_url eq "") {
		die("Could not isolate folder index location\n");
	}

	# Ok let's get the folder list!
	dispText("Loading folder list...\n");
	my @folder_list = getPage("http://$host/cgi-bin/folders?$folder_index_url", "", 0, 1, 0);
	
	# Join the page into one big string, and split it into bits that interest us
 	my $onestr = join "", @folder_list;
 	$onestr =~ s/\n/ /g;
 	@folder_list = grep { /<td><a\s*href=\"\/cgi-bin\/HoTMaiL\?/ }
		split(/(<tr[^>]*>|<\/tr>)/, $onestr);

	foreach my $item (@folder_list)
	{
		if ($item =~ m/<a(.*)href=\"\/cgi-bin\/HoTMaiL\?(\S+)\"\s*><font class="Wf">(.+)<\/font><\/a>/) {
			my($url) = $2;
			my($name) = $3;	
			# We assume the presence of a <b> indicates new mail.
			if ((!$conf_only_get_new_messages) || ($item =~ /<b>/)) {
				# Check that this actually _is_ a folder name, without any html tags... Also makes sure we are not getting the trash (it looks really stupid when we download a message, delete it, and then download it again from the trash and delete it into the trash yet again =)
				if ( (!($name =~ /[<>]/)) && (!($name =~ /Trash Can/i))  && (!($name =~ /Sent Messages/i)) && (!($name =~ /Drafts/i)) && (($conf_folders eq "") || ($conf_folders =~ /$name/i)) )
				{
					getFolder($name, $url, 1);
				}
			}
		}
	}
}

# Make sure we end up cleaning up after ourselves
#END { doCleanTempFiles(); }

parseConfig();
parseArgs();
dispIntroText();
doCheckPrograms();
doCleanOtherFiles();
my($inbox_location) = doLogin();
doGetFolders($inbox_location);
dispText("\nAll done!\n");
#doCleanTempFiles();

exit;
