\$!: Permission Denied", 0, 1);
}
undef %files;
foreach $file (@files) {
$files{$file} = 1;
}
while (scalar(keys(%files))) {
$flag = 1; $ctr = time;
open (LOCKS, "$admin_dir/locks.txt");
@global = \$!: Permission Denied", 0, 1);
}
} else {
&error_message("File Locking Error", "The locks directory does not exist. Could not gain lock on file.", 0, 1);
}
O: foreach $file (@files) {
$done = 0;
if ($file eq "*") {
while ($done == 0) {
if (open (GLOBAL, "$admin_dir/locks/GLOBAL")) {
@global =
[$filenm]", 0, 1);
}
}
return 0 if ($subr_locker eq "src-board-subs-common");
}
@global = grep(/\S/, @global);
open (LOCKS, ">$admin_dir/locks.txt") || &error_message("File Locking Error", "Could not write locks.txt file!");
print LOCKS @global;
close (LOCKS);
return 1;
}
if (-e "$admin_dir/locks") {
if (!-w "$admin_dir/locks") {
$msg = "The locks directory is not writable by this UID.\n";
$msg .= "On unix, make sure the permissions on the "locks"\n";
$msg .= "directory are set to 0777 (rwxrwxrwx). On NT, have the system\n";
$msg .= "administrator make the "locks" directory writable by\n";
$msg .= "the WWW server. This is a permissions problem and is between\n";
$msg .= "you and your ISP to work out. DiscusWare, LLC cannot help you\n";
$msg .= "resolve this problem. Click here for assistance.\n";
&error_message("File Locking Error", $msg . "
[$filenm]", 0, 1);
}
if ($subr_locker eq "change_board_colors") {
return 0;
}
for ($delay_counter = 1; $delay_counter <= 250000; $delay_counter++) {
}
}
}
}
}
return 1;
}
sub unlock {
my (@files, @locks, %files, $line, $x, $y, $tcache);
@files = @_; $tcache = time;
if ($files[0] !~ m|/| && $files[0] ne "*") {
$subr_locker = shift(@files);
} else {
$subr_locker = "?";
}
if ($GLOBAL_OPTIONS{'lock_with_file'}) {
foreach $line (@files) {
$line = (split(/\t/, $line))[0];
if ($line =~ m|.*/(.*)|) {
$line = $1;
}
$files{$line} = 1;
}
open (LOCKS, "$admin_dir/locks.txt");
@locks =
\n";
print "\n";
print "$explanation \n";
if ($excl_pt && !$noerr) {
print "\$!: $excl_pt ";
}
if ($@) {
print "\$\@: $@ ";
}
print "
Please contact $contact if this problem persists.\n"; $URL_F = "javascript:history.back()"; if ($FORM{'HTTP_REFERER'} =~ m|/(\d+)/(\d+)\.$ext|) { $topic = $1; $page = $2; $URL_F = "$message_url/$topic/$page.$ext" if -e "$message_dir/$topic"; $URL_F = "$script_url/board-auth.$cgi_extension?file=/$topic/$page.$ext" if !-e "$message_dir/$topic"; } print "
$L{ILBACK}\n"; print "
Discus ";
print "Pro " if $pro;
print " $release_version";
print ".$free_revision" if !$pro;
print ".$pro_revision" if $pro;
print "
Copyright 2000, DiscusWare, LLC, all rights reserved\n";
if ($ENV{'SCRIPT_URI'} ne "") {
$ENV{'SCRIPT_URI'} =~ m|(.*)/|; $suri = $';
if ($suri eq "") {
$suri = $ENV{'SCRIPT_URI'};
}
print "
$suri\n";
}
print "
Perl $]";
print "
[$FUNCTION_NAME_EXECUTING]" if $FUNCTION_NAME_EXECUTING;
print "$ERROR_STRINGS
" if $ERROR_STRINGS;
print "
\n"; if (!$nobug) { print "
\n"; } print "\n";
print "\n";
exit(0);
}
sub extract {
my ($strin, $error_trapping, $subr_caller) = @_;
my ($line, $filename, @file, $key);
undef %level_number;
$secure = 0;
$strin .= ".$ext" if $strin !~ m|\.$ext$|;
$strin = "/$strin" if $strin !~ m|^/|;
if ($strin =~ m|.*/(\d+)/(\d+)\.$ext|) {
$f1 = $1; $f2 = $2;
} else {
&log_error("src-board-subs-common", "extract", "Input file $strin is not valid (called from '$subr_caller')");
&error_message('Undefined Error',"Undefined Error extracting file! Input file $strin is not a valid file!!!", 0, 1);
}
$filename = "$message_dir/$f1/$f2.$ext"; $filename2 = "";
if (!-e "$message_dir/$f1") {
$filename2 = "$secdir/$f1/$f2.$ext";
$secure = 1;
}
$filename = $filename2 if $filename2 ne "";
if (!-e $filename) {
if (-e "$filename.NEW") {
&lock("extract", $filename);
if (!-e $filename && -e "$filename.NEW") {
if ($platform eq "NT" || $NT || $platform =~ m|NT|i) {
$code = 0;
} else {
$code = rename("$filename.NEW", "$filename");
}
if ($code != 1 || !-e $filename) {
open (FILE, "$filename.NEW");
@file =
/\n/g;
foreach $tag (reverse(@CHARCONVERT)) {
$tag =~ m|(\S+)\t(.*)|; $line = $1; $conv = quotemeta($2);
$stringin =~ s/$conv/$line/g;
}
$stringin =~ s/\r\n/\n/g;
$stringin =~ s/\r/\n/g;
}
$stringin = &JavaScript_prepare($stringin, $extra_param) if $JSP;
return $stringin;
}
sub JavaScript_prepare {
my ($str, $param) = @_;
$str =~ s//\[$1\]/g;
$str =~ s/<([^>]*)>//g if $param ne "nostrip";
$str =~ s/\n//g;
if ($param == 1) {
$str =~ s/([^\w&#; ])/&makeord($1)/ge;
} else {
$str =~ s/&#(\d+);//g;
$str =~ s/'//g;
$str =~ s/"//g;
$str =~ s/"//g;
$str =~ s/&//g;
}
return $str;
}
sub makeord {
my ($o, $num) = @_;
if (ord($o) <= 126 || ord($o) == 255) {
$num = ord($o);
return "&#$num;";
} else {
return $o;
}
}
sub remove_links {
my ($string) = @_;
my ($str);
$str = $string;
$str =~ s/
/\[$1\]/g;
$str =~ s/<[^>]*>//g;
$str =~ s/&#(\d+);//g if $flag == 0;
return $str;
}
sub seturl {
my ($targeturl) = @_;
if (!($nph_server)) {
print "Location: $targeturl\n\n";
exit(0);
} else {
&header;
print "