summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGunnar Wrobel <wrobel@gentoo.org>2005-02-26 17:37:18 +0000
committerGunnar Wrobel <wrobel@gentoo.org>2005-02-26 17:37:18 +0000
commit5ee24498eb4d13c9df9400d836b0427b035f1218 (patch)
treeded9b2582869cf57b25f3f74171e269462993ab7 /z-distfiles
parentFixes for the gpg encryption (diff)
downloadmisc-5ee24498eb4d13c9df9400d836b0427b035f1218.tar.gz
misc-5ee24498eb4d13c9df9400d836b0427b035f1218.tar.bz2
misc-5ee24498eb4d13c9df9400d836b0427b035f1218.zip
Added the tonline and the spamcop script
svn path=/z-distfiles/; revision=95
Diffstat (limited to 'z-distfiles')
-rwxr-xr-xz-distfiles/scripts-gw-1.1/spamcop174
-rwxr-xr-xz-distfiles/scripts-gw-1.1/tonline.pl204
2 files changed, 378 insertions, 0 deletions
diff --git a/z-distfiles/scripts-gw-1.1/spamcop b/z-distfiles/scripts-gw-1.1/spamcop
new file mode 100755
index 0000000..9b5c258
--- /dev/null
+++ b/z-distfiles/scripts-gw-1.1/spamcop
@@ -0,0 +1,174 @@
+#!/usr/bin/perl -w
+
+use HTML::Form;
+use LWP;
+use HTTP::Cookies;
+
+if ($ARGV[0] eq "--help" ) {
+ print 'usage: spamcop {EMAIL-FOLDER}'."\n";
+ print 'usage: spamcop /home/heinz/mail/Inbox/.SpamCop'."\n";
+ exit;
+}
+
+# Configuration settings
+
+my $spam_cop_user = 'gunnarwrobel@yahoo.de';
+my $spam_cop_pass = 'k8FHdADl';
+
+# Main routine
+my $folder = $ARGV[0]; # the folder with spam cop answers
+
+my $ua = LWP::UserAgent->new();
+$ua->cookie_jar(HTTP::Cookies->new(file => "$ENV{HOME}/.cookies.txt"));
+
+
+my @link_batch = get_all_links( $folder );
+
+if (scalar( @link_batch ) > 0)
+{
+
+ get_login_cookie( $ua,
+ $link_batch[0],
+ $spam_cop_user,
+ $spam_cop_pass
+ );
+
+ report_all_spam( $ua,
+ \@link_batch
+ );
+}
+else
+{
+ die "Unable to extract any links from folder $folder!";
+}
+
+## Function get_all_links
+##
+## Retrieves all the SpamCop report links from the
+## mails in one folder
+##
+## Parameters:
+##
+## folder: the path to the folder to check for links
+
+sub get_all_links ( $ )
+{
+ my $folder = shift;
+
+ opendir (DIR, $folder . "/cur");
+ my @files = grep { $_ ne '.' and $_ ne '..'} readdir( DIR );
+
+ my @links = ();
+ my $link;
+
+ if (scalar @files > 0)
+ {
+ foreach my $file (@files)
+ {
+ open(FILE, $folder . "/cur/" . $file);
+ while (<FILE>)
+ {
+ if (($link) = ($_ =~ /(.*www.spamcop.net.sc.id=.*)/))
+ {
+ push @links, {'LINK' => $link, 'FILE' => $folder . "/cur/" . $file};
+ }
+ }
+ close(FILE);
+ }
+ }
+
+ return @links;
+}
+
+## Function get_login_cookie
+##
+## Logs the user into spamcop
+## and returns the session cookie
+##
+## Parameters:
+##
+## ua: LWP user agent
+## link: one of the extracted report links
+## user: SpamCop user
+## pass: SpamCop password
+
+sub get_login_cookie ( $$$$ )
+{
+
+ my $ua = shift;
+ my $link = shift;
+ my $user = shift;
+ my $pass = shift;
+
+ my $form = $ua->get($link->{'LINK'})
+ or
+ die "Couldn't fetch $link";
+
+ if ( $form->is_error() )
+ {
+ die $form->message();
+ }
+
+ my $formurl = "http://www.spamcop.net/mcgi";
+
+ my $resp = $ua->post
+ (
+ $formurl,
+ [
+ 'username' => $user,
+ 'password' => $pass,
+ 'duration' => '+12h',
+ 'action' => 'cookielogin',
+ 'returnurl' => '/mcgi?action=verifylogin',
+ 'submit' => 'Login'
+ ]
+ );
+
+ if ( $resp->is_error() )
+ {
+ die $resp->message();
+ }
+}
+
+## Function report_all_spam
+##
+## Reports every spam link
+##
+## Parameters:
+##
+## ua: LWP user agent
+## linklist: The list of report pages
+
+sub report_all_spam ( $$ )
+{
+ my $ua = shift;
+ my $link_list = shift;
+ my $form;
+ my @forms;
+ my $response;
+
+ foreach my $link (@{$link_list})
+ {
+ $form = $ua->get($link->{'LINK'})
+ or
+ die "Couldn't fetch $link";
+
+ @forms = HTML::Form->parse( $form );
+
+ foreach my $sendform (@forms)
+ {
+ if ($sendform->attr( 'name' ) eq 'sendreport')
+ {
+ $response = $ua->request($sendform->click());
+ if ( $response->is_error() )
+ {
+ die "Failed to report spam:\n\n" . $response->message();
+ }
+ else
+ {
+ unlink $link->{'FILE'}
+ }
+ }
+ }
+ }
+}
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
+
+