add an audit log to BSE (needed for paypal)
authorTony Cook <tony@develop-help.com>
Mon, 25 Oct 2010 00:49:39 +0000 (00:49 +0000)
committertony <tony@45cb6cf1-00bc-42d2-bb5a-07f51df49f94>
Mon, 25 Oct 2010 00:49:39 +0000 (00:49 +0000)
MANIFEST
schema/bse.sql
site/cgi-bin/bse.cfg
site/cgi-bin/modules/BSE/DB.pm
site/cgi-bin/modules/BSE/Jobs/AuditClean.pm [new file with mode: 0644]
site/cgi-bin/modules/BSE/Request/Base.pm
site/cgi-bin/modules/BSE/TB/AuditEntry.pm [new file with mode: 0644]
site/cgi-bin/modules/BSE/TB/AuditLog.pm [new file with mode: 0644]
site/data/db/bse_background_tasks.data
site/data/db/sql_statements.data
site/util/mysql.str

index dbc5a99..2afb764 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -109,6 +109,7 @@ site/cgi-bin/modules/BSE/ImportTargetProduct.pm
 site/cgi-bin/modules/BSE/Importer.pm
 site/cgi-bin/modules/BSE/Index/BSE.pm
 site/cgi-bin/modules/BSE/Index/Base.pm
+site/cgi-bin/modules/BSE/Jobs/AuditClean.pm
 site/cgi-bin/modules/BSE/Mail.pm
 site/cgi-bin/modules/BSE/Mail/SMTP.pm
 site/cgi-bin/modules/BSE/Mail/Sendmail.pm
@@ -161,6 +162,8 @@ site/cgi-bin/modules/BSE/TB/AdminUIState.pm
 site/cgi-bin/modules/BSE/TB/AdminUIStates.pm
 site/cgi-bin/modules/BSE/TB/AdminUser.pm
 site/cgi-bin/modules/BSE/TB/AdminUsers.pm
+site/cgi-bin/modules/BSE/TB/AuditEntry.pm
+site/cgi-bin/modules/BSE/TB/AuditLog.pm
 site/cgi-bin/modules/BSE/TB/ArticleFile.pm
 site/cgi-bin/modules/BSE/TB/ArticleFileMeta.pm
 site/cgi-bin/modules/BSE/TB/ArticleFileMetas.pm
index 7b33f11..53b5360 100644 (file)
@@ -1097,3 +1097,57 @@ create table bse_admin_ui_state (
   name varchar(80) not null,
   val text not null
 );
+
+drop table if exists bse_audit_log;
+create table bse_audit_log (
+  id integer not null auto_increment primary key,
+  when_at datetime not null,
+
+  -- bse for core BSE code, add on code supplies something different
+  facility varchar(20) not null default 'bse',
+
+  -- shop, search, editor, etc
+  component varchar(20) not null,
+
+  -- piece of component, paypal, index, etc
+  -- NOT a perl module name
+  module varchar(20) not null,
+
+  -- what the module what doing
+  function varchar(40) not null,
+
+  -- level of event: (stolen from syslog)
+  --  emerg - the system is broken
+  --  alert - something needing immediate action
+  --  crit - critical problem
+  --  error - error
+  --  warning - warning, something someone should look at
+  --  notice - notice, something significant happened, but not an error
+  --  info - informational
+  --  debug - debug
+  -- Stored as numbers from 0 to 7
+  level smallint not null,
+
+  -- actor
+  -- type of actor:
+  --  S - system
+  --  U - member
+  --  A - admin
+  actor_type char not null,
+  actor_id integer null,
+
+  -- object (if any)
+  object_type varchar(40) null,
+  object_id integer null,
+
+  ip_address varchar(20) not null,  
+
+  -- brief description
+  msg varchar(255) not null,
+
+  -- debug dump
+  dump longtext null,
+
+  index ba_when(when_at),
+  index ba_what(facility, component, module, function)
+);
index 16dae8c..0e9a48f 100644 (file)
@@ -453,3 +453,6 @@ flv=BSE::FileHandler::FLV
 [template descriptions]
 common/default.tmpl=Default template
 
+[nightly work]
+bse_session_clean=1
+bse_audit_log_clean=1
index 8495fbe..bdaae66 100644 (file)
@@ -116,8 +116,10 @@ sub run {
 
   my $sth = $self->stmt($name);
 
-  $sth->execute(@args)
+  my $result = $sth->execute(@args)
     or confess "Cannot execute statement $name: ",$sth->errstr;
+
+  return 0 + $result;
 }
 
 sub dbh {
diff --git a/site/cgi-bin/modules/BSE/Jobs/AuditClean.pm b/site/cgi-bin/modules/BSE/Jobs/AuditClean.pm
new file mode 100644 (file)
index 0000000..ed5c683
--- /dev/null
@@ -0,0 +1,11 @@
+package BSE::Jobs::AuditClean;
+use strict;
+use BSE::DB;
+
+sub run {
+  my $days = BSE::Cfg->single->entry("basic", "audit_log_age", 30);
+  my $count = BSE::DB->run(bseAuditLogClean => $days);
+  print "$count records removed\n";
+}
+
+1;
index b3277cd..b9f1d61 100644 (file)
@@ -1041,45 +1041,20 @@ sub csrf_error {
 
 Simple audit logging.
 
-We record:
+See BSE::TB::AuditLog.
 
-  object id, object describe result, action, siteuserid, ip address, date/time
-
-object and action are required.
+object, component, msg are required.
 
 =cut
 
 sub audit {
   my ($self, %opts) = @_;
 
-  my $object = delete $opts{object}
-    or confess "Missing object parameter";
-
-  my $action = delete $opts{action}
-    or confess "Missing action parameter";
-
-  # check all of these are callable
-  my $id = $object->id;
-  my $desc = $object->describe;
-
-  $self->cfg->entry("basic", "auditlog", 0)
-    or return; # no audit logging
+  require BSE::TB::AuditLog;
 
-  # assumed that check_admin_logon() has been done
-  my $admin = $self->user;
+  $opts{actor} ||= $self->user;
 
-  require BSE::Util::SQL;
-  require BSE::TB::AuditLog;
-  my %entry =
-    (
-     object_id => $id,
-     object_desc => $desc,
-     action => $action,
-     admin_id => $admin ? $admin->id : undef,
-     ip_address => $ENV{REMOTE_ADDR},
-     when_at => BSE::Util::SQL::now_datetime(),
-    );
-  BSE::TB::AuditLog->make(%entry);
+  return BSE::TB::AuditLog->log(%opts);
 }
 
 =item message_catalog
diff --git a/site/cgi-bin/modules/BSE/TB/AuditEntry.pm b/site/cgi-bin/modules/BSE/TB/AuditEntry.pm
new file mode 100644 (file)
index 0000000..4f3226f
--- /dev/null
@@ -0,0 +1,27 @@
+package BSE::TB::AuditEntry;
+use strict;
+use base qw(Squirrel::Row);
+
+sub columns {
+  return qw/id 
+            when_at
+           facility
+           component
+           module
+           function
+           level
+           actor_type
+           actor_id
+           object_type
+           object_id
+           ip_address
+           msg
+           dump
+          /;
+}
+
+sub table {
+  "bse_audit_log";
+}
+
+1;
diff --git a/site/cgi-bin/modules/BSE/TB/AuditLog.pm b/site/cgi-bin/modules/BSE/TB/AuditLog.pm
new file mode 100644 (file)
index 0000000..60f2ed8
--- /dev/null
@@ -0,0 +1,160 @@
+package BSE::TB::AuditLog;
+use strict;
+use Squirrel::Table;
+use vars qw(@ISA $VERSION);
+@ISA = qw(Squirrel::Table);
+use BSE::TB::AuditEntry;
+use Scalar::Util;
+
+sub rowClass {
+  return 'BSE::TB::AuditEntry';
+}
+
+=item log
+
+Log a message to the audit log.
+
+Required parameters:
+
+=over
+
+=item *
+
+component - either a simple component name like "shop", or colon
+separated component, module and function.
+
+=item *
+
+level - level of event, one of 
+
+=back
+
+=cut
+
+sub log {
+  my ($class, %opts) = @_;
+
+  my %entry =
+    (
+     when_at => BSE::Util::SQL::now_datetime(),
+    );
+
+  my $facility = delete $opts{facility} || "bse";
+  $entry{facility} = $facility;
+
+  my $component = delete $opts{component}
+    or $class->crash("Missing component");
+  if ($component =~ /^(\w+):(\w*):(.+)$/) {
+    @entry{qw/component module function/} = ( $1, $2, $3 );
+  }
+  else {
+    $entry{component} = $component;
+    $entry{module} = delete $opts{module} || '';
+    $entry{function} = delete $opts{function} || delete $opts{action}
+      or $class->crash("Missing function parameter")
+  }
+
+  my $object = delete $opts{object};
+  if ($object) {
+    $entry{object_type} = blessed $object;
+    $entry{object_id} = $object->id;
+  }
+  else {
+    $entry{object_type} = undef;
+    $entry{object_id} = undef;
+  }
+
+  $entry{ip_address} = delete $opts{ip_address} || $ENV{REMOTE_ADDR} || '';
+  my $level_name = delete $opts{level} || "emerg";
+  $entry{level} = _level_name_to_id($level_name);
+
+  my $actor = delete $opts{actor}
+    or $class->crash("No actor supplied");
+
+  if (ref $actor) {
+    if ($actor->isa("BSE::TB::AdminUser")) {
+      $entry{actor_type} = "A";
+    }
+    else {
+      $entry{actor_type} = "A";
+    }
+    $entry{actor_id} = $actor->id;
+  }
+  else {
+    if ($actor eq "S") {
+      $entry{actor_type} = "S";
+    }
+    else {
+      $entry{actor_type} = "U";
+    }
+    $entry{actor_id} = undef;
+  }
+
+  $entry{msg} = delete $opts{msg}
+    or $class->crash("No msg");
+  $entry{dump} = delete $opts{dump};
+
+  my $cfg = BSE::Cfg->single;
+
+  my $section = "audit log $facility";
+  unless ($cfg->entry
+         (
+          $section, join(":", @entry{qw/component module function/}),
+          $cfg->entry
+          (
+           $section, join(":", @entry{qw/component module/}),
+           $cfg->entry
+           (
+            $section, $entry{component}, 1
+           )
+          )
+         )
+        ) {
+    return;
+  }
+
+  require BSE::Util::SQL;
+  require BSE::TB::AuditLog;
+  BSE::TB::AuditLog->make(%entry);
+  keys %opts
+    and $class->crash("Unknown parameters ", join(",", keys %opts), " to log()");
+}
+
+sub crash {
+  my ($class, @msg) = @_;
+
+  @msg or push @msg, "Unknown";
+  my $longmsg = Carp::longmess(@msg);
+  $class->log
+    (
+     component => "unknown",
+     module => "unknown",
+     function => "unknown",
+     level => "crit",
+     actor => "S",
+     msg => join("", @msg) || "Unknown",
+     dump => $longmsg,
+    );
+  die $longmsg;
+}
+
+my @level_names = qw(emerg alert crit error warning notice info debug);
+my %level_name_to_id;
+@level_name_to_id{@level_names} = 0 .. $#level_names;
+my %level_id_to_name;
+@level_id_to_name{0 .. $#level_names} = @level_names;
+
+sub _level_name_to_id {
+  my ($name) = @_;
+
+  # default to 0 (emerg)
+  return $level_name_to_id{$name} || 0;
+}
+
+sub level_id_to_name {
+  my ($class, $id) = @_;
+
+  return $level_id_to_name{$id} || sprintf("unknown-%d", $id);
+}
+
+1;
index 0ac0289..3c28f18 100644 (file)
@@ -36,3 +36,14 @@ long_desc: <<TEXT
 Cleans up old entries from BSE's session table.
 TEXT
 
+id: bse_audit_log_clean
+description: Audit log clean up
+modname: BSE::Jobs::AuditClean
+long_desc: <<TEXT
+<p>Clean up entries from the BSE audit log older than the limit.</p>
+
+<p>The default limit is 30 days, but this can be set in bse.cfg:</p>
+<pre>[basic]
+audit_log_age=60
+</pre>
+TEXT
index 78d9ef9..a5bc8c2 100644 (file)
@@ -400,3 +400,9 @@ select exists(
     and forSale <> 0
   ) as "have_sale_files"
 SQL
+
+name: bseAuditLogClean
+sql_statement: <<SQL
+delete from bse_audit_log
+where when_at < date_sub(now(), interval ? day)
+SQL
index 6370717..453a315 100644 (file)
@@ -120,6 +120,24 @@ Table bse_article_groups
 Column article_id;int(11);NO;NULL;
 Column group_id;int(11);NO;NULL;
 Index PRIMARY;1;[article_id;group_id]
+Table bse_audit_log
+Column id;int(11);NO;NULL;auto_increment
+Column when_at;datetime;NO;NULL;
+Column facility;varchar(20);NO;bse;
+Column component;varchar(20);NO;NULL;
+Column module;varchar(20);NO;NULL;
+Column function;varchar(40);NO;NULL;
+Column level;smallint(6);NO;NULL;
+Column actor_type;char(1);NO;NULL;
+Column actor_id;int(11);YES;NULL;
+Column object_type;varchar(40);YES;NULL;
+Column object_id;int(11);YES;NULL;
+Column ip_address;varchar(20);NO;NULL;
+Column msg;varchar(255);NO;NULL;
+Column dump;longtext;YES;NULL;
+Index PRIMARY;1;[id]
+Index ba_what;0;[facility;component;module;function]
+Index ba_when;0;[when_at]
 Table bse_background_tasks
 Column id;varchar(20);NO;NULL;
 Column description;varchar(80);NO;NULL;