# #
# File: user/fo_posting.pl #
# #
-# Authors: André Malo <nd@o3media.de>, 2001-03-31 #
+# Authors: André Malo <nd@o3media.de> #
# #
# Description: Accept new postings, display "Neue Nachricht" page #
# #
-# not ready, be patient please #
-# #
################################################################################
-#unknown_error
-#not_saved
-#no_option
-#occupied
-#master_lock
-#no_reply
-#dupe
-#missing_key
-#unexpected_key
-#unknown_encoding
-#unknown_followup
-#too_long
-#too_short
-#wrong_mail
-#wrong_http_url
-#wrong_url
-
use strict;
-use vars qw($Bin $Shared $Script);
+use vars qw(
+ $Bin
+ $Shared
+ $Script
+ $Config
+);
# locate the script
#
BEGIN {
- my $null = $0; $null =~ s/\\/\//g; # for win :-(
- ($Bin) = ($null =~ /^(.*)\/.*$/)? $1 : '.';
- $Shared = "$Bin/../shared";
- ($Script) = ($null =~ /^.*\/(.*)$/)? $1 : $null;
+# 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 : '.';
+ $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.
#
-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::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
bless $self, $class;
}
+sub severance {
+ my $self = shift;
+
+ start_severance ($self -> {conf} -> {original} -> {files} -> {sev_app});
+}
+
### sub response ###############################################################
#
# print the response to STDOUT
# response the 'new message' page
#
if ($self -> {response} -> {new_thread}) {
- my $list = [map {{$assign -> {optval} => plain($_)}} @{$formdata -> {posterCategory} -> {values}}];
+
+ # fill in the default form data
+ # and optionlist(s)
+ #
+ my $default = {};
+ for (keys %$formdata) {
+ unless (exists ($formdata -> {$_} -> {type}) and $formdata -> {$_} -> {type} eq 'internal') {
+ if (exists ($formdata -> {$_} -> {default}) and exists ($formdata -> {$_} -> {assign} -> {value})) {
+ $default -> {$formdata -> {$_} -> {assign} -> {value}}
+ = $formdata -> {$_} -> {default};
+ }
+ elsif (exists($formdata -> {$_} -> {values})) {
+ my ($_name, $val) = $_;
+ $val = exists ($formdata -> {$_} -> {default})
+ ? $formdata -> {$_} -> {default}
+ : undef;
+ $default -> {$formdata -> {$_} -> {assign} -> {value}}
+ = $self -> {template} -> list (
+ $assign -> {option},
+ [ map {
+ { $assign -> {optval} => plain($_),
+ ((defined $val and $_ eq $val)
+ ? ($assign -> {optsel} => 1)
+ : ()
+ )
+ }
+ } @{$formdata -> {$_name} -> {values}}
+ ]
+ );
+ }
+ }
+ }
print $q -> header (-type => 'text/html');
print ${$template -> scrap (
$assign -> {docNew},
{ $formdata->{uniqueID} ->{assign}->{value} => plain(unique_id),
- $formdata->{quoteChar} ->{assign}->{value} =>
- 'ÿ'.plain($self -> {conf} -> {admin} -> {View} -> {quoteChars}),
- $formdata->{posterCategory}->{assign}->{value} => $template->list ($assign -> {option}, $list),
- $formact->{post}->{assign} => $formact->{post}->{url}
+ $formdata->{quoteChar} ->{assign}->{value} => 'ÿ'.plain($self -> {conf} -> {admin} -> {View} -> {quoteChars}),
+ $formact->{post}->{assign} => $formact->{post}->{url},
},
- $pars
+ $pars,
+ $default
)};
return;
}
my $q = $self -> {cgi_object};
my $f = $self -> {forum};
my $pars = {
- author => $q -> param ($formdata -> {posterName} -> {name}),
- email => $q -> param ($formdata -> {posterEmail} -> {name}),
- category => $q -> param ($formdata -> {posterCategory} -> {name}),
- subject => $q -> param ($formdata -> {posterSubject} -> {name}),
- body => $q -> param ($formdata -> {posterBody} -> {name}),
- homepage => $q -> param ($formdata -> {posterURL} -> {name}),
- image => $q -> param ($formdata -> {posterImage} -> {name}),
quoteChars => $q -> param ($formdata -> {quoteChar} -> {name}),
uniqueID => $q -> param ($formdata -> {uniqueID} -> {name}),
time => $time,
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..
+ #
+ my %may = (
+ author => 'posterName',
+ email => 'posterEmail',
+ category => 'posterCategory',
+ subject => 'posterSubject',
+ body => 'posterBody',
+ homepage => 'posterURL',
+ image => 'posterImage'
+ );
+
+ for (keys %may) {
+ $pars -> {$_} = $q -> param ($formdata -> {$may{$_}} -> {name})
+ if (defined $q -> param ($formdata -> {$may{$_}} -> {name}));
+ }
+
+ 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, $tid) = write_reply_posting ($pars);
+ }
+ else {
+ ($stat, $xml, $mid, $tid) = write_new_thread ($pars);
}
-
- my ($stat, $xml, $mid) = write_posting ($pars);
if ($stat) {
$self -> {error} = {
};
}
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};
+ my $thx = $self -> {conf} -> {show_posting} -> {thanx};
# define special response data
#
$self -> {response} -> {doc} = $self -> {conf} -> {assign} -> {docThx};
$self -> {response} -> {pars} = {
- $thx -> {subject} => plain ($q -> param ($formdata -> {posterSubject} -> {name})),
- $thx -> {author} => plain ($q -> param ($formdata -> {posterName} -> {name})),
- $thx -> {email} => plain ($q -> param ($formdata -> {posterEmail} -> {name})),
- $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,
assign => $self -> {conf} -> {assign},
quoteChars => $q -> param ($formdata -> {quoteChar} -> {name}),
quoting => $self -> {conf} -> {admin} -> {View} -> {quoting}
- }),
- $thx -> {category} => plain ($q -> param ($formdata -> {posterCategory} -> {name})),
- $thx -> {home} => plain ($q -> param ($formdata -> {posterURL} -> {name})),
- $thx -> {image} => plain ($q -> param ($formdata -> {posterImage} -> {name}))
+ }) || ''
};
+
+ # set the variables if defined..
+ #
+ my %may = (
+ author => 'posterName',
+ email => 'posterEmail',
+ category => 'posterCategory',
+ subject => 'posterSubject',
+ homepage => 'posterURL',
+ image => 'posterImage'
+ );
+
+ for (keys %may) {
+ my $x = $q -> param ($formdata -> {$may{$_}} -> {name});
+ $x = '' unless (defined $x);
+ $self -> {response} -> {pars} -> {$thx -> {$_}} = plain ($x)
+ if (defined $thx -> {$_});
+ }
}
}
}
# 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});
}
sub jerk {
- my $text = $_[1] || 'An error has occurred.';
+ my $text = shift;
+ $text = 'An error has occurred.' unless defined $text;
+
print <<EOF;
-Content-type: text/plain\n\n
+Content-type: text/plain
+
+
Oops.
git.p6c8.net / selfforum.git / blobdiff