#!/usr/bin/perl $|=1; # Ausgaben nicht puffern (fuer Browser evtl angenehmer) use strict; # Vorschlag von Arne use locale; # ****XXXX**** fuers Datum use POSIX qw(strftime); # Locale-Zeitstring require 5.004; # wegen locale handler use POSIX qw(locale_h); # eigene Locale-Wahl statt LC_CTYPE, LC_ALL, LANG setlocale(LC_CTYPE, "de"); # wo vorhanden auch: setlocale(LC_CTYPE, "de_DE.ISO8859-1"); 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 und so weiter: # ****XXXX**** my $ME="eric"; # ****XXXX**** my $MYDOMAIN="www.example.com"; # ****XXXX**** my $HOMEPATHS="home"; # ****XXXX**** my $WHEREAMI="stuff/uv-gb"; # ****XXXX**** my $PAGE_TEMPLATE="/$HOMEPATHS/$ME/public_html/$WHEREAMI/gaestebuch-template.ht"; # YES/NO: ausser in URL HTML erlauben? my $HTML="NO"; # 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. # url: Homepage Adresse des Gastes (muss http://DOMAIN/ETC sein) # name, woher: Name und Herkunft des Gastes, kann je nach Wert von # $HTML HTML enthalten # 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: # ****XXXX**** # my $NEW_REQUIRED="name,message"; my $NEW_REQUIRED="name"; # 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 # ****XXXX**** my $GUESTBOOK="/$HOMEPATHS/$ME/public_html/$WHEREAMI/gaeste.html"; # $GUESTBOOK_URL : Url des Gaestebuches - nach Ausfuehrung des CGI gibt es # eine automatische Umleitung zum Gaestebuch zurueck! # ****XXXX**** my $GUESTBOOK_URL="http://www.$MYDOMAIN/~$ME/$WHEREAMI/gaeste.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! # ****XXXX**** 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!!! # ****XXXX**** my $MY_EMAIL="$ME\@$MYDOMAIN"; # 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. # ****XXXX**** 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 (gross/klein egal) # @CENSORED_EVEN_AS_PART_OF_WORD ist dasselbe fuer Wort-Abschnitte... my @CENSORED=('fuck','shit','asshole','fick','arsch','scheiss'); 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. # ****XXXX**** my $VALID_DOMAIN="www.$MYDOMAIN"; ################################################################## # 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 # (must be checked before &load_template) # ****XXXX**** &load_gbtemplate; # read in template for new entries (by Eric 1/2001) &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" || $TELL_ME eq "NO")) { ¬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 "Name: $fields{'name'}\nWoher: $fields{'woher'}\n"; print MZT "Homepage: $fields{'url'}\nPrivat: $fields{'private'}\n"; print MZT "Wiedas: $fields{'wiedas'}\nText:\n$fields{'message'}\n"; close (MZT); } ################################################################## sub test_required { my $tst; foreach $tst (@mandatory) { if ( ($fields{$tst} eq "") || (!($fields{$tst} =~ /^[A-Za-z0-9]+.*$/)) ) { $errmesg = "\nBitte mehr Felder ausfuellen - $tst war zu leer"; $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) # \ ' NUL MAX und neu 23.1.01 $ rauswerfen und ersetzen! # ****XXXX**** $content =~ tr/\\\`\0\377\$/\/\' %/; $content =~ s/ä/\ä/g; $content =~ s/ö/\ö/g; $content =~ s/ü/\ü/g; $content =~ s/Ä/\Ä/g; $content =~ s/Ö/\Ö/g; $content =~ s/Ü/\Ü/g; $content =~ s/ß/\ß/g; # 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 eq "url") ) # Eric: Kein HTML in URL! { $content =~ s/<([^>]|\n)*>//g; # der Rest ist neu (Eric): $content =~ s/\213([^\233]|\n)*\233//g; $content =~ s//>/g; $content =~ s/\233/>>/g; $content =~ s/\026/"/g; } 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!?) my $quote_flag=0; my $open_flag=0; my $i; for ($i=0;$i") && (($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; } if ( -e $PAGE_TEMPLATE) { } else { $errmesg = "Interner Fehler: Datei laut \$PAGE_TEMPLATE existiert nicht\n"; &error_exit; } if ( -r $PAGE_TEMPLATE) { } else { $errmesg ="Interner Fehler: Datei laut \$PAGE_TEMPLATE ist nicht lesbar\n"; &error_exit; } } ################################################################## sub write_entry { &get_the_lock; # verhindern, dass das Gaestebuch zweimal zugleich # geschrieben wird $errmesg = "Kann das Buch nicht aufmachen\n"; open(RDBK,"<$GUESTBOOK") || &error_exit; my @book=; close(RDBK); open(WRBK,">$GUESTBOOK") || &error_exit; # 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; } $errmesg = "Lockfile kann nicht angelegt werden\n"; open(LOCK_FILE, ">$lockfile"); # ****XXXX**** || &error_exit; # 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 $testurl = $fields{'url'}; 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; } } ################################################################## 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; } # noch pingeliger waere es, alles bis zum "?" zu vergleichen... else { $errmesg = "Skript muss vom Gaestebuch aus starten\n"; &error_exit; } } ################################################################## sub load_gbtemplate { $errmesg = "Template kann nicht geladen werden\n"; open(RDBK,"<$PAGE_TEMPLATE") || &error_exit; my @templ=; close(RDBK); $PAGE_TEMPLATE = ""; my $line; foreach $line (@templ) { chomp $line; $PAGE_TEMPLATE .= "$line\n"; } } ################################################################## sub setup_pageentry { my $tzn = $fields{'email'}; # if ($MUNG eq "YES") { $tzn =~ s/\./_PKT_/g; $tzn =~ s/\@/_BEI_/g; }; # ****XXXX**** if ($MUNG eq "YES") { $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 =~ tr/\\\`\0\&\$/XXXXX/; my $seite = $fields{'url'}; if ($seite eq "") # ****XXXX**** { $seite ="keine Homepage"; } else { $seite = "$fields{'url'}"; }; # $PAGE_ENTRY=<<__END_OF_PAGE_ENTRY__; #
# # # # #
# $fields{'name'}   ($tzn) ($fields{'woher'}) schreibt: #
$fields{'message'} #
# Heimseite: $seite # - Datum: $the_date
# Wie kam $fields{'name'} hier her?: $fields{'wiedas'} # #
#
# __END_OF_PAGE_ENTRY__ # ****XXXX**** if ($fields{'woher'} eq "") { $fields{'woher'} = "unbekannt"; } $PAGE_ENTRY=$PAGE_TEMPLATE; $PAGE_ENTRY =~ s/SIGNERNAME/$fields{'name'}/g; $PAGE_ENTRY =~ s/SIGNERMAIL/$tzn/g; $PAGE_ENTRY =~ s/SIGNERURLWITHTAG/$seite/g; $PAGE_ENTRY =~ s/SIGNERPLACE/$fields{'woher'}/g; # $PAGE_ENTRY =~ s/SIGNERDATE/$the_date/g; my $german_date = strftime "%d. %B %Y", gmtime; # %a Kurzwochentag %A lang... %b Kurzmonatsname %B lang... %w Wochentagsnummer # %c local Date-Time-Default-Format %S Sekunde %x Date-Default %X Time-Default # %U Wochennummer (Sonntagswochen) %u ... (Montagswochen) # %d Tag %H Stunde %I 12h-Stunde %j Jahrestag %m Monat %M Minute %p am/pm # %y Jahr2 %Y Jahr4 %Z Zeitzone %% % # siehe man perlfunc -> gmtime, time, ctime, timegm, POSIX::strftime # da die .de locale leider oft fehlt: us -> de mimimalistisch: $german_date =~ s/y /i /g; $german_date =~ s/uari/uar/g; $german_date =~ s/March/M\ärz/g; $german_date =~ s/June/Juni/g; $german_date =~ s/Oct/Okt/g; $german_date =~ s/Dec/Dez/g; $PAGE_ENTRY =~ s/SIGNERDATE/$german_date/g; $PAGE_ENTRY =~ s/SIGNERTEXT/$fields{'message'}/g; $PAGE_ENTRY .= ""; }