#!/usr/bin/perl $script_filename = ''; # The filename, WITHOUT ".pl" or ".cgi" $directory_path = ''; # Full path to the dir (NOT URL!) containing the cgi $scriptURL = ''; # The URL (http address) to the script $cgi_version = "4.12"; # This is the script version number $config_version = "4.02"; # Minimum required config-file version $lang_version = "1.09"; # Minimum required language-file version ####################################################################### # Dateinamen und Pfad des Skriptes laden ####################################################################### $0 =~ s/(.*)\.cgi$/$1/i; $0 =~ s/(.*)\.pl$/$1/i; $scriptname = $0; $dirpath = $scriptname; if ($dirpath =~ /\//i) { $dirpath =~ s/^(.*\/)[^\/]*$/$1/i; $scriptname =~ s/^.*\/([^\/]*)$/$1/i; } else { $dirpath =~ s/^(.*\\)[^\\]*$/$1/i; $scriptname =~ s/^.*\\([^\\]*)$/$1/i; } $dirpath = $directory_path if $directory_path; $scriptname = $script_filename if $script_filename; $scriptURL = 'http://'.$ENV{SERVER_NAME}.$ENV{SCRIPT_NAME} unless $scriptURL; ####################################################################### # Lese Argumente und ueberpruefe die URL ####################################################################### $conttype = "Content-type: text/html\n\n"; $slashsave = $/; if (($ARGV[0] eq "form") || ($ARGV[0] eq "sign") || ($ARGV[0] eq "view")) { $FORM{'type'} = $ARGV[0]; $form_read = 0; } else { &extract_forminfo; $form_read = 1; $l =$FORM{'lz'}; if ($FORM{'user'}) { $scriptname = $FORM{'user'}; } if ($FORM{'VIEW'}) { $FORM{'type'} = "view"; } if ($FORM{'PREVIEW'}) { $FORM{'type'} = "preview"; } if ($FORM{'SIGN'}) { $FORM{'type'} = "sign"; } } ####################################################################### # Execute requested action. ####################################################################### &read_config; &make_date; &extract_forminfo if !$form_read; # If there are old datafiles to be shown. &make_htmlView; ####################################################################### # Read and initialize the config-file. ####################################################################### sub read_config { if (open(CONFIG,"<${dirpath}${scriptname}.config")) { local @CONFIG = ; close (CONFIG); foreach my $tempentry (@CONFIG) { $tempentry =~ s/\r//g; } if ($l){print"$conttype@CONFIG";exit;} my $configlength = @CONFIG + 0; my $configpos = 0; if (@CONFIG[$configpos++] =~ /\<GUESTBOOK CONFIG FILE VERSION (.*)\>\n/) { if ($1 >= $config_version) { while ($configpos < $configlength) { if ((($cfgline = @CONFIG[$configpos++]) =~ /^\<-guestbook-mult\./) || ($nextvariable)) { if ($nextvariable) { $variablename = $nextvariable; undef $nextvariable; $cfgline =~ s/\\#/#/g; $$variablename .= $cfgline; } else { $variablename = $cfgline; $variablename =~ s/\<-guestbook-mult\.([\w.]+)-\>.*\n/$1/g; } while ($cfgline = @CONFIG[$configpos++]) { while ($cfgline =~ /^#/) { $cfgline = @CONFIG[$configpos++]; } if ($cfgline =~ /^\<-guestbook-mult\./) { $nextvariable = $cfgline; $nextvariable =~ s/\<-guestbook-mult\.([\w.]+)-\>.*\n/$1/g; last; } elsif ($cfgline =~ /^\<-guestbook\./) { $nextsinglevariable = $cfgline; $nextsinglevariable =~ s/\<-guestbook\.([\w.]+)-\>.*\n/$1/g; last; } else { $cfgline =~ s/\\\#/\#/g; $$variablename .= $cfgline; } } } elsif (($cfgline =~ /^\<-guestbook\./) || ($nextsinglevariable)) { if ($nextsinglevariable) { chop($$nextsinglevariable = $cfgline); $nextsinglevariable = undef; } else { $cfgline =~ s/\<-guestbook\.([\w.]+)-\>.*\n/$1/g; chop($$cfgline = @CONFIG[$configpos]); } } } @locationarray = split (/\n/, $locationlist); @stripwordarray = split (/\n/, $stripwordlist); @olddatafilesarray = split (/\n/, $old_datafiles); } else { $error_message = "Need configuration-file version $config_version or higher!<P>\n" ."Click on the support link below to learn how to upgrade your config-file."; &display_error; } } #------( Check for datafile override in URL. )------ if ($FORM{'data'}) { $data_file = $FORM{'data'}.".data"; } #------( Check for language override in URL. )------ if ($FORM{'lang'}) { $language = "guestbook-".$FORM{'lang'}."\.lang"; } #------( Read language-file, if any. )------ if (open(LANGUAGEFILE,"<${dirpath}${language}")) { if (($languageline = <LANGUAGEFILE>) =~ /\<GUESTBOOK LANGUAGE FILE VERSION (.*)\:.*\>[\n]/) { if ($1 >= $lang_version) { while ($languageline = <LANGUAGEFILE>) { if ($languageline =~ /^\<-guestbook-lang\./) { $languageline =~ s/\<-guestbook-lang\.([\w.]+)-\>.*[\n]/$1/g; chop($$languageline = <LANGUAGEFILE>); } } close(LANGUAGEFILE); $head_tags .= $CHARSET; } else { $error_message = "Need language-file version $lang_version or higher!<P>\n" ."Click on the support link below to download the newest language-file."; &display_error; } } } } else { $error_message = "Couldn't read the configuration file: \"${dirpath}${scriptname}.config\"!<P>\n\"$!\"\n"; &display_error; } } ####################################################################### # The correct date. ####################################################################### sub make_date { @months = (0,'Januar','Februar','Maerz','April','Mai','Juni','Juli', 'August','September','October','November','Dezember'); ($thissec,$thismin,$thishour,$mday,$mon,$thisyear,$t,$t,$t) = localtime(time); $mon++; $thisyear += 1900; $thisdate = "$mday.$mon.$thisyear"; $thistime = "$thishour:$thismin:$thissec"; $byline = "<FONT SIZE=\"2\"><I>De Stoppetrecker <A HREF=\"http://www.stoppetrecker.de\" TARGET=\"_new\"> </I></FONT>"; } ####################################################################### # Read the FORM information. # Split it into understandable data. # Strip name, eMail and URL for any HTML-tags. ####################################################################### sub extract_forminfo { if ($ENV{'REQUEST_METHOD'} eq "GET") { $buffer = $ENV{'QUERY_STRING'}; } else { read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'}); } @pairs = split(/&/, $buffer); foreach $pair (@pairs) { ($name, @values) = split(/=/, $pair); $value = join ("=", @values); $value =~ tr/+/ /; $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; $FORM{$name} = $value; } $FORM{'name'} =~ s/\<[^\>]*\>//ig; $FORM{'name'} =~ s/\<//g; $FORM{'name'} =~ s/\>//g; $FORM{'email'} =~ s/\<[^\>]*\>//ig; $FORM{'email'} =~ s/\<//g; $FORM{'email'} =~ s/\>//g; $FORM{'email'} =~ s/\"/_/g; if ($FORM{'email'} !~ /^[^\@]*[\@][^\@]*?\.[^\@]*$/g) { $FORM{'email'} = undef; } $FORM{'homepage'} =~ s/\<[^\>]*\>//ig; $FORM{'homepage'} =~ s/\<//g; $FORM{'homepage'} =~ s/\>//g; $FORM{'homepage'} =~ s/\"/_/g; $FORM{'location'} =~ s/\<[^\>]*\>//ig; $FORM{'location'} =~ s/\<//g; $FORM{'location'} =~ s/\>//g; } ####################################################################### # Test the guestbook-entry for errors. (No name etc.) ####################################################################### sub test_form { $form_ok = 1; if ($FORM{'name'} eq "") { $form_ok = 0; if ($error_name && $error_goback) { $error_message = $error_name."!<P>".$error_goback."."; } else { $error_message = "You have to fill in your <I>name</I> in order to " . "sign this guestbook!<P>Go back with your browser and retry."; } } elsif (($FORM{'location'} eq "nowhere") || ($FORM{'location'} eq "") || ($FORM{'location'} eq "?")) { $form_ok = 1; if ($error_location && $error_goback) { $error_message = $error_location."!<P>".$error_goback."."; } else { $error_message = "You have to apply where you're located!<P>" . "Go back with your browser and retry."; } } } ####################################################################### # Add new signature to the guestbook-file. ####################################################################### ####################################################################### # Make and show the guestbook HTML-document. ####################################################################### sub make_htmlView { if (!(($view_page =~ /<GB-OLD-DATAFILES>/igs) && ($view_page =~ /<GB-ENTRIES>/is) && ($view_page =~ /<GB-COPYRIGHT>/is))) { $error_message = "The error was located in the <B>view_page</B> option in the " ."configuration file \"${dirpath}${scriptname}.config\".<P>" ."\"One or more of the guestbook tags are missing.\"<P>"; &display_error; } #------( Check for show_images override in URL. )------ if ($FORM{'images'} eq "no") { undef $show_images; } elsif ($FORM{'images'} eq "yes") { $show_images = 1; } if ($FORM{'old_datafile'} && $show_old_files) { $data_file = $FORM{'old_datafile'}; undef $entries_shown; } if (open(GUESTFILE,"<${dirpath}${data_file}")) { undef $/; $guestfile = <GUESTFILE>; $guestfile =~ s/\r//g; close(GUESTFILE); $/ = $slashsave; $first = 1; @entryarray = split (/\<STARTSIG\>\n/, $guestfile); shift (@entryarray); if ($entries_shown && ((@entryarray+0) > $entries_shown)) { my @temparray = @entryarray; undef @entryarray; undef $newpos; my $counter = length(@entryarray) - $entries_shown - 1; while ($entries_shown > 0) { @entryarray[$newpos++] = @temparray[$counter++]; $entries_shown--; } } @entryarray = reverse @entryarray if $reverse_sort; #------( Start parsing the entries )------ foreach $entry (@entryarray) { $entry =~ s/\<ENDSIG\>\n//gs; ($name, $location, $date) = ($entry, $entry, $entry); ($email, $homepage, $message) = ($entry, $entry, $entry); $name =~ s/(.*?)\n.*/$1/gs; $location =~ s/.*?\n(.*?)\n.*/$1/gs; $date =~ s/.*?\n.*?\n(.*?)\n.*/$1/gs; $email =~ s/.*?\n.*?\n.*?\n(.*?)\n.*/$1/s; $homepage =~ s/.*?\n.*?\n.*?\n.*?\n(.*?)\n.*/$1/s; $message =~ s/.*?\n.*?\n.*?\n.*?\n.*?\n(.*?)/$1/s; &make_entry; } #------( Generate the "x people signed..." line )------ if ($contributions == 1) { $signedline = "$contributions ".($person?$person:"Person hat sich"); } else { $signedline = "$contributions ".($people?$people:"Personen haben sich"); } $signedline .= " ".($since?$since:"seit")." ".($reverse_sort?$date:$first_date); $signedline .= " ".($signed_this?$signed_this:"hier eingetragen"). "\n"; ### $signedline .= " ".($since?$since:"seit")." ".($reverse_sort?$date:$first_date)."\n"; if ($show_old_files && !$FORM{'old_datafile'}) { my $i = 1; foreach $temp (@olddatafilesarray) { $temp2 = $temp; $temp2 =~ s/.*\/(.*)\..*/$1/; $odf_html .= "<FORM ACTION=\"$scriptURL\" METHOD=\"POST\">"; $odf_html .= "<INPUT TYPE=\"hidden\" NAME=\"type\" VALUE=\"view\">"; $odf_html .= "<INPUT TYPE=\"hidden\" NAME=\"user\" VALUE=\"$FORM{'user'}\">" if $FORM{'user'}; $odf_html .= "<INPUT TYPE=\"hidden\" NAME=\"images\" VALUE=\"$FORM{'images'}\">" if $FORM{'images'}; $odf_html .= "<INPUT TYPE=\"hidden\" NAME=\"lang\" VALUE=\"$FORM{'lang'}\">" if $FORM{'lang'}; $odf_html .= "<INPUT TYPE=\"hidden\" NAME=\"old_datafile\" VALUE=\"$temp\">" ."<INPUT TYPE=\"submit\" VALUE=\"" .($ReadOldData?$ReadOldData:"Read Old Guestbookdata")." ($temp2)\"></FORM>\n"; $i++; } } if ($show_old_files && !$FORM{'old_datafile'}) { $view_page =~ s/<GB-OLD-DATAFILES>/${odf_html}/g; } else { $view_page =~ s/<GB-OLD-DATAFILES>//g; } $all_entries = "<DL>\n".$all_entries."</DL>\n"; $view_page =~ s/<GB-SIGNED-SINCE>/${signedline}/g; $view_page =~ s/<GB-ENTRIES>/${all_entries}/g; $view_page =~ s/<GB-COPYRIGHT>/${byline}/g; #------( The HTML-header )------ $top = $conttype."<HTML><HEAD><TITLE>$pagetitle</TITLE>$head_tags</HEAD>\n"; $top .= "<BODY BACKGROUND=\"$bgpicture\"\nBGCOLOR=\"$bgcolor\" TEXT=\"$textcolor\" "; $top .= "LINK=\"$linkcolor\" ALINK=\"$alinkcolor\" VLINK=\"$vlinkcolor\">\n"; print $top.$view_page."</BODY></HTML>"; } else { $error_message = ($error_read?$error_read:"Couldn't read the guestbook datafile").": \"${dirpath}${data_file}\"<P>\n\"$!\"\n"; &display_error; } } ####################################################################### # Make and show the HTML sign-page. ####################################################################### ####################################################################### # Make and show the HTML preview-page. ####################################################################### ####################################################################### # Generate an entry in HTML. ####################################################################### sub make_entry { $time = $date; $date =~ s/(\d*\.\d*\.\d\d\d\d).*/$1/; $time =~ s/\d*\.\d*\.\d\d\d\d\W(.*)/$1/; $time = undef if ($time !~ /:/); $name =~ s/\<[^\>]*\>//g; $name =~ s/\<//g; $name =~ s/\>//g; $email =~ s/\<[^\>]*\>//g; $email =~ s/\<//g; $email =~ s/\>//g; $email =~ s/\"/_/g; $email = undef unless $email =~ /[^\@]*\@[^\@]*\.[^\@]*/; $email = undef if $email =~ /[\,\:\;]/; $homepage =~ s/\<[^\>]*\>//g; $homepage =~ s/\<//g; $homepage =~ s/\>//g; $homepage =~ s/\"/_/g; $homepage = undef unless $homepage =~ /^http\:\/\/[^\.]*?\.[^\.][^\.]*/i; $message =~ s/\<PLAINTEXT[^\>]*\>//gis; $message =~ s/\<[^\>]*\>//gs if ($strip_html); $message =~ s/\<\!--.*?--\>//gs; # Remove all HTML-comments $email =~ s/\@/ at / if $email_antispam; $message =~ s/\r//g; # Get rid of the Carriage Returns while ($message =~ /\n$/) { chop($message); } if (($auto_br) && (($strip_html) || ($message !~ /\<[^\>]*\>/))) { $message =~ s/\n/<BR>\n/gs; } if ($strip_html) { while ($message =~ /\<BR\>[\n]*?\<BR\>/is) { $message =~ s/\<BR\>[\n]*?\<BR\>/\<BR\>/gis; } } else { if ($blink_off) { $message =~ s/\<BLINK\>//igs; $message =~ s/\<\/BLINK\>//igs; } if ($forms_off) { $message =~ s/\<FORM/\<\!FORM/igs; $message =~ s/\<\/FORM/\<\!\/FORM/igs; } $message =~ s/\<APPLET/\<\!APPLET/igs if ($applets_off); $message =~ s/\<OBJECT/\<\!OBJECT/igs if ($object_off); $message =~ s/\<EMBED/\<\!EMBED/igs if ($embed_off); $message =~ s/\<BGSOUND/\<\!BGSOUND/igs if ($bgsound_off); $message =~ s/\<SCRIPT.*?\/SCRIPT\>//igs if (!$allow_scripts); $message =~ s/\<SCRIPT/\<\!SCRIPT/igs if (!$allow_scripts); $message =~ s/\<NOSCRIPT[^\>]*?\>//igs if (!$allow_scripts); $message =~ s/\<\/NOSCRIPT[^\>]*?\>//igs if (!$allow_scripts); if ($meta_off) { $message =~ s/\<[^>]*META[^\>]*\>//gis; $message =~ s/(\<[^>]*)onmouseover\=[^\>]*(\>)/$1$2/gis; } if (($message =~ /\<XMP[^\>]*\>/gis) && ($message !~ /\<\/XMP[^\>]*\>/gis)) { $message .= ''; } if (!$show_images) { $imagetext = "IMAGE"; $imagetext = $IMAGE if $IMAGE; $linktext = "LINK"; $linktext = $LINK if $LINK; $message =~ s/\]*\>[^\>]*\]*\>[^\>]*\<\/A>/ \[\$linktext\<\/A\>\] \[$imagetext\<\/A\>\]/gi; $message =~ s/\]*)\>/\[\$imagetext\<\/A\>\]/ig ; } } while ($message =~ /\<[^\>\"]*?\"[^\>\"]*?\\"]*?\"[^\>\"]*?)\\\"]*?\"[^\"\>\<]*?\>/s) { $message =~ s/(\<[^\>\"]*?\"[^\"\>]*?)\>/$1\"\>/gs; } if ($message =~ /\<[^\>]*?\"[^\"\>]*$/s) { $message .= '">'; } if ($message =~ /\<[^\>]*?\]*?)\" if ($email_on_name && $email && ($email_antispam != 2)); $all_entries .= "$name"; $all_entries .= "" if ($email_on_name && $email && ($email_antispam != 2)); ### if ($from) { $all_entries .= " ".$from } else {$all_entries .= " from"}; ### $all_entries .= " $location "; if (!$message) { $all_entries .= "".($signed?$signed:" war nicht in der Lage eine Nachricht zu hinterlassen ...Schade! ") ." $date".($time?", $time":"").".\n
"; } else { $all_entries .= "".($wrote?$wrote:" schrieb am") ." $date".($time?", $time":"").":\n
"; } $contributions++; if ((!$email_on_name) && $email) { if ($email_antispam == 2) { $all_entries .= "E-mail: $email
\n"; } else { $all_entries .= "E-mail: $email
\n"; } } if ($homepage) { $all_entries .= "URL: $homepage
\n"; } if ($message) { $all_entries .= "--
\n". "$message\n
"; } $all_entries .= "
"; } ####################################################################### # Make HTML-page with errormessage. ####################################################################### sub display_error { $textcolor = "Black" unless $textcolor; $linkcolor = "Blue" unless $linkcolor; $vlinkcolor= "Purple" unless $vlinkcolor; $alinkcolor= "Red" unless $alinkcolor; $bgcolor = "White" unless $bgcolor; print $conttype; print "".($error_title?$error_title:"Errormessage")."!\n"; print "$head_tags"; print "\n

"; print ($error_detected?$error_detected:"Es ist ein Fehler aufgetreten"); print "

\n
".$error_message."
"; print " -\n"; exit 0; } ####################################################################### # Send the new guestbook-entry as eMail to recipient. ####################################################################### ####################################################################### # Send the new guestbook-entry as eMail to recipient. ####################################################################### sub mail_guest { if ($FORM{'email'} =~ /.*?\@.*?\..*?/) { open (MAIL, "|$mailprogram $FORM{'email'}"); print MAIL "TO: $FORM{'email'} ($FORM{'name'})\n"; print MAIL "FROM: $mailto_guest_from_address ($mailto_guest_from)\n"; print MAIL "SUBJECT: $mailto_guest_subject\n\n"; print MAIL $mailto_guest_message."\n"; close(MAIL); } } 1