#!/usr/bin/perl -w

# $Id: tonline.pl,v 1.5 2003/12/10 08:55:40 endresct Exp $

use strict;
use HTML::Entities;
use MIME::Base64;
use Net::SMTP;
use LWP;
use LWP::Debug qw(+);

if ($ARGV[0] eq "--help" ) {
    print 'usage: tonline.pl {USER}  {PASS} {LOCALUSER}'."\n";
    print 'usage: tonline.pl hmuster secret heinz@localserver'."\n";
    exit;
}

# Configuration
my $uname     = $ARGV[0];   # change to your t-online name
my $pword     = $ARGV[1];   # change to your password
my $localname = $ARGV[2];   # change to your local name
my $deliver   = 'smtp';  # change to 'smtp', if Hamster or
                         # <yourfavoriteunixsmtpserver>
                         # is running on the same machine

my $url   = 'https://modem.webmail.t-online.de';
my $ua    = LWP::UserAgent->new();
my $spool = '/var/spool/mail/';

my $location = createLogin( $ua, $url, $uname, $pword );

# Comment out the first line an uncomment the second to fetch the "Ablage" folder
my $inbox = $ua->get($location);

if ($location) {

    $location =~ s/main.cgp.*//;

    my @ids = grepIDs($inbox);

    for ( my $i = 0 ; $i < @ids ; $i++ ) {
	my $mail = fetchFile( $location, $ids[$i] );
	open(LOGFILE, "+>>", "/root/heide.mail.log");
	print LOGFILE $mail;
	close(LOGFILE);
	my $issave = fileMail( $mail, $spool, $localname );
	
	if ($issave) {
	    deleteMail($location, $ids[$i], $i);
	    # it's commented out, but: BE CAREFUL - please, save FIRST.
	}

	sleep(2);  # don't kill webservers with too fast polls
    } ## end for ( my $i =...
}

$ua->get( $url . "/logout.cgp" );

sub createLogin {
    my ( $ua, $url, $uname, $pword ) = @_;

    my $location;
    my $form_login;
    my $form_pass;
    my $form;
    my $id;
    my $resp;
    
    push @{ $ua->requests_redirectable() }, 'POST';
    
    $form = $ua->get($url . "/index.cgp") or die "Couldn't fetch $url";
    die $form->message() if $form->is_error();
    
    ($id) = $form->content() =~ m{/([^/]+)/login_in_frame\.cgp}s;
    
    ($form_login) = $form->content() =~ m{/.*type="text" name='([^']+)}s;
    ($form_pass) = $form->content() =~ m{/.*type="password" name='([^']+)}s;
    $resp = $ua->post(
        $url . "/main.cgp",
        [
            $form_login => $uname,
            $form_pass  => $pword,
            'js'        => '0',
            'sessionid' => $id
        ]
    );

    if ($resp->header('Refresh')) {
        ($location) = ( $resp->header('Refresh') =~ m/URL=(.*)/ );
        return $url . $location;
    } else {
        return
    }

} ## end sub createLogin

sub grepIDs {
    my $mbox = shift;
    my %ids;

    foreach my $key ( $mbox->content() =~ m/MAIL=(\d+?)\"/sg ) {
        $ids{$key} = 1;
    }

  return keys(%ids);
} ## end sub grepIDs

sub deleteMail {
    my ( $url, $id, $count ) = @_;
    my $resp =
      $ua->get( $url . "main.cgp?MAIL[$count]=" . $id . "&Loeschen.x=1" );

  return 0 unless ( $resp->status_line() =~ /OK/ );
} ## end sub deleteMail

sub fileMail {
    my ( $mail, $spool, $localname ) = @_;

    if ( $deliver eq 'smtp' ) {
        my ($from) = ( $mail =~ m/From: .+?<([^<]+)>/ );
        my $smtp = Net::SMTP->new('localhost')
          or die "Can't connect SMTP localhost!\n";

	$mail =~ s/^From\s([^@]+@[^@ ]+)\s.*/From: $1/;
	## Hopefully fixes mailing problems
	$mail =~ s/^-- /\#\#-- /;
	$mail =~ s/^----------/\#\#---------/;

        $smtp->mail($from);
        $smtp->to($localname);
        $smtp->data();
        $smtp->datasend($mail);
        $smtp->dataend();
        $smtp->quit;

	## AutoResponder
        $smtp = Net::SMTP->new('localhost')
          or die "Can't connect SMTP localhost!\n";

	$mail = "From: Heide u.Bernd Wrobel <hbwrobel\@torp4.de>\n";
	$mail .= "Subject: Adressaenderung\n";
	$mail .= "Content-Type: text/plain; charset=UTF-8\n";
	$mail .= "Date: " . scalar(localtime()) . "\n";
	$mail .= '
Automatische Mitteilung
#---------------------#

Lieber Absender,

Sie haben eine E-Mail an die Adresse hbwrobel@t-online.de versendet.
Da wir diese Adresse innerhalb des nächsten halben Jahres löschen
möchten, bitten wir Sie unseren Eintrag in Ihrem Adressbuch auf 
hbwrobel@torp4.de zu aktualisieren.

Vielen Dank!

Mit freundlichen Grüßen

Heide und Bernd Wrobel
';

        $smtp->mail('hbwrobel@torp4.de');
        $smtp->to($from);
        $smtp->data();
        $smtp->datasend($mail);
        $smtp->dataend();
        $smtp->quit;
      return 1;
    } ## end if ( $deliver...
    elsif ( $deliver eq 'mbox' ) {
        open( MBOX, ">>$spool$localname" )
          or die "Can't open Mailbox of $localname!\n";
        print MBOX $mail;
        close MBOX;
      return 1;
    } ## end elsif ( $deliver...
    else {
      return 0;
    }
} ## end sub fileMail

sub fetchFile{
# fetches via t-online the complete mail with headers and attachments as file. The file
# isn't compatible to mbox. Please, adjust by yourself.
# Create a unique ID at the main for-loop - just the content is
# returned by this function, the filename has to be done by yourself.

    my ( $url, $mail_id ) = @_;
    my $resp =
      $ua->get( $url
          . "main.cgp?MAIL[0]="
          . $mail_id
          . "&Speichern.x=1&Speichern.y=1" );
    my $mail;

    if ( $resp->is_redirect() ) {
        my $mail = $ua->get( $resp->headers()->{'location'} );
      return $mail->content();
    } else {
	return $resp->content();
    }
} ## end sub fetchFile