#!/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-filetags @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(/