0.12_10 commit r0_12_10
authorTony Cook <tony@develop-help.com>
Mon, 26 Aug 2002 06:46:53 +0000 (06:46 +0000)
committertony <tony@45cb6cf1-00bc-42d2-bb5a-07f51df49f94>
Mon, 26 Aug 2002 06:46:53 +0000 (06:46 +0000)
32 files changed:
MANIFEST
Makefile
localinst.perl
site/cgi-bin/admin/logon.pl [new file with mode: 0755]
site/cgi-bin/admin/menu.pl [new file with mode: 0755]
site/cgi-bin/bse.cfg
site/cgi-bin/modules/BSE/AdminLogon.pm [new file with mode: 0644]
site/cgi-bin/modules/BSE/AdminMenu.pm [new file with mode: 0644]
site/cgi-bin/modules/BSE/AdminUsers.pm
site/cgi-bin/modules/BSE/CustomBase.pm
site/cgi-bin/modules/BSE/DB/Mysql.pm
site/cgi-bin/modules/BSE/Edit/Article.pm
site/cgi-bin/modules/BSE/Permissions.pm
site/cgi-bin/modules/BSE/Request.pm
site/cgi-bin/modules/BSE/Util/Tags.pm
site/cgi-bin/modules/Generate.pm
site/cgi-bin/shop.pl
site/docs/access.pod
site/docs/bse.pod
site/docs/config.pod
site/templates/admin/edit_0.tmpl
site/templates/admin/edit_1.tmpl
site/templates/admin/edit_2.tmpl
site/templates/admin/edit_catalog.tmpl
site/templates/admin/edit_product.tmpl
site/templates/admin/grouplist.tmpl
site/templates/admin/logon.tmpl [new file with mode: 0644]
site/templates/admin/menu.tmpl [new file with mode: 0644]
site/templates/admin/menu_adv.tmpl [new file with mode: 0644]
site/templates/admin/showgroup.tmpl
site/templates/admin/userlist.tmpl
t/BSE/Test.pm

index 875d8fb..8881619 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -18,7 +18,9 @@ site/cgi-bin/admin/adminusers.pl
 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
@@ -34,6 +36,8 @@ site/cgi-bin/modules/ArticleFile.pm
 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
@@ -193,6 +197,9 @@ site/templates/admin/edit_product.tmpl
 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
index 977bfac..8a9ce40 100755 (executable)
--- a/Makefile
+++ b/Makefile
@@ -1,4 +1,4 @@
-VERSION=0.12_09
+VERSION=0.12_10
 DISTNAME=bse-$(VERSION)
 DISTBUILD=$(DISTNAME)
 DISTTAR=../$(DISTNAME).tar
index e841808..f7d2d0c 100644 (file)
@@ -51,30 +51,84 @@ $con =~ s/(^\$PW = ')[^']*/$1$dbpass/m;
 $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();
diff --git a/site/cgi-bin/admin/logon.pl b/site/cgi-bin/admin/logon.pl
new file mode 100755 (executable)
index 0000000..f5d1f06
--- /dev/null
@@ -0,0 +1,31 @@
+#!/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};
diff --git a/site/cgi-bin/admin/menu.pl b/site/cgi-bin/admin/menu.pl
new file mode 100755 (executable)
index 0000000..9be1414
--- /dev/null
@@ -0,0 +1,31 @@
+#!/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};
index 8814c5e..51ffb85 100644 (file)
@@ -6,7 +6,7 @@ secureurl=$(url)
 
 [basic]
 randomdata = /dev/urandom
-accesscontrol=0
+access_control=0
 
 [paths]
 ; the following needs to be set to a path writable by the BSE processes
@@ -138,13 +138,13 @@ brief=Change body
 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_*)
 
diff --git a/site/cgi-bin/modules/BSE/AdminLogon.pm b/site/cgi-bin/modules/BSE/AdminLogon.pm
new file mode 100644 (file)
index 0000000..c840eff
--- /dev/null
@@ -0,0 +1,70 @@
+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;
diff --git a/site/cgi-bin/modules/BSE/AdminMenu.pm b/site/cgi-bin/modules/BSE/AdminMenu.pm
new file mode 100644 (file)
index 0000000..3cdfcc3
--- /dev/null
@@ -0,0 +1,51 @@
+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;
index 79834a4..9939799 100644 (file)
@@ -3,6 +3,7 @@ use strict;
 use BSE::Util::Tags;
 use HTML::Entities;
 use URI::Escape;
+use BSE::Permissions;
 
 my %actions =
   (
@@ -26,6 +27,9 @@ 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) {
@@ -85,6 +89,7 @@ sub common_tags {
     (
      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),
@@ -138,6 +143,9 @@ sub hash_tag {
 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');
@@ -174,6 +182,9 @@ sub req_adduser {
 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');
@@ -488,6 +499,9 @@ sub req_showgroup {
 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
@@ -495,6 +509,7 @@ sub req_saveuser {
   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');
@@ -520,7 +535,7 @@ sub req_saveuser {
   }
   $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;
@@ -545,6 +560,9 @@ sub req_saveuser {
 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
@@ -578,6 +596,9 @@ sub req_saveuserart {
 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
@@ -588,7 +609,7 @@ sub req_savegroup {
   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) {
@@ -601,19 +622,21 @@ sub req_savegroup {
   }
   $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});
+      }
     }
   }
 
@@ -624,6 +647,9 @@ sub req_savegroup {
 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');
@@ -658,6 +684,9 @@ sub req_savegroupart {
 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
@@ -676,6 +705,9 @@ sub req_deluser {
 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
index 59afad0..a4751b1 100644 (file)
@@ -2,53 +2,57 @@ package BSE::CustomBase;
 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 ();
 }
@@ -84,6 +88,11 @@ Return a list of extra "actions" or members of the %acts hash used for
 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
index 806661f..5123c77 100644 (file)
@@ -201,6 +201,12 @@ SQL
    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,
@@ -213,6 +219,13 @@ select * from admin_perms where object_id = ? and admin_id = ?
 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
index 23a3b47..65e7545 100644 (file)
@@ -4,11 +4,15 @@ use HTML::Entities;
 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) {
@@ -23,13 +27,16 @@ sub article_dispatch {
   }
   $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) {
@@ -39,12 +46,15 @@ sub noarticle_dispatch {
     }
   }
   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;
@@ -164,7 +174,7 @@ sub should_be_catalog {
 }
 
 sub possible_parents {
-  my ($self, $article, $articles) = @_;
+  my ($self, $article, $articles, $req) = @_;
 
   my %labels;
   my @values;
@@ -173,11 +183,14 @@ sub possible_parents {
   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";
   }
@@ -186,6 +199,7 @@ sub possible_parents {
     # 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;
@@ -194,13 +208,17 @@ sub possible_parents {
       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";
+       }
       }
     }
   }
@@ -209,7 +227,7 @@ sub possible_parents {
 }
 
 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);
@@ -228,7 +246,7 @@ sub tag_list {
                            -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',
@@ -776,6 +794,38 @@ sub iter_admin_groups {
   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) = @_;
 
@@ -810,12 +860,14 @@ sub low_edit_tags {
     (
      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,
@@ -875,6 +927,7 @@ sub low_edit_tags {
      edit => \&tag_edit_link,
      error => [ \&tag_hash, $errors ],
      error_img => [ \&tag_error_img, $self, $errors ],
+     ifFieldPerm => [ \&tag_if_field_perm, $request, $article ],
     );
 }
 
@@ -916,10 +969,10 @@ sub edit_form {
 }
 
 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+$/) {
@@ -951,7 +1004,11 @@ sub add_form {
   $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' }
@@ -1024,7 +1081,8 @@ sub save_new {
   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;
@@ -1035,14 +1093,34 @@ sub save_new {
   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();
@@ -1943,6 +2021,22 @@ sub remove {
   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
index bc293f6..047faa4 100644 (file)
@@ -1,6 +1,15 @@
 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) = @_;
 
@@ -26,7 +35,7 @@ sub new {
     $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;
@@ -68,6 +77,34 @@ sub new {
               }, $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) = @_;
 
@@ -113,16 +150,144 @@ sub set_article_perm {
   }
 }
 
-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) {
@@ -143,16 +308,33 @@ sub _make_perm_info {
 }
 
 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+)\)$/) {
@@ -166,4 +348,65 @@ sub _make_art_info {
   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;
index c212ace..d50fcdc 100644 (file)
@@ -33,6 +33,36 @@ sub session {
 
 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}) {
index 01b7139..f70653c 100644 (file)
@@ -319,4 +319,88 @@ HTML
     );
 }
 
+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;
+
index 7dd6e13..312ce33 100644 (file)
@@ -482,7 +482,7 @@ sub baseActs {
     (
      %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 },
index 04075c7..9b63427 100755 (executable)
@@ -75,6 +75,7 @@ my %steps =
    add=>\&add_item,
    cart=>\&show_cart,
    checkout=>\&checkout,
+   checkupdate => \&checkupdate,
    recheckout => sub { checkout('', 1); },
    confirm => \&checkout_confirm,
    recalc=>\&recalc,
@@ -162,14 +163,15 @@ sub show_cart {
   $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,
@@ -196,7 +198,7 @@ sub update_quantities {
   $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;
 }
 
@@ -217,6 +219,17 @@ sub remove_item {
   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
@@ -246,7 +259,7 @@ sub checkout {
   $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 );
@@ -264,7 +277,8 @@ sub checkout {
      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) {
@@ -316,7 +330,7 @@ sub checkout_confirm {
 # 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);
@@ -411,7 +425,7 @@ sub prePurchase {
   }
 
   $order{total} += BSE::Custom->total_extras(\@cart, \@products, 
-                                            $session{custom});
+                                            $session{custom}, $cfg);
   ++$session{changed};
   # blank anything else
   for my $column (@columns) {
@@ -426,7 +440,8 @@ sub prePurchase {
 
   # 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 ($@) {
@@ -505,7 +520,7 @@ sub prePurchase {
 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;
@@ -618,7 +633,7 @@ sub purchase {
 
   $order{orderDate} = $today;
   $order{total} += BSE::Custom->total_extras(\@cart, \@products, 
-                                            $session{custom});
+                                            $session{custom}, $cfg);
   $order{paymentType} = $paymentType;
   ++$session{changed};
 
@@ -642,7 +657,7 @@ sub purchase {
 
   # 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);
@@ -669,7 +684,7 @@ sub purchase {
   %acts =
     (
      BSE::Custom->purchase_actions(\%acts, \@items, \@products, 
-                                  $session{custom}),
+                                  $session{custom}, $cfg),
      iterate_items_reset => sub { $item_index = -1; },
      iterate_items => 
      sub { 
index 9df7f34..4cc82d3 100644 (file)
@@ -138,5 +138,47 @@ permission ids.
 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
 
index 7a35d49..152bea9 100644 (file)
@@ -10,6 +10,41 @@ Maybe I'll add some other bits here.
 
 =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
index 7f2c1ed..d297a91 100644 (file)
@@ -160,6 +160,18 @@ followed by a / and then by a simplified version of the article title.
 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]
@@ -492,9 +504,14 @@ The URI where images are kept.  Default: /images
 
 =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
 
index 99f100d..0251a16 100644 (file)
@@ -13,7 +13,8 @@
 <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:>
@@ -21,9 +22,8 @@
 <: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">
index f433661..4c964f3 100644 (file)
@@ -23,7 +23,7 @@
   <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:>
@@ -31,8 +31,8 @@
 <: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:>">
 
index f433661..55aa3d7 100644 (file)
@@ -23,7 +23,7 @@
   <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:>
@@ -31,8 +31,8 @@
 <: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:>">
 
@@ -47,9 +47,9 @@
           <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>
@@ -57,7 +57,7 @@
             <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>
index 5117a8a..a079f3f 100644 (file)
@@ -22,7 +22,7 @@
   <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:>
@@ -30,8 +30,8 @@
 <: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">
index 669da50..320885e 100644 (file)
@@ -14,8 +14,7 @@
   <: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:>
@@ -23,8 +22,8 @@
 <: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">
index d5ef698..3a4c908 100644 (file)
@@ -35,7 +35,7 @@
             <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:> 
@@ -48,6 +48,7 @@
 </tr>
 </table>
 </form>
+<:if UserCan admin_group_add :>
 <h2>Add new group</h2>
 
 <form method="POST" action="<:script:>">
@@ -80,6 +81,7 @@
     </tr>
   </table>
 </form>
+<:or UserCan:><:eif UserCan:>  
   
 <p><font size="-1">BSE Release <:release:></font></p>
 </body
diff --git a/site/templates/admin/logon.tmpl b/site/templates/admin/logon.tmpl
new file mode 100644 (file)
index 0000000..742706a
--- /dev/null
@@ -0,0 +1,55 @@
+<!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>
diff --git a/site/templates/admin/menu.tmpl b/site/templates/admin/menu.tmpl
new file mode 100644 (file)
index 0000000..b5011de
--- /dev/null
@@ -0,0 +1,175 @@
+<!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">&nbsp;</td>
+    <td>&nbsp;</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">&nbsp;</td>
+    <td>&#149; <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">&nbsp;</td>
+<td>&#149; <a 
+href="/cgi-bin/admin/add.pl?level=2">Add a new 
+subsection</a></td>
+  </tr>
+  <tr> 
+    <td width="15">&nbsp;</td>
+<td>&#149; <a 
+href="/cgi-bin/admin/add.pl">Add a new 
+article</a></td>
+  </tr>
+  <tr> 
+    <td width="15">&nbsp;</td>
+<td>&nbsp;</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">&nbsp;</td>
+    <td>&#149; <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">&nbsp;</td>
+    <td>&#149; <a 
+
+href="/cgi-bin/admin/add.pl?parentid=3">Add catalog</a></td>
+</tr>
+  <tr> 
+    <td width="15">&nbsp;</td>
+    <td>&nbsp;</td>
+</tr>
+  <tr> 
+    <td colspan="2"><a 
+href="/cgi-bin/admin/subs.pl">Subscriptions administration</a></td>
+</tr>
+  <tr> 
+    <td width="15">&nbsp;</td>
+    <td>&nbsp;</td>
+</tr>
+  <tr> 
+    <td colspan="2"><a 
+href="/cgi-bin/admin/generate.pl">Regenerate static &amp; 
+      base 
+pages</a> (<a 
+href="/cgi-bin/admin/generate.pl?progress=1">verbose</a>)</td>
+</tr>
+  <tr> 
+    <td width="15">&nbsp;</td>
+    <td>&#149; <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">&nbsp;</td>
+    <td>&nbsp;</td>
+</tr>
+  <tr> 
+    <td colspan="2"><a 
+
+href="/cgi-bin/admin/userlist.pl">Download member list</a></td>
+</tr>
+  <tr> 
+    <td width="15">&nbsp;</td>
+    <td>&nbsp;</td>
+</tr>
+  <tr> 
+    <td colspan="2"><a href="/cgi-bin/admin/menu.pl?_t=adv">Advanced 
+tools</a></td>
+  </tr>
+  <tr> 
+    <td width="15">&nbsp;</td>
+<td>&nbsp;</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>
diff --git a/site/templates/admin/menu_adv.tmpl b/site/templates/admin/menu_adv.tmpl
new file mode 100644 (file)
index 0000000..d8bb674
--- /dev/null
@@ -0,0 +1,48 @@
+<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">&lt;&lt; Back to Administration Centre</a></td>
+</tr>
+  <tr> 
+    <td width="15">&nbsp;</td>
+    <td>&#149; <a 
+href="/cgi-bin/admin/datadump.pl">Dump database to email</a></td>
+</tr>
+  <tr> 
+    <td width="15">&nbsp;</td>
+    <td>&#149; <a 
+href="/cgi-bin/admin/imageclean.pl">Cleanup images</a></td>
+  </tr>
+<tr> 
+    <td width="15">&nbsp;</td>
+    <td>&nbsp;</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>
index fe5bcd9..c2ae1a3 100644 (file)
@@ -26,6 +26,7 @@
 
 <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> 
index 7304d15..e9f72b5 100644 (file)
@@ -36,7 +36,7 @@
             <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 :> 
@@ -50,6 +50,7 @@
 </tr>
 </table>
 </form>
+<:if UserCan admin_user_add :>
 <h2>Add new user</h2>
 
 <form method="POST" action="<:script:>">
@@ -96,7 +97,7 @@
     </tr>
   </table>
 </form>
-  
+<:or UserCan:><:eif UserCan:>  
 <p><font size="-1">BSE Release <:release:></font></p>
 </body
 ></html>
index b8fed8e..d7272f1 100644 (file)
@@ -40,6 +40,10 @@ sub test_dbclass { $conf{dbclass} or die "No dbclass in test config" }
 
 sub test_sessionclass { $conf{sessionclass} or die "No sessionclass in config" }
 
+sub test_conffile {
+  return $conffile;
+}
+
 my $test_num = 1;
 
 sub ok ($$) {