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
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
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)
+);
[template descriptions]
common/default.tmpl=Default template
+[nightly work]
+bse_session_clean=1
+bse_audit_log_clean=1
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 {
--- /dev/null
+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;
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
--- /dev/null
+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;
--- /dev/null
+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;
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
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
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;
projects / bse.git / commitdiff