#!/usr/bin/perl -w use warnings; use strict; use CGI; my $cgi = CGI->new(); my %FORMDATA = $cgi->Vars(); my @arrnameval = (); my $querystring =(); my $nam =(); my $val =(); my $namval =(); my $ergebnis =(); my $fehlermeldung =(); $FORMDATA{item}=0; $FORMDATA{Galerie}=""; $FORMDATA{User}=""; ###### FormularDaten holen, die per Post übertragen wurden... if ($ENV{'REQUEST_METHOD'} eq 'GET') { $querystring = $ENV{'QUERY_STRING'}; } if ($querystring !~ "QQitemZ") { @arrnameval = split(/&/, $querystring); } else { @arrnameval = split(/QQ/, $querystring); } foreach $namval (@arrnameval) { if ($querystring !~ "QQitemZ") { ($nam, $val) = split(/=/, $namval);} else { ($nam, $val) = split(/Z/, $namval);} $val =~ tr/+/ /; # replace + with space $val =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; # translate hex values $FORMDATA{$nam} = $val; } my $querystringa; ###### Und den Referrer auslesen.... $querystringa = $ENV{'HTTP_REFERER'}; if ($querystringa !~ "QQitemZ") { @arrnameval = split(/&/, $querystringa); } else { @arrnameval = split(/QQ/, $querystringa); } foreach $namval (@arrnameval) { if ($querystringa !~ "QQitemZ") { ($nam, $val) = split(/=/, $namval);} else { ($nam, $val) = split(/Z/, $namval);} $val =~ tr/+/ /; # replace + with space $val =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; $FORMDATA{$nam} = $val; } my $item; if ($FORMDATA{item} > 1) { $item ="item=".$item."&"; } else {$item ="";} ### ### Aufrufen nach User A-L und M - Z aufteilen, um zur Lastverteilung die hälfte der Aufrufe von einem anderen Server durchführen zu lassen... ### my $buchstabe= lc(substr($FORMDATA{User}, 0,1)); if ($buchstabe =~ /[0-9]/) {$buchstabe = "09"} my $Server; if ($buchstabe =~ /[a-l]/) { print "Location: http://www.myDomain6.de/cgi-perl/imagetn.pl?".$item."User=$FORMDATA{User}&Galerie=$FORMDATA{Galerie}&Image=$FORMDATA{Image}\n\n"; exit; } else {$Server ="www.myDomain4.de"; } ### ### Die User A - L sind nun weg... ### if (!$FORMDATA{Image} && $FORMDATA{Bild}) { $FORMDATA{Image} = $FORMDATA{Bild}}; # Für alte Anfrage, in denen Formulfeldarname BILD anstelle von IMAGE verwendet wird print "Content-type: image/jpg\n"; if (!$FORMDATA{item} || $FORMDATA{item} eq 0){ ### wenn der Wert item nicht existiert, erfolgt der Aufruf von einer anderen URL und soll angezeigt werden!! print "Location: http://$Server/ebay/userdaten/$buchstabe/$FORMDATA{User}/$FORMDATA{Galerie}/$FORMDATA{Image}tn.jpg\n\n"; exit; } ### Wenn der Wert item doch existiert (= Bildaufruf erfolgt aus einer eBay-Auktion), soll in einer Blacklist überprüft werden, ### ob dieses Bild für diese Auktion (=item) gespert ist. ##Blacklist? &blacklist; ### ### Mögliche Ausgaben der DB: ### 0 = Alle Bilder gesperrt. ### 6: Alle Bilder über 6 gesperrt (0-5 erlaubt), ### "ok"= ALLE Bilder dürfen angezeigt werden, ### "": Eintrag existiert nicht -> alle Bilder anzeigen ### if (( $ergebnis eq "ok" || ($FORMDATA{Image} <= $ergebnis && $ergebnis ne "0") || $ergebnis eq "")&& $ergebnis ne "0"){ print "Location: http://$Server/ebay/userdaten/$buchstabe/$FORMDATA{User}/$FORMDATA{Galerie}/$FORMDATA{Image}tn.jpg?$ergebnis\n\n"; exit; } else { print "Location: http://www.myDomain3.de/grafics/keinBild.gif\n\n"; exit; } ### FERTIG sub blacklist { use CGI::Carp qw(fatalsToBrowser); use Fcntl qw(:DEFAULT :flock); use CGI qw(:standard); use CGI; use Apache::DBI(); use DBI; my $datenbank = "blacklist"; my $datenbankhost = "localhost"; my $datenbankuser = "xxx"; my $datenbankpw = "yyy"; ########################################################## $fehlermeldung = "
  • Fehler bei der Datenbankverbindung aufgetreten. Bitte ueberpruefen Sie die Angaben"; my $dbh = DBI->connect("DBI:mysql:$datenbank:$datenbankhost","$datenbankuser","$datenbankpw") || fehlerausgabe($fehlermeldung); ########################################################## my $sth = $dbh->prepare("SELECT art FROM `blacklist` WHERE item = '$FORMDATA{item}' and Galerie = '$FORMDATA{Galerie}' "); $sth->execute or die DBI->errstr; $ergebnis = $sth->fetchrow_array(); $dbh->disconnect; # DB Connect beenden }# Ende sub sub fehlerausgabe{ print $fehlermeldung; }