diff options
Diffstat (limited to 'z-distfiles/scripts-gw-1.1/tonline.pl')
| -rwxr-xr-x | z-distfiles/scripts-gw-1.1/tonline.pl | 204 |
1 files changed, 204 insertions, 0 deletions
diff --git a/z-distfiles/scripts-gw-1.1/tonline.pl b/z-distfiles/scripts-gw-1.1/tonline.pl new file mode 100755 index 0000000..03875f1 --- /dev/null +++ b/z-distfiles/scripts-gw-1.1/tonline.pl @@ -0,0 +1,204 @@ +#!/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 + + |