site/cgi-bin/admin/datadump.pl
site/cgi-bin/admin/generate.pl
site/cgi-bin/admin/imageclean.pl
+site/cgi-bin/admin/logon.pl
site/cgi-bin/admin/makeIndex.pl
+site/cgi-bin/admin/menu.pl
site/cgi-bin/admin/move.pl
site/cgi-bin/admin/reorder.pl
site/cgi-bin/admin/shopadmin.pl
site/cgi-bin/modules/ArticleFiles.pm
site/cgi-bin/modules/Articles.pm
site/cgi-bin/modules/BSE/Admin/StepParents.pm
+site/cgi-bin/modules/BSE/AdminLogon.pm
+site/cgi-bin/modules/BSE/AdminMenu.pm
site/cgi-bin/modules/BSE/AdminUsers.pm
site/cgi-bin/modules/BSE/Cfg.pm
site/cgi-bin/modules/BSE/Custom.pm
site/templates/admin/edit_steps.tmpl
site/templates/admin/filelist.tmpl
site/templates/admin/grouplist.tmpl
+site/templates/admin/logon.tmpl
+site/templates/admin/menu.tmpl
+site/templates/admin/menu_adv.tmpl
site/templates/admin/interestemail.tmpl
site/templates/admin/order_detail.tmpl
site/templates/admin/order_list.tmpl
-VERSION=0.12_09
+VERSION=0.12_10
DISTNAME=bse-$(VERSION)
DISTBUILD=$(DISTNAME)
DISTTAR=../$(DISTNAME).tar
$con =~ s/(^\$BASEDIR = ')[^']+/$1 . BSE::Test::base_dir/me;
#$con =~ s/(^\$URLBASE = ["'])[^'"]+/$1 . BSE::Test::base_url/me;
#$con =~ s/(^\$SECURLBASE = ["'])[^'"]+/$1 . BSE::Test::test_securl/me;
-$con =~ s/(^\$SESSION_CLASS = ["'])[^'"]+/$1 . BSE::Test::test_sessionclass()/me;
+$con =~ s/(^\$SESSION_CLASS = [\"\'])[^\'\"]+/$1 . BSE::Test::test_sessionclass()/me;
open CON, "> $instbase/cgi-bin/modules/Constants.pm"
or die "Cannot open Constants.pm for write: $!";
print CON $con;
close CON;
+# rebuild the config file
+# first load values from the test.cfg file
+my $conffile = BSE::Test::test_conffile();
+my %conf;
+$conf{site}{name} = "Test Server";
+$conf{site}{url} = BSE::Test::base_url();
+$conf{site}{secureurl} = BSE::Test::base_securl();
+my $uploads = "$instbase/uploads";
+$conf{paths}{downloads} = $uploads;
+open TESTCONF, "< $conffile"
+ or die "Could not open config file $conffile: $!";
+while (<TESTCONF>) {
+ chomp;
+ /^\s*(\w+)\.(\w+)\s*=\s*(.*\S)\s*$/ or next;
+ $conf{lc $1}{lc $2} = $3;
+}
+
+$uploads = $conf{paths}{downloads};
# fix bse.cfg
open CFG, "< $instbase/cgi-bin/bse.cfg"
or die "Cannot open $instbase/cgi-bin/bse.cfg: $!";
-my $cfg = do { local $/; <CFG> };
+my $section = "";
+my @cfg;
+while (<CFG>) {
+ chomp;
+ if (/^\[(.*)\]\s*$/) {
+ my $newsect = lc $1;
+ if ($conf{$section} && keys %{$conf{$section}}) {
+ for my $key (sort keys %{$conf{$section}}) {
+ push @cfg, "$key=$conf{$section}{$key}";
+ }
+ delete $conf{$section};
+ }
+ $section = $newsect;
+ }
+ elsif (/^\s*(\w+)\s*=\s*.*$/ && exists $conf{$section}{lc $1}) {
+ my $key = lc $1;
+ print "found $section.$key\n";
+ $_ = "$key=$conf{$section}{$key}";
+ delete $conf{$section}{$key};
+ }
+ push @cfg, $_;
+}
+if ($conf{$section} && keys %{$conf{$section}}) {
+ for my $key (sort keys %{$conf{$section}}) {
+ push @cfg, "$key=$conf{$section}{$key}";
+ }
+ delete $conf{$section};
+}
+for my $sect (keys %conf) {
+ if ($conf{$sect} && keys %{$conf{$sect}}) {
+ push @cfg, "[$sect]";
+ for my $key (sort keys %{$conf{$sect}}) {
+ push @cfg, "$key=$conf{$section}{$key}";
+ }
+ push @cfg, "";
+ }
+}
close CFG;
-$cfg =~ s/^name\s*=.*/name=Test Server/m;
-$cfg =~ s/^url\s*=.*/"url=" . BSE::Test::base_url()/me;
-$cfg =~ s/^secureurl\s*=.*/"secureurl=" . BSE::Test::base_securl()/me;
-my $uploads = "$instbase/uploads";
-$cfg =~ s!^downloads\s*=.*!downloads=$uploads!m;
--d $uploads
- or mkdir $uploads, 0777
- or die "Cannot find or create upload directory: $!";
+
open CFG, "> $instbase/cgi-bin/bse.cfg"
or die "Cannot create $instbase/cgi-bin/bse.cfg: $!";
-print CFG $cfg;
+for my $line (@cfg) {
+ print CFG $line, "\n";
+}
close CFG;
+-d $uploads
+ or mkdir $uploads, 0777
+ or die "Cannot find or create upload directory: $!";
+
+
# build the database
unless ($leavedb) {
my $dsn = BSE::Test::test_dsn();
--- /dev/null
+#!/usr/bin/perl -w
+# -d:ptkdb
+BEGIN { $ENV{DISPLAY} = '192.168.32.15:0.0' }
+use strict;
+use FindBin;
+use lib "$FindBin::Bin/../modules";
+use BSE::DB;
+use BSE::Request;
+use BSE::Template;
+use Carp 'confess';
+use BSE::AdminLogon;
+
+$SIG{__DIE__} = sub { confess $@ };
+
+my $req = BSE::Request->new;
+
+my $result = BSE::AdminLogon->dispatch($req);
+$| = 1;
+push @{$result->{headers}}, "Content-Type: $result->{type}";
+push @{$result->{headers}}, $req->extra_headers;
+if (exists $ENV{GATEWAY_INTERFACE}
+ && $ENV{GATEWAY_INTERFACE} =~ /^CGI-Perl\//) {
+ use Apache;
+ my $r = Apache->request or die;
+ $r->send_cgi_header(join("\n", @{$result->{headers}})."\n");
+}
+else {
+ print "$_\n" for @{$result->{headers}};
+ print "\n";
+}
+print $result->{content};
--- /dev/null
+#!/usr/bin/perl -w
+# -d:ptkdb
+BEGIN { $ENV{DISPLAY} = '192.168.32.15:0.0' }
+use strict;
+use FindBin;
+use lib "$FindBin::Bin/../modules";
+use BSE::DB;
+use BSE::Request;
+use BSE::Template;
+use Carp 'confess';
+use BSE::AdminMenu;
+
+$SIG{__DIE__} = sub { confess $@ };
+
+my $req = BSE::Request->new;
+
+my $result = BSE::AdminMenu->dispatch($req);
+$| = 1;
+push @{$result->{headers}}, "Content-Type: $result->{type}";
+push @{$result->{headers}}, $req->extra_headers;
+if (exists $ENV{GATEWAY_INTERFACE}
+ && $ENV{GATEWAY_INTERFACE} =~ /^CGI-Perl\//) {
+ use Apache;
+ my $r = Apache->request or die;
+ $r->send_cgi_header(join("\n", @{$result->{headers}})."\n");
+}
+else {
+ print "$_\n" for @{$result->{headers}};
+ print "\n";
+}
+print $result->{content};
[basic]
randomdata = /dev/urandom
-accesscontrol=0
+access_control=0
[paths]
; the following needs to be set to a path writable by the BSE processes
help=The user has complete access to articles in the shop
articles=3
descendants=1
-permissions=!admin_*
+permissions=not(admin_*)
brief=Shop admin
[permission all_but_shop]
help=The user has complete access to all articles but the shop.
-articles=!3
+articles=not(3)
descendants=1
brief=All but shop admin
-permissions=!admin_*
+permissions=not(admin_*)
--- /dev/null
+package BSE::AdminLogon;
+use strict;
+use BSE::Util::Tags;
+use HTML::Entities;
+use URI::Escape;
+
+my %actions =
+ (
+ logon_form=>1,
+ logon=>1,
+ );
+
+sub dispatch {
+ my ($class, $req) = @_;
+
+ my $cgi = $req->cgi;
+ my $action;
+ for my $check (keys %actions) {
+ if ($cgi->param("a_$check")) {
+ $action = $check;
+ last;
+ }
+ }
+ $action ||= 'logon_form';
+ my $method = "req_$action";
+ $class->$method($req);
+}
+
+sub req_logon_form {
+ my ($class, $req, $msg) = @_;
+
+ my %acts;
+ %acts =
+ (
+ BSE::Util::Tags->admin(undef, $req->cfg),
+ BSE::Util::Tags->basic(undef, $req->cgi, $req->cfg),
+ BSE::Util::Tags->secure($req),
+ message => $msg,
+ );
+
+ return BSE::Template->get_response('admin/logon', $req->cfg, \%acts);
+}
+
+sub req_logon {
+ my ($class, $req) = @_;
+
+ my $cgi = $req->cgi;
+ my $logon = $cgi->param('logon');
+ my $password = $cgi->param('password');
+
+ defined $logon && length $logon
+ or return $class->req_logon($req, "Please enter your logon name");
+ defined $password && length $password
+ or return $class->req_logon($req, "Please enter your password");
+ require BSE::TB::AdminUsers;
+ my $user = BSE::TB::AdminUsers->getBy(logon=>$logon);
+ $user && $user->{password} eq $password
+ or return $class->req_logon($req, "Invalid logon or password");
+ $req->session->{adminuserid} = $user->{id};
+
+ my $r = $cgi->param('r');
+ unless ($r) {
+ $r = $req->cfg->entryErr('site', 'url') . "/cgi-bin/admin/menu.pl";
+ }
+
+ return BSE::Template->get_refresh($r, $req->cfg);
+}
+
+
+1;
--- /dev/null
+package BSE::AdminMenu;
+use strict;
+use BSE::Util::Tags;
+use HTML::Entities;
+use URI::Escape;
+use BSE::Permissions;
+
+my %actions =
+ (
+ menu=>1,
+ );
+
+sub dispatch {
+ my ($class, $req) = @_;
+
+ my $cgi = $req->cgi;
+ my $action;
+ for my $check (keys %actions) {
+ if ($cgi->param("a_$check")) {
+ $action = $check;
+ last;
+ }
+ }
+ $action ||= 'menu';
+ my $method = "req_$action";
+ $class->$method($req);
+}
+
+sub req_menu {
+ my ($class, $req, $msg) = @_;
+
+ BSE::Permissions->check_logon($req)
+ or return BSE::Template->get_refresh($req->url('logon'), $req->cfg);
+
+ my %acts;
+ %acts =
+ (
+ BSE::Util::Tags->admin(undef, $req->cfg),
+ BSE::Util::Tags->basic(undef, $req->cgi, $req->cfg),
+ BSE::Util::Tags->secure($req),
+ message => $msg,
+ );
+
+ my $template = 'admin/menu';
+ my $t = $req->cgi->param('_t');
+ $template .= "_$t" if defined($t) && $t =~ /^\w+$/;
+
+ return BSE::Template->get_response($template, $req->cfg, \%acts);
+}
+
+1;
use BSE::Util::Tags;
use HTML::Entities;
use URI::Escape;
+use BSE::Permissions;
my %actions =
(
sub dispatch {
my ($class, $req) = @_;
+ BSE::Permissions->check_logon($req)
+ or return BSE::Template->get_refresh($req->url('logon'), $req->cfg);
+
my $cgi = $req->cgi;
my $action;
for my $check (keys %actions) {
(
BSE::Util::Tags->admin(undef, $req->cfg),
BSE::Util::Tags->basic(undef, $req->cgi, $req->cfg),
+ BSE::Util::Tags->secure($req),
message => $msg,
DevHelp::Tags->make_iterator2
([ \&iter_get_users, $req ], 'iuser', 'users', \@users, \$user_index),
sub req_adduser {
my ($class, $req) = @_;
+ $req->user_can('admin_user_add')
+ or return $req->access_error("You don't have admin_user_add access");
+
my $cgi = $req->cgi;
my $logon = $cgi->param('logon');
my $name = $cgi->param('name');
sub req_addgroup {
my ($class, $req) = @_;
+ $req->user_can('admin_group_add')
+ or return $req->access_error("You don't have admin_user_add access");
+
my $cgi = $req->cgi;
my $name = $cgi->param('name');
my $description = $cgi->param('description');
sub req_saveuser {
my ($class, $req) = @_;
+ $req->user_can('admin_user_save')
+ or return $req->access_error("You don't have admin_user_save access");
+
my $cgi = $req->cgi;
my $userid = $cgi->param('userid');
$userid
require BSE::TB::AdminUsers;
my $user = BSE::TB::AdminUsers->getByPkey($userid)
or return $class->req_users($req, "User id $userid not found");
+
my $name = $cgi->param('name');
my $password = $cgi->param('password');
my $confirm = $cgi->param('confirm');
}
$user->save;
- if ($cgi->param('savegroups')) {
+ if ($cgi->param('savegroups') && $req->user_can("admin_save_user_groups")) {
require BSE::TB::AdminGroups;
require BSE::TB::AdminUsers;
my @group_ids = map $_->{id}, BSE::TB::AdminGroups->all;
sub req_saveuserart {
my ($class, $req) = @_;
+ $req->user_can("admin_user_save_artrights")
+ or return $req->access_error("You don't have admin_user_save_artrights access");
+
my $cgi = $req->cgi;
my $userid = $cgi->param('userid');
$userid
sub req_savegroup {
my ($class, $req, $msg) = @_;
+ $req->user_can("admin_group_save")
+ or return $req->access_error("You don't have admin_group_save access");
+
my $cgi = $req->cgi;
my $groupid = $cgi->param('groupid');
$groupid
my $description = $cgi->param('description');
$group->{description} = $description if defined $description;
- if ($cgi->param('savegperms')) {
+ if ($cgi->param('savegperms') && $req->user_can("admin_group_save_gperms")) {
my $perms = '';
my @gperms = $cgi->param('gperms');
for my $id (@gperms) {
}
$group->save;
- require BSE::TB::AdminGroups;
- require BSE::TB::AdminUsers;
- my @member_ids = map $_->{id}, BSE::TB::AdminUsers->all;
- my %want_users = map { $_ => 1 } $cgi->param('users');
- my %current_users = map { $_->{user_id} => 1 }
- BSE::DB->query(groupUsers=>$group->{id});
-
- for my $user_id (@member_ids) {
- if ($want_users{$user_id} && !$current_users{$user_id}) {
- BSE::DB->run(addUserToGroup=>$user_id, $group->{id});
- }
- elsif (!$want_users{$user_id} && $current_users{$user_id}) {
- BSE::DB->run(delUserFromGroup=>$user_id, $group->{id});
+ if ($cgi->param('saveusers') && $req->user_can("admin_save_group_users")) {
+ require BSE::TB::AdminGroups;
+ require BSE::TB::AdminUsers;
+ my @member_ids = map $_->{id}, BSE::TB::AdminUsers->all;
+ my %want_users = map { $_ => 1 } $cgi->param('users');
+ my %current_users = map { $_->{user_id} => 1 }
+ BSE::DB->query(groupUsers=>$group->{id});
+
+ for my $user_id (@member_ids) {
+ if ($want_users{$user_id} && !$current_users{$user_id}) {
+ BSE::DB->run(addUserToGroup=>$user_id, $group->{id});
+ }
+ elsif (!$want_users{$user_id} && $current_users{$user_id}) {
+ BSE::DB->run(delUserFromGroup=>$user_id, $group->{id});
+ }
}
}
sub req_savegroupart {
my ($class, $req) = @_;
+ $req->user_can("admin_group_save_artrights")
+ or return $req->access_error("You don't have admin_group_save_artrights access");
+
my $cgi = $req->cgi;
my $userid = $cgi->param('userid');
my $groupid = $cgi->param('groupid');
sub req_deluser {
my ($class, $req) = @_;
+ $req->user_can("admin_user_del")
+ or return $req->access_error("You don't have admin_user_del access");
+
my $cgi = $req->cgi;
my $userid = $cgi->param('userid');
$userid
sub req_delgroup {
my ($class, $req, $msg) = @_;
+ $req->user_can("admin_group_del")
+ or return $req->access_error("You don't have admin_group_del access");
+
my $cgi = $req->cgi;
my $groupid = $cgi->param('groupid');
$groupid
use strict;
sub enter_cart {
- my ($class, $items, $products, $state) = @_;
+ my ($class, $items, $products, $state, $cfg) = @_;
return 1;
}
sub cart_actions {
- my ($class, $acts, $items, $products, $state) = @_;
+ my ($class, $acts, $items, $products, $state, $cfg) = @_;
return ();
}
sub checkout_actions {
- my ($class, $acts, $items, $products) = @_;
+ my ($class, $acts, $items, $products, $cfg) = @_;
return ();
}
+sub checkout_update {
+ my ($class, $q, $items, $products, $state, $cfg) = @_;
+}
+
sub order_save {
- my ($class, $cgi, $order, $items) = @_;
+ my ($class, $cgi, $order, $items, $cfg) = @_;
return 1;
}
sub total_extras {
- my ($class, $cart,$state) = @_;
+ my ($class, $cart, $state, $cfg) = @_;
0;
}
sub recalc {
- my ($class, $q, $items, $products, $state) = @_;
+ my ($class, $q, $items, $products, $state, $cfg) = @_;
}
sub required_fields {
- my ($class, $q, $state) = @_;
+ my ($class, $q, $state, $cfg) = @_;
qw(name1 name2 address city postcode state country email);
}
sub purchase_actions {
- my ($class, $acts, $items, $products, $state) = @_;
+ my ($class, $acts, $items, $products, $state, $cfg) = @_;
return;
}
sub base_tags {
- my ($class, $articles, $acts, $article, $embedded) = @_;
+ my ($class, $articles, $acts, $article, $embedded, $cfg) = @_;
return ();
}
converting the checkout template to the final output. Used to define
extra tags for the checkout page.
+=item checkout_update($cgi, $items, $products, $state, $cfg)
+
+This is called by the checkupdate target of shop.pl, which does
+nothing else.
+
=item order_save($cgi, $order, $items)
Called immediately before the order is saved. You can perform extra
replaceAdminGroup => 'replace into admin_groups values(?,?,?,?)',
deleteAdminGroup => 'delete from admin_groups where base_id = ?',
groupUsers => 'select * from admin_membership where group_id = ?',
+ 'AdminGroups.userPermissionGroups' => <<SQL,
+select bs.*, ag.* from admin_base bs, admin_groups ag, admin_membership am
+where bs.id = ag.base_id
+ and ( (ag.base_id = am.group_id and am.user_id = ?)
+ or ag.name = 'everyone' )
+SQL
addUserToGroup => 'insert into admin_membership values(?,?)',
delUserFromGroup => <<SQL,
SQL
addArticleObjectPerm => 'insert into admin_perms values(?,?,?)',
replaceArticleObjectPerm => 'replace into admin_perms values(?,?,?)',
+ userAndGroupPerms => <<SQL,
+select distinct ap.*
+from admin_perms ap, admin_users au, admin_groups ag, admin_membership am
+where ap.admin_id = ?
+ or (ap.admin_id = am.group_id and am.user_id = ?)
+ or (ap.admin_id = ag.base_id and ag.name = 'everyone')
+SQL
);
sub _single
use base qw(BSE::Edit::Base);
use BSE::Util::Tags;
use BSE::Util::SQL qw(now_sqldate);
+use BSE::Permissions;
sub article_dispatch {
- my ($self, $request, $article, $articles) = @_;
-
- my $cgi = $request->cgi;
+ my ($self, $req, $article, $articles) = @_;
+
+ BSE::Permissions->check_logon($req)
+ or return BSE::Template->get_refresh($req->url('logon'), $req->cfg);
+
+ my $cgi = $req->cgi;
my $action;
my %actions = $self->article_actions;
for my $check (keys %actions) {
}
$action ||= 'edit';
my $method = $actions{$action};
- return $self->$method($request, $article, $articles, @extraargs);
+ return $self->$method($req, $article, $articles, @extraargs);
}
sub noarticle_dispatch {
- my ($self, $request, $articles) = @_;
+ my ($self, $req, $articles) = @_;
- my $cgi = $request->cgi;
+ BSE::Permissions->check_logon($req)
+ or return BSE::Template->get_refresh($req->url('logon'), $req->cfg);
+
+ my $cgi = $req->cgi;
my $action = 'add';
my %actions = $self->noarticle_actions;
for my $check (keys %actions) {
}
}
my $method = $actions{$action};
- return $self->$method($request, $articles);
+ return $self->$method($req, $articles);
}
sub edit_sections {
my ($self, $req, $articles) = @_;
+ BSE::Permissions->check_logon($req)
+ or return BSE::Template->get_refresh($req->url('logon'), $req->cfg);
+
my %article;
my @cols = Article->columns;
@article{@cols} = ('') x @cols;
}
sub possible_parents {
- my ($self, $article, $articles) = @_;
+ my ($self, $article, $articles, $req) = @_;
my %labels;
my @values;
my @parents = $articles->getBy('level', $article->{level}-1);
@parents = grep { $_->{generator} eq 'Generate::Article'
&& $_->{id} != $shopid } @parents;
+
+ # user can only select parent they can add to
+ @parents = grep $req->user_can('edit_add_child', $_), @parents;
@values = ( map {$_->{id}} @parents );
%labels = ( map { $_->{id} => "$_->{title} ($_->{id})" } @parents );
- if ($article->{level} == 1) {
+ if ($article->{level} == 1 && $req->user_can('edit_add_child')) {
push @values, -1;
$labels{-1} = "No parent - this is a section";
}
# we also list the siblings and grandparent (if any)
my @siblings = grep $_->{id} != $article->{id} && $_->{id} != $shopid,
$articles->getBy(parentid => $article->{parentid});
+ @siblings = grep $req->user_can('edit_add_child', $_), @siblings;
push @values, map $_->{id}, @siblings;
@labels{map $_->{id}, @siblings} =
map { "-- move down a level -- $_->{title} ($_->{id})" } @siblings;
my $parent = $articles->getByPkey($article->{parentid});
if ($parent->{parentid} != -1) {
my $gparent = $articles->getByPkey($parent->{parentid});
- push @values, $gparent->{id};
- $labels{$gparent->{id}} =
- "-- move up a level -- $gparent->{title} ($gparent->{id})";
+ if ($req->user_can('edit_add_child', $gparent)) {
+ push @values, $gparent->{id};
+ $labels{$gparent->{id}} =
+ "-- move up a level -- $gparent->{title} ($gparent->{id})";
+ }
}
else {
- push @values, -1;
- $labels{-1} = "-- move up a level -- become a section";
+ if ($req->user_can('edit_add_child')) {
+ push @values, -1;
+ $labels{-1} = "-- move up a level -- become a section";
+ }
}
}
}
}
sub tag_list {
- my ($self, $article, $articles, $cgi, $what) = @_;
+ my ($self, $article, $articles, $cgi, $req, $what) = @_;
if ($what eq 'listed') {
my @values = qw(0 1);
-default=>$article->{listed});
}
else {
- my ($values, $labels) = $self->possible_parents($article, $articles);
+ my ($values, $labels) = $self->possible_parents($article, $articles, $req);
my $html;
if (defined $article->{parentid}) {
$html = $cgi->popup_menu(-name=>'parentid',
BSE::TB::AdminGroups->all;
}
+sub tag_if_field_perm {
+ my ($req, $article, $field) = @_;
+
+ $field =~ /^\w+$/ or return;
+ if ($article->{id}) {
+ return 1;
+ }
+ else {
+ return $req->user_can("edit_field_edit_$field", $article);
+ }
+}
+
+sub tag_default {
+ my ($self, $req, $article, $args, $acts, $funcname, $templater) = @_;
+
+ my ($col, $func, $funcargs) = split ' ', $args, 3;
+ if ($article->{id}) {
+ if ($func) {
+ return $templater->perform($acts, $func, $funcargs);
+ }
+ else {
+ my $value = $article->{$args};
+ defined $value or $value = '';
+ return encode_entities($value);
+ }
+ }
+ else {
+ my $value = $self->default_value($req, $article, $col);
+ return encode_entities($value);
+ }
+}
+
sub low_edit_tags {
my ($self, $acts, $request, $article, $articles, $msg, $errors) = @_;
(
BSE::Util::Tags->basic($acts, $cgi, $cfg),
BSE::Util::Tags->admin($acts, $cfg),
+ BSE::Util::Tags->secure($request),
article => [ \&tag_hash, $article ],
old => [ \&tag_old, $article, $cgi ],
+ default => [ \&tag_default, $self, $request, $article ],
articleType => [ \&tag_art_type, $article->{level}, $cfg ],
parentType => [ \&tag_art_type, $article->{level}-1, $cfg ],
ifnew => [ \&tag_if_new, $article ],
- list => [ \&tag_list, $self, $article, $articles, $cgi ],
+ list => [ \&tag_list, $self, $article, $articles, $cgi, $request ],
script => $ENV{SCRIPT_NAME},
level => $article->{level},
checked => \&tag_checked,
edit => \&tag_edit_link,
error => [ \&tag_hash, $errors ],
error_img => [ \&tag_error_img, $self, $errors ],
+ ifFieldPerm => [ \&tag_if_field_perm, $request, $article ],
);
}
}
sub add_form {
- my ($self, $request, $articles, $msg, $errors) = @_;
+ my ($self, $req, $articles, $msg, $errors) = @_;
my $level;
- my $cgi = $request->cgi;
+ my $cgi = $req->cgi;
my $parentid = $cgi->param('parentid');
if ($parentid) {
if ($parentid =~ /^\d+$/) {
$article{listed} = 1;
$article{generator} = $self->generator;
- return $self->low_edit_form($request, \%article, $articles, $msg, $errors);
+ my ($values, $labels) = $self->possible_parents(\%article, $articles, $req);
+ @$values
+ or return $req->access_error("You can't add children to any article at that level");
+
+ return $self->low_edit_form($req, \%article, $articles, $msg, $errors);
}
sub generator { 'Generate::Article' }
my @columns = $table_object->rowClass->columns;
$self->save_thumbnail($cgi, undef, \%data);
for my $name (@columns) {
- $data{$name} = $cgi->param($name) if defined $cgi->param($name);
+ $data{$name} = $cgi->param($name)
+ if defined $cgi->param($name);
}
my $msg;
my $parent;
if ($data{parentid} > 0) {
$parent = $articles->getByPkey($data{parentid}) or die;
+ $req->user_can('edit_add_child', $parent)
+ or return $self->add_form($req, $articles,
+ "You cannot add a child to that article");
+ for my $name (@columns) {
+ if (exists $data{$name} &&
+ !$req->user_can("edit_add_field_$name", $parent)) {
+ delete $data{$name};
+ }
+ }
}
-
+ else {
+ $req->user_can('edit_add_child')
+ or return $self->add_form($req, $articles,
+ "You cannot create a top-level article");
+ for my $name (@columns) {
+ if (exists $data{$name} &&
+ !$req->user_can("edit_add_field_$name")) {
+ delete $data{$name};
+ }
+ }
+ }
+
$self->validate_parent(\%data, $articles, $parent, \$msg)
or return $self->add_form($req, $articles, $msg);
$self->fill_new_data($req, \%data, $articles);
my $level = $parent ? $parent->{level}+1 : 1;
- $data{displayOrder} ||= time;
+ $data{displayOrder} = time;
$data{titleImage} ||= '';
$data{imagePos} = 'tr';
$data{release} = sql_date($data{release}) || now_sqldate();
return BSE::Template->get_refresh($url, $self->{cfg});
}
+sub default_value {
+ my ($self, $req, $article, $col) = @_;
+
+ if ($article->{parentid}) {
+ my $section = "children of $article->{parentid}";
+ my $value = $req->cfg->entry($section, $col);
+ if (defined $value) {
+ }
+ }
+ my $section = "level $article->{level}";
+ my $value = $req->cfg->entry($section, $col);
+ defined($value) and return encode_entities($value);
+
+ return '';
+}
+
1;
=head1 NAME
package BSE::Permissions;
use strict;
+# these are the permissions that are checked beyond just whether the permissions DB allows them
+my @checks =
+ qw(
+ edit_delete_article
+ edit_field_title
+ edit_field_summary
+ );
+my %checks = map { $_=> 1 } @checks;
+
sub new {
my ($class, $cfg) = @_;
$obj{articles} = $cfg->entry($section, 'articles')
or next;
$obj{perminfo} = _make_perm_info($obj{permissions});
- $obj{artinfo} = _make_art_info($obj{permissions});
+ $obj{artinfo} = _make_art_info($obj{articles}, $cfg);
push @gobjs, \%obj;
$gobjs{$name} = \%obj;
}, $class;
}
+# check that the user is logged on, assuming we're configured to
+# require that
+sub check_logon {
+ my ($class, $req) = @_;
+
+ my $cfg = $req->cfg;
+ $cfg->entry('basic', 'access_control', 0)
+ or return 1;
+
+ return 1 if $req->user;
+
+ my $user;
+ require BSE::TB::AdminUsers;
+ if ($ENV{REMOTE_USER}) {
+ ($user) = BSE::TB::AdminUsers->getBy(logon => $ENV{REMOTE_USER});
+ }
+ if ($req->session->{adminuserid}) {
+ $user = BSE::TB::AdminUsers->getByPkey($req->session->{adminuserid});
+ }
+ if ($user) {
+ $req->setuser($user);
+ return 1;
+ }
+ else {
+ return 0;
+ }
+}
+
sub global_perms {
my ($self) = @_;
}
}
-sub can_user {
- my ($self, $user, $article, @actions) = @_;
+sub _load_user_perms {
+ my ($self, $user) = @_;
-
+ require BSE::TB::AdminGroups;
+ my @usergroups = BSE::TB::AdminGroups->getSpecial(userPermissionGroups=>$user->{id});
+ my @userperms = BSE::DB->query(userAndGroupPerms=>$user->{id}, $user->{id});
+ $self->{usergroups} = \@usergroups;
+ $self->{userperms} = \@userperms;
+
+ $self->{userid} = $user->{id};
+}
+
+sub _permname_match {
+ my ($name, $info) = @_;
+
+ my $match = 0;
+ for my $re (@{$info->{res}}) {
+ if ($name =~ $re) {
+ ++$match;
+ last;
+ }
+ }
+
+ return $info->{not} ? !$match : $match;
+}
+
+sub _art_ancestors {
+ my ($self, $article) = @_;
+
+ my @result;
+ while ($article->{id} > 0 && $article->{parentid} != -1) {
+ $article = $self->{artcache}{$article->{parentid}}
+ || $article->parent;
+ push @result, $article;
+ }
+ if ($article && $article->{parentid} == -1) {
+ $self->{sitearticle} ||=
+ {
+ generator=>'Generate::Article',
+ id=>-1,
+ parentid=>0,
+ title=>'The site',
+ };
+ push @result, $self->{sitearticle};
+ }
+
+ @result;
+}
+
+sub _garticle_match {
+ my ($self, $article, $perm) = @_;
+
+ my @articles = $article;
+ if ($perm->{descendants}) {
+ push @articles, $self->_art_ancestors($article);
+ }
+
+ for my $test (@{$perm->{arts}}) {
+ if ($test->{type} eq 'exact') {
+ return 1
+ if grep $_->{id} == $test->{article}, @articles;
+ }
+ elsif ($test->{type} eq 'childof') {
+ return 1
+ if grep $_->{parentid} == $test->{article}, @articles;
+ }
+ elsif ($test->{type} eq 'typeof') {
+ return 1
+ if grep $_->{generator} eq "Generate::$test->{name}", @articles;
+ }
+ }
+
+ return 0;
+}
+
+sub _aarticle_match {
+ my ($self, $article, $perm, $id) = @_;
+
+ my @articles = $article;
+ if ($perm->{descendants}) {
+ push @articles, $self->_art_ancestors($article);
+ }
+ return 1
+ if grep $_->{id} == $id, @articles;
+
+ return 0;
+}
+
+sub user_has_perm {
+ my ($self, $user, $article, $action, $rmsg) = @_;
+
+ unless ($rmsg) {
+ my $msg;
+ $rmsg = \$msg;
+ }
+ $self->{cfg}->entry('basic', 'access_control', 0)
+ or return 1;
+
+ if ($checks{$action}) {
+ my $method = "check_$action";
+ $self->$method($user, $article, $action, $rmsg)
+ or return;
+ }
+
+ $self->{userid} && $self->{userid} == $user->{id}
+ or $self->_load_user_perms($user);
+
+ for my $permmap ($user->{perm_map},
+ map $_->{perm_map}, @{$self->{usergroups}}) {
+ for my $globperm (@{$self->{gobj_array}}) {
+ next
+ unless length($permmap) > $globperm->{id}
+ and substr($permmap, $globperm->{id}, 1);
+ _permname_match($action, $globperm->{perminfo})
+ or next;
+ $self->_garticle_match($article, $globperm)
+ and return 1;
+ }
+ }
+ for my $perm (@{$self->{userperms}}) {
+ for my $artperm (@{$self->{aobj_array}}) {
+ next
+ unless length($perm->{perm_map}) > $artperm->{id}
+ and substr($perm->{perm_map}, $artperm->{id}, 1);
+ _permname_match($action, $artperm->{perminfo})
+ or next;
+ $self->_aarticle_match($article, $artperm, $perm->{object_id})
+ and return 1;
+ }
+ }
+
+ return;
}
sub _make_perm_info {
my ($perm) = @_;
- my $not = $perm =~ s/^!//;
+ my $not = $perm =~ s/^not\((.*)\)$/$1/;
my @tests = split /,/, $perm;
my @res;
for my $test (@tests) {
}
sub _make_art_info {
- my ($art) = @_;
+ my ($art, $cfg) = @_;
- my $not = $art =~ s/^!//;
+ my $not = $art =~ s/^not\((.*)\)$/$1/;
my @tests = split /,/, $art;
my @arts;
for my $test (@tests) {
if ($test =~ /^(?:\d+|-1|[a-z]\w+)$/) {
+ unless ($test =~ /^(\d+|-1)$/) {
+ my $id = $cfg->entry('articles', $test);
+ unless ($id) {
+ print STDERR "Unknown article name '$test' skipped\n";
+ next;
+ }
+ $test = $id;
+ }
push @arts, { type=>'exact', article=>$test };
}
elsif ($test =~ /^childof\((\d+|-1|[a-z]\w+)\)$/) {
+ my $name = $1;
+ unless ($name =~ /^(\d+|-1)$/) {
+ my $id = $cfg->entry('articles', $name);
+ unless ($id) {
+ print STDERR "Unknown article name '$name' skipped\n";
+ next;
+ }
+ $test = $id;
+ }
push @arts, { type=>'childof', article=>$1 };
}
elsif ($test =~ /^typeof\((\w+)\)$/) {
return { not=>$not, arts=>\@arts };
}
+sub _is_product_and_in_use {
+ my ($article) = @_;
+
+ if ($article->{generator} eq 'Generate::Product') {
+ # can't delete products that have been used in orders
+ require OrderItems;
+ my @items = OrderItems->getBy(productId=>$article->{id});
+ if (@items) {
+ return 1;
+ }
+ }
+ return 0;
+}
+
+sub check_edit_delete_article {
+ my ($self, $user, $article, $action, $rmsg) = @_;
+
+ # can't delete an article that has children
+ if (Articles->children($article->{id})) {
+ $$rmsg = "This article has children. You must delete the children first (or change their parents)";
+ return;
+ }
+ if (grep $_ == $article->{id}, @Constants::NO_DELETE) {
+ $$rmsg = "Sorry, these pages are essential to the site structure - they cannot be deleted";
+ return;
+ }
+ my $shopid = $self->{cfg}->entryErr('articles', 'shop');
+ if ($article->{id} == $shopid) {
+ $$rmsg = "Sorry, these pages are essential to the store - they cannot be deleted - you may want to hide the the store instead.";
+ return;
+ }
+ if (_is_product_and_in_use($article)) {
+ $$rmsg = "There are orders for this product. It cannot be deleted.";
+ return;
+ }
+
+ return 1;
+}
+
+sub check_edit_field_title {
+ my ($self, $user, $article, $action, $rmsg) = @_;
+
+ if (_is_product_and_in_use($article)) {
+ $$rmsg = "There are orders for this product. The title cannot be changed.";
+ return;
+ }
+
+ return 1;
+}
+
+sub check_edit_field_summary {
+ my ($self, $user, $article, $action, $rmsg) = @_;
+
+ if (_is_product_and_in_use($article)) {
+ $$rmsg = "There are orders for this product. The summary cannot be changed.";
+ return;
+ }
+
+ return 1;
+}
+
1;
sub extra_headers { return }
+sub user {
+ return $_[0]{adminuser};
+}
+
+sub setuser {
+ $_[0]{adminuser} = $_[1];
+}
+
+sub url {
+ my ($self, $action, $params, $name) = @_;
+
+ my $url = $self->cfg->entryErr('site', 'url');
+ $url .= "/cgi-bin/admin/$action.pl";
+ if ($params && keys %$params) {
+ $url .= "?" . join("&", map { "$_=".encode_entities($params->{$_}) } keys %$params);
+ }
+ $url .= "#$name" if $name;
+
+ $url;
+}
+
+sub user_can {
+ my ($self, $perm, $object, $rmsg) = @_;
+
+ return 1 unless $self->{user};
+ require BSE::Permissions;
+ $self->{perms} ||= BSE::Permissions->new($self->cfg);
+ return $self->{perms}->user_has_perm($self->user, $object, $perm, $rmsg);
+}
+
sub DESTROY {
my ($self) = @_;
if ($self->{session}) {
);
}
+my %dummy_site_article =
+ (
+ id=>-1,
+ parentid=>0,
+ title=>'Your site',
+ );
+
+sub tag_if_user_can {
+ my ($req, $rperms, $args, $acts, $funcname, $templater) = @_;
+
+ require BSE::Permissions;
+ $$rperms ||= BSE::Permissions->new($req->cfg);
+
+ my @checks = split /,/, $args;
+ for my $check (@checks) {
+ my ($perm, $artname) = split /:/, $check, 2;
+ my $article;
+ if ($artname) {
+ if ($artname =~ /^\[/) {
+ my ($workname) = DevHelp::Tags->get_parms($artname, $acts, $templater);
+ unless ($workname) {
+ print STDERR "Could not translate '$artname'\n";
+ return;
+ }
+ $artname = $workname;
+ }
+ if ($artname =~ /^(-1|\d+)$/) {
+ if ($artname == -1) {
+ $article = \%dummy_site_article;
+ }
+ else {
+ $article = Articles->getByPkey($artname);
+ unless ($article) {
+ print STDERR "Could not find article $artname\n";
+ return;
+ }
+ }
+ }
+ elsif ($artname =~ /^\w+$/) {
+ $article = $req->get_object($artname);
+ unless ($article) {
+ if (my $artid = $req->cfg->entry('articles', $artname)) {
+ if ($artid == -1) {
+ $article = \%dummy_site_article;
+ }
+ else {
+ $article = Articles->getByPkey($artid);
+ }
+ unless ($article) {
+ print STDERR "Could not find article id $artid (from $artname)\n";
+ return;
+ }
+ }
+ else {
+ print STDERR "Unknown article name $artname\n";
+ return;
+ }
+ }
+ }
+ }
+ else {
+ $article = \%dummy_site_article;
+ }
+
+ # whew, so we should have an article
+
+ $$rperms->user_has_perm($req->user, $article, $perm)
+ or return;
+ }
+
+ return 1;
+}
+
+sub secure {
+ my ($class, $req) = @_;
+
+ my $perms;
+ return
+ (
+ ifUserCan => [ \&tag_if_user_can, $req, \$perms ],
+ );
+}
+
1;
+
(
%extras,
- BSE::Custom->base_tags($articles, $acts, $article, $embedded),
+ BSE::Custom->base_tags($articles, $acts, $article, $embedded, $cfg),
BSE::Util::Tags->static($acts, $self->{cfg}),
# for embedding the content from children and other sources
ifEmbedded=> sub { $embedded },
add=>\&add_item,
cart=>\&show_cart,
checkout=>\&checkout,
+ checkupdate => \&checkupdate,
recheckout => sub { checkout('', 1); },
confirm => \&checkout_confirm,
recalc=>\&recalc,
$session{custom} ||= {};
my %custom_state = %{$session{custom}};
- BSE::Custom->enter_cart(\@cart, \@cart_prods, \%custom_state);
+ BSE::Custom->enter_cart(\@cart, \@cart_prods, \%custom_state, $cfg);
$msg = '' unless defined $msg;
$msg = CGI::escapeHTML($msg);
my %acts;
%acts =
(
- BSE::Custom->cart_actions(\%acts, \@cart, \@cart_prods, \%custom_state),
+ BSE::Custom->cart_actions(\%acts, \@cart, \@cart_prods, \%custom_state,
+ $cfg),
shop_cart_tags(\%acts, \@cart, \@cart_prods, \%session, $CGI::Q),
basic_tags(\%acts),
msg => $msg,
$session{cart} = \@cart;
$session{custom} ||= {};
my %custom_state = %{$session{custom}};
- BSE::Custom->recalc($CGI::Q, \@cart, [], \%custom_state);
+ BSE::Custom->recalc($CGI::Q, \@cart, [], \%custom_state, $cfg);
$session{custom} = \%custom_state;
}
print "Content-Type: text/html\n\n<html> </html>\n";
}
+sub checkupdate {
+ my @cart = @{$session{cart}};
+ my @cart_prods = map { Products->getByPkey($_->{productId}) } @cart;
+ my %custom_state = %{$session{custom}};
+ BSE::Custom->checkout_update($CGI::Q, \@cart, \@cart_prods, \%custom_state,
+ $cfg);
+ $session{custom} = \%custom_state;
+
+ checkout("", 1);
+}
+
# display the checkout form
# can also be called with an error message and a flag to fillin the old
# values for the form elements
$session{custom} ||= {};
my %custom_state = %{$session{custom}};
- BSE::Custom->enter_cart(\@cart, \@cart_prods, \%custom_state);
+ BSE::Custom->enter_cart(\@cart, \@cart_prods, \%custom_state, $cfg);
my @payment_types = split /,/, $cfg->entry('shop', 'payment_types', '0');
@payment_types = grep $valid_payment_types{$_}, @payment_types;
@payment_types or @payment_types = ( 0 );
message => sub { $message },
old => sub { CGI::escapeHTML($olddata ? param($_[0]) :
$user && defined $user->{$_[0]} ? $user->{$_[0]} : '') },
- BSE::Custom->checkout_actions(\%acts, \@cart, \@cart_prods, \%custom_state, $CGI::Q),
+ BSE::Custom->checkout_actions(\%acts, \@cart, \@cart_prods,
+ \%custom_state, $CGI::Q, $cfg),
ifMultPaymentTypes => @payment_types > 1,
);
for my $name (keys %payment_names) {
# information
# BUG!!: this duplicates the code in purchase() a great deal
sub prePurchase {
- my @required = BSE::Custom->required_fields($CGI::Q, $session{custom});
+ my @required = BSE::Custom->required_fields($CGI::Q, $session{custom}, $cfg);
for my $field (@required) {
defined(param($field)) && length(param($field))
or return checkout("Field $field is required", 1);
}
$order{total} += BSE::Custom->total_extras(\@cart, \@products,
- $session{custom});
+ $session{custom}, $cfg);
++$session{changed};
# blank anything else
for my $column (@columns) {
# check if a customizer has anything to do
eval {
- BSE::Custom->order_save($CGI::Q, \%order, \@cart, \@products, $session{custom});
+ BSE::Custom->order_save($CGI::Q, \%order, \@cart, \@products,
+ $session{custom}, $cfg);
++$session{changed};
};
if ($@) {
sub purchase {
# some basic validation, in case the user switched off javascript
my @required =
- BSE::Custom->required_fields($CGI::Q, $session{custom});
+ BSE::Custom->required_fields($CGI::Q, $session{custom}, $cfg);
my @payment_types = split /,/, $cfg->entry('shop', 'payment_types', '0');
@payment_types = grep $valid_payment_types{$_}, @payment_types;
$order{orderDate} = $today;
$order{total} += BSE::Custom->total_extras(\@cart, \@products,
- $session{custom});
+ $session{custom}, $cfg);
$order{paymentType} = $paymentType;
++$session{changed};
# check if a customizer has anything to do
eval {
- BSE::Custom->order_save($CGI::Q, \%order, \@cart, \@products);
+ BSE::Custom->order_save($CGI::Q, \%order, \@cart, \@products, $cfg);
};
if ($@) {
return checkout($@, 1);
%acts =
(
BSE::Custom->purchase_actions(\%acts, \@items, \@products,
- $session{custom}),
+ $session{custom}, $cfg),
iterate_items_reset => sub { $item_index = -1; },
iterate_items =>
sub {
The [permission names] section is used to translate permission indexes
to descriptive permission names.
+=head1 PERMISSIONS REFERENCE
+
+=head2 Article editing
+
+=over
+
+=item *
+
+edit_add_child
+
+The user can add a child to this article, or reparent an article to
+have this article as a parent.
+
+=item *
+
+edit_field_edit_I<fieldname>
+
+The user can edit the given field in an existing article.
+
+=item *
+
+edit_field_add_I<fieldname>
+
+The user can edit the give field when creating a new article. These
+permissions are applied to the parent where articles might be added.
+
+For fields that the user doesn't have permission for, either the value
+from the [children of I<parentid>] section, the [level I<level>]
+section, or some default value will be used.
+
+=back
+
+=head2 User/Group Administration
+
+=over
+
+=item *
+
+admin_*
+
+=back
+
=cut
=head1 CHANGES
+=head2 0.12_10
+
+=over
+
+=item *
+
+pass the configuration object to each BSE::Custom method
+
+=item *
+
+new shop target, "checkupdate" intended for updating information on
+the checkout page for customizations
+
+=item *
+
+you can now set extra configuration items in test.cfg using
+
+I<section>.I<key> = I<value>
+
+(Adrian asked for this a while back.)
+
+=item *
+
+dynamic menu display
+
+=item *
+
+logon page (only seen if access control is enabled)
+
+=item *
+
+start of access control
+
+=back
+
=head2 0.12_09
=over
The aim is to include at least some title information in the URL
without modifying the name of the HTML file. Default: False.
+=item access_control
+
+If this is true then the user/group/permissions database is used to
+control access to the system. Default: False.
+
+=item htusers
+
+This should be the path to a file to be updated with the list of users
+and crypt() versions of their passwords. If this is set then the
+security system will check for a user set by the browser before
+attempting a form based logon. Default: None.
+
=back
=head2 [mail]
=item articles
+=back
+=head2 [articles]
-=back
+This will provide translations from symbolic names to article ids.
+
+Currently this is used for converting article ids in the access
+control code, and for looking up the id of the shop.
=head1 AUTHOR
<p><b><:message:></b></p>
<:or:><:eif:>
<p>| <a href="/admin/">Admin menu</a> | </p>
-<form action="/cgi-bin/admin/adminusers.pl"><input type=submit name="a_showobjectart" value="Manage access for"><input type=hidden name=id value="<: article id:>">
+
+<table><tr><td nowrap><form action="/cgi-bin/admin/adminusers.pl"><font size=2>Manage access: <input type=hidden name=id value="<: article id:>">
<select name=adminid>
<:iterator begin adminusers:>
<option value=<:iadminuser id:>>User <:iadminuser logon:>
<:iterator begin admingroups:>
<option value=<:iadmingroup id:>>Group <:iadmingroup name:>
<:iterator end admingroups:>
-</select>
-
-</form>
+</select><input type=submit name="a_showobjectart" value="Manage">
+</font></form></td></tr></table>
<:if children:> <a name="children"></a>
<table border="0" cellspacing="0" cellpadding="0" bgcolor="#000000" width="100%" class="table">
<h2><:articleType:> Details</h2>
<:ifnew:><:or:>
-<form action="/cgi-bin/admin/adminusers.pl"><input type=submit name="a_showobjectart" value="Manage access for"><input type=hidden name=id value="<: article id:>">
+<table><tr><td nowrap><form action="/cgi-bin/admin/adminusers.pl"><font size=2>Manage access: <input type=hidden name=id value="<: article id:>">
<select name=adminid>
<:iterator begin adminusers:>
<option value=<:iadminuser id:>>User <:iadminuser logon:>
<:iterator begin admingroups:>
<option value=<:iadmingroup id:>>Group <:iadmingroup name:>
<:iterator end admingroups:>
-</select>
-</form><:eif:>
+</select><input type=submit name="a_showobjectart" value="Manage">
+</font></form></td></tr></table><:eif:>
<form enctype="multipart/form-data" method="POST" action="<:script:>">
<h2><:articleType:> Details</h2>
<:ifnew:><:or:>
-<form action="/cgi-bin/admin/adminusers.pl"><input type=submit name="a_showobjectart" value="Manage access for"><input type=hidden name=id value="<: article id:>">
+<table><tr><td nowrap><form action="/cgi-bin/admin/adminusers.pl"><font size=2>Manage access: <input type=hidden name=id value="<: article id:>">
<select name=adminid>
<:iterator begin adminusers:>
<option value=<:iadminuser id:>>User <:iadminuser logon:>
<:iterator begin admingroups:>
<option value=<:iadmingroup id:>>Group <:iadmingroup name:>
<:iterator end admingroups:>
-</select>
-</form><:eif:>
+</select><input type=submit name="a_showobjectart" value="Manage">
+</font></form></td></tr></table><:eif:>
<form enctype="multipart/form-data" method="POST" action="<:script:>">
<tr>
<th nowrap bgcolor="#FFFFFF" align="left"> <:parentType:>: </th>
<td bgcolor="#FFFFFF" width="100%">
- <select name="parentid">
+ <:ifFieldPerm parentid:><select name="parentid">
<option value="">Please select a <:parentType:><: list:>
- </select>
+ </select><:or:><input type=hidden name=parentid value=<:article parentid:><:eif:>
</td>
<td bgcolor="#FFFFFF"><:help edit section:> </td>
</tr>
<th nowrap bgcolor="#FFFFFF" align="left"> <:articleType:> title:
</th>
<td bgcolor="#FFFFFF" width="100%">
- <input type="text" name="title" maxlength="<:cfg fields title_size 255:>" size="64" value="<: article title :>">
+ <:ifFieldPerm title:><input type="text" name="title" maxlength="<:cfg fields title_size 255:>" size="64" value="<: article title :>"><:or:><:default title:><:eif:>
</td>
<td bgcolor="#FFFFFF"><:help edit title:> </td>
</tr>
<h2>Catalog Details</h2>
<:ifnew:><:or:>
-<form action="/cgi-bin/admin/adminusers.pl"><input type=submit name="a_showobjectart" value="Manage access for"><input type=hidden name=id value="<: article id:>">
+<table><tr><td nowrap><form action="/cgi-bin/admin/adminusers.pl"><font size=2>Manage access: <input type=hidden name=id value="<: article id:>">
<select name=adminid>
<:iterator begin adminusers:>
<option value=<:iadminuser id:>>User <:iadminuser logon:>
<:iterator begin admingroups:>
<option value=<:iadmingroup id:>>Group <:iadmingroup name:>
<:iterator end admingroups:>
-</select>
-</form><:eif:>
+</select><input type=submit name="a_showobjectart" value="Manage">
+</font></form></td></tr></table><:eif:>
<form enctype="multipart/form-data" method="POST" action="<:script:>">
<input type=hidden name=type value="Catalog">
<:eif Product:>| <a href="/cgi-bin/admin/add.pl?id=<:product id:>&_t=steps">Manage
step parents</a> | <:ifProduct listed:><:or:>Hidden<:eif:></p>
<h2>Edit Product</h2>
-<:ifnew:><:or:>
-<form action="/cgi-bin/admin/adminusers.pl"><input type=submit name="a_showobjectart" value="Manage access for"><input type=hidden name=id value="<: article id:>">
+<table><tr><td nowrap><form action="/cgi-bin/admin/adminusers.pl"><font size=2>Manage access: <input type=hidden name=id value="<: article id:>">
<select name=adminid>
<:iterator begin adminusers:>
<option value=<:iadminuser id:>>User <:iadminuser logon:>
<:iterator begin admingroups:>
<option value=<:iadmingroup id:>>Group <:iadmingroup name:>
<:iterator end admingroups:>
-</select>
-</form><:eif:>
+</select><input type=submit name="a_showobjectart" value="Manage">
+</font></form></td></tr></table>
<form action="<:script:>" enctype="multipart/form-data" method="POST">
<input type="hidden" name="id" value="<:product id:>">
<table border="0" cellspacing="0" cellpadding="0" bgcolor="#000000" class="table">
<td valign="top"><:igroup description:></td>
<td valign="top"><:ifGroup_users igroup:><:iterator begin group_users igroup:><:group_user logon:><:iterator separator group_users:>, <:iterator end group_users:><:or:>(none)<:eif:>
</td>
- <td valign="top"><a href="<:script:>?a_showgroup=1&groupid=<:igroup id:>&_t=del">Delete</a></td>
+ <:ifUserCan admin_group_del:><td valign="top"><a href="<:script:>?a_showgroup=1&groupid=<:igroup id:>&_t=del">Delete</a></td><:or:><:eif:>
</tr>
<: iterator end groups :>
<:or Groups:>
</tr>
</table>
</form>
+<:if UserCan admin_group_add :>
<h2>Add new group</h2>
<form method="POST" action="<:script:>">
</tr>
</table>
</form>
+<:or UserCan:><:eif UserCan:>
<p><font size="-1">BSE Release <:release:></font></p>
</body
--- /dev/null
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
+<html>
+<head>
+
+ <title>Administration - Logon</title>
+
+ <link rel="stylesheet" type="text/css" href="/css/admin.css" />
+
+</head>
+
+<body>
+<h1>Logon</h1>
+<p>
+| <a href="/admin/">Admin menu</a>
+|
+</p>
+<:ifMessage:>
+<p><b><:message:></b></p>
+<:or:><:eif:>
+
+<form method="POST" action="<:script:>">
+<:if Cgi r:>
+<input type=hidden name=r value="<:cgi r:>">
+<:or Cgi:><:eif Cgi:>
+ <table border="0" cellspacing="0" cellpadding="0" bgcolor="#000000" class="table">
+ <tr>
+ <td>
+ <table cellpadding="6" border="0" cellspacing="1">
+ <tr>
+ <th bgcolor="#FFFFFF" align="left">Logon: </th>
+ <td bgcolor="#FFFFFF">
+ <input type="text" name="logon" />
+ </td>
+ <td bgcolor="#FFFFFF"><:help logon logon:> </td>
+ </tr>
+ <tr>
+ <th bgcolor="#FFFFFF" align="left"> Password: </th>
+ <td bgcolor="#FFFFFF">
+ <input type="password" name="password" />
+ </td>
+ <td bgcolor="#FFFFFF"> <:help logon password:></td>
+ </tr>
+ <tr>
+ <td bgcolor="#FFFFFF" colspan="3" align="right">
+ <input type="submit" name="a_logon" value=" Logon " />
+ </td>
+ </tr>
+ </table>
+ </td>
+ </tr>
+ </table>
+</form>
+<p><font size="-1">BSE Release <:release:></font></p>
+</body
+></html>
--- /dev/null
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
+<html><head><title>Administration Centre</title>
+<link rel="stylesheet" href="/css/admin.css">
+</head>
+<body>
+<h1>Administration Centre</h1>
+<p>
+<table width="50%" border="0" cellspacing="0"
+
+cellpadding="5">
+ <tr>
+ <td colspan="2"><a
+
+href="/cgi-bin/admin/admin.pl?id=1">Browse in edit mode</a></td>
+
+</tr>
+ <tr>
+ <td colspan="2"><a href="/">Browse in static
+mode</a></td>
+ </tr>
+<:if UserCan edit_add_child:2 :>
+ <tr>
+ <td colspan="2"><a href="/cgi-bin/admin/add.pl?parentid=2">Add to home page</a></td>
+
+</tr>
+<:or UserCan:><:eif UserCan:>
+ <tr>
+ <td width="15"> </td>
+ <td> </td>
+
+</tr>
+ <tr>
+ <td colspan="2"><a
+
+href="/cgi-bin/admin/add.pl?id=-1">Administer sections</a></td>
+
+</tr>
+<:if UserCan edit_add_child:-1 :>
+ <tr>
+ <td width="15"> </td>
+ <td>• <a
+
+href="/cgi-bin/admin/add.pl?level=1&parentid=-1">Add a new
+section</a></td>
+ </tr>
+<:or UserCan:><:eif UserCan:>
+ <tr>
+ <td width="15"> </td>
+
+<td>• <a
+href="/cgi-bin/admin/add.pl?level=2">Add a new
+subsection</a></td>
+ </tr>
+ <tr>
+ <td width="15"> </td>
+
+<td>• <a
+href="/cgi-bin/admin/add.pl">Add a new
+article</a></td>
+ </tr>
+ <tr>
+ <td width="15"> </td>
+
+<td> </td>
+ </tr>
+ <tr>
+ <td colspan="2"><a
+href="/cgi-bin/admin/shopadmin.pl">Shop administration</a></td>
+
+<:if UserCan shop_show_orders :>
+</tr>
+ <tr>
+ <td
+width="15"> </td>
+ <td>• <a
+
+href="/cgi-bin/admin/shopadmin.pl?order_list=1&template=order_list_unfilled">View
+
+ current orders</a> (<a
+href="/cgi-bin/admin/shopadmin.pl?order_list=1">all</a>
+ or <a
+href="/cgi-bin/admin/shopadmin.pl?order_list=1&template=order_list_filled">filled</a>)</td>
+
+</tr>
+<:or UserCan:><:eif UserCan:>
+ <tr>
+ <td
+width="15"> </td>
+ <td>• <a
+
+href="/cgi-bin/admin/add.pl?parentid=3">Add catalog</a></td>
+
+</tr>
+ <tr>
+ <td width="15"> </td>
+ <td> </td>
+
+</tr>
+ <tr>
+ <td colspan="2"><a
+href="/cgi-bin/admin/subs.pl">Subscriptions administration</a></td>
+
+</tr>
+ <tr>
+ <td width="15"> </td>
+ <td> </td>
+
+</tr>
+ <tr>
+ <td colspan="2"><a
+href="/cgi-bin/admin/generate.pl">Regenerate static &
+ base
+pages</a> (<a
+href="/cgi-bin/admin/generate.pl?progress=1">verbose</a>)</td>
+
+</tr>
+ <tr>
+ <td width="15"> </td>
+ <td>• <a
+href="/cgi-bin/admin/generate.pl?id=extras">Regenerate extras
+
+and base pages</a> (<a
+href="/cgi-bin/admin/generate.pl?id=extras&progress=1">verbose</a>)</td>
+
+</tr>
+ <tr>
+ <td colspan="2"><a
+
+href="/cgi-bin/admin/makeIndex.pl">Regenerate search index</a></td>
+
+</tr>
+ <tr>
+ <td width="15"> </td>
+ <td> </td>
+
+</tr>
+ <tr>
+ <td colspan="2"><a
+
+href="/cgi-bin/admin/userlist.pl">Download member list</a></td>
+
+</tr>
+ <tr>
+ <td width="15"> </td>
+ <td> </td>
+
+</tr>
+ <tr>
+ <td colspan="2"><a href="/cgi-bin/admin/menu.pl?_t=adv">Advanced
+tools</a></td>
+ </tr>
+ <tr>
+ <td width="15"> </td>
+
+<td> </td>
+ </tr>
+ <tr>
+ <td colspan="2">
+ <form
+
+action="/cgi-bin/admin/admin.pl">
+ Jump to:
+ <input
+
+type=text name=id size=4>
+ <input type="submit"
+
+value="Jump!">
+ (Article ID eg: 1 = Home)
+ </form>
+
+</td>
+ </tr>
+</table>
+</body></html>
--- /dev/null
+<html><head><title>Advanced Tools</title>
+<link rel="stylesheet"
+href="/css/admin.css">
+</head>
+<body>
+<h1>Advanced
+Tools</h1>
+<p>
+<table width="50%" border="0" cellspacing="0"
+cellpadding="5">
+ <tr>
+ <td colspan="2"><a
+href="/cgi-bin/admin/menu.pl"><< Back to Administration Centre</a></td>
+
+</tr>
+ <tr>
+ <td width="15"> </td>
+ <td>• <a
+href="/cgi-bin/admin/datadump.pl">Dump database to email</a></td>
+
+</tr>
+ <tr>
+ <td width="15"> </td>
+ <td>• <a
+href="/cgi-bin/admin/imageclean.pl">Cleanup images</a></td>
+ </tr>
+
+<tr>
+ <td width="15"> </td>
+ <td> </td>
+ </tr>
+
+<tr>
+ <td colspan="2">
+ <form
+action="/cgi-bin/admin/admin.pl">
+ Jump to:
+ <input
+type=text name=id2 size=4>
+ <input type="submit" value="Jump!"
+name="submit">
+ (Article ID eg: 1 = Home)
+ </form>
+
+</td>
+ </tr>
+</table>
+</body></html>
<form method="POST" action="<:script:>">
<input type=hidden name=groupid value=<:group id:>>
+<input type=hidden name=savegroups value=1>
<table border="0" cellspacing="0" cellpadding="0" bgcolor="#000000" class="table">
<tr>
<td>
<td valign="top"><:ifUser_groups iuser:><:iterator begin user_groups iuser:><:user_group name:><:iterator separator user_groups:>, <:iterator end user_groups:><:or:>(none)<:eif:>
</td>
<td>
- <a href="<:script:>?a_showuser=1&userid=<:iuser id:>&_t=del">Delete</a>
+ <:ifUserCan admin_user_del:><a href="<:script:>?a_showuser=1&userid=<:iuser id:>&_t=del">Delete</a><:or:><:eif:>
</td>
</tr>
<: iterator end users :>
</tr>
</table>
</form>
+<:if UserCan admin_user_add :>
<h2>Add new user</h2>
<form method="POST" action="<:script:>">
</tr>
</table>
</form>
-
+<:or UserCan:><:eif UserCan:>
<p><font size="-1">BSE Release <:release:></font></p>
</body
></html>
sub test_sessionclass { $conf{sessionclass} or die "No sessionclass in config" }
+sub test_conffile {
+ return $conffile;
+}
+
my $test_num = 1;
sub ok ($$) {
projects / bse.git / commitdiff