X-Git-Url: https://git.p6c8.net/selfforum.git/blobdiff_plain/2a78476e5bf2aee7120b59f5ee5e30ad5609fe55..ddcd73d3997cd6d2f56815c4ea539a4bed7d20c4:/selfforum-cgi/user/fo_posting.pl?ds=sidebyside diff --git a/selfforum-cgi/user/fo_posting.pl b/selfforum-cgi/user/fo_posting.pl index 0bb18de..658f445 100644 --- a/selfforum-cgi/user/fo_posting.pl +++ b/selfforum-cgi/user/fo_posting.pl @@ -4,29 +4,56 @@ # # # File: user/fo_posting.pl # # # -# Authors: André Malo , 2001-04-08 # +# Authors: André Malo # # # # Description: Accept new postings, display "Neue Nachricht" page # # # ################################################################################ use strict; -use vars qw($Bin $Shared $Script $Config); +use vars qw( + $Bin + $Shared + $Script + $Config +); # locate the script # BEGIN { - my $null = $0; $null =~ s/\\/\//g; # for win :-( +# my $null = $0; $null =~ s/\\/\//g; # for win :-( +# $Bin = ($null =~ /^(.*)\/.*$/)? $1 : '.'; +# $Shared = "$Bin/../shared"; +# $Config = "$Bin/config"; +# $Script = ($null =~ /^.*\/(.*)$/)? $1 : $null; + + my $null = $0; $Bin = ($null =~ /^(.*)\/.*$/)? $1 : '.'; - $Shared = "$Bin/../shared"; - $Config = "$Bin/config"; + $Config = "$Bin/../../cgi-config/forum"; + $Shared = "$Bin/../../cgi-shared"; $Script = ($null =~ /^.*\/(.*)$/)? $1 : $null; } + +# setting umask, remove or comment it, if you don't need +# +umask 000; + use lib "$Shared"; use CGI::Carp qw(fatalsToBrowser); use Conf; use Conf::Admin; +use Posting::Cache; + +################################################################################ +# +# Version check +# +# last modified: +# $Date$ (GMT) +# by $Author$ +# +sub VERSION {(q$Revision$ =~ /([\d.]+)\s*$/)[0] or '0.0'} # load script configuration and admin default conf. # @@ -49,6 +76,10 @@ $request -> handle_error or $request -> save; # $request -> response; +# shorten the main file? +# +$request -> severance; + # # ### main end ################################################################### @@ -57,10 +88,11 @@ $request -> response; ### Posting::Request ########################################################### package Posting::Request; +use Arc::Starter; use CheckRFC; -use Encode::Plain; $Encode::Plain::utf8 = 1; # generally convert from UTF-8 +use Encode::Plain; $Encode::Plain::utf8 = 1; use Encode::Posting; -use Lock qw(:ALL); +use Lock; use Posting::_lib qw( hr_time parse_xml_file @@ -111,6 +143,12 @@ sub new { bless $self, $class; } +sub severance { + my $self = shift; + + start_severance ($self -> {conf} -> {original} -> {files} -> {sev_app}); +} + ### sub response ############################################################### # # print the response to STDOUT @@ -396,17 +434,17 @@ sub save { 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) { @@ -417,6 +455,13 @@ sub save { }; } 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}; @@ -460,7 +505,7 @@ sub save { # 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; } @@ -498,13 +543,12 @@ sub parse_cgi { # 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) { + 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' @@ -522,7 +566,7 @@ sub load_main_file { } } else { - $self -> {forum} -> {flocked} = 1; + $self -> {forum} -> {flocked} = $forum; ( $self -> {forum} -> {threads}, $self -> {forum} -> {last_thread}, $self -> {forum} -> {last_message}, @@ -743,7 +787,7 @@ sub check_cgi { # 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' @@ -797,6 +841,30 @@ sub check_cgi { # (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', @@ -837,6 +905,16 @@ sub check_cgi { }; $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}) @@ -882,11 +960,11 @@ sub fetch { 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}); @@ -947,7 +1025,9 @@ sub decode_param { } sub jerk { - my $text = $_[1] || 'An error has occurred.'; + my $text = shift; + $text = 'An error has occurred.' unless defined $text; + print <