package HTML::WebMake::CGI::CGIBase;
use CGI qw/:standard/;
use strict;
use HTML::Entities;
use HTML::WebMake::Main;
use HTML::WebMake::Util;
use HTML::WebMake::CGI::RWMetaTable;
use File::Basename;
use vars qw{
@ISA $BASIC_TMPL_TOP $BASIC_TMPL_REST
};
@ISA = qw();
###########################################################################
$BASIC_TMPL_TOP = q{
WebMake: __PAGE_TITLE__
WebMake: __PAGE_HEADER__
__BREADCRUMBS__
};
$BASIC_TMPL_REST = q{
__ERRORS__
__MODULE_OUTPUT__
};
###########################################################################
sub new {
my $class = shift;
$class = ref($class) || $class;
my $self = {
'q', shift,
'file_base', undef,
'template', $BASIC_TMPL_TOP.$BASIC_TMPL_REST,
'info_msgs', '',
'msgs', ''
};
$self->{metatable} = new HTML::WebMake::CGI::RWMetaTable ();
$self->{cvs_supported} = 0;
if (defined $ENV{'CVSROOT'}) {
$self->{cvs_supported} = 1;
}
$self->{cvs} = new HTML::WebMake::CGI::CVS ($self);
bless ($self, $class);
$self;
}
sub set_file_base {
my ($self, $base) = @_;
$self->{file_base} = $base;
if (!-d $base) {
die ("WebMakeCGI: FILE_BASE setting is invalid: ".
"\"$base\" is not a directory.\n");
}
# if we have a CVS dir in the file_base, the user has set this
# area up with a "cvs login" and "cvs checkout". Good call.
if (-f $base."/CVS/Root") {
$self->{cvs_supported} = 1;
}
}
###########################################################################
sub txt2html {
my $self = shift;
my $txt = join ('',@_);
$txt =~ s/&/&/gs;
$txt =~ s//>/gs;
$txt =~ s/\n/
\n/gs;
$txt;
}
sub warn {
my ($self, $err) = @_;
chomp $err; warn "WebMakeCGI: $err\n";
$self->{msgs} .= "Warning: $err
\n";
}
sub info {
my ($self, $err) = @_;
$self->{info_msgs} .= "Note: $err
\n";
}
sub is_media {
my ($self, $filename) = @_;
return 0 if (!defined $filename);
if ($filename =~ /\.(?:gif|jp[eg]+|png|mov|avi|qt|mp[eg]+|ra|ram|gz|Z|zip)$/i
|| $filename =~ /\.(?:class|jar|cab|db|hist|sys|exe|com|mp3|prc|pdb|dat)$/i)
{
return 1;
} else {
return 0;
}
}
# ---------------------------------------------------------------------------
sub run {
my ($self) = @_;
my $q = $self->{q};
$|++;
if (!$q->param ('dump')) {
print "Content-Type: text/html\r\n\r\n";
}
$self->{msgs} = '';
$self->{info_msgs} = '';
my $form = '';
$self->{filename} = '';
if (!is_authorised ($q)) {
$self->warn ("This site can only be edited by authenticated users.");
goto end;
}
$self->{wmkfile} = &mksafepath($q->param('wmkf'));
# this may be overridden in Site.pm, the module for editing .wmk files
# check to see if CVS is available in this subdir
my $base = File::Basename::dirname ($self->{wmkfile});
if (-d $self->{file_base}."/".$base."/CVS") {
$self->{cvs_supported} = 1;
}
$self->{cvsadd} = &mksafepathlist($q->param('cvsadd'));
$self->{cvsaddbin} = &mksafepathlist($q->param('cvsaddbin'));
$self->{cvsrm} = &mksafepathlist($q->param('cvsrm'));
$self->{cvsrmdir} = &mksafepathlist($q->param('cvsrmdir'));
# if we have a dirprefix parameter, add it to the filename.
if ($q->param('dirprefix')) {
$self->{filename} =
$self->makepath ($q->param('dirprefix'), $q->param('f'));
$q->param('dirprefix', '');
$q->param('f', $self->{filename});
} else {
$self->{filename} = &mksafepath($q->param('f'));
}
if (!defined $self->{wmkfile} && !$self->{no_wmkf_needed}) {
$self->warn ("No .wmk file specified! Please use the 'wmkf' parameter.");
goto end;
}
if (!$self->{no_filename_needed}
&& (!defined $self->{filename} || $self->{filename} eq ''))
{
$self->warn ("No filename provided.\n");
} else {
$form = $self->subrun ($q);
}
end:
if (!$q->param ('dump')) {
$self->write_html_main ($form);
}
}
# ---------------------------------------------------------------------------
sub std_cgi_hidden_items {
my ($self, $q) = @_;
$self->{cvsadd} ||= ''; $self->{cvsaddbin} ||= '';
$self->{cvsrm} ||= ''; $self->{cvsrmdir} ||= '';
$self->{wmkfile} ||= '';
return $q->hidden(-name=>'wmkf',-value=>$self->{wmkfile})
. $q->hidden(-name=>'cvsadd',-value=>$self->{cvsadd})
. $q->hidden(-name=>'cvsaddbin',-value=>$self->{cvsaddbin})
. $q->hidden(-name=>'cvsrm',-value=>$self->{cvsrm})
. $q->hidden(-name=>'cvsrmdir',-value=>$self->{cvsrmdir});
}
# ---------------------------------------------------------------------------
sub std_cgi_hidden_items_as_str {
my ($self, $q) = @_;
$self->{cvsadd} ||= ''; $self->{cvsaddbin} ||= '';
$self->{cvsrm} ||= ''; $self->{cvsrmdir} ||= '';
$self->{wmkfile} ||= '';
return 'wmkf='.$q->escape ($self->{wmkfile}) . '&'
. 'cvsadd='.$q->escape ($self->{cvsadd}) . '&'
. 'cvsaddbin='.$q->escape ($self->{cvsaddbin}) . '&'
. 'cvsrm='.$q->escape ($self->{cvsrm}) . '&'
. 'cvsrmdir='.$q->escape ($self->{cvsrmdir});
}
# ---------------------------------------------------------------------------
sub write_html_main {
my ($self, $form) = @_;
my $q = $self->{q};
my $txt = $self->{template};
my $user = $q->remote_user(); $user ||= '(nobody)';
my $wmkf = $self->{wmkfile}; $wmkf ||= '(none)';
my $bread = $self->get_breadcrumbs();
if (!$self->{cvs_supported}) { $txt =~ s/.*<\/CVSONLY>//gs; }
$txt =~ s/__PAGE_TITLE__/$self->{page_title}/ge;
$txt =~ s/__PAGE_HEADER__/$self->{page_header}/ge;
$txt =~ s/__BREADCRUMBS__/$bread/gs;
$txt =~ s/__ERRORS__/$self->{msgs} $self->{info_msgs}/gs;
$txt =~ s/__MODULE_OUTPUT__/${form}/gs;
$txt =~ s/__FNAME__/$self->{filename}/gs;
$txt =~ s/__USERNAME__/${user}/gs;
$txt =~ s/__WMKF__/${wmkf}/gs;
$txt =~ s/__WMVER__/${HTML::WebMake::Main::VERSION}/gs;
$txt =~ s{__REINVOKE__(\S+?)__}{ $self->reinvoke_with_param(0,$1); }ge;
$txt =~ s{__REINVOKEALL__(\S+?)__}{ $self->reinvoke_with_param(1,$1); }ge;
print $txt;
}
# ---------------------------------------------------------------------------
sub reinvoke_with_param {
my ($self, $keepexisting, $params) = @_;
my $q = $self->{q};
my $href = $q->url (-relative=>1, -path=>1) . '?' . $params;
my $str;
if ($keepexisting)
{
# keep all CGI parameters (except the ones overridden by new settings)
$str = $q->query_string ();
} else {
# just keep the essentials. namely: the name of the .wmk file,
# and cvs operations pending
$str = $self->std_cgi_hidden_items_as_str ($q);
}
my %pkeys = ();
foreach my $pkey (split (/[\&\;]/, $params)) {
$pkey =~ s/=.*$//; $pkeys{$pkey} = 1;
}
foreach my $elem (split (/\&/, $str)) {
if ($elem =~ /^(.*?)=/) {
if (defined $pkeys{$1}) { next; }
}
$href .= '&'.$elem;
}
$href;
}
# ---------------------------------------------------------------------------
sub mydirname {
my ($self) = @_;
return File::Basename::dirname ($self->{filename});
}
sub mydirurl {
my ($self) = @_;
return $self->{q}->escape ($self->mydirname());
}
# ---------------------------------------------------------------------------
sub makepath {
my ($self, $dir, $path) = @_;
if (!defined($dir) || $dir eq '' || $dir eq '.') {
# ignore it
} else {
$path = $dir.'/'.$path;
}
return mksafepath ($path);
}
###########################################################################
sub cvs_add {
my ($self, $fname) = @_;
return if (!$self->{cvs_supported});
if ($self->is_media ($fname)) {
if ($self->{cvsaddbin}) {
$self->{cvsaddbin} .= "|".$fname;
} else {
$self->{cvsaddbin} = $fname;
}
} else {
if ($self->{cvsadd}) {
$self->{cvsadd} .= "|".$fname;
} else {
$self->{cvsadd} = $fname;
}
}
}
sub cvs_delete {
my ($self, $fname) = @_;
return if (!$self->{cvs_supported});
if (-d $self->{file_base}.$fname) {
if ($self->{cvsrmdir}) {
$self->{cvsrmdir} .= "|".$fname;
} else {
$self->{cvsrmdir} = $fname;
}
} else {
if ($self->{cvsrm}) {
$self->{cvsrm} .= "|".$fname;
} else {
$self->{cvsrm} = $fname;
}
}
}
###########################################################################
sub read_wmk_file
{
my ($self, $file) = @_;
my $dir = $self->mydirname();
$self->{webmake} = new HTML::WebMake::Main ( {
'base_dir' => $self->{file_base}.'/'.$dir
} );
my $cgi = $self->{webmake}->cgi_parse_file
($self->{file_base}.'/'.$file);
if (!defined $cgi) {
$self->warn ("Failed to parse WebMake file \"$file\"");
return 0;
}
$self->{fulltext} = $cgi->{fulltext};
$self->{items} = $cgi->{items};
1;
}
###########################################################################
sub get_breadcrumbs {
my ($self) = @_;
my $q = $self->{q};
# [edit] Top > main.wmk > contents: data/ > cv.txt [view]
$self->{cvsadd} ||= ''; $self->{cvsaddbin} ||= '';
$self->{cvsrm} ||= ''; $self->{cvsrmdir} ||= '';
my $href = $q->url (-relative=>1, -path=>1).'?'
. 'cvsadd='.$q->escape ($self->{cvsadd}) . '&'
. 'cvsaddbin='.$q->escape ($self->{cvsaddbin}) . '&'
. 'cvsrm='.$q->escape ($self->{cvsrm}) . '&'
. 'cvsrmdir='.$q->escape ($self->{cvsrmdir});
my $txt = qq{
Top
}; #"
if (defined $self->{wmkfile}) {
$txt .= qq{
»
$self->{wmkfile}
}; #"
}
if (defined $self->{task_breadcrumb}) {
$txt .= qq{
»
$self->{task_breadcrumb}
}; #"
}
$txt .= qq{
}; #"
return $txt;
}
###########################################################################
sub mksafe {
local($_) = shift;
if (!defined $_) { return undef; }
s/\0/_/gs; # strip NULs
s/[^-=_+\[\]\@\#,.\/:\~%^\(\)\{\}A-Za-z0-9 ]/_/gs;
$_;
}
sub mksafepath {
local($_) = shift;
if (!defined $_) { return undef; }
$_ = mksafe($_);
s/[^-_+\@,.\/\#\=:%A-Za-z0-9 ]/_/gs;
s,^\/+,,gs; # //foo -> foo
s,\/\/+,/,gs; # foo//bar -> foo/bar
1 while s,^\.\/+,,gs; # strip ./././foo
s,[^/]+/+\.\./+,,gs; # strip ..s
s,\.\./+,,gs; # strip any leftover ..s
s,^\.\.$,.,gs; # ".." = "."
$_;
}
sub mksafepathlist {
local($_) = shift;
if (!defined $_) { return undef; }
my @new = ();
foreach my $item (split (/\|/, $_)) {
next if ($item eq '');
push (@new, mksafepath ($item));
}
return join ('|', @new);
}
sub is_authorised {
my ($q) = @_;
my $auth = $q->auth_type();
my $user = $q->remote_user();
if (defined $auth && defined $user) { return 1; }
CORE::warn "unauthorised access from ".$q->remote_host()."\n";
return 0;
}
###########################################################################
sub subst_template {
my ($self, $tmpl, $vars) = @_;
foreach my $key (keys %{$vars}) {
$tmpl =~ s/\{${key}\}/$vars->{$key}/gs;
$tmpl =~ s/__${key}__/$vars->{$key}/gs;
}
return $tmpl;
}
###########################################################################
1;