################################################################################
use strict;
-use vars qw($Bin $Shared $Script);
+use vars qw(
+ $Bin
+ $Shared
+ $Script
+ $Config
+ $VERSION
+);
# locate the script
#
BEGIN {
my $null = $0; $null =~ s/\\/\//g; # for win :-(
- ($Bin) = ($null =~ /^(.*)\/.*$/)? $1 : '.';
- $Shared = "$Bin/../shared";
- ($Script) = ($null =~ /^.*\/(.*)$/)? $1 : $null;
+ $Bin = ($null =~ /^(.*)\/.*$/)? $1 : '.';
+ $Shared = "$Bin/../shared";
+ $Config = "$Bin/config";
+ $Script = ($null =~ /^.*\/(.*)$/)? $1 : $null;
+
+# my $null = $0;
+# $Bin = ($null =~ /^(.*)\/.*$/)? $1 : '.';
+# $Config = "$Bin/../../daten/forum/config";
+# $Shared = "$Bin/../../cgi-shared";
+# $Script = ($null =~ /^.*\/(.*)$/)? $1 : $null;
}
+# setting umask, remove or comment it, if you don't need
+#
+umask 006;
+
use lib "$Shared";
use CGI::Carp qw(fatalsToBrowser);
use Conf;
use Conf::Admin;
+use Posting::Cache;
+
+# Version check
+#
+$VERSION = do { my @r =(q$Revision$ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
# load script configuration and admin default conf.
#
-my $conf = read_script_conf ($Bin, $Shared, $Script);
+my $conf = read_script_conf ($Config, $Shared, $Script);
my $adminDefault = read_admin_conf ($conf -> {files} -> {adminDefault});
# Initialize the request
#
$request -> response;
+# shorten the main file?
+#
+$request -> severance;
+
#
#
### main end ###################################################################
### Posting::Request ###########################################################
package Posting::Request;
+use Arc::Archive;
use CheckRFC;
use Encode::Plain; $Encode::Plain::utf8 = 1; # generally convert from UTF-8
use Encode::Posting;
-use Lock qw(:ALL);
+use Lock;
use Posting::_lib qw(
hr_time
parse_xml_file
bless $self, $class;
}
+sub severance {
+ my $self = shift;
+
+ my $stat = cut_tail ({
+ forumFile => $self -> {conf} -> {forum_file_name},
+ messagePath => $self -> {conf} -> {message_path},
+ archivePath => $self -> {conf} -> {original} -> {files} -> {archivePath},
+ lockFile => $self -> {conf} -> {original} -> {files} -> {sev_lock},
+ adminDefault => $self -> {conf} -> {admin},
+ cachePath => $self -> {conf} -> {original} -> {files} -> {cachePath}
+ });
+# die $stat->{(keys %$stat)[0]} if (%$stat);
+
+}
+
### sub response ###############################################################
#
# print the response to STDOUT
lastMessage => $f -> {last_message},
parsedThreads => $f -> {threads},
dtd => $f -> {dtd},
- messages => $self -> {template} -> {messages} || {},
+ messages => $self -> {conf} -> {template} -> {messages} || {},
+ base_uri => $self -> {conf} -> {original} -> {files} -> {forum_base}
};
# set the variables if defined..
if (defined $q -> param ($formdata -> {$may{$_}} -> {name}));
}
- my ($stat, $xml, $mid);
+ my ($stat, $xml, $mid, $tid);
# we've got a fup if it's a reply
#
if ($self -> {response} -> {reply}) {
$pars -> {parentMessage} = $self -> {fup_mid};
$pars -> {thread} = $self -> {fup_tid};
- ($stat, $xml, $mid) = write_reply_posting ($pars);
+ ($stat, $xml, $mid, $tid) = write_reply_posting ($pars);
}
else {
- ($stat, $xml, $mid) = write_new_thread ($pars);
+ ($stat, $xml, $mid, $tid) = write_new_thread ($pars);
}
if ($stat) {
};
}
else {
+ my $cache = new Posting::Cache ($self->{conf}->{original}->{files}->{cachePath});
+ $cache -> add_posting (
+ { thread => ($tid =~ /(\d+)/)[0],
+ posting => ($mid =~ /(\d+)/)[0]
+ }
+ );
+
$self -> {check_success} = 1;
my $thx = $self -> {conf} -> {show_posting} -> {thanx};
#
$self -> {response} -> {doc} = $self -> {conf} -> {assign} -> {docThx};
$self -> {response} -> {pars} = {
- $thx -> {time} => plain (hr_time($time)),
- $thx -> {body} => message_as_HTML (
+ $thx -> {time} => plain (hr_time($time)),
+ $thx -> {body} => message_as_HTML (
$xml,
$self -> {template},
{ posting => $mid,
# unlock forum main file
#
if ($self -> {forum} -> {flocked}) {
- violent_unlock_file($self -> {conf} -> {forum_file_name}) unless write_unlock_file ($self -> {conf} -> {forum_file_name});
+ $self -> {forum} -> {flocked} -> unlock;
$self -> {forum} -> {flocked} = 0;
}
#
sub load_main_file {
my $self = shift;
- my $lock_stat;
+ my $forum = new Lock ($self -> {conf} -> {forum_file_name});
- unless ($lock_stat = write_lock_file ($self -> {conf} -> {forum_file_name})) {
- if (defined $lock_stat and $lock_stat == 0) {
+ unless ($forum -> lock(LH_EXCL)) {
+ unless ($forum -> masterlocked) {
# occupied or no w-bit set for the directory..., hmmm
#
- violent_unlock_file ($self -> {conf} -> {forum_file_name});
$self -> {error} = {
spec => 'occupied',
type => 'repeat'
}
}
else {
- $self -> {forum} -> {flocked} = 1;
+ $self -> {forum} -> {flocked} = $forum;
( $self -> {forum} -> {threads},
$self -> {forum} -> {last_thread},
$self -> {forum} -> {last_message},
#
my ($ftid, $fmid) = split /;/ => $q -> param ($formdata -> {followUp} -> {name}) => 2;
- unless ($ftid =~ /\d+/ and $fmid =~ /\d+/) {
+ unless ($ftid =~ /^\d+$/ and $fmid =~ /^\d+$/) {
$self -> {error} = {
spec => 'unknown_followup',
type => 'fatal'
#
(my $val_ww = $val) =~ s/\s+//g;
+ if (exists ($formdata -> {$name {$_}} -> {type}) and $formdata -> {$name {$_}} -> {type} eq 'name') {
+ $val_ww =~ y/a-zA-Z//cd;
+
+ my @badlist;
+# my @badlist = map {qr/\Q$_/i} qw (
+# # insert badmatchlist here
+# );
+
+# push @badlist => map {qr/\b\Q$_\E\b/i} qw(
+# # insert badwordlist here
+# );
+
+ for (@badlist) {
+ if ($val_ww =~ /$_/) {
+ $self -> {error} = {
+ spec => 'undesired',
+ desc => $name{$_},
+ type => 'fatal'
+ };
+ return;
+ }
+ }
+ }
+
if (length $val_ww < $formdata -> {$name {$_}} -> {minlength}) {
$self -> {error} = {
spec => 'too_short',
};
$self -> kill_param or return;
}
+
+ elsif ($formdata -> {$name {$_}} -> {type} eq 'unique-id' and not may_id $val) {
+ $self -> {error} = {
+ spec => 'wrong_unique_id',
+ desc => $name{$_},
+ type => $formdata -> {$name {$_}} -> {errorType}
+ };
+ print STDERR "Manipuliert!";
+ $self -> kill_param or return;
+ }
}
if (exists ($formdata -> {$name {$_}} -> {values})
my $formdata = $self -> {conf} -> {form_data};
if (@{$self -> {fetch}}) {
- my $filename = $self -> {conf} -> {message_path}.'t'.$self -> {fup_tid}.'.xml';
+ my $thread = new Lock ($self -> {conf} -> {message_path}.'t'.$self -> {fup_tid}.'.xml');
- if (lock_file ($filename)) {
- my $xml = parse_xml_file ($filename);
- violent_unlock_file($filename) unless unlock_file ($filename);
+ if ($thread -> lock (LH_SHARED)) {
+ my $xml = parse_xml_file ($thread -> filename);
+ $thread -> unlock;
if ($xml) {
my $mnode = get_message_node ($xml, 't'.$self -> {fup_tid}, 'm'.$self -> {fup_mid});