Added the tonline and the spamcop script

svn path=/z-distfiles/; revision=95

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
+
+