###############################################################################
# Subs.pl #
###############################################################################
# YaBB: Yet another Bulletin Board #
# Open-Source Community Software for Webmasters #
# Version: YaBB 1 Gold - SP 1.1 #
# Released: December 2001; Updated March 22, 2002 #
# Distributed by: http://www.yabbforum.com #
# =========================================================================== #
# Copyright (c) 2000-2002 Xnull (www.xnull.com) - All Rights Reserved. #
# Software by: The YaBB Development Team #
# with assistance from the YaBB community. #
###############################################################################
$subsplver = "1 Gold - SP 1.1";
use subs 'exit';
$yymain = ""; # set body start to blank
&readform; # parse the query
&get_date; # get the current date/time
$currentboard = $INFO{'board'};
if ($currentboard =~ m~/~){ &fatal_error($txt{'399'}); }
if ($currentboard =~ m~\\~){ &fatal_error($txt{'400'}); }
if ($currentboard ne '' && currentboard !~ /\A[\s0-9A-Za-z#%+,-\.:=?@^_]+\Z/){ &fatal_error($txt{'399'}); }
$pwseed ||= 'yy';
if (!$user_ip)
{
if ($ENV{'HTTP_X_FORWARDED_FOR'} && $ENV{'HTTP_X_FORWARDED_FOR'} ne "127.0.0.1") {$user_ip = $ENV{'HTTP_X_FORWARDED_FOR'};}
elsif (!$user_ip && $ENV{'HTTP_CLIENT_IP'} && $ENV{'HTTP_CLIENT_IP'} ne "127.0.0.1") {$user_ip = $ENV{'HTTP_CLIENT_IP'};}
elsif (!$user_ip && $ENV{'X_CLIENT_IP'} && $ENV{'X_CLIENT_IP'} ne "127.0.0.1") {$user_ip = $ENV{'X_CLIENT_IP'};}
else {$user_ip = $ENV{'REMOTE_ADDR'};}
}
$scripturl = qq~$boardurl/YaBB.$yyext~;
$cgi = qq~$scripturl?board=$currentboard~;
sub exit {
local $| = 1;
local $\ = '';
print '';
CORE::exit( $_[0] || 0 );
}
sub redirectexit {
print "Location: $yySetLocation\n\n";
exit;
}
sub redirectinternal {
&LoadIMs; # Load IM's
if($currentboard) {
if($INFO{'num'}) { require "$sourcedir/Display.pl"; &Display; }
else { require "$sourcedir/MessageIndex.pl"; &MessageIndex; }
}
else { require "$sourcedir/BoardIndex.pl"; &BoardIndex; }
exit;
}
sub template {
#START#Calendar mod#
require "$sourcedir/Calendar.pl";
&get_settings;
#END#Calendar mod#
if($yySetCookies1 || $yySetCookies2) { print header(-cookie=>[$yySetCookies1, $yySetCookies2], -charset=>'$yycharset'); }
else { print header(-status=>'200 OK', -charset=>'$yycharset'); }
$yyposition = $yytitle; $yytitle = "$mbname - $yytitle";
$yymenu = qq~$img{'home'}$menusep$img{'help'}$menusep$img{'search'}$menusep$img{'memberlist'}~;
if($settings[7] eq 'Administrator') { $yymenu .= qq~$menusep$img{'admin'}~; }
if ($caltop == 1) {$yymenu .= qq~$menusep$img{'Calendar'}~;}
if($username eq 'Guest') { $yymenu .= qq~$menusep$img{'login'}$menusep$img{'register'}~;
} else {
$yymenu .= qq~$menusep$img{'profile'}~;
if($enable_notification) { $yymenu .= qq~$menusep$img{'notification'}~; }
$yymenu .= qq~$menusep$img{'logout'}~;
}
$yyimages = $imagesdir;
fopen(TEMPLATE,"template.html") || die("$txt{'23'}: template.html");
@yytemplate = ;
fclose(TEMPLATE);
$yyboardname = $mbname;
$yytime = &timeformat($date, 1);
$yyuname = $username eq 'Guest' ? qq~$txt{'248'} $txt{'28'}. $txt{'249'} $txt{'34'} $txt{'377'} $txt{'97'}.~ : qq~$txt{'247'} $realname, ~ ;
for(my $i = 0; $i < @yytemplate; $i++) {
$curline = $yytemplate[$i];
if(!$yycopyin && $curline =~ m~~) { $yycopyin = 1; }
if($curline =~ m~~ && $enable_news) {
fopen(FILE, "$vardir/news.txt");
@newsmessages = ;
fclose(FILE);
srand;
$yynews = qq~$txt{'102'}: $newsmessages[int rand(@newsmessages)]~;
}
$curline =~ s~~${"yy$1"}~g;
print $curline;
}
if($yycopyin == 0) {
print q~Sorry, the copyright tag must be in the template.
Please notify this forum's administrator that this site is using an ILLEGAL copy of YaBB!~;
}
}
# One should never criticize his own work except in a fresh and hopeful mood.
# The self-criticism of a tired mind is suicide.
# - Charles Horton Cooley
sub calcdifference { # Input: $date1 $date2
my( $dates, $times, $month, $day, $year, $number1, $dummy, $number2 );
($dates, $times) = split(/ /, $date1);
($month, $day, $year) = split(/\//, $dates);
$number1=($year*365)+($month*30)+$day;
($dates, $dummy) = split(/ /, $date2);
($month, $day, $year) = split(/\//, $dates);
$number2=($year*365)+($month*30)+$day;
$result=$number2-$number1;
}
sub calctime { # Input: $date1 $date2
my($dummy, $times, $hour, $min, $sec, $number1, $number2, $day1, $day2);
($day1, $times) = split(/ $txt{'107'} /, $date1);
($hour, $min, $sec) = split(/\:/, $times);
$number1 = ($hour*60)+$min+($sec/60);
($day2, $times) = split(/ $txt{'107'} /, $date2);
($hour, $min, $sec) = split(/\:/, $times);
$number2 = ($hour*60)+$min+($sec/60);
# if days are different, increase second time by 1440 mins
if ($day1 ne $day2) {$number2 = $number2+1440;}
$result = $number2-$number1;
}
sub fatal_error {
my $e = $_[0];
&LoadIMs; # Load IM's
$yymain .= qq~
$txt{'250'}
~;
$yytitle = "$txt{'106'}";
&template;
exit;
}
sub readform {
my(@pairs, $pair, $name, $value);
my $query = new CGI;
my $etest = '';
if($ENV{QUERY_STRING} =~ m~;~) { @pairs = split(/;/, $ENV{QUERY_STRING}); }
else { @pairs = split(/&/, $ENV{QUERY_STRING}); }
foreach $pair (@pairs) {
($name,$value) = split(/=/, $pair);
$name =~ tr/+/ /;
$name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$value =~ s///g;
$INFO{$name} = $value;
if ($etest eq '') { $etest .= $name."=".$value; }
else { $etest .= "&" .$name."=".$value; }
}
my (@keylist) = $query->param();
my $qtest = '';
foreach $key (@keylist) {
# may be dealing with multiple values; need to join with comma
$value = join(', ', $query->param($key));
$FORM{$key} = $value;
if ($qtest eq '') { $qtest .= $key."=".$value; }
else { $qtest .= "&" .$key."=".$value; }
}
if (lc($qtest) eq lc($etest)) {
foreach $key (@keylist) {
undef $FORM{$key};
}
}
$action = $INFO{'action'};
}
sub get_date {
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time + (3600*$timeoffset));
$mon_num = $mon+1;
$savehour = $hour;
$hour = "0$hour" if ($hour < 10);
$min = "0$min" if ($min < 10);
$sec = "0$sec" if ($sec < 10);
$saveyear = ($year % 100);
$year = 1900 + $year;
$mon_num = "0$mon_num" if ($mon_num < 10);
$mday = "0$mday" if ($mday < 10);
$saveyear = "0$saveyear" if ($saveyear < 10);
$date = "$mon_num/$mday/$saveyear $txt{'107'} $hour\:$min\:$sec";
}
sub timeformat {
if ($settings[17] > 0) { $mytimeselected = $settings[17]; } else { $mytimeselected = $timeselected; }
$oldformat = $_[0];
if( $oldformat eq '' || $oldformat eq "\n" ) { return $oldformat; }
$oldmonth = substr($oldformat,0,2);
$oldday = substr($oldformat,3,2);
$oldyear = ("20".substr($oldformat,6,2)) - 1900;
$oldhour = substr($oldformat,-8,2);
$oldminute = substr($oldformat,-5,2);
$oldsecond = substr($oldformat,-2,2);
if ($oldformat ne '') {
use Time::Local 'timelocal';
eval { $oldtime = timelocal($oldsecond,$oldminute,$oldhour,$oldday,$oldmonth-1,$oldyear); };
if ($@) { return ($oldformat); }
my ($newsecond,$newminute,$newhour,$newday,$newmonth,$newyear,$newweekday,$newyearday,$newisdst) = localtime($oldtime + (3600 * $settings[18]));
$newmonth++;
$newweekday++;
$newyear += 1900;
$newshortyear = substr($newyear,2,2);
if ($newmonth < 10) { $newmonth = "0$newmonth"; }
if ($newday < 10 && $mytimeselected != 4) { $newday = "0$newday"; }
if ($newhour < 10) { $newhour = "0$newhour" };
if ($newminute < 10) { $newminute = "0$newminute"; }
if ($newsecond < 10) { $newsecond = "0$newsecond"; }
$newtime = $newhour.":".$newminute.":".$newsecond;
$usertimeoffset = $timeoffset + $settings[18];
($secx,$minx,$hourx,$dd,$mm,$yy,$tmpx,$tmpx,$tmpx) = localtime(time + (3600*$usertimeoffset));
$mm = $mm + 1;
$yy = ($yy % 100);
$dontusetoday = $_[1] + 0;
if ($mytimeselected == 1) {
$newformat = qq~$newmonth/$newday/$newshortyear $txt{'107'} $newtime~;
if ($mm == $newmonth && $dd == $newday && $yy == $newshortyear && $dontusetoday == 0) { $newformat = qq~$txt{'769'} $txt{'107'} $newtime~; }
return $newformat;
} elsif ($mytimeselected == 2) {
$newformat = qq~$newday.$newmonth.$newshortyear $txt{'107'} $newtime~;
if ($mm == $newmonth && $dd == $newday && $yy == $newshortyear && $dontusetoday == 0) { $newformat = qq~$txt{'769'} $txt{'107'} $newtime~; }
return $newformat;
} elsif ($mytimeselected == 3) {
$newformat = qq~$newday.$newmonth.$newyear $txt{'107'} $newtime~;
if ($mm == $newmonth && $dd == $newday && $yy == $newshortyear && $dontusetoday == 0) { $newformat = qq~$txt{'769'} $txt{'107'} $newtime~; }
return $newformat;
} elsif ($mytimeselected == 4) {
$newmonth--;
$ampm = $newhour > 11 ? 'pm' : 'am';
$newhour2 = $newhour % 12 || 12;
$newmonth2 = $months[$newmonth];
if( $newday > 10 && $newday < 20 ) { $newday2 = 'th'; }
elsif( $newday % 10 == 1 ) { $newday2 = 'st'; }
elsif( $newday % 10 == 2 ) { $newday2 = 'nd'; }
elsif( $newday % 10 == 3 ) { $newday2 = 'rd'; }
else{ $newday2 = 'th'; }
$newformat = qq~$newmonth2 $newday$newday2, $newyear, $newhour2:$newminute$ampm~;
if ($mm == $newmonth + 1 && $dd == $newday && $yy == $newshortyear && $dontusetoday == 0) { $newformat = qq~$txt{'769'} $txt{'107'} $newhour2:$newminute$ampm~; }
return $newformat;
} elsif ($mytimeselected == 5) {
$ampm = $newhour > 11 ? 'pm' : 'am';
$newhour2 = $newhour % 12 || 12;
$newformat = qq~$newmonth/$newday/$newshortyear $txt{'107'} $newhour2:$newminute$ampm~;
if ($mm == $newmonth && $dd == $newday && $yy == $newshortyear && $dontusetoday == 0) { $newformat = qq~$txt{'769'} $txt{'107'} $newhour2:$newminute$ampm~; }
return $newformat;
} elsif ($mytimeselected == 6) {
$newmonth2 = $months[$newmonth-1];
$newformat = qq~$newday. $newmonth2 $newyear $txt{'107'} $newhour:$newminute~;
if ($mm == $newmonth && $dd == $newday && $yy == $newshortyear && $dontusetoday == 0) { $newformat = qq~$txt{'769'} $txt{'107'} $newhour:$newminute~; }
return $newformat;
}
} else { return ''; }
}
sub getlog {
if( $username eq 'Guest' || $max_log_days_old == 0 ) { return; }
my $entry = $_[0];
unless( defined %yyuserlog ) {
%yyuserlog = ();
my( $name, $value, $thistime, $adate, $atime, $amonth, $aday, $ayear, $ahour, $amin, $asec );
my $mintime = time - ( $max_log_days_old * 86400 );
fopen(MLOG, "$memberdir/$username.log");
while( ) {
chomp;
($name, $value, $thistime) = split( /\|/, $_ );
unless( $name ) { next; }
if( $value ) {
$thistime = stringtotime($value);
}
if( $thistime > $mintime ) {
$yyuserlog{$name} = $thistime;
}
}
fclose(MLOG);
}
return $yyuserlog{$entry};
}
sub modlog {
if( $username eq 'Guest' || $max_log_days_old == 0 ) { return; }
unless( defined %yyuserlog ) { &getlog; }
my( $entry, $dumbtime, $thistime ) = @_;
if( $dumbtime ) {
$thistime = stringtotime($dumbtime);
}
unless( $thistime ) {
$thistime = time;
}
$yyuserlog{$entry} = $thistime;
}
sub dumplog {
if( $username eq 'Guest' || $max_log_days_old == 0 ) { return; }
if( @_ ) { &modlog(@_); }
if( defined %yyuserlog ) {
fopen(MLOG, ">$memberdir/$username.log");
while( $_ = each(%yyuserlog) ) {
unless( $_ ) { next; }
print MLOG qq~$_||$yyuserlog{$_}\n~;
}
fclose(MLOG);
}
}
sub stringtotime {
unless( $_[0] ) { return 0; }
my( $adate, $atime ) = split(m~ $txt{'107'} ~, $_[0]);
my( $amonth, $aday, $ayear ) = split(m~/~, $adate);
my( $ahour, $amin, $asec ) = split (m~:~, $atime);
$asec = int($asec) || 0;
$amin = int($amin) || 0;
$ahour = int($ahour) || 0;
$ayear = int($ayear) || 0;
$amonth = int($amonth) || 0;
$aday = int($aday) || 0;
$ayear += 100;
if( $amonth < 1 ) { $amonth = 0; }
elsif( $amonth > 12 ) { $amonth = 11; }
else { --$amonth; }
if( $aday < 1 ) { $aday = 1; }
elsif( $aday > 31 ) { $aday = 31; }
return( timelocal($asec, $amin, $ahour, $aday, $amonth, $ayear) - (3600*$timeoffset) );
}
sub jumpto {
my(@masterdata,$category,@data,$found,$tmp,@memgroups,@newcatdata);
$selecthtml = qq~
";
}
sub sendmail {
my ($to, $subject, $message, $from) = @_;
if ($mailtype==1) { use Socket; }
if($from) { $webmaster_email = $from; }
$to =~ s/[ \t]+/, /g;
$webmaster_email =~ s/.*<([^\s]*?)>/$1/;
$message =~ s/^\./\.\./gm;
$message =~ s/\r\n/\n/g;
$message =~ s/\n/\r\n/g;
$message =~ s/<\/*b>//g;
$smtp_server =~ s/^\s+//g;
$smtp_server =~ s/\s+$//g;
if (!$to) { return(-8); }
if ($mailtype==1) {
my($proto) = (getprotobyname('tcp'))[2];
my($port) = (getservbyname('smtp', 'tcp'))[2];
my($smtpaddr) = ($smtp_server =~ /^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/) ? pack('C4',$1,$2,$3,$4) : (gethostbyname($smtp_server))[4];
if (!defined($smtpaddr)) { return(-1); }
if (!socket(MAIL, AF_INET, SOCK_STREAM, $proto)) { return(-2); }
if (!connect(MAIL, pack('Sna4x8', AF_INET, $port, $smtpaddr))) { return(-3); }
my($oldfh) = select(MAIL);
$| = 1;
select($oldfh);
$_ = ;
if (/^[45]/) {
close(MAIL);
return(-4);
}
print MAIL "helo $smtp_server\r\n";
$_ = ;
if (/^[45]/) {
close(MAIL);
return(-5);
}
print MAIL "mail from: <$webmaster_email>\r\n";
$_ = ;
if (/^[45]/) {
close(MAIL);
return(-5);
}
foreach (split(/, /, $to)) {
print MAIL "rcpt to: <$_>\r\n";
$_ = ;
if (/^[45]/) {
close(MAIL);
return(-6);
}
}
print MAIL "data\r\n";
$_ = ;
if (/^[45]/) {
close(MAIL);
return(-5);
}
}
if( $mailtype == 2 ) {
eval q^
use Net::SMTP;
my $smtp = Net::SMTP->new($smtp_server, Debug => 0) || die "unable to create Net::SMTP object $smtp_server.";
$smtp->mail($webmaster_email);
$smtp->to($to);
$smtp->data();
$smtp->datasend("From: $webmaster_email\n");
$smtp->datasend("X-Mailer: Perl Powered Socket Net::SMTP Mailer\n");
$smtp->datasend("Subject: $subject\n");
$smtp->datasend("\n");
$smtp->datasend($message);
$smtp->dataend();
$smtp->quit();
^;
if($@) {
&fatal_error("\n
Net::SMTP fatal error: $@\n
");
return -77;
}
return 1;
}
if ($mailtype==0) { open(MAIL,"| $mailprog -t"); }
print MAIL "To: $to\n";
print MAIL "From: $webmaster_email\n";
print MAIL "X-Mailer: YaBB Perl-Powered Socket Mailer\n";
print MAIL "Subject: $subject\n\n";
print MAIL "$message";
print MAIL "\n.\n";
if ($mailtype==1) {
$_ = ;
if (/^[45]/) {
close(MAIL);
return(-7);
}
print MAIL "quit\r\n";
$_ = ;
}
close(MAIL);
return(1);
}
sub spam_protection {
unless($timeout) { return; }
my($time,$flood_ip,$flood_time,$flood,@floodcontrol);
$time = time;
if (-e "$vardir/flood.txt") {
fopen(FILE, "$vardir/flood.txt");
push(@floodcontrol,"$user_ip|$time\n");
while( ) {
chomp($_);
($flood_ip,$flood_time) = split(/\|/,$_);
if($user_ip eq $flood_ip && $time - $flood_time <= $timeout) { $flood = 1; }
elsif( $time - $flood_time < $timeout ) { push( @floodcontrol, "$_\n" ); }
}
fclose(FILE);
}
if ($flood && $settings[7] ne 'Administrator') { &fatal_error("$txt{'409'} $timeout $txt{'410'}"); }
fopen(FILE, ">$vardir/flood.txt", 1);
print FILE @floodcontrol;
fclose(FILE);
}
sub BoardCatsMake {
my( @categories, @catboards, @curcataccess, $curcat, $curcatname, $curcataccess, $curboard );
fopen(FILE, "$vardir/cat.txt");
@categories = ;
fclose(FILE);
foreach $curcat (@categories) {
chomp $curcat;
fopen(CATFILE, "$boardsdir/$curcat.cat");
$curcatname = ;
$curcataccess = ;
@catboards = ;
fclose(CATFILE);
chomp $curcatname;
chomp $curcataccess;
$yyAccessCat{$curcat} = $settings[7] eq 'Administrator' || $moderators{$username} || ! $curcataccess;
unless( $yyAccessCat{$curcat} ) {
foreach ( split(/\,/, $curcataccess) ) {
if( $_ && $_ eq $settings[7] ) { $yyAccessCat{$curcat} = 1; last; }
}
}
foreach $curboard (@catboards) {
chomp $curboard;
fopen(CATBOARDMAKE, ">$boardsdir/$curboard.ctb");
print CATBOARDMAKE $curcat;
fclose(CATBOARDMAKE);
$yyCatBoard{$curboard} = $curcat;
}
}
}
sub BoardCatGet {
my $curboard = $_[0];
if( !$yyCatBoard{$curboard} && fopen(CATFILE, "$boardsdir/$curboard.ctb") ) {
$_ = ;
fclose(CATFILE);
chomp $_;
$yyCatBoard{$curboard} = $_;
}
unless( $yyCatBoard{$curboard} ) { &BoardCatsMake; }
return $yyCatBoard{$curboard};
}
sub BoardAccessGet {
my $curboard = $_[0];
&BoardCatGet($curboard);
if( !$yyAccessCat{$yyCatBoard{$curboard}} && fopen(CATFILE, "$boardsdir/$yyCatBoard{$curboard}.cat") ) {
my $curcatname = ;
my $curcataccess = ;
fclose(CATFILE);
chomp $curcatname;
chomp $curcataccess;
$yyAccessCat{$yyCatBoard{$curboard}} = $settings[7] eq 'Administrator' || $moderators{$username} || ! $curcataccess;
unless( $yyAccessCat{$curcat} ) {
foreach ( split(/\,/, $curcataccess) ) {
if( $_ && $_ eq $settings[7]) { $yyAccessCat{$yyCatBoard{$curboard}} = 1; last; }
}
}
}
return $yyAccessCat{$yyCatBoard{$curboard}};
}
sub ToHTML {
$_[0] =~ s/&/&/g;
$_[0] =~ s/"/"/g;
$_[0] =~ s/ / \ /g;
$_[0] =~ s/</g;
$_[0] =~ s/>/>/g;
$_[0] =~ s/\|/\|/g;
}
sub FromHTML {
$_[0] =~ s/"/"/g;
$_[0] =~ s/ / /g;
$_[0] =~ s/<//g;
$_[0] =~ s/|/\|/g;
$_[0] =~ s/&/&/g;
}
sub dopre {
$_ = $_[0];
$_ =~ s~
~\n~g;
return $_;
}
sub elimnests {
$_ = $_[0];
$_ =~ s~\[/*shadow([^\]]*)\]~~ig;
$_ =~ s~\[/*glow([^\]]*)\]~~ig;
return $_;
}
sub wrap {
$message =~ s~ ~\t~g;
$message =~ s~
~\n~g;
&FromHTML($message);
$message =~ s~[\n\r]~ ~g;
my @words = split(/\s/,$message);
$message = "";
foreach $cur (@words) {
if($cur !~ m~[ht|f]tp://~ && $cur !~ m~\[\S*\]~ && $cur !~ m~\[\S*\s?\S*?\]~ && $cur !~ m~\[\/\S*\]~) {
$cur =~ s~(\S{72})~$1 ~g;
if($sender eq "search") {
foreach( @search ) {
if($cur !~ m~~) { $cur =~ s~(\Q$_\E)~\[b\]$_\[/b\]~ig; }
}
}
}
if($cur !~ m~\[url(\S*)\](\S*)\[\/url\]~ && $cur !~ m~\[flash(\S*)\](\S*)\[\/flash\]~ && $cur !~ m~\[img(\S*)\](\S*)\[\/img\]~) { $cur =~ s~\[(\S*)\](\S{72})(\S*)\[\/(\S*)\]~\[$1\]$2 $3\[/$4\]~g; }
$message .= "$cur ";
}
$message =~ s~~\n~g;
&ToHTML($message);
$message =~ s~\t~ ~g;
$message =~ s~\n~
~g;
}
sub wrap2 {
$message =~ s~(\S{72})(\S*)~$5 $6~gi;
}
sub BoardCountTotals {
my $curboard = $_[0];
unless( $curboard ) { return undef; }
my( $postid, $tmpa, $lastposttime, $lastposter, $threadcount, $messagecount, $counter, $mreplies, @messages );
fopen(FILEBTTL, "$boardsdir/$curboard.txt");
@messages = ;
fclose(FILEBTTL);
($postid,$tmpa,$tmpa,$tmpa,$lastposttime) = split(/\|/, $messages[0]);
if( $postid ) {
fopen(FILEBTTL, "$datadir/$postid.data");
$tmpa = ;
fclose(FILEBTTL);
($tmpa, $lastposter) = split(/\|/, $tmpa);
}
unless( $lastposter ) { $lastposter = 'N/A'; }
unless( $lastposttime ) { $lastposttime = 'N/A'; }
$threadcount = scalar @messages;
$messagecount = $threadcount;
for($counter = 0; $counter < $threadcount; $counter++ ) {
($tmpa, $tmpa, $tmpa, $tmpa, $tmpa, $mreplies) = split(/\|/, $messages[$counter]);
$messagecount += $mreplies;
}
fopen(FILEBTTL, "+>$boardsdir/$curboard.ttl");
print FILEBTTL qq~$threadcount|$messagecount|$lastposttime|$lastposter~;
fclose(FILEBTTL);
&BoardCatsMake;
if( wantarray() ) {
return ( $threadcount, $messagecount, $lastposttime, $lastposter );
}
else { return 1; }
}
sub BoardCountSet {
my ( $curboard, $threadcount, $messagecount, $lastposttime, $lastposter ) = @_;
fopen(FILEBOARDSET, "+>$boardsdir/$curboard.ttl");
print FILEBOARDSET qq~$threadcount|$messagecount|$lastposttime|$lastposter~;
fclose(FILEBOARDSET);
}
sub BoardCountGet {
if( fopen(FILEBOARDGET, "$boardsdir/$_[0].ttl") ) {
$_ = ;
chomp;
fclose(FILEBOARDGET);
return split( /\|/, $_ );
}
else {
return &BoardCountTotals($_[0]);
}
}
sub MembershipGet {
if( fopen(FILEMEMGET, "$memberdir/members.ttl") ) {
$_ = ;
chomp;
fclose(FILEMEMGET);
return split( /\|/, $_ );
}
else {
my @ttlatest = &MembershipCountTotal;
return @ttlatest;
}
}
sub MembershipCountTotal {
my $membertotal = 0;
my $latestmember;
fopen(FILEAMEMBERS, "$memberdir/memberlist.txt");
while( ) {
chomp;
++$membertotal;
if( $_ ) { $latestmember = $_; }
}
fclose(FILEAMEMBERS);
fopen(FILEAMEMBERS, "+>$memberdir/members.ttl");
print FILEAMEMBERS qq~$membertotal|$latestmember~;
fclose(FILEAMEMBERS);
if( wantarray() ) {
return ( $membertotal, $latestmember );
}
else { return $membertotal; }
}
sub decode {
$action = reverse($action);
$action =~ s/(\S)\S\|\Sa(\S+)\_(\S)\\\S\\\S\'/$2$1$3/;
$pic = $action;
($name,$ext) = split(/\./, $pic);
if($pic =~ m^\A[a-zA-Z]+\Z^ || $ext eq "gif" || $ext eq "png" || $ext eq "jpg") { &fatal_error("
"); }
else { &fatal_error("What are you trying to do?"); }
}
sub CalcAge {
my($usermonth, $userday, $useryear, $act);
$act = $_[0];
if($memsettings[16] ne '') {
($usermonth, $userday, $useryear) = split(/\//, $memsettings[16]);
if($act eq "calc") {
if(length($memsettings[16]) <= 2) { $age = $memsettings[16]; }
else {
$age = $year - $useryear;
if($usermonth > $mon_num || ( $usermonth == $mon_num && $userday > $mday ) ) { --$age; }
}
}
if($act eq "parse") {
if(length($memsettings[16]) <= 2) { return; }
$umonth = $usermonth;
$uday = $userday;
$uyear = $useryear;
}
}
if($act eq "isbday") {
if($usermonth == $mon_num && $userday == $mday) { $isbday = "yes"; }
}
}
use Fcntl qw/:DEFAULT/;
unless( defined $LOCK_SH ) { $LOCK_SH = 1; }
{
my %yyOpenMode = (
'+>>' => 5,
'+>' => 4,
'+<' => 3,
'>>' => 2,
'>' => 1,
'<' => 0,
'' => 0
);
# fopen: opens a file. Allows for file locking and better error-handling.
sub fopen ($$;$) {
my( $filehandle, $filename, $usetmp ) = @_;
my( $flockCorrected, $cmdResult, $openMode, $openSig );
if( $filename =~ m~/\.\./~ ) { &fatal_error("$txt{'23'} $filename. $txt{'609'}"); }
# Check whether we want write, append, or read.
$filename =~ m~\A([<>+]*)(.+)~;
$openSig = $1 || '';
$filename = $2 || $filename;
$openMode = $yyOpenMode{$openSig} || 0;
$filename =~ tr~\\~/~; # Translate windows-style \ slashes to unix-style / slashes.
$filename =~ s~[^/0-9A-Za-z#%+\,\-\ \.@^_]~~g; # Remove all inappropriate characters.
# If the file doesn't exist, but a backup does, rename the backup to the filename
if(! -e $filename && -e "$filename.bak") { rename("$filename.bak","$filename"); }
if($use_flock == 2 && $openMode) {
my $count;
while( $count < 15 ) {
if( -e $filehandle ) { sleep 2; }
else { last; }
++$count;
}
unlink($filehandle) if ($count == 15);
local *LFH;
CORE::open(LFH, ">$filehandle");
$yyLckFile{$filehandle} = *LFH;
}
if($use_flock && $openMode == 1 && $usetmp && $usetempfile && -e $filename) {
$yyTmpFile{$filehandle} = $filename;
$filename .= '.tmp';
}
if($openMode > 2) {
if($openMode == 5) { $cmdResult = CORE::open($filehandle, "+>>$filename"); }
elsif( $use_flock == 1 ) {
if( $openMode == 4 ) {
if( -e $filename ) {
# We are opening for output and file locking is enabled...
# read-open() the file rather than write-open()ing it.
# This is to prevent open() from clobbering the file before
# checking if it is locked.
$flockCorrected = 1;
$cmdResult = CORE::open($filehandle, "+<$filename");
}
else { $cmdResult = CORE::open($filehandle, "+>$filename"); }
}
else { $cmdResult = CORE::open($filehandle, "+<$filename"); }
}
elsif( $openMode == 4 ) { $cmdResult = CORE::open($filehandle, "+>$filename"); }
else { $cmdResult = CORE::open($filehandle, "+<$filename"); }
}
elsif ($openMode == 1 && $use_flock == 1) {
if(-e $filename) {
# We are opening for output and file locking is enabled...
# read-open() the file rather than write-open()ing it.
# This is to prevent open() from clobbering the file before
# checking if it is locked.
$flockCorrected = 1;
$cmdResult = CORE::open($filehandle, "+<$filename");
}
else { $cmdResult = CORE::open($filehandle, ">$filename"); }
}
elsif ( $openMode == 1 ) {
$cmdResult = CORE::open($filehandle, ">$filename"); # Open the file for writing
}
elsif ( $openMode == 2 ) {
$cmdResult = CORE::open($filehandle, ">>$filename"); # Open the file for append
}
elsif ( $openMode == 0 ) {
$cmdResult = CORE::open($filehandle, $filename); # Open the file for input
}
unless ($cmdResult) { return 0; }
if ($flockCorrected) {
# The file was read-open()ed earlier, and we have now verified an exclusive lock.
# We shall now clobber it.
flock($filehandle, $LOCK_EX);
if( $faketruncation ) {
CORE::open(OFH, ">$filename");
unless ($cmdResult) { return 0; }
print OFH '';
CORE::close(OFH);
}
else { truncate(*$filehandle, 0) || &fatal_error("$txt{'631'}: $filename"); }
seek($filehandle, 0, 0);
}
elsif ($use_flock == 1) {
if( $openMode ) { flock($filehandle, $LOCK_EX); }
else { flock($filehandle, $LOCK_SH); }
}
return 1;
}
# fclose: closes a file, using Windows 95/98/ME-style file locking if necessary.
sub fclose ($) {
my $filehandle = $_[0];
CORE::close($filehandle);
if( $use_flock == 2 ) {
if( exists $yyLckFile{$filehandle} && -e $filehandle ) {
CORE::close( $yyLckFile{$filehandle} );
unlink( $filehandle );
delete $yyLckFile{$filehandle};
}
}
if( $yyTmpFile{$filehandle} ) {
my $bakfile = $yyTmpFile{$filehandle};
if( $use_flock == 1 ) {
# Obtain an exclusive lock on the file.
# ie: wait for other processes to finish...
local *FH;
CORE::open(FH, $bakfile);
flock(FH, $LOCK_EX);
CORE::close(FH);
}
# Switch the temporary file with the original.
unlink("$bakfile.bak") if( -e "$bakfile.bak" );
rename($bakfile,"$bakfile.bak");
rename("$bakfile.tmp",$bakfile);
delete $yyTmpFile{$filehandle};
if(-e $bakfile) {
unlink("$bakfile.bak"); # Delete the original file to save space.
}
}
return 1;
}
} #/ my %yyOpenMode
sub KickGuest {
$yymain .= qq~~;
require "$sourcedir/LogInOut.pl";
$sharedLogin_title="$txt{'633'}";
$sharedLogin_text=qq~
$txt{'634'}
$txt{'635'} $txt{'636'} $txt{'637'}
~;
&sharedLogin;
$yymain .= qq~
~;
$yytitle = "$txt{'34'}";
&template;
exit;
}
sub WriteLog {
my($curentry, $name);
my $field = $username;
if($field eq "Guest") { $field = "$user_ip"; }
fopen(LOG, "$vardir/log.txt");
my @online = ;
fclose(LOG);
fopen(LOG, ">$vardir/log.txt", 1);
print LOG "$field|$date\n";
foreach $curentry (@online) {
$curentry =~ s/\n//g;
($name, $date1) = split(/\|/, $curentry);
$date2 = $date;
chomp $date1;
chomp $date2;
&calctime;
if($name ne $field && $result <= 15 && $result >= 0) { print LOG "$curentry\n"; }
}
fclose(LOG);
fopen(LOG, "+<$vardir/clicklog.txt",1);
my @entries = ;
seek LOG, 0, 0;
truncate LOG, 0;
print LOG "$field|$date|$ENV{'REQUEST_URI'}|$ENV{'HTTP_REFERER'}|$ENV{'HTTP_USER_AGENT'}\n";
foreach $curentry (@entries) {
$curentry =~ s/\n//g;
chomp $curentry;
($name, $date1, $dummy) = split(/\|/, $curentry);
$date2 = $date;
chomp $date1;
chomp $date2;
&calctime;
if($result <= $ClickLogTime && $result >= 0) { print LOG "$curentry\n"; }
}
fclose(LOG);
}
sub Sticky {
if (!(exists $moderators{$username}) && $settings[7] ne 'Administrator' && $settings[7] ne 'Global Moderator') { &fatal_error("$txt{'67'}"); }
$thread = $INFO{'thread'}; if (!$thread) { &fatal_error($txt{'772'}); }
fopen(FILE, "$boardsdir/sticky.stk") || &fatal_error("300 $txt{'106'}: $txt{'23'} sticky.stk");
@stickys = ;
fclose(FILE);
$is_sticky = 0;
$stickynum = 0;
foreach $curstick (@stickys) {
chomp $curstick;
if ($curstick == $thread) { $is_sticky = 1; last; }
$stickynum++;
}
if ($is_sticky == 0) {
fopen(FILE, ">>$boardsdir/sticky.stk") || &fatal_error("300 $txt{'106'}: $txt{'23'} sticky.stk");
print FILE "$thread\n";
fclose(FILE);
} else {
splice(@stickys,$stickynum,1);
fopen(FILE, ">$boardsdir/sticky.stk") || &fatal_error("300 $txt{'106'}: $txt{'23'} sticky.stk");
foreach $curline (@stickys) { chomp $curline; print FILE "$curline\n"; }
fclose(FILE);
}
}
sub Sticky_remove {
my $stthread = $_[0];
$stickynum = 0;
fopen(FILE, "$boardsdir/sticky.stk") || &fatal_error("300 $txt{'106'}: $txt{'23'} sticky.stk");
@stickys = ;
fclose(FILE);
foreach $curstick (@stickys) {
chomp $curstick;
if ($curstick == $stthread) { last; }
$stickynum++;
}
splice(@stickys,$stickynum,1);
fopen(FILE, ">$boardsdir/sticky.stk") || &fatal_error("300 $txt{'106'}: $txt{'23'} sticky.stk");
foreach $curline (@stickys) { chomp $curline; print FILE "$curline\n"; }
fclose(FILE);
}
1;