#!/usr/bin/perl # # GotMail - perl script to get mail from hotmail mailboxes. # Copyright (C) 2000-2002 Peter Hawkins # # 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 # # ----------------------------------------------------------------------- # Currently maintained by paul cannon for # Debian (http://www.debian.org/). Peter Hawkins is no longer # involved with the development of this software. # # Please send bug reports, patches, etc, to paul or to the Debian # Bug Tracking System (http://www.debian.org/Bugs/). # # See ChangeLog for modifications. # # $Id: gotmail,v 1.13 2003/03/14 00:11:39 paulcannon Exp $ require 5.004; # Uncomment this if you have SpamAssassin installed # eval "use Mail::SpamAssassin;"; use English; use URI::Escape; use POSIX qw(tmpnam); use FileHandle; use strict; # Signal handlers: $SIG{INT} = $SIG{TERM} > sub { my($text) = @_; print STDERR "gotmail died with message: $text\n"; print STDERR "Exiting abnormally, cleaning temp files.\n"; doCleanTempFiles(); exit(1); }; # Hide command line in a "ps" listing; $0 = '[ gotmail getting new messages ]'; # This is not great security. The command line can still be found by other # users. I recommend using a ~/.gotmailrc file, so that curl will be passed # the username and password via private temporary files. # Don't allow others to read our temp files my($oldumask) = umask(077); # Constants... # FIXME: This opens the possibility of race conditions. my($tmp_headers) = tmpnam()."gotmail_headers"; my($tmp_cookies) = tmpnam()."gotmail_cookies"; my($tmp_formdata) = tmpnam()."gotmail_form"; my($log) = "/tmp/gotmail_log"; my($gotmail_version) = "0.7.9"; my($gotmail_date) = "2003-03-13"; # Some option dependent variables my($conf_proxy)=""; my($conf_proxy_auth)=""; my($login) = ""; my($password) = ""; my($domain) = 'hotmail.com'; my($resend_address) = ""; my($conf_file) = ""; 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) = 'curl'; my($conf_speed_limit) = 0; my($conf_retry_limit) = 2; my($conf_verbosity) = 0; # -1 = silent; 0 = normal; 1 = verbose; 2 = debug spew my($conf_smtpserver) = ""; my($conf_save_to_login) = 0; # 0 = no, 1 = yes my($conf_procmail) = 0; # 0 = no, 1 = yes my($conf_sa) = 0; # 0 = no, 1 = yes my($conf_nodownload) = 0; # 0 = no, 1 = yes my($conf_deletespam) = 0; # 0 = no, 1 = yes my($conf_procmail_bin) = '/usr/bin/procmail'; # 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) = (); # 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; } } # Various utility functions sub dispIntroText() { if ($conf_verbosity >= 0) { print "Gotmail v".$gotmail_version." Copyright (C) 2000-2002 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"; if ($conf_verbosity > 1) { my($out) = new FileHandle ">> $log" || return; print $out "Gotmail v".$gotmail_version." logfile.\n"; close $out; } } } 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 " -c, --config-file Specify config file (default ~/.gotmailrc)\n"; print " -u, --username Specify your hotmail username (REQUIRED)\n"; print " -p, --password Specify your hotmail password (REQUIRED)\n"; print " -d, --domain Specify hotmail.com (default) or msn.com\n"; print " --proxy Specify an HTTP proxy to use. Format is\n" . " host:port - eg: localhost:3128\n"; print " --proxy-auth Specify authentification details for the\n" . " HTTP proxy.\n"; print " -s, --smtpserver Specify SMTP server. Will not use sendmail\n"; print " -f, --forward
Specify an email address to forward to. If a\n" . " forwarding address is not given, messages\n" . " will be saved to disk\n"; print " --folders \"folders\" Only get these folders (list of folders in\n" . " quotes, i.e.: \"Inbox, Bulk Mail\")\n"; print " --folder-dir /my/dir Download messages into this directory\n"; print " --only-new Only unread messages will be retrieved\n"; print " --mark-read Messages will be marked as read once downloaded\n"; print " --delete 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 " --save-to-login Save to folder-dir/username for Inbox and\n" . " /folder-dir/username-foldername for others\n"; print " --use-procmail Send all messages only to procmail\n"; print " --procmail-bin Use this program as procmail (default is\n" . " /usr/bin/procmail) (implies --use-procmail)\n"; print " --curl-bin Specify the path to the cURL program if it's\n" . " not in your path.\n"; print " --silent Do not print messages\n"; print " -v, --verbose Verbosely print messages\n"; print " --debug Print debug output\n"; print " --use-sa Use SpamAssassin to not ignore spam\n"; print " --delete-spam Delete spam from server when using SpamAssassin\n"; print " --nodownload Don't download anything (useful for clearing spam)\n"; exit(); } # 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 # and also to Tim Dijkstra. -pik- sub parseConfig { if ("@ARGV" =~ /(\s|^)(-c|--config-file)\ ([\w\.~\/\-]*)(\s|$)/i) { $conf_file = $3; if (! -r $conf_file) { die "Config file <$conf_file> is not readable!\n"; } } elsif ($ENV{"HOME"}) { $conf_file = $ENV{"HOME"} . "/.gotmailrc"; } else { if (-e $ENV{"HOMEDRIVE"} . $ENV{"HOMEPATH"} . ".gotmailrc") { # Using w2k environment variables. $conf_file = $ENV{"HOMEDRIVE"} . $ENV{"HOMEPATH"} . ".gotmailrc"; } elsif (-e "/.gotmailrc") { # Try root directory $conf_file = "/.gotmailrc"; } else { # Or try current directory $conf_file = "./.gotmailrc"; } } # Open the config file, otherwise bail out of this subroutine open(RCFILE, $conf_file) || return; # I made these options identical to the ones in the arguments. # To avoid breaking compatibility, the old names can also be # used. -pik- # Parse the file while () { next if ($_ =~ /^#/); if ($_ =~ /^user(name)?=(.+)$/i) { $login = $2; } elsif ($_ =~ /^pass(word)?=(.+)$/i) { $password = $2; } elsif ($_ =~ /^domain=hotmail\.com$/i) { $domain = 'hotmail.com'; } elsif ($_ =~ /^domain=msn\.com$/i) { $domain = 'msn.com'; } elsif ($_ =~ /^proxy=(.+)$/i) { $conf_proxy = $1; } elsif ($_ =~ /^proxy_auth=(.+)$/i) { $conf_proxy_auth = $1; } elsif ($_ =~ /^forward(ing-email)?=(.+)$/i) { $resend_address = $2; } elsif ($_ =~ /^folders=(.+)$/i) { @conf_folders = split(/ *, */, $1); } elsif ($_ =~ /^folder[_-]dir(ectory)?=(.+)$/i) { $conf_folder_directory = $2; if ($conf_folder_directory !~ /\/$/) { # Make sure it has a trailing slash $conf_folder_directory.="/"; } } elsif ($_ =~ /^retry-?limit=([0-9]+)$/i) { $conf_retry_limit=$1; } elsif ($_ =~ /^(mark-?read|mark-messages-as-read)/i) { $conf_mark_messages_as_read = 1; } elsif ($_ =~ /^delete/i) { $conf_delete_messages_after_download = 1; } elsif ($_ =~ /^only-?new/i) { $conf_only_get_new_messages = 1; } elsif ($_ =~ /^speed-?limit/i) { $conf_speed_limit = 1; } elsif ($_ =~ /^silent/i) { $conf_verbosity = -1; } elsif ($_ =~ /^smtpserver=(.+)$/i) { $conf_smtpserver=$1; } elsif ($_ =~ /^save-to-login/i) { $conf_save_to_login = 1; } elsif ($_ =~ /^use-procmail/i) { $conf_procmail = 1; } elsif ($_ =~ /^procmail-bin=(.+)$/i) { $conf_procmail_bin = $1; $conf_procmail = 1; } elsif ($_ =~ /^curl-bin=(.+)$/i) { $conf_curl = $1; } } # Make a note that we obtained some configs from the options file $gotconfig = 1; close(RCFILE); } # Parse the command line sub parseArgs() { # If we have a config file, we don't care if there aren't any arguments... if (address@hidden && ($gotconfig == 0)) { dispUsageAndExit(); } while(@ARGV) { my($element)=shift(@ARGV); if ($element =~ /^(-\?|--help|--usage)$/i) { dispUsageAndExit(); } elsif ($element =~ /^--version$/) { dispVersionText(); } elsif ($element =~ /^(-c|--config-file)$/) { shift(@ARGV); } elsif ($element =~ /^(-u|--username)$/i) { if (@ARGV) { $login = shift(@ARGV); } else { dispUsageAndExit(); } } elsif ($element =~ /^(-p|--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-dir(ectory)?$/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|--forward|--forwarding-email)$/i) { if (@ARGV) { $resend_address = shift(@ARGV); } else { dispUsageAndExit(); } } elsif ($element =~ /^--folders$/i) { if (@ARGV) { @conf_folders = split(/ *, */, shift(@ARGV)); } else { dispUsageAndExit(); } } elsif ($element =~ /^--retry-limit$/i) { if (@ARGV) { $conf_retry_limit = shift(@ARGV); } else { dispUsageAndExit(); } } elsif ($element =~ /^(-s|--smtpserver)$/i) { if (@ARGV) { $conf_smtpserver = shift(@ARGV); } else { dispUsageAndExit(); } } elsif ($element =~ /^(-d|--domain)$/i) { if (@ARGV) { $domain = shift(@ARGV); if ($domain ne 'msn.com') { $domain = 'hotmail.com'; } } } elsif ($element =~ /^--save-to-login$/i) { $conf_save_to_login = 1; } 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 =~ /^(-v|--verbose)$/i) { $conf_verbosity = 1; } elsif ($element =~ /^--use-procmail$/i) { $conf_procmail = 1; } elsif ($element =~ /^--procmail-bin$/i) { if (@ARGV) { $conf_procmail_bin = shift(@ARGV); $conf_procmail = 1; } else { dispUsageAndExit(); } } elsif ($element =~ /^--curl-bin$/i) { if (@ARGV) { $conf_curl = shift(@ARGV); } else { dispUsageAndExit(); } } elsif ($element =~ /^--use-sa$/i) { $conf_sa = 1; } elsif ($element =~ /^--delete-spam$/i) { $conf_deletespam = 1; } elsif ($element =~ /^--nodownload$/i) { $conf_nodownload = 1; } else { dispText("Unrecognized option $element\n"); dispUsageAndExit(); } } if (($login eq "") || ($password eq "")) { print STDERR "A username and password are REQUIRED.\n"; print STDERR "Try --help for usage info.\n"; exit 1; } } # Clean up any temporary files sub doCleanTempFiles() { if (-e $tmp_headers) { unlink($tmp_headers) or warn "Could not unlink tmp header: $!\n"; } if (-e $tmp_cookies) { unlink($tmp_cookies) or warn "Could not unlink tmp cookie: $!\n"; } if (-e $tmp_formdata) { unlink($tmp_formdata) or warn "Could not unlink tmp formdata: $!\n"; } } 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"); # $PERL_VERSION and $^V seem to be broken dispText("Perl version is: ".$]."\n"); } 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" } # Make sure procmail is there. if ((! -x $conf_procmail_bin) and $conf_procmail) { die "Procmail binary at \"$conf_procmail_bin\" can't be run. Aborting"; } } # Grep any cookies from the header file into the cookies file. sub parseHeaders($) { my ($getCookies) = @_; my $redirector = ""; my $newcook = ""; 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\;/; $newcook = uri_unescape($_); push(@cookies, $newcook); } if (m/^Location: (\S+)\s/) { $redirector = $1; } } close($in); if ($getCookies) { # 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); } return $redirector; } # 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, whether we should send and # receive cookies, and 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 ($url =~ m/http:\/\/(\S+?)\//i) { $host = $1; } 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)\""; # Copy output to logfile if necessary if ($conf_verbosity > 1) { $cmdline .= "| tee -a $log"; dispText("command line: $cmdline\n"); } my $tries = 1; my(@tmp_page) = `$cmdline`; # Retry at most $conf_retry_limit times if we fail. while (address@hidden && !$headers_only && $tries <= $conf_retry_limit) { dispText("Retrying [$tries/$conf_retry_limit]...\n"); $tries++; @tmp_page = `$cmdline`; } if (address@hidden && !$headers_only && $tries >= $conf_retry_limit) { die("An error was encountered getting the page. Command was $cmdline"); } my $redir = parseHeaders($cookies); # If we have been asked to follow Location: headers if ($follow_forward) { if ($redir ne "") { if ($conf_verbosity > 1) { dispText("Following redirect to $redir\n"); } return &getPage($redir, "", $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); ## This will have the login page. my($form_label); my(@java_page) = getPage("http://www.hotmail.com/", "", 1, 1, 0); ## @java_page is now an intermediate page which checks if you ## have javascript enabled or not!! my($page) = join("", @java_page); my($check_java); if($page =~ m//i) { $check_java = $1; } if ($check_java) { ## This processing happens only for the "new" hotmail structure. dispText("Processing java check....\n"); my($inp); ## This var will store all the input fields. while($page =~ m/<\s*input\s+.*name=\"(\S+)\"\s+value=\"(\S+)\"/) { $inp .= "$1=$2\&"; ## Get rid of the input field we processed. $page =~ s/<\s*input/some_weird_unique_value_jsdahf/; } ## Get rid of the last "&" $inp =~ s/&$//g; my($FORMFILE) = new FileHandle "> $tmp_formdata" || die "Couldn't open formdata file: $!\n"; print $FORMFILE ("$inp"); close($FORMFILE); my($params) = "address@hidden"; ## Hopefully this should get us to the correct index page. @index_page = getPage($check_java, $params, 0, 1, 0); $form_label = "hotmail_com"; } else { ## The "old" hotmail page structure @index_page = @java_page; $form_label = ""; } # Find the form "ACTION" parameter... my($login_script) = ""; my($ctnum) = ""; my $page = join "", @index_page; if ($page =~ m//i) { $login_script = $1; } if ($page =~ m/ct=([0-9]+)/i) { $ctnum = uri_escape($1); } if ($login_script eq "") { die "Page doesn't contain any form action field!\n"; } my($FORMFILE) = new FileHandle "> $tmp_formdata" || die "Couldn't open formdata file: $!\n"; print $FORMFILE ("login=" . uri_escape($login, "^A-Za-z") . "\&passwd=" . uri_escape($password, "^A-Za-z") . "\&svc=mail\&mspp_shared=1" . "\&domain=" . uri_escape($domain) . "\&RemoteDAPost=https://login.msnia.passport.com/ppsecure/post.asp" . "\&sec=share\&curmbox=ACTIVE\&js=yes\&_lang=EN" . "\&beta=0\&ishotmail=1\&id=2\&fs=1" . "\&cb=_lang%3dEN%26country%3dUS\&ct=$ctnum"); close $FORMFILE; my($params) = "address@hidden"; 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 ($domain eq 'msn.com') { if ($page =~ m/Location: (\S+)/i) { $redirect_location = $1; } elsif ($page =~ /unavailable/i) { die("Hotmail is reporting that your account is temporarily " . "unavailable. Please try again later.\n"); } if ($redirect_location eq "") { die("Hotmail's page structure has changed! (msncom)\n"); } my(@redirect_page) = getPage($redirect_location, "", 0, 1, 0); $page = join "", @redirect_page; } if ($page =~ m/top\.location\.replace\(\"(.*)\"\);/i) { $redirect_location = $1; $redirect_location =~ s/\$/\\\$/g; } if ($redirect_location eq "") { die("Hotmail's page structure has changed! (redirloc)\n"); } elsif ($redirect_location =~ /loginerr/i) { die("There was an error logging in. Please check that your " . "username and password are correct.\n"); } if ($redirect_location =~ m/http:\/\/([^\/]+)\/(.*)$/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) { my $inbox_loc = $1; $inbox_loc =~ /(.+)\/dasp\/ua_info.asp\?pg=browser_limit(.+)/; $inbox_location = "$1\/HoTMail"; dispText("Going to Inbox Page: $inbox_location\n"); my(@redirect_page) = getPage($inbox_location, "", 0, 1, 0); } 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! (inboxloc)\n"); } return $inbox_location; } sub doSaveEmail($$) { my ($output, $email) = @_; # restore umask to whatever user had before umask($oldumask); my($OUT) = new FileHandle ">> $output"; if (! defined ($OUT)) { die("Unable to open $output."); } print $OUT "$email\n"; $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 doResendSMTPEmail($$$) { use Net::SMTP; my($destaddr, $email, $server) = @_; my $from = "address@hidden"; if ($email =~ s/^From ([^ ]*).*\n//) { $from = $1; } dispText("Forwarding email to $destaddr by SMTP\n"); my $smtp_debug = 0; if ($conf_verbosity == 2) { $smtp_debug = 1; } my $mail = Net::SMTP->new($server, Debug => $smtp_debug) or die "Could not connect to SMTP server $server. $!\n"; $mail->mail($from); $mail->recipient($destaddr); $mail->data($email); $mail->quit(); if ($conf_speed_limit) { sleep(1); } } sub getEmail($$$) { my($url, $add_mboxheader, $folder) = @_; my(@output) = (); dispText("Getting email message...\n"); $url = "http://$host/$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 - No
tag\n\n$emailstr\n"); } ## # Get everything between the
 
tags @email_page = split(/<\/?pre>/, $emailstr); if (@email_page != 3) { die("Unable to download email message - $emailstr\n"); } $_ = $email_page[1]; s/^[\s\n]*//s; # Strip any HTML artifacts from the message body. s/&/&/g; s/<//g; s/"/\"/g; # We'll try to parse out the envelope sender and date received by # Hotmail. Apparently, those fields are not _always_ added. If we # can't find good data, we'll have to make stuff up. my($from_addr) = "address@hidden"; my($from_date) = scalar gmtime; # Strip "From whoever" when found on the first line- the format # is wrong for mbox files anyway. if (s/^From ([^ ]*) [^\n]*\n//s) { $from_addr = $1; } elsif (m/^From:[^<]*<([^>]*)>/m) { $from_addr = $1; } if ($add_mboxheader) { # Apply >From quoting s/^From ([^\n]*)\n/>From $1/gm; # If an mboxheader was desired, make up one if (m/^Date: (\w+), (\d+) (\w+) (\d+) (\d+):(\d+):(\d+) ([+-]\d\d)/m) { my($dow) = $1; my($mon) = $3; my($dom) = $2; my($hr) = $5; my($min) = $6; my($sec) = $7; my($yr) = $4; my($senttz) = $8; # Put date in mboxheader in UTC time $hr -= $senttz; while ($hr < 0) { $hr += 24; } while ($hr > 23) { $hr -= 24; } $from_date = sprintf ("%s %s %02d %02d:%02d:%02d %d", $dow, $mon, $dom, $hr, $min, $sec, $yr); } # Add an mbox-compatible header s/^/From $from_addr $from_date\n/; } # Add some more special headers right before the message body. my($gm_headers) = "X-gotmail-version: $gotmail_version\nX-gotmail-folder: $folder\nX-gotmail-user: $login\n"; s/^$/$gm_headers/m; 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\&page=$page", "", 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; #foreach my $f (@folder) #{ # $f =~ m/.*()/i; # dispText("Trying to get page " . $1 ."\n"); # my $m = $1; # if ($m) # { # push(@messages, $m); # } #} my $fold = join("", @folder); my @mess2= split(/|<\/tr>/i, $fold); my @messages = grep(//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 =~ /msgread/i)) { next; } my $Message =getEmail($msg_url, 1, $foldername); # Check for spam, if requested to. Probable SPAMS are # not downloaded if ($conf_sa) { my $SpamTest = Mail::SpamAssassin -> new(); my $MessageObject = $SpamTest -> check_message_text($Message); my $IsSpam = $MessageObject -> is_spam(); if ($IsSpam) { if ($conf_deletespam) { dispText("Deleting spam...\n"); getPage("http://$host/$msg_url\&_HMaction=move\&tobox=F000000004", "", 0, 1, 1); } else { dispText("Probably spam, skipping.\n"); } next; } } # If we're just scanning for spam on the server, don't download if ($conf_nodownload) { next; } # Are we resending or saving? if ($conf_procmail) { my($output) = $Message; dispText("Sending mail message to procmail..."); open PR,"|" . $conf_procmail_bin; print PR $output; close PR; print "Done.\n"; } elsif ($resend_address eq "") { my($output) = $Message; my($outfile) = $conf_folder_directory; if ($conf_save_to_login) { $outfile .= $login; if ($foldername ne "Inbox") { $outfile .= ("-" . $foldername); } } else { $outfile .= $foldername; } doSaveEmail($outfile, $output); dispText("Saving message to $outfile...\n"); } elsif ($conf_smtpserver) { my($output) = $Message; doResendSMTPEmail($resend_address, $output, $conf_smtpserver); } else { my($output) = getEmail($msg_url, 0, $foldername); doResendEmail($resend_address, $output); dispText ("Forwarding message to $resend_address\n"); } if ($conf_mark_messages_as_read) { dispText("Marking message as read...\n"); getPage("http://$host/$msg_url", "", 1, 1, 1); } if ($conf_delete_messages_after_download) { dispText("Deleting message...\n"); getPage("http://$host/$msg_url\&_HMaction=move\&tobox=F000000004", "", 0, 1, 1); } } } # If a "next page" exists, let's go there... if ($next_page_str =~ m/title="Next Page"/) { # If we've deleted all the messages, we don't need to go to the # next page. We stay on the same page- which will now contain # a fresh set of undeleted messages. if ($conf_delete_messages_after_download) { &getFolder($foldername, $url, 1); } else { &getFolder($foldername, $url, $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/]*>]*>|<\/tr>)/, $onestr); foreach my $item (@folder_list) { # dispText("Loading folder $item...\n"); # if ($item =~ m/(.+)<\/font><\/a>/) { if ($item =~ m/.*(.+)<\/a>.*/) { my($url) = $1; my($name) = $2; # Establish numbers of new, unread, total mail in box - courtesy # of Jens Preikschat # Establish total size of mail box - may be useful in the future # $item =~ m/(\w+)<\/font><\/td>/; # my($totalSize) = $1; # Establish "total number of messages" and "number of unread messages" # in the folder $item =~ m/(\d+)<\/td> (\d+)<\/td>/; my($totalItems) = $1; my($unreadItems) = $2; # dispText("Unread Items:$unreadItems\n"); if ((!$conf_only_get_new_messages) || ($unreadItems > 0)) { # 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)) ) { $" = "~"; if (address@hidden || ("address@hidden" =~ /~$name~/i)) { dispText ("Processing Folder: \"" . $name . "\", Total messages: " . $totalItems . ", Unread messages: " . $unreadItems . ".\n"); getFolder($name, $url, 1); } } } } } } parseConfig(); parseArgs(); dispIntroText(); doCheckPrograms(); doCleanOtherFiles(); my($inbox_location) = doLogin(); doGetFolders($inbox_location); dispText("\nAll done!\n"); doCleanTempFiles(); exit; # vim:noet:sw=2:ts=2:filetype=perl