#!/usr/bin/perl # $Id: index.cgi,v 1.1.1.1.2.6 2004/02/24 07:45:04 marto Exp $ my $basedir; BEGIN { use File::Spec; use Cwd; if ( $^O =~ m!win!i ) { $basedir = File::Spec->catdir( ( Cwd::cwd(), 'ForumLite' ) ); chdir( $basedir ); } else { $basedir = Cwd::cwd(); } } use lib '.'; use SharedLib; use Time::Local; use CGI; use HTML::Entities; use strict; # Don't change these values here - Use "cgiforum.conf" instead. # This way, you can simply replace "cgiforum.pl" when upgrading. my $period_new = 2; my $default_day_limit = 30; my $default_headline = 'None'; my $default_author = 'Anonymous'; my $doload_text = 0; my $only_registered = 0; my $allow_registration = 1; my $cookieName; my $cookiePasswd; my $main; my $title; my @entryrelations = (); my @childs = (); my %EntryInfo = (); my $thesection = ''; my @ShortWeekDays = ('Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat', 'Sun'); my %FullWeekDay = ( Mon => 'Monday', Tue => 'Tuesday', Wed => 'Wednesday', Thu => 'Thursday', Fri => 'Friday', Sat => 'Saturday', Sun => 'Sunday' ); my %NumMonth = ( Jan => "01", Feb => "02", Mar => "03", Apr => "04", May => "05", Jun => "06", Jul => "07", Aug => "08", Sep => "09", Oct => "10", Nov => "11", Dec => "12" ); my %DateTime = (); my $cgi = SharedLib->new(); $cgi->import_names('PARS'); my $username; my $passwd; my $allUsers = ''; open USERS, '<', SharedLib::catdir( ( $basedir, 'users/users.db' ) ); { local $/; $allUsers = ; } close USERS; if ( defined $cgi->cookie('username')) { $username = $cgi->cookie('username'); } if ( defined $cgi->cookie('passwd') && defined $username ) { $passwd = $cgi->cookie('passwd'); } if ( defined $PARS::action && $PARS::action eq 'logout' ) { undef $username, $passwd; } # {{{ sub array getDate () # returns two element string array of one month ago date "-" current date, and two months ago "-" one month ago # Sample: ['12.03.03 - 12.04.03', '12.02.03 - 12.03.03'] # needed by Search by date form sub getDate { my $ltime = localtime; if (substr ($ltime, 8, 1) eq ' ') { substr ($ltime, 8, 1) = '0'; } my ($weekday, $monthstr, $day, $Time, $year) = split (/ /, $ltime); $year =~ s#^\d\d(\d\d)$#$1#; my $nummonth = $NumMonth{$monthstr}; my $previousMonth = $nummonth - 1; if ( $previousMonth == 0 ) { $previousMonth = "12"; $year = $year - 1; } if ( length ($previousMonth) == 1 ) { $previousMonth = "0" . $previousMonth; } if ( length ($year) ==1 ) { $year = "0" . $year; } my $twoAgo = $previousMonth - 1; $twoAgo = "12" if ( $twoAgo == 0 ); if ( length ($twoAgo) == 1 ) { $twoAgo = "0" . $twoAgo; } my $currDate = $day . "." . $nummonth . "." . $year; my $oneMonthAgo = $day . "." . $previousMonth . "." . $year; my $twoMonthAgo = $day . "." . $twoAgo . "." . $year; $twoMonthAgo = $twoMonthAgo . " - " . $oneMonthAgo; $oneMonthAgo =$oneMonthAgo . " - " . $currDate; return [ $oneMonthAgo, $twoMonthAgo]; } # }}} end of getDate() # {{{ sub scalar filterUserInput ( string sourceString ) # returns parced sourceString sub filterUserInput { my $string = shift; # This code was contributed by b0iler@hotmail.com . Many thanks! $string =~ s/([\&;\`'\|\"*\?\~\^\(\)\[\]\{\}\$\n\r])/\\$1/g; #meta characters $string =~ s/\0//g; #null byte $string =~ s/\.\.//g; #then .. $string =~ s/^\s+$//s; # by mono return $string; } # }}} end of filteruserInput() # {{{ sub scalar EncDec ( string password ) # encrypt/decrypt passed parameter (password) # returns encrypted/decrypted password sub EncDec { my @args = split //, shift(); my $retval = ''; for (my $stringpos = 0; $stringpos <= $#args; $stringpos++) { $retval .= chr(ord($args[$stringpos]) ^ 0x12); } return $retval; } # }}} end of EncDec() # {{{ sub scalar NumDaysOld () # calculates how old is currently loaded message ( loaded by FillEntryInfo($, $) ) # returns the age of message in days sub NumDaysOld { # how many days is the currently loaded entry old? my $newstime = timelocal(0, 0, 0, $DateTime{'day'}, $DateTime{'month'} - 1, $DateTime{'year'} - 1900); my $ltime = localtime; if (substr ($ltime, 8, 1) eq ' ') { substr ($ltime, 8, 1) = '0'; } my ($weekday, $monthstr, $day, $Time, $year) = split (/ /, $ltime); my $nummonth = $NumMonth{$monthstr}; my $currenttime = timelocal(0, 0, 0, $day, $nummonth - 1, $year - 1900); my $diff = $currenttime - $newstime; my $seconds = $diff % 60; $diff = ($diff - $seconds) / 60; my $minutes = $diff % 60; $diff = ($diff - $minutes) / 60; my $hours = $diff % 24; $diff = ($diff - $hours) / 24; my $days = $diff % 7; my $weeks = ($diff - $days) / 7; return ($days + $weeks * 7); } # }}} end of NumDaysOld() # {{{ sub bool IsInsideDateLimits () # checks if current loaded message is in date limits # return TRUE if message is in limits or FALSE if it is not sub IsInsideDateLimits { my $youngerthanstart = 0; my $olderthanend = 0; if (($EntryInfo{'start'} == -1) || ($EntryInfo{'start'} == 0) || (NumDaysOld() <= $EntryInfo{'start'})) { $youngerthanstart = 1; } if (NumDaysOld() >= $EntryInfo{'end'}) { $olderthanend = 1; } if ($youngerthanstart && $olderthanend) { return 1; } return 0; } # }}} end of IsInsideDateLimits() # sub void FillDateTime ( int timestamp ) # set global variable %DateTime values sub FillDateTime { my $ltime = shift; $ltime = localtime if (!$ltime); if (substr ($ltime, 8, 1) eq ' ') { substr ($ltime, 8, 1) = '0'; } my ($weekday, $monthstr, $day, $Time, $year) = split (/ /, $ltime); $DateTime{'weekday'} = $FullWeekDay{ (substr $weekday, 0, 3)}; $DateTime{'time'} = $Time; $DateTime{'day'} = $day; $DateTime{'monthstr'} = $monthstr; $DateTime{'month'} = $NumMonth{$monthstr}; $DateTime{'year'} = $year; $DateTime{'hour'} = substr $Time, 0, 2; # 16:03:22 $DateTime{'minute'} = substr $Time, 3, 2; $DateTime{'second'} = substr $Time, 6, 2; $DateTime{'newsdate'} = $year . $NumMonth{$monthstr} . $day; } # }}} end of FillDateTime() # {{{ sub void GetEntryTimeInfo ( string section, int entrynumber ) # get the creation date of the entry with "entrynumber" and call FillDateTime with that date sub GetEntryTimeInfo { my ($section, $entrynumber) = @_; my $entrypath = SharedLib::catdir( ( $basedir, 'sections', $section, 'entries', $entrynumber ) ); my $infoline = "||"; if (-e "$entrypath.inf") { open ENTRYINFO, "< $entrypath.inf"; $infoline = ; close ENTRYINFO; } chomp $infoline; my ($author, $time, $email) = split /\|/, $infoline; FillDateTime($time); } # }}} end of GetEntryTimeInfo() # {{{ getChildrenCount ( int entrynumber ) # return the count of 1st level children sub getChildrenCount { my ( $section, $entry ) = @_; my $count = 0; my $db = SharedLib::catdir( $basedir, 'sections', $section, 'entries/entries.db' ); open ( ENTRIES, "< $db" ); while ( ) { my ( $child, $parent ) = split /\|/, $_; next if ( -e SharedLib::catdir( $basedir, 'sections', $section, 'entries', "$child.del" ) ); $count++ if ( $parent == $entry ); } #end of while ( ) close ( ENTRIES ); return $count; } # }}} end of getChildrenCount() # {{{ sub void FillEntryInfo ( string section, int entrynumber, bool doLoadText ) # set some of global variable %EntryInfo values ( text, headline, author, email, numhits ) sub FillEntryInfo { my ($section, $entrynumber, $loadtext) = @_; $EntryInfo{'entrynumber'} = $entrynumber; my $childrenCount = getChildrenCount( $section, $entrynumber ); $EntryInfo{'children'} = $childrenCount; my $entrypath = SharedLib::catdir( ( $basedir, 'sections', $section, 'entries', $entrynumber ) ); if ($loadtext) { $EntryInfo{'text'} = HTML::Entities::encode_entities( FileToScalar("$entrypath.msg") ); $EntryInfo{'text'} =~ s/\n/
/g; } my $headlinefile = SharedLib::catdir( ( $basedir, 'sections', $section ) ); if ($entrynumber == 0) { $headlinefile = SharedLib::catdir( ( $headlinefile, 'section.txt' ) ); } else { $headlinefile = SharedLib::catdir( ( $headlinefile, 'entries', "$entrynumber.hdl" ) ); } my $headline = ''; if (-e $headlinefile ) { open HDL, "< $headlinefile"; $headline = ; close HDL; } if (!$headline) { $headline = $default_headline; } chomp $headline; $EntryInfo{'headline'} = HTML::Entities::encode_entities( $headline ); GetEntryTimeInfo($section, $entrynumber); my $infoline = '||'; if (-e "$entrypath.inf") { open ENTRYINFO, "<$entrypath.inf"; $infoline = ; chomp $infoline; close ENTRYINFO; } my ($author, $time, $email) = split /\|/, $infoline; my $authornum = 0; if ($author =~ /^REGISTERED/) { ($authornum = $author) =~ s/REGISTERED//; chomp $authornum; open( AUTHOR, '<', SharedLib::catdir( ( $basedir, 'users', "$authornum.syn" ) ) ); $author = ; if (!$author) { $author = $default_author; } close AUTHOR; chomp $author; } if ($email =~ /seeeml/) { open( EMAIL, '<', SharedLib::catdir( ( $basedir, 'users', "$authornum.eml" ) ) ); $email = ; if (!$email) { $email = " "; } close EMAIL; chomp $email; } if (!$author) { $author = $default_author; } $EntryInfo{'author'} = $author; if ( $email ) { $EntryInfo{'email'} = "href=\"mailto:" . HTML::Entities::encode( $email ) . "\""; } else { $EntryInfo{'email'} = ""; } my $numhits = 0; # Prior to version 1.04, no "cnt"-file was written by default. if (-e "$entrypath.cnt") { open COUNT, "<$entrypath.cnt"; $numhits = ; close COUNT; chomp $numhits; } $EntryInfo{'numhits'} = $numhits; } # }}} end of FillEntryInfo() # sub array GetChildren ( int entrynumber, bool recursive ) # returns array of children of the entry with "entrynumber", returns them recursively if "resursive" is TRUE my $level = 0; sub GetChildren { my ($currentthread, $control) = @_; my @children = (); $level += 1; foreach my $entry (grep (/\|$currentthread\n/, @entryrelations)) { my $is_hidden = 0; my ($child, $parent) = split /\|/, $entry; # $parent now equals to $currentthread, not used if (!-e SharedLib::catdir( ( $basedir, 'sections', $thesection, 'entries', "$child.del" ) ) ) { # Before 1.06, we did this: # if ($level == 1) { # check if this (base) thread should be displayed # GetEntryTimeInfo($thesection, $child); # if (!IsInsideDateLimits()) { next; } # } # Many thanks to John S. Jacob for contributing a # better solution! push @children, "$child\|$level"; # here is no more check for date limits # because we assume children are younger than # their parents if ($control ne 'nonrecursive') { push @children, GetChildren( $child, $control ); } if ($is_hidden) { $level += 1; } } } $level -= 1; return @children; } # }}} end of getChildren() # {{{ sub string substSpecialChars ( string HtmlSource ) # substitute "<" and ">" in all HTML tags with < and >, but
sub substSpecialChars { my $string = shift; $string =~ s/<(?!br)/\<\;/g; #replace all "<" and ">" with < and > but
$string =~ s/(?/\>\;/g; return $string; } # }}} end of substSpecialChars() # {{{ sub strint SubRefVars ( string template ) # substitute special placeholders ##something## with $EntryInfo{'something'} # returns ready for use template sub SubstRefVars { my $template = shift; while ($template =~ /\#\#.*?\#\#/) { (my $refvar = $template) =~ s/.*?\#\#(.*?)\#\#.*/$1/; chomp $refvar; my $referredvar = ''; if (exists $EntryInfo{"$refvar"}) { $referredvar = $EntryInfo{"$refvar"}; } elsif ( exists $DateTime{"$refvar"} ) { $referredvar = $DateTime{"$refvar"}; } if ($referredvar) { $referredvar = substSpecialChars($referredvar); } $template =~ s/\#\#.*?\#\#/$referredvar/; } return $template; } # }}} end of SubstRefVars # {{{ sub string FileToScalar ( string pathToFile ) # returns text file content in scalar sub FileToScalar { my $file = pop; my $scalar = ''; if (!-e $file) { warn "$file doesn't exist"; $scalar = ""; } else { open FILE, "<$file"; while () { $scalar .= $_; } close FILE; } return $scalar; } # }}} end of FileToScalar() # {{{ sub string loadTemplate ( string section, string pathToFile ) sub LoadTemplate { my ($section, $file) = @_; my $templatefile = CheckHTMLOverride($section, $file); my $template = FileToScalar($templatefile); $template =~ s/\n//g; return $template; } # }}} end of LoadTemplate # {{{ sub array getParents ( int entrynumber ) # returns array of parents recursively for each child. Begin with "entrynumber" sub getParents { my ( $aChild ) = @_; my @parents = (); @childs = (); open ( ENTRIES, SharedLib::catdir( ( $basedir, 'sections', $thesection, 'entries/entries.db' ) ) ) || warn "Cannot open entries.db: $!"; while( my $entry = ) { my($child, $parent) = split(/\|/, $entry); push @{$childs[$parent]}, $child; push @entryrelations , $entry; } close ( ENTRIES ); sub recursion { my ( $aAChild ) = @_; my @line = grep( /$aAChild\|/, @entryrelations ); chomp( $line[0] ); my ($child, $parent) = split( /\|/, $line[0] ); chomp( $parent ); if( $parent ne '0' && $parent) { push( @parents, ($parent) ); recursion( $parent ); } } recursion( $aChild ); @parents = reverse( @parents ); return @parents; } # }}} end of getParents() # {{{ sub hash printParents ( int entrynumber, string section ) # returns hash: 1. HTML part file with all parents returned by getParents(), and # 2. parents count sub printParents { my ( $aCurMsg, $aSection ) = @_; my @parrents = getParents( $aCurMsg ); my $parentMsg; # my $templateLoader = SharedLib->new(); $cgi->load_template( "html/parent_msg_tmpl.html", \$parentMsg ); my $result; my $ends; my $parentsCount; foreach my $entry (@parrents) { FillEntryInfo( $aSection, $entry, 0 ); my $tempHash = { 'section' => HTML::Entities::encode( $EntryInfo{ 'section' } ), 'entrynumber' => HTML::Entities::encode( $EntryInfo{'entrynumber'} ), 'headline' => $EntryInfo{'headline'} , #already encoded in FillEntryInfo 'author' => HTML::Entities::encode( $EntryInfo{'author'} ), 'month' => HTML::Entities::encode( $DateTime{'month'} ), 'day' => HTML::Entities::encode( $DateTime{'day'} ), 'year' => HTML::Entities::encode( $DateTime{'year'} ), 'numhit' => HTML::Entities::encode( $EntryInfo{'numhits'} ), 'email' => $EntryInfo{'email'}, 'children' => $EntryInfo{'children'}, }; $parentsCount++; $result .= $cgi->load_file( $tempHash, $parentMsg ); $ends .= LoadTemplate( $aSection, "parententry.end"); #to close all
    }#end of foreach $result = $result . $ends; return {'result'=>$result, 'count'=>$parentsCount}; } # }}} end of printParents # {{{ sub void PrintEntries ( string section, int entrynumber, bool recursive ) # loads in global variable "main" substituted templates for all children sub PrintEntries { my ($section, $startthread, $recursive) = @_; my $db = SharedLib::catdir( ( $basedir, 'sections', $section, 'entries/entries.db' ) ); if (-e $db && ($#entryrelations == -1)) { # @entryrelations could already be read in if we are called by # ShowEntry(). In this case, the list is already "optimized". my $thestartentry = $startthread; if (($startthread == 0) && ($EntryInfo{'start'} == $default_day_limit)) { $thestartentry = 0; } open ENTRYBASE, "<$db"; while () { my ($child, $parent) = split /\|/; if ($child >= $thestartentry) { push @entryrelations, $_; } } close ENTRYBASE; } # Reverse sort all level _1_ entries (children of "0") when # printing whole section if (($startthread == 0) && ($#entryrelations >= 0)) { my $lastswapped = $#entryrelations + 1; my $index = 0; while ($index < $lastswapped) { if ($entryrelations[$index] =~ /\|0\n/) { # find last level-1-entry in list $lastswapped -= 1; while ($lastswapped >= $index) { if ($entryrelations[$lastswapped] =~ /\|0\n/) { last; } $lastswapped--; } # and swap them my $tempentry = $entryrelations[$index]; $entryrelations[$index] = $entryrelations[$lastswapped]; $entryrelations[$lastswapped] = $tempentry; } $index++; } } my @entriestree = GetChildren($startthread, $recursive); if ( ! @entriestree and $PARS::select ) { if ( ! $PARS::action ) { $main .= "There aren't records for this period."; } # end of if ( ! @entriestree and $PARS::select ) } if ($startthread == 0) { # Uncomment this to have everything in one large "base-thread" # unshift @entriestree, "$startthread\|0"; } else { unshift @entriestree, "$startthread\|0"; } my $parent_template = LoadTemplate($section, "parententry.tpl"); my $parent_active = LoadTemplate($section, "parententry.tpa"); my $parent_end = LoadTemplate($section, "parententry.end"); my $normal_template = LoadTemplate($section, "normalentry.tpl"); my $normal_active = LoadTemplate($section, "normalentry.tpa"); my $parent_new_template = LoadTemplate($section, "parententry_new.tpl"); my $parent_new_active = LoadTemplate($section, "parententry_new.tpa"); my $normal_new_template = LoadTemplate($section, "normalentry_new.tpl"); my $normal_new_active = LoadTemplate($section, "normalentry_new.tpa"); my $lastlevel = 0; for (my $index = 0; $index <= $#entriestree; $index++) { my ($number, $level) = split /\|/, $entriestree[$index]; if ($level < $lastlevel) { my $numopenparents = $lastlevel - $level; while ($numopenparents > 0) { $main .= SubstRefVars($parent_end); $numopenparents--; } } $lastlevel = $level; my $isparent = 0; my $nextentry = $entriestree[$index + 1]; if ($nextentry) { my ($nextnumber, $nextlevel) = split /\|/, $nextentry; if ($nextlevel > $level) { $isparent = 1; } } FillEntryInfo($section, $number, $doload_text); if ($isparent) { if (NumDaysOld() <= $period_new) { if ($EntryInfo{'topmost'} == $number) { $main .= SubstRefVars($parent_new_active); } else { $main .= SubstRefVars($parent_new_template); } } else { if ($EntryInfo{'topmost'} == $number) { $main .= SubstRefVars($parent_active) } else { $main .= SubstRefVars($parent_template); } } } else { if (NumDaysOld() <= $period_new) { if ($EntryInfo{'topmost'} == $number) { $main .= SubstRefVars($normal_new_active); } else { $main .= SubstRefVars($normal_new_template); } } else { if ($EntryInfo{'topmost'} == $number) { $main .= SubstRefVars($normal_active); } else { $main .= SubstRefVars($normal_template); } } } } while ($lastlevel > 0) { $main .= SubstRefVars($parent_end); $lastlevel--; } } # }}} end of PrintEntries() # {{{ sub int getLatestEntry ( string pathToFile_entries.db) # returns the number of last sent entry sub getLatestEntry { my $entriesfile = shift; my $latestentry = 0; if (-e $entriesfile) { open ENTRIES, "<$entriesfile"; while () { $latestentry++; } close ENTRIES; } return $latestentry; } # }}} end of getLatestEntry() # {{{ sub void init () # sets some substitute parameters for navigation bar view sub init { if ( $username ) { $EntryInfo{'loginDis'} = "Dis"; $EntryInfo{'onclickLogin'} = ""; $EntryInfo{'logoutDis'} = ""; $EntryInfo{'onclickLogout'} = 'style="cursor: hand;" onclick="document.LOGOUT.submit();"'; } else { $EntryInfo{'LoginDis'} = ""; $EntryInfo{'onclickLogin'} = 'style="cursor: hand;" onclick="showLogin();"'; $EntryInfo{'logoutDis'} = "Dis"; $EntryInfo{'onclick'} = ""; } #end of if ( $username ) if ( $allow_registration ) { $EntryInfo{'registration'} = "onclick=\"javascript:window.open('./html/usr/register.html', 'Registration', 'width=400, height=320, resizable=no, scrollbars=no, status=no, toolbar=no, location=no, directories=no, menubar=no');\""; } else { $EntryInfo{'registration'} = "onclick=\"javascript:window.open('./html/usr/notallowed.html', 'Registration', 'width=400, height=320, resizable=no, scrollbars=no, status=no, toolbar=no, location=no, directories=no, menubar=no');\""; } #end of ( $allow_registration ) } # }}} end of init() # sub void ShowEntry ( string section, int entrynumber ) # shows specific entry in fullentry.tpl # also update hits for showed entry sub ShowEntry { my ( $section, $entrynumber ) = @_; my $db = SharedLib::catdir( ( $basedir, 'sections', $section, 'entries/entries.db' ) ); init(); my $latestentry = getLatestEntry($db); if ($entrynumber !~ /^\d+$/) { $entrynumber = 0; } if ($entrynumber > $latestentry) { $entrynumber = $latestentry; } FillEntryInfo($section, $entrynumber, 1); # Save this headline - we may need it later. $EntryInfo{'clickedheadline'} = $EntryInfo{'headline'}; my $periods = getDate(); $EntryInfo{'oneAgo'} = $periods->[0]; $EntryInfo{'twoAgo'} = $periods->[1]; OutputHTMLFile($section, 'forum.hdr'); OutputHTMLFile($section, 'navigation.tpl'); my $parents = printParents( $entrynumber, $section ); $main .= $parents->{'result'}; my $cnt = $parents->{'count'}; FillEntryInfo($section, $entrynumber, 1); OutputHTMLFile($section, 'fullentry.tpl'); # We used to do a # PrintEntries($section, $entrynumber, 'recursive'); # here. # I think it is more useful to display every entry with the same # (topmost) parent as the currently displayed entry instead. This # facilitates browsing through entries when you have not visited the # site for some time. So we wind up through @entryrelations until we # find a thread with "0" as parent. if (-e $db) { open ENTRYBASE, "<$db"; @entryrelations = ; close ENTRYBASE; my $topparent = $entrynumber; my $nextparent = $topparent; my $index = $entrynumber - 1; do { my $entry = $entryrelations[$index]; chomp $entry; if ($entry =~ /$topparent\|/) { (my $child, $nextparent) = split /\|/, $entry; if ($nextparent > 0) { $topparent = $nextparent; } } $index--; } while (($nextparent > 0) && ($index >= 0)); # It's safe to cut of all entries up to, but not including, # this topmost parent (child of "0"). They would only slow down # determining the relations. $main .= "
      " x ($cnt +1); #makes indent for children @entryrelations = @entryrelations[++$index..$#entryrelations]; $EntryInfo{'topmost'} = $entrynumber; for(@{$childs[$entrynumber]}) { PrintEntries($section, $_, 'recursive') } } $main .= "
    " x ( $cnt +1 ); #removes indent after children OutputHTMLFile( $section, 'afterEntries.html'); # Restore the original headline $EntryInfo{'headline'} = $EntryInfo{'clickedheadline'}; $EntryInfo{'entry'} ="reply"; if ( defined $username ) { $EntryInfo{'username'} = ", " . $username; OutputHTMLFile($section, 'formHead.html'); } else { OutputHTMLFile($section, 'formHead.html'); OutputHTMLFile($section, 'formHat.html'); } OutputHTMLFile($section, 'addentry.tpl'); $EntryInfo{'success'} = "Your reply is sent. Thank you, $username."; OutputHTMLFile($section, 'forum.end'); # Prior to version 1.04, no "cnt"-file was written by default. my $numhits = 0; my $EntryNumberCntFile = SharedLib::catdir( ( $basedir, 'sections', $section, 'entries', "$entrynumber.cnt" ) ); if (-e $EntryNumberCntFile ) { open COUNT, "< $EntryNumberCntFile"; $numhits = ; close COUNT; chomp $numhits; } $numhits++; open COUNT, "> $EntryNumberCntFile"; flock COUNT, 2; print COUNT $numhits; flock COUNT, 8; close COUNT; } # }}} end of ShowEntry() # sub void WriteEntry () # save sent messages in files sub WriteEntry { my $author; my $password; my $cookieError; my $section = $thesection; my $currentEntry = ""; my $parent = $PARS::parent; if ($parent !~ /^\d+$/) { # How insane must a brain be to try these things ?? # To all you phreakers: Stop wasting your time and program # something useful yourself. $parent = 0; } my $email = $PARS::email; $email =~ s#\|##; # to protect .hdl file structure unless ( $username ) { $author = $PARS::author; $author =~ s#\|##; } else { $author = $username; } unless ( $passwd ) { $password = $PARS::password; } else { $password = $passwd; } my $headline = $PARS::headline; my $text = $PARS::text; my $entryinfo = ''; my $authornum = -1; my $UsersDBFile = SharedLib::catdir( ( $basedir, 'users/users.db' ) ); if (-e $UsersDBFile ) { open( USERS, '<', $UsersDBFile ); while () { my ($usernum, $name) = split /\|/; if (!$name) { next; } chomp $name; chomp $author; if ($name eq $author) { $authornum = $usernum; last; } } close USERS; } #end of if (-e $basedir . "users/users.db") my $tmp = 0; if ($authornum >= 0) { open( PW, '<', SharedLib::catdir( ( $basedir, 'users', "$authornum.pwl" ) ) ); my $savedpw = ; close PW; if ($allUsers =~ /$author/) { $username = $author; $passwd = $password; } #end of if ($allUsers =~ /$author/) if ( trim( $headline ) eq $default_headline ) { $headline = ""; } #end of if ( trim( $headline ) eq $default_headline ) elsif (! $text ) { $EntryInfo{'error'} = "ERROR: No Message!"; if ( $PARS::parent != 0 ) { ShowEntry( $section, $PARS::parent ); } else { ShowSection( $section); } return; } #end of elsif (! $text ) open( EMAIL, '<', SharedLib::catdir( ( $basedir, 'users', "$authornum.eml" ) ) ); my $registeredemail = ; if (!$registeredemail) { $registeredemail = " "; } close EMAIL; $email = $registeredemail if ( $registeredemail ); if ((!$email) || ($registeredemail eq $email)) { $email = "seeeml"; } $entryinfo = "REGISTERED$authornum\|" . localtime() ."\|$email"; $tmp = 1; } elsif ($only_registered) { $EntryInfo{'error'} = "You have to register yourself to post messages."; if ( $PARS::parent != 0 ) { ShowEntry( $section, $PARS::parent ); } else { ShowSection( $section); } return; } if ( trim( $author ) eq $default_author ) { $author = ""; } if ( trim( $headline ) eq $default_headline ) { $headline = ""; } if (! $text ) { $EntryInfo{'error'} = "ERROR: No Message!"; if ( $PARS::parent != 0 ) { ShowEntry( $section, $PARS::parent ); } else { ShowSection( $section); } return; } if ( ! $tmp ) { if ( length $author > 0 ) { $author = "Anonymous ( " . $author ." )" ; } $entryinfo = "$author\|" . localtime() ."\|$email"; } my $entriesfile = SharedLib::catdir ( ( $basedir, 'sections', $section, 'entries/entries.db' ) ); my $latestentry = getLatestEntry($entriesfile); my $thisentry = $latestentry + 1; if ($parent > $latestentry) { # see above $parent = $latestentry; } open( ENTRIES, ">> $entriesfile" ) || warn "Cannot open entries.db: $!"; flock ENTRIES, 2; print ENTRIES "$thisentry\|$parent\n"; flock ENTRIES, 8; close ENTRIES; my $ThisEntry = SharedLib::catdir ( ( $basedir, 'sections', $section, 'entries', $thisentry ) ); open( INF,"> $ThisEntry.inf" ) || warn "Cannot open entries.db: $!"; print INF "$entryinfo\n"; close INF; open( MSG, "> $ThisEntry.msg" ) || warn "Cannot open ##.msg: $!"; print MSG $text; close MSG; open( HDL, "> $ThisEntry.hdl" ) || warn "Cannot open ##.hdl: $!"; print HDL $headline; close HDL; open( CNT, "> $ThisEntry.cnt" ) || warn "Cannot open ##.cnt file: $!"; print CNT "0"; close CNT; FillEntryInfo($section, $thisentry, 1); if ( $parent != 0 ) { $EntryInfo{'success'} = "Your reply is sent. Thank you, $author."; } # end of if ( $parent != 0 ) else { $EntryInfo{'success'} = "New post successfully sent. Thank you, $author."; } ShowSection( $section ); } # }}} end of WriteEntry() # {{{ sub string CheckHTMLOverride ( string section, string templateFile ) # returns full path to template file sub CheckHTMLOverride { my ($section, $file) = @_; if (!-e SharedLib::catdir( ( $basedir, 'sections', $section, 'html', $file ) ) ) { return SharedLib::catdir( ( $basedir, 'html', $file ) ); } else { return SharedLib::catdir( ( $basedir, 'sections', $section, 'html', $file ) ); } } # }}} end of CheckHTMLOverride() # {{{ sub void OutputHTMLFile ( string section, string fileName ) # loads substituted template to global variable "main" sub OutputHTMLFile { my ($section, $file) = @_; my $filename = CheckHTMLOverride($section, $file); if (-e $filename) { open HTMLFILE, "<$filename"; while () { if ($_) { $main .= SubstRefVars($_); } } close HTMLFILE; } else { warn "File $filename does not exist!"; } } # }}} end of OutputHTMLFile # {{{ sub hash hasNewChild ( string section, int array mainThreads ) # returns hash with TRUE values for all parents who have child created in "period_new" period sub hasNewChild { my $section = shift; my @parents = @_; my %hasNewChild = (); my $db = SharedLib::catdir( ( $basedir, 'sections', $section, 'entries/entries.db' ) ); if ( -e $db ) { open ( ENTRIES, "<$db"); @entryrelations = ; # fill global array with all entries close ENTRIES; } # end of if ( -e $db ) foreach ( @parents ) { my ( $child, $parent ) = split /\|/; my @children = GetChildren( $child, 'recursion'); foreach my $grandSon ( @children ) { my ( $younger, $middle ) = split /\|/, $grandSon; GetEntryTimeInfo( $section, $younger ); if (NumDaysOld() <= $period_new) { $hasNewChild{$child} = 1; last; } #end of if (NumDaysOld() <= $period_new) }# end of foreach $grandSon ( @children ) } #end of foreach ( @entryrelations ) return %hasNewChild; } # }}} end of hasNewChild() # {{{ sub void printMainThreads ( string section ) # loads templates for main threads in global variable "main" sub printMainThreads { my ($section ) = @_; my $db = SharedLib::catdir( ( $basedir, 'sections', $section, 'entries/entries.db' ) ); my @entryrelations = (); if ( -e $db ) { my $thestartentry = 0; open ENTRYBASE, "<$db"; while () { my ( $child, $parent ) = split /\|/; if ( $parent == 0 ) { next if ( -e SharedLib::catdir( ( $basedir, 'sections', $section, 'entries', "$child.del" ) ) ); push @entryrelations, $_; } } close ENTRYBASE; } # end of if ( -e $db ) @entryrelations = reverse @entryrelations; my %withNewChild = hasNewChild( $section, @entryrelations ); my $mainThread = LoadTemplate($section, "mainThread.html"); my $mainThread_new = LoadTemplate($section, "mainThread_new.html");; my $i = 0; foreach ( @entryrelations ) { my ( $child, $parent ) = split /\|/; if ( $withNewChild {$child} ) { $EntryInfo{'newReply'} = "show"; } else { $EntryInfo{'newReply'} = "none"; } FillEntryInfo( $section, $child, 0 ); next if ( ! IsInsideDateLimits() ) ; if (NumDaysOld() <= $period_new) { $main .= SubstRefVars( $mainThread_new ); } else { $main .= SubstRefVars( $mainThread ); } $i++; } #end of foreach if ( $i == 0 and $PARS::select ) { if ( ! $PARS::action ) { $main .= "There aren't records for this period."; } # end of if ( ! $PARS::action ) } #end of if ( ! $i == 0 and $PARS::select ) } # }}} end printMainThreads() # {{{ sub void ShowSection ( string section ) # shows forum main page sub ShowSection { my $section = shift(); my $entriesDB = SharedLib::catdir( ( $basedir, 'sections', $section, 'entries/entries.db' ) ); init(); if ( !defined $PARS::start or ( $PARS::start / 30) == 1 ) { #on first load PARS::start is undefined, else newer messages start is 30 days $EntryInfo{'this'} = "selected"; } elsif ( ($PARS::start / 30) == 2 ) { #old messages ( previous month ), start is 60 days $EntryInfo{'last'} = "selected"; } elsif ( ($PARS::start / 30) < 0 ) { #all messages -> start is -1 $EntryInfo{'all'} = "selected"; } if ( defined $PARS::action && $PARS::action eq 'showEntireThread' ) { ShowEntry( $section, $PARS::entry); } else { my $periods = getDate(); $EntryInfo{'oneAgo'} = $periods->[0]; $EntryInfo{'twoAgo'} = $periods->[1]; $EntryInfo{'forumTitle'} = $title; OutputHTMLFile($section, 'forum.hdr'); OutputHTMLFile($section, 'explainRow.tpl') if (! -z $entriesDB ); $EntryInfo{'entry'} = $PARS::entry; $EntryInfo{'topmost'} = 0; printMainThreads( $section ); OutputHTMLFile( $section, 'afterEntries.html'); if ( defined $username ) { $EntryInfo{'entry'} ="new entry"; $EntryInfo{'username'} = ", " . $username; $EntryInfo{'parent'} = $PARS::entry; OutputHTMLFile($section, 'formHead.html'); } else { $EntryInfo{'entry'} ="new entry"; $EntryInfo{'parent'} = $PARS::entry; OutputHTMLFile($section, 'formHead.html'); OutputHTMLFile($section, 'formHat.html'); } OutputHTMLFile($section, 'newentry.tpl'); OutputHTMLFile($section, 'forum.end'); } } # }}} end of ShowSection # {{{ sub void DoSearch ( string section ) # shows results matched by pattern sub DoSearch { my $section = shift(); my $searchstring = $PARS::searchstring; my $original = $searchstring; $searchstring = filterUserInput( $searchstring ); $searchstring =~ s/([\+\.])/\\$1/g; #meta characters $searchstring =~ s/\0//g; #null byte my $normal_template = LoadTemplate($section, "normalentry.tpl"); my $path = SharedLib::catdir( ( $basedir, 'sections', $section, 'entries' ) ); my @sortedentries = (); foreach my $entry (<$path/*.msg>) { (my $entrynum = $entry) =~ s/.*\/(.*)\.msg/$1/; if ( !-e SharedLib::catdir( ( $path, "$entrynum.del" ) ) ) { my $hdl = FileToScalar( SharedLib::catdir( ( $path, "$entrynum.hdl" ) ) ); if ( $hdl =~ /$searchstring/i) { push( @sortedentries, $entrynum ); } else { my $msg = FileToScalar( $entry ); push( @sortedentries, $entrynum ) if ( $msg =~ m/$searchstring/i ); } } } @sortedentries = sort {$b <=> $a} @sortedentries; if (! @sortedentries ) { $EntryInfo{'error'} = "There are no matching results."; ShowSection($section); return; }# end of if (! @sortedentries ) OutputHTMLFile($section, 'forum.hdr'); OutputHTMLFile($section, 'navigation.tpl'); $EntryInfo{'pattern'} = HTML::Entities::encode_entities( $original ); OutputHTMLFile($section, 'results.html'); OutputHTMLFile($section, 'explainRow.tpl') if (! -z SharedLib::catdir( ( $basedir, 'sections', $section, 'entries/entries.db' ) ) ); foreach my $entrynum (@sortedentries) { FillEntryInfo($section, $entrynum, 0); $main .= SubstRefVars($normal_template); } OutputHTMLFile( $section, 'afterEntries.html'); } # }}} end of DoSearch() # {{{ sub string trim ( string input ) # cuts all leading and trailing whitespaces in "input" sub trim { my $param = shift; $param =~ s/^\s+//; $param =~ s/\s+$//; return $param; } # }}} end of trim() # {{{ sub void AddUser () # registrates new users sub AddUser { if ($allow_registration == 0) { $EntryInfo{'allow_regist'}= "Registration is not allowed. Sorry you can't register yourself at the moment."; OutputHTMLFile($thesection, 'usr/notallowed.html'); return; } my $newuser = $PARS::name; $newuser = trim( $newuser ); my $newemail = $PARS::email; $newemail = trim( $newemail ); my $newpw = $PARS::newpw; $newpw = trim( $newpw ); my $retypedpw = $PARS::retpw; $retypedpw = trim( $retypedpw ); if (! $newuser or $newuser eq '' ) { $EntryInfo{'regist_err'} = "Type a username, please."; $EntryInfo{'tmpemail'} = $newemail; OutputHTMLFile($thesection, 'usr/register1.html'); return; } elsif ( $newuser !~ /^\w+$/ ) { $EntryInfo{'regist_err'} = "Username invalid. Username may contain only characters and digits."; $EntryInfo{'tmpemail'} = $newemail; OutputHTMLFile($thesection, 'usr/register1.html'); return; } elsif (! $newemail or $newemail eq '' or ! SharedLib::valid( $newemail )) { $EntryInfo{'regist_err'} = "Type correct email, please."; $EntryInfo{'tmpname'} = $newuser; OutputHTMLFile($thesection, 'usr/register1.html'); return; } elsif (! $newpw or $newpw eq '' or length($newpw)<4 ) { $EntryInfo{'regist_err'} = "Password must be 4 characters at least, please."; $EntryInfo{'tmpname'} = $newuser; $EntryInfo{'tmpemail'} = $newemail; OutputHTMLFile($thesection, 'usr/register1.html'); return; } my $authornum = -1; my $lastusernum = -1; my $UsersDBFile = SharedLib::catdir( ( $basedir, 'users/users.db' ) ); if (-e $UsersDBFile ) { open USERS, "<$UsersDBFile"; while () { my ($usernum, $name) = split /\|/; chomp $name; if ($name eq $newuser) { $authornum = $usernum; } $lastusernum = $usernum; } close USERS; } if ($authornum >= 0) { $EntryInfo{'regist_err'} = "Registration failed. Username is already in use. Please choose another."; $EntryInfo{'tmpemail'} = $newemail; OutputHTMLFile($thesection, 'usr/register1.html'); return; } if ($newpw ne $retypedpw) { $EntryInfo{'regist_err'} = "Registration failed. Passwords do not match."; $EntryInfo{'tmpname'} = $newuser; $EntryInfo{'tmpemail'} = $newemail; OutputHTMLFile($thesection, 'usr/register1.html'); return; } my $newusernum = $lastusernum + 1; open USERS, ">>$UsersDBFile"; flock USERS, 2; print USERS "$newusernum\|$newuser\n"; flock USERS, 8; close USERS; open( EMAIL, '>>', SharedLib::catdir( ( $basedir, 'users', "$newusernum.eml" ) ) ); print EMAIL $newemail; close EMAIL; my $encpw = EncDec($newpw); open( PW, '>', SharedLib::catdir( ( $basedir, 'users', "$newusernum.pwl" ) ) ); print PW "$encpw"; close PW; # Write username also in separate file open( SYNTAX, '>', SharedLib::catdir( ( $basedir, 'users', "$newusernum.syn" ) ) ); print SYNTAX $newuser; close SYNTAX; open( LASTIP, '>', SharedLib::catdir( ( $basedir, 'users/lastip' ) ) ); print LASTIP $ENV{'REMOTE_ADDR'}; close LASTIP; $EntryInfo{'username'}= $newuser; OutputHTMLFile($thesection, "usr/registered.html"); } # }}} end of AddUser() # {{{ sub ShowLoginPage #sub ShowLoginPage { # my $section = shift(); # $EntryInfo{'forumTitle'} = $title; # OutputHTMLFile($section, 'forum.hdr'); # $EntryInfo{'topmost'} = 0; # PrintEntries($section, 0, 'recursive'); # OutputHTMLFile( $section, 'afterEntries.html'); # $EntryInfo{'entry'} ="new entry"; # OutputHTMLFile($section, 'formHead.html'); # OutputHTMLFile($section, 'formHat.html'); # OutputHTMLFile($section, 'newentry.tpl'); # OutputHTMLFile($section, 'forum.end'); #} # end of ShowLoginPage() # {{{ sub void DoLogin ( string section ) # checks if user exists and if so do login # create session cookies also sub DoLogin { my $section = shift; my $user = $PARS::username; chomp( $user ); my $pass = $PARS::passwd; chomp( $pass ); my $authornum = -1; if (-e SharedLib::catdir( ( $basedir, 'users/users.db' ) ) ) { open( USERS, '<', SharedLib::catdir( ( $basedir, 'users/users.db' ) ) ); while () { my ($usernum, $name) = split /\|/; if (!$name) { next; } chomp $name; chomp $user; if ($name eq $user) { $authornum = $usernum; last; } }# end of while close USERS; } # end of if (-e $basedir . "users/users.db") if ($authornum >= 0) { open( PW, '<', SharedLib::catdir( ( $basedir, 'users', "$authornum.pwl" ) ) ); my $savedpw = ; close PW; $savedpw = EncDec($savedpw); if ($savedpw ne $pass) { $EntryInfo{'error'} = "Wrong username or password."; ShowSection( $thesection ); return 0; } #end of if ($savedpw ne $password) $cookieName = $cgi->cookie(-name=>'username', -value=>$user, -expires=>'+1d'); $cookiePasswd = $cgi->cookie(-name=>'passwd', -value=>$pass, -expires=>'+1d'); $EntryInfo{'success'} = "Welcome, $user."; $username = $user; ShowSection($section); } else { $EntryInfo{'error'} = "Wrong username or password."; ShowSection( $thesection ); } } # {{{ end of DoLogin() # {{{ sub void DoLogout ( string section ) # delete session cookies and log out sub DoLogout { my $section = shift; $cookieName = $cgi->cookie(-name=>'username', -value=>'blah', -expires=>'-1d'); $cookiePasswd = $cgi->cookie(-name=>'passwd', -value=>'blah', -expires=>'-1d'); $EntryInfo{'success'} = "You were successfully logged out. Have a nice day."; ShowSection($section); } # end of DoLogout() # Load configuration file open( CONF, '<', SharedLib::catdir( ( $basedir, 'cgiforum.conf' ) ) ) || warn 'Cannot open cgiforum.conf: $!'; while () { s/\r//g; chomp; my ($variable, $value) = split /=/, $_; if ($variable =~ /basedir/i) { $basedir = $value; if (substr($basedir, -1, 1) ne '/') { $basedir .= '/'; } } elsif ($variable =~ /period\_new/i) { $period_new = $value; } elsif ($variable =~ /default_day_limit/i) { $default_day_limit = $value; } elsif ($variable =~ /default_author/i) { $default_author = $value; if (!$default_author) { $default_author = 'Anonymous'; } $EntryInfo{'anonymous'} = $default_author; } elsif ($variable =~ /default_headline/i) { $default_headline = $value; if (!$default_headline) { $default_headline = 'No subject'; } $EntryInfo{'defaultSubject'} = $default_headline; if (!$default_headline) { $default_headline = ' '; } } elsif ($variable =~ /load_text/i) { $doload_text = $value; if (!$doload_text) { $doload_text = 0; } } elsif ($variable =~ /only_registered/i) { $only_registered = $value; if (!$only_registered) { $only_registered = 0; } } elsif ($variable =~ /allow_registration/i) { $allow_registration = $value; if (!$allow_registration) { $allow_registration = 0; } } elsif ( $variable =~ /title/i ) { $title = $value; } } close CONF; $thesection = $PARS::thesection || 'default'; $thesection = filterUserInput($thesection); # Security measure # I have written "A Comment on Bugtracking" on this issue: # http://triskam.virtualave.net/bugtracking.html # Load weekday-names if (!(-e SharedLib::catdir( ( $basedir, 'sections', $thesection, 'html/wdays' ) ) ) ) { open( WDAYS, '<', SharedLib::catdir( ( $basedir, 'html/wdays' ) ) ); } else { open( WDAYS, '<', SharedLib::catdir( ( $basedir, 'sections', $thesection, 'html/wdays' ) ) ); } my $counter = 0; while () { chomp; $FullWeekDay{$ShortWeekDays[$counter]} = $_; $counter++; } close WDAYS; $EntryInfo{'basedir'} = $basedir; $EntryInfo{'section'} = $thesection; $EntryInfo{'end'} = $PARS::end || 0; $EntryInfo{'start'} = $PARS::start || 0; if ($EntryInfo{'start'} == 0) { if ($EntryInfo{'end'} == 0) { $EntryInfo{'start'} = $default_day_limit; } } if ( (!$PARS::action) || ($PARS::action eq 'showsection') || ($PARS::action eq 'showEntireThread') ) { ShowSection($thesection); } elsif ($PARS::action eq "addentry") { WriteEntry(); } elsif ($PARS::action eq "showentry") { ShowEntry($thesection, filterUserInput($PARS::entry)) } elsif ($PARS::action eq "adduser") { AddUser(); } elsif ($PARS::action eq "search") { DoSearch($thesection); } elsif ($PARS::action eq "logout") { DoLogout($thesection); } elsif ($PARS::action eq "loginpage") { ShowLoginPage(); } elsif ($PARS::action eq "login") { DoLogin($thesection); } print $cgi->header(-cookie=>[$cookieName, $cookiePasswd]), $main;