#!/usr/bin/perl
$|=1; # Ausgaben nicht puffern (fuer Browser evtl angenehmer)
use strict; # Vorschlag von Arne
my $errmesg = "Kein Fehler!?";
my %fields; # Variable aus dem CGI Aufruf landen hier!
my $the_date;
my $checkthis;
my $PAGE_ENTRY; # 1 Funktion schreibt das, die 2. liest es...
# Benutzername bei der COLI:
my $ME="eric";
# YES/NO: ausser in URL HTML erlauben?
my $HTML="YES";
# bnbbook.cgi: yes, another guest book script....
# Release 1.0 on 09/06/98
# (C) 1998 BigNoseBird.Com, Inc. This program is freeware and may
# be used at no cost to you (just leave this notice intact).
# Feel free to modify, hack, and play with this script.
# This guestbook (like the world really needs another one)
# has borrowed several ideas from the works of Selena Sol
# (http://www.extropia.com/) and Matt Wright
# (http://cgi-resources.com/). The script is the result of user
# requests for something smaller and simpler to work with, but
# with some new tricks.
# Diese Version wurde heftigst veraendert von Eric Auer
# um es "vollkommen HTML- und Narren-Sicher" zu machen!
# Ausserdem wurde die Funktion stark angepasst...
##################################################################
# START USER CONFIGURATION SECTION #
##################################################################
#
# FORMULAR-WERTE die dieses Skript verwendet: (siehe auch gbook.html)
#
# email: Adresse des Gastes - auch fuer automatische Mail verwendet
# (muss NAME@DOMAIN sein, DOMAIN: IP oder Textformat erlaubt)
# private: Wenn "YES" wird der Eintrag Dir gemailt STATT eingetragen.
# zzurl: Homepage Adresse des Gastes (muss http://DOMAIN/ETC sein)
# url: Spamskript-Bait: Wer das Feld statt zzurl verwendet saugt!
# name, woher: Name und Herkunft des Gastes, kann je nach Wert von
# $HTML HTML enthalten - oder doch lieber nicht (10/2006)
# wiedas: So kam der Gast her (gedacht fuer eine Drop-Down-Liste)
# Kann auch HTML enthalten.
#
# Fast alle Einschraenkungen, was in den Formularwerten stehen darf,
# wurden von mir neu hinzugefuegt oder verschaerft. Eric.
#
##################################################################
# War eine Hidden-Form-Value, Skript-intern ist aber besser:
my $NEW_REQUIRED="name,massage";
# set $HTML="NO" if you do not want users to be able to enter HTML tags
# # # habe ich schon ganz oben gesetzt... $HTML="YES";
# $GUESTBOOK : Dateiname (mit vollem Pfad!) des Gaestebuches
my $GUESTBOOK="/.../gbook.html";
# $GUESTBOOK_URL : Url des Gaestebuches - nach Ausfuehrung des CGI gibt es
# eine automatische Umleitung zum Gaestebuch zurueck!
my $GUESTBOOK_URL="http://.../gbook.html";
# $TEMPDIR : Hier wird der Lockfile (etc) sein, aber nur waehrend das Skript
# laeuft - muss also ein schreibbares Verzeichnis sein;
# Um Symlinks zu vermeiden, besser ein EIGENES Verzeichnis verwenden!
my $TEMPDIR="/tmp/$ME" . "s_guestbook";
my $lockfile="$TEMPDIR/bnbbook.lck"; # A propos: Locking sollte atomar sein...
# $MY_EMAIL : Deine E-Mail Adresse, fuer die Mails die Dir sagen, dass
# sich Jemand ins Gaestebuch eingetragen hat... @ als \@ schreiben!!!
my $MY_EMAIL="$ME\@...";
### $ME habe ich schon oben gesetzt - viele Variablen sind so schon
# Wenn du $TELL_ME="YES" setzt, bekommst du immer Mail, wenn sich Jemand
# ins Gaestebuch eingetragen hat. Du kannst aber auch $TELL_ME="NO" setzen.
my $TELL_ME="YES";
# $MAIL_PROGRAM ist dein Mail-Programm (vergiss nicht das -t !!!)
# Meistens ist es "/usr/lib/sendmail -t" oder "/usr/sbin/sendmail -t"
my $MAIL_PROGRAM="/usr/lib/sendmail -t";
# $MUNG="YES" ersetzt @ und . in E-Mail-Adressen, um "Spam-Spiders" abzuhalten
my $MUNG="YES";
# @CENSORED sind Worte, die im Gaestebuch zensiert werden (Kleinschreibung egal)
# @CENSORED_EVEN_AS_PART_OF_WORD ist dasselbe fuer Wort-Abschnitte...
my @CENSORED=('leave.your.mark', 'fuck','shit','asshole','fick','Arsch','Scheiss','Scheiß');
my @CENSORED_EVEN_AS_PART_OF_WORD=('fick','fuck','arsch');
# $VALID_DOMAIN ist "" oder der Name der Domain von der das Skript
# gerufen werden darf - normalerweise der Name Deiner Domain.
my $VALID_DOMAIN="www...";
##################################################################
sub setup_pageentry
{
my $tzn = $fields{'email'};
if ($MUNG eq "YES") { $tzn =~ s/\./_PKT_/g; $tzn =~ s/\@/_BEI_/g; };
# Info in $snoop kann gefaelscht werden, also HTML killen!!! (2/2000, Eric)
my $snoop = "From $ENV{'REMOTE_HOST'} [$ENV{'REMOTE_ADDR'}] with ";
$snoop .= "$ENV{'HTTP_USER_AGENT'}";
$snoop =~ s/\213/<\;/g;
$snoop =~ s/\233/>\;/g;
$snoop =~ s/<\;/g;
$snoop =~ s/>/>\;/g;
$snoop =~ tr/\\\`\0\&/XXXX/;
my $seite = $fields{'zzurl'};
# 3/2006 rel=nofollow to make search engines ignore potentially spammy hrefs in my guestbook
if ($seite eq "")
{ $seite ="";
$seite .= "keine"; }
else { $seite = "$fields{'zzurl'}"; };
$PAGE_ENTRY=<<__END_OF_PAGE_ENTRY__;
$fields{'name'} ($tzn) ($fields{'woher'}) schreibt:
|
$fields{'massage'}
|
Heimseite: $seite
- Datum: $the_date
Wie kam $fields{'name'} hier her?: $fields{'wiedas'}
|
__END_OF_PAGE_ENTRY__
}
##################################################################
# END USER CONFIGURATION SECTION #
##################################################################
# MAIN ###########################################################
# This is where the script starts execution from
my @mandatory=split( /,/ , $NEW_REQUIRED );
# read in list of mandatory fields (changed by Eric)
&valid_page; # referer checked
$the_date=localtime();
&findbook; # file exists and is writeable
&decode_vars; # read in form fields (HTML killer really improved by Eric)
&valid_address; # email is in valid syntax (improved by Eric)
&valid_url; # url is in valid syntax and contains a domain (Eric)
&test_required; # everything filled out
&setup_pageentry;
if (($MY_EMAIL ne "") && ($TELL_ME eq "YES"))
{ ¬ify_me;} # send mail to tell me that my guestbook was signed
### ... if ($fields{'private'} ne "YES") {
&write_entry;
### ... } # add entry to guestbook
print "Location: $GUESTBOOK_URL\n\n"; # CGI now responds with REDIRECT...
exit;
##################################################################
# NOTE! Windows 95/98/NT users will have to edit this routine
##################################################################
sub notify_me
{
my $SBJ = "Neues vom Gaestebuch";
my $tmpename = $fields{'email'};
if ($fields{'email'} eq "")
{ $SBJ .= " (ohne Email-Adresse)";
$tmpename=$MY_EMAIL; }
open (MZT,"|$MAIL_PROGRAM") || die "Content-type: text/plain\n\n Unable to send mail";
print MZT "To: $MY_EMAIL\n";
print MZT "From: $tmpename\n"; # darf keine Zeilenwechsel enthalten... ok.
print MZT "Subject: $SBJ\n\n";
# Auf Wunsch kann die folgende Mail auch anders formuliert werden...
print MZT "Caller DNS: $ENV{'REMOTE_HOST'}\nCaller IP: [$ENV{'REMOTE_ADDR'}\n";
print MZT "Name: $fields{'name'}\nWoher: $fields{'woher'}\n";
print MZT "Homepage: $fields{'zzurl'}\n";
print MZT "Bait1: $fields{'zzzurl'}\nBait2: $fields{'url'}\n";
print MZT "BaitMsg: $fields{'message'}\n";
print MZT "Wiedas: $fields{'wiedas'}\nText:\n$fields{'massage'}\n";
close (MZT);
}
##################################################################
sub test_required
{
my $tst;
foreach $tst (@mandatory) {
# if ( ($fields{$tst} eq "") || (!($fields{$tst} =~ /^[A-Za-z0-9]+.*$/)) )
### (changed 10/2004, the above rule was too picky...)
if ( ($fields{$tst} eq "") || (!($fields{$tst} =~ /[A-Za-z0-9]/)) )
{
$errmesg = "\nBitte mehr Felder ausfuellen - $tst war zu leer";
### $errmesg .= "\n(Es war: " . $fields{$tst} . ")";
if ($tst eq "massage") { $errmesg = "Du musst eine Botschaft eintragen!"; }
### $errmesg .= "\nDiese Felder sollen ausgefuellt werden: $NEW_REQUIRED";
&error_exit;
}
}
}
##################################################################
sub decode_vars
{
my $i=0;
my $temp;
my $item;
my $citem;
if ( $ENV{'REQUEST_METHOD'} eq "GET")
{ $temp=$ENV{'QUERY_STRING'};}
else { read(STDIN,$temp,$ENV{'CONTENT_LENGTH'});}
my @pairs=split(/&/,$temp);
foreach $item(@pairs)
{
my ($key,$content)=split(/=/,$item,2);
$content=~tr/+/ /;
$content=~s/%(..)/pack("c",hex($1))/ge;
$content =~ s///g; # Kommentare weg (SSI Gefahr)
$content =~ tr/\\\`\0\377/XXXX/;
$content =~ s/ä/\ä/g;
$content =~ s/ö/\ö/g;
$content =~ s/ü/\ü/g;
$content =~ s/Ä/\Ä/g;
$content =~ s/Ö/\Ö/g;
$content =~ s/Ü/\Ü/g;
$content =~ s/ß/\ß/g;
my $oldcontent = $content;
# Netscape-JS-Entities und nummerierte Zeichen rauswerfen: 3/00
$content =~ s/\&\{([^\}]|\n)*\};/NS-JS-ENTITY/g;
$content =~ s/\&\{//g;
$content =~ s/\&\#[0-9]*;/\ø/g;
$content =~ s/\&\#//g;
if ( ($HTML eq "NO") || ($key ne "massage") )
{ # war: kein HTML in URL -> neu 10/2006: HTML nur in Message
$content =~ s/<([^>]|\n)*>//g; # der Rest ist neu (Eric):
$content =~ s/\213([^\233]|\n)*\233//g;
$content =~ s/</g;
$content =~ s/\213/<</g;
$content =~ s/>/>/g;
$content =~ s/\233/>>/g;
$content =~ s/\026/"/g;
$content =~ s/http//g; # klingt nach URL, klingt nach Spam :-p
}
else
{
$content =~ s/\213/</g;
$content =~ s/\233/>/g;
$content =~ s///g;
$fields{$key}=$content;
}
}
##################################################################
sub error_exit
{
print "Content-type: text/plain\n\nFehler:\n$errmesg\n\n";
print "Bitte BACK Button druecken und Eintrag korrigieren.\n";
exit;
}
##################################################################
sub check_html
{
# Erwartet Code ohne \213 und \233 - ansonsten jetzt
# SEHR VIEL SICHERER vor syntaktisch falschem HTML... Eric.
# Neu 2/2000 Eric: Java-Leute aergern und () entfernen... grins...
# CSS verwenden normal {}, ist also ok... CSS-Kommentare sind (* ... *)
my $tocheck = $checkthis;
$tocheck =~ s/SCRIPT/SMALL/gi; # Verarscht... =8-P
$tocheck =~ s/javascript/javashit/gi; # Verarscht Nummer 2 (nicht sicher,
# da offenbar ... statt Buchstaben in Tag-Properties erlaubt sind!?)
# 3/2006 - sorry, keine href mehr, viel zu viel spam :-(
if ( $tocheck =~ /href/i )
{
$errmesg = "\nHREF are forbidden, there was too much spam, sorry!\n";
&error_exit;
# damit die Spammer hoffentlich mal merken, dass es keinen Sinn hat.
}
# alternativ: Verarscht Nummer 3: $tocheck =~ s-href-label-ig;
my $quote_flag=0;
my $open_flag=0;
my $i;
for ($i=0;$i folgen - HTML Fehler\n"; &error_exit; }
# --- verhindert auch < innerhalb ", da " innerhalb < sein muss ---
if ( ($tc eq "<") && ($open_flag == 0) ) { $open_flag++; }
if ( ($tc eq "(") && ($open_flag != 0) )
{ $errmesg = "\nIn <> darf kein () stehen - HTML Fehler\n"; &error_exit; }
if ( ($tc eq ")") && ($open_flag != 0) )
{ $errmesg = "\nIn <> darf kein () stehen - HTML Fehler\n"; &error_exit; }
if ( ($tc eq ">") && (($open_flag != 1) || ($quote_flag != 0)) )
{ $errmesg = "\n> darf nicht ohne <\n";
$errmesg .= "oder innerhalb eines Zitates stehen\n"; &error_exit; }
if ( ($tc eq ">") && ($open_flag == 1) && ($quote_flag == 0) ) { $open_flag--; }
}
if ( ($open_flag != 0) || ($quote_flag != 0) )
{ $errmesg = "Am Ende waren noch einsame < oder \" uebrig!\n"; &error_exit; }
}
##################################################################
sub findbook
{
if ( -e $GUESTBOOK) { }
else
{ $errmesg = "Interner Fehler: Datei laut \$GUESTBOOK existiert nicht\n";
&error_exit; }
if ( -w $GUESTBOOK) { }
else
{ $errmesg ="Interner Fehler: Datei laut \$GUESTBOOK ist nicht schreibbar\n";
&error_exit; }
}
##################################################################
sub write_entry
{
&get_the_lock; # verhindern, dass das Gaestebuch zweimal zugleich
# geschrieben wird
open(RDBK,"<$GUESTBOOK");
my @book=;
close(RDBK);
open(WRBK,">$GUESTBOOK");
# Wer das Buch wohin getan hat, wo Symlinks drohen, ist selber Schuld.
# Das Buch sollte nur vom Webserver geschrieben werden duerfen,
# wer das kann, sollte es also httpd uebereignen (und chmod 644 setzen).
my $line;
foreach $line (@book)
{ chomp $line;
if ($line eq "")
{ print WRBK "\n"; print WRBK "$PAGE_ENTRY\n"; }
else { print WRBK "$line\n"; }
}
close(WRBK);
&drop_the_lock; # Schreibzugriff als beendet markieren, damit der
# naechste wartende Eintrag rein kann
}
##################################################################
sub get_the_lock
{
# ??? local ($endtime);
my $endtime = 60;
$endtime = time + $endtime;
while (-e $lockfile && time < $endtime) { $endtime = $endtime; } # wait...
if (time >= $endtime)
{ $errmesg = "Das Gaestebuch ist zur Zeit ueberlastet...\n"; &error_exit; }
open(LOCK_FILE, ">$lockfile");
# OVERWRITE! Besser append, ausserdem zusaetzlich vor Symlinks schuetzen?
# Tipp Arne: until (symlink('dangling link','lockfile')) { sleep $i++; }
}
##################################################################
sub drop_the_lock
{
# ??? close($lockfile);
unlink($lockfile); # or warn 'No Lockfile'
# UNLINK! Zusaetzlich vor Symlinks schuetzen?
}
##################################################################
sub valid_address
{
my $testmail = $fields{'email'};
if ($testmail eq "") { return; }
if (!($testmail =~ /^[a-zA-Z0-9\-\.\_]+\@([a-zA-Z0-9\-\.]+\.[a-zA-Z]{2,3}|[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3})$/ ))
# Kontrolle stark verschaerft - Eric
{ $fields{'email'} = "";
$errmesg = "Trage bitte KEINE oder eine RICHTIGE E-Mail Adresse ein!\n";
if ($MUNG eq "YES")
{ $errmesg .= "Keine Sorge, das Gaestebuch \"tarnt\" @ und . ...\n"; }
&error_exit;
}
}
##################################################################
sub valid_url # neu von Eric... ziemlich pingelig eingestellt...
{
my $spamurl = $fields{'zzzurl'}; # bait 1
$spamurl .= $fields{'url'}; # bait 2
$spamurl .= $fields{'message'}; # bait 3
if ($spamurl ne "") { $errmesg = "Spambots suck!"; &error_exit; }
my $testurl = $fields{'zzurl'};
if ($testurl eq "") { return; } # Leere URL ist erlaubt...
if (!($testurl =~ /^http:\/\/([a-zA-Z0-9\-\.]+\.[a-zA-Z]{2,3}|[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3})\/[a-zA-Z0-9\%\/\~\-\_\.\?\&\=\+]*$/ ))
{ $errmesg = "Bitte gib KEINE oder eine GUELTIGE URL ein!"; &error_exit; }
if (($testurl =~ /ialis/i) || ($testurl =~ /amadol/i) || ($testurl =~ /ambl/i) || ($testurl =~ /insurance/i))
{ $errmesg = "Leider musste ich wegen Spam-Idioten bestimmte URLs blockieren!"; &error_exit; }
if (($testurl =~ /buy/i) || ($testurl =~ /soma/i) || ($testurl =~ /phenter/i) || ($testurl =~ /iagra/i))
{ $errmesg = "Leider musste ich wegen Spam-Idioten bestimmte URLs blockieren!"; &error_exit; }
if (($testurl =~ /casin/i) || ($testurl =~ /gambl/i) || ($testurl =~ /mp3/i) || ($testurl =~ /ring/i))
{ $errmesg = "Leider musste ich wegen Spam-Idioten bestimmte URLs blockieren!"; &error_exit; }
}
##################################################################
sub valid_page
{
if ($VALID_DOMAIN eq "") { return; }
my $DN=$ENV{'HTTP_REFERER'};
if ($DN eq "") # bisher akzeptierte das Skript unbekannte Referer (Eric)
{ $errmesg= "Skript blockiert - REFERER unbekannt\n"; &error_exit; }
$DN =~ tr/A-Z/a-z/;
$VALID_DOMAIN =~ tr/A-Z/a-z/;
if ($DN =~ /$VALID_DOMAIN/) { return; }
else { $errmesg = "Skript muss vom Gaestebuch aus starten\n"; &error_exit; }
# noch pingeliger waere es, alles bis zum "?" zu vergleichen...
}