summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--FS/FS/AccessRight.pm1
-rw-r--r--FS/FS/Conf.pm9
-rw-r--r--FS/FS/Cron/bill.pm6
-rw-r--r--FS/FS/Cron/upload.pm16
-rw-r--r--FS/FS/Log.pm103
-rw-r--r--FS/FS/Log/Output.pm50
-rw-r--r--FS/FS/Mason.pm3
-rw-r--r--FS/FS/Schema.pm27
-rw-r--r--FS/FS/cust_main/Billing.pm5
-rw-r--r--FS/FS/log.pm354
-rw-r--r--FS/FS/log_context.pm145
-rw-r--r--FS/MANIFEST4
-rwxr-xr-xFS/bin/freeside-daily5
-rw-r--r--FS/bin/freeside-queued6
-rw-r--r--FS/t/log.t5
-rw-r--r--FS/t/log_context.t5
-rw-r--r--httemplate/elements/menu.html12
-rw-r--r--httemplate/search/elements/search-html.html18
-rw-r--r--httemplate/search/log.html221
19 files changed, 991 insertions, 4 deletions
diff --git a/FS/FS/AccessRight.pm b/FS/FS/AccessRight.pm
index b38c267..66624e1 100644
--- a/FS/FS/AccessRight.pm
+++ b/FS/FS/AccessRight.pm
@@ -277,6 +277,7 @@ tie my %rights, 'Tie::IxHash',
'Financial reports',
{ rightname=> 'List inventory', global=>1 },
{ rightname=>'View email logs', global=>1 },
+ { rightname=>'View system logs' },
'Download report data',
'Services: Accounts',
diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm
index 0aafd25..d11916f 100644
--- a/FS/FS/Conf.pm
+++ b/FS/FS/Conf.pm
@@ -749,6 +749,15 @@ sub reason_type_options {
},
{
+ 'key' => 'event_log_level',
+ 'section' => 'notification',
+ 'description' => 'Store events in the internal log if they are at least this severe. "info" is the default, "debug" is very detailed and noisy.',
+ 'type' => 'select',
+ 'select_enum' => [ '', 'debug', 'info', 'notice', 'warning', 'error', ],
+ # don't bother with higher levels
+ },
+
+ {
'key' => 'log_sent_mail',
'section' => 'notification',
'description' => 'Enable logging of template-generated email.',
diff --git a/FS/FS/Cron/bill.pm b/FS/FS/Cron/bill.pm
index a9df376..6e110e8 100644
--- a/FS/FS/Cron/bill.pm
+++ b/FS/FS/Cron/bill.pm
@@ -13,6 +13,8 @@ use FS::cust_main;
use FS::part_event;
use FS::part_event_condition;
+use FS::Log;
+
@ISA = qw( Exporter );
@EXPORT_OK = qw ( bill bill_where );
@@ -27,6 +29,9 @@ use FS::part_event_condition;
sub bill {
my %opt = @_;
+ my $log = FS::Log->new('Cron::bill');
+ $log->info('start');
+
my $check_freq = $opt{'check_freq'} || '1d';
my $debug = 0;
@@ -134,6 +139,7 @@ sub bill {
$cursor_dbh->commit or die $cursor_dbh->errstr;
+ $log->info('finish');
}
# freeside-daily %opt:
diff --git a/FS/FS/Cron/upload.pm b/FS/FS/Cron/upload.pm
index ccf8e1a..628c680 100644
--- a/FS/FS/Cron/upload.pm
+++ b/FS/FS/Cron/upload.pm
@@ -9,6 +9,7 @@ use FS::Record qw( qsearch qsearchs );
use FS::Conf;
use FS::queue;
use FS::agent;
+use FS::Log;
use FS::Misc qw( send_email ); #for bridgestone
use FS::upload_target;
use LWP::UserAgent;
@@ -33,6 +34,8 @@ $me = '[FS::Cron::upload]';
sub upload {
my %opt = @_;
+ my $log = FS::Log->new('Cron::upload');
+ $log->info('start');
my $debug = 0;
$debug = 1 if $opt{'v'};
@@ -96,7 +99,10 @@ sub upload {
} # foreach @agents
# if there's nothing to do, don't hold up the rest of the process
- return '' if !@tasks;
+ if (!@tasks) {
+ $log->info('finish (nothing to upload)');
+ return '';
+ }
# wait for any ongoing billing jobs to complete
if ($opt{m}) {
@@ -142,11 +148,13 @@ sub upload {
}
}
+ $log->info('finish');
}
sub spool_upload {
my %opt = @_;
+ my $log = FS::Log->new('spool_upload');
warn "$me spool_upload called\n" if $DEBUG;
my $conf = new FS::Conf;
@@ -166,6 +174,7 @@ sub spool_upload {
my $dbh = dbh;
my $agentnum = $opt{agentnum};
+ $log->debug('start', agentnum => $agentnum);
my $agent;
if ( $agentnum ) {
@@ -184,6 +193,8 @@ sub spool_upload {
{
warn "$me neither $dir/$file-header.csv nor ".
"$dir/$file-detail.csv found\n" if $DEBUG > 1;
+ $log->debug("finish (neither $file-header.csv nor ".
+ "$file-detail.csv found)");
$dbh->commit or die $dbh->errstr if $oldAutoCommit;
return;
}
@@ -263,6 +274,7 @@ sub spool_upload {
unless ( -f "$dir/$file.csv" ) {
warn "$me $dir/$file.csv not found\n" if $DEBUG > 1;
+ $log->debug("finish ($dir/$file.csv not found)");
$dbh->commit or die $dbh->errstr if $oldAutoCommit;
return;
}
@@ -451,6 +463,8 @@ sub spool_upload {
} #opt{handling}
+ $log->debug('finish', agentnum => $agentnum);
+
$dbh->commit or die $dbh->errstr if $oldAutoCommit;
'';
diff --git a/FS/FS/Log.pm b/FS/FS/Log.pm
new file mode 100644
index 0000000..b11630b
--- /dev/null
+++ b/FS/FS/Log.pm
@@ -0,0 +1,103 @@
+package FS::Log;
+
+use base 'Log::Dispatch';
+use FS::Record qw(qsearch qsearchs);
+use FS::Conf;
+use FS::Log::Output;
+use FS::log;
+use vars qw(@STACK @LEVELS);
+
+# override the stringification of @_ with something more sensible.
+BEGIN {
+ @LEVELS = qw(debug info notice warning error critical alert emergency);
+
+ foreach my $l (@LEVELS) {
+ my $sub = sub {
+ my $self = shift;
+ $self->log( level => $l, message => @_ );
+ };
+ no strict 'refs';
+ *{$l} = $sub;
+ }
+}
+
+=head1 NAME
+
+FS::Log - Freeside event log
+
+=head1 SYNOPSIS
+
+use FS::Log;
+
+sub do_something {
+ my $log = FS::Log->new('do_something'); # set log context to 'do_something'
+
+ ...
+ if ( $error ) {
+ $log->error('something is wrong: '.$error);
+ return $error;
+ }
+ # at this scope exit, do_something is removed from context
+}
+
+=head1 DESCRIPTION
+
+FS::Log provides an interface for logging errors and profiling information
+to the database. FS::Log inherits from L<Log::Dispatch>.
+
+=head1 CLASS METHODS
+
+=over 4
+
+new CONTEXT
+
+Constructs and returns a log handle. CONTEXT must be a known context tag
+indicating what activity is going on, such as the name of the function or
+script that is executing.
+
+Log context is a stack, and each element is removed from the stack when it
+goes out of scope. So don't keep log handles in persistent places (i.e.
+package variables or class-scoped lexicals).
+
+=cut
+
+sub new {
+ my $class = shift;
+ my $context = shift;
+
+ my $min_level = FS::Conf->new->config('event_log_level') || 'info';
+
+ my $self = $class->SUPER::new(
+ outputs => [ [ '+FS::Log::Output', min_level => $min_level ] ],
+ );
+ $self->{'index'} = scalar(@STACK);
+ push @STACK, $context;
+ return $self;
+}
+
+=item context
+
+Returns the current context stack.
+
+=cut
+
+sub context { @STACK };
+
+=item log LEVEL, MESSAGE[, OPTIONS ]
+
+Like L<Log::Dispatch::log>, but OPTIONS may include:
+
+- agentnum
+- object (an <FS::Record> object to reference in this log message)
+- tablename and tablenum (an alternate way of specifying 'object')
+
+=cut
+
+# inherited
+
+sub DESTROY {
+ my $self = shift;
+ splice(@STACK, $self->{'index'}, 1); # delete the stack entry
+}
+
+1;
diff --git a/FS/FS/Log/Output.pm b/FS/FS/Log/Output.pm
new file mode 100644
index 0000000..18d7f1b
--- /dev/null
+++ b/FS/FS/Log/Output.pm
@@ -0,0 +1,50 @@
+package FS::Log::Output;
+
+use base Log::Dispatch::Output;
+use FS::Record qw( dbdef );
+
+sub new { # exactly by the book
+ my $proto = shift;
+ my $class = ref $proto || $proto;
+
+ my %p = @_;
+
+ my $self = bless {}, $class;
+
+ $self->_basic_init(%p);
+
+ return $self;
+}
+
+sub log_message {
+ my $self = shift;
+ my %m = @_;
+
+ my $object = $m{'object'};
+ my ($tablename, $tablenum) = @m{'tablename', 'tablenum'};
+ if ( $object and $object->isa('FS::Record') ) {
+ $tablename = $object->table;
+ $tablenum = $object->get( dbdef->table($tablename)->primary_key );
+
+ # get the agentnum from the object if it has one
+ $m{'agentnum'} ||= $object->get('agentnum');
+ # maybe FS::cust_main_Mixin objects should use the customer's agentnum?
+ # I'm trying not to do database lookups in here, though.
+ }
+
+ my $entry = FS::log->new({
+ _date => time,
+ agentnum => $m{'agentnum'},
+ tablename => ($tablename || ''),
+ tablenum => ($tablenum || ''),
+ level => $self->_level_as_number($m{'level'}),
+ message => $m{'message'},
+ });
+ my $error = $entry->insert( FS::Log->context );
+ if ( $error ) {
+ # guh?
+ warn "Error writing log entry: $error";
+ }
+}
+
+1;
diff --git a/FS/FS/Mason.pm b/FS/FS/Mason.pm
index 4b1f800..2bc1596 100644
--- a/FS/FS/Mason.pm
+++ b/FS/FS/Mason.pm
@@ -56,6 +56,7 @@ if ( -e $addl_handler_use_file ) {
#use CGI::Carp qw(fatalsToBrowser);
use CGI::Cookie;
use List::Util qw( max min sum );
+ use List::MoreUtils qw( first_index uniq );
use Scalar::Util qw( blessed );
use Data::Dumper;
use Date::Format;
@@ -329,6 +330,8 @@ if ( -e $addl_handler_use_file ) {
use FS::agent_pkg_class;
use FS::svc_export_machine;
use FS::GeocodeCache;
+ use FS::log;
+ use FS::log_context;
# Sammath Naur
if ( $FS::Mason::addl_handler_use ) {
diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm
index 9eb59a0..172ac82 100644
--- a/FS/FS/Schema.pm
+++ b/FS/FS/Schema.pm
@@ -191,6 +191,7 @@ sub dbdef_dist {
foreach my $table (
grep { ! /^clientapi_session/
&& ! /^h_/
+ && ! /^log(_context)?$/
&& ! $tables_hashref_torrus->{$_}
}
$dbdef->tables
@@ -3972,6 +3973,32 @@ sub tables_hashref {
'index' => [],
},
+ 'log' => {
+ 'columns' => [
+ 'lognum', 'serial', '', '', '', '',
+ '_date', 'int', '', '', '', '',
+ 'agentnum', 'int', 'NULL', '', '', '',
+ 'tablename', 'varchar', 'NULL', $char_d, '', '',
+ 'tablenum', 'int', 'NULL', '', '', '',
+ 'level', 'int', '', '', '', '',
+ 'message', 'text', '', '', '', '',
+ ],
+ 'primary_key' => 'lognum',
+ 'unique' => [],
+ 'index' => [ ['_date'], ['level'] ],
+ },
+
+ 'log_context' => {
+ 'columns' => [
+ 'logcontextnum', 'serial', '', '', '', '',
+ 'lognum', 'int', '', '', '', '',
+ 'context', 'varchar', '', 32, '', '',
+ ],
+ 'primary_key' => 'logcontextnum',
+ 'unique' => [ [ 'lognum', 'context' ] ],
+ 'index' => [],
+ },
+
%{ tables_hashref_torrus() },
# tables of ours for doing torrus virtual port combining
diff --git a/FS/FS/cust_main/Billing.pm b/FS/FS/cust_main/Billing.pm
index 11247a2..3dc8f9c 100644
--- a/FS/FS/cust_main/Billing.pm
+++ b/FS/FS/cust_main/Billing.pm
@@ -21,6 +21,7 @@ use FS::cust_bill_pkg_tax_rate_location;
use FS::part_event;
use FS::part_event_condition;
use FS::pkg_category;
+use FS::Log;
# 1 is mostly method/subroutine entry and options
# 2 traces progress of some operations
@@ -104,6 +105,9 @@ options of those methods are also available.
sub bill_and_collect {
my( $self, %options ) = @_;
+ my $log = FS::Log->new('bill_and_collect');
+ $log->debug('start', object => $self, agentnum => $self->agentnum);
+
my $error;
#$options{actual_time} not $options{time} because freeside-daily -d is for
@@ -168,6 +172,7 @@ sub bill_and_collect {
}
}
$job->update_statustext('100,finished') if $job;
+ $log->debug('finish', object => $self, agentnum => $self->agentnum);
'';
diff --git a/FS/FS/log.pm b/FS/FS/log.pm
new file mode 100644
index 0000000..a4ad214
--- /dev/null
+++ b/FS/FS/log.pm
@@ -0,0 +1,354 @@
+package FS::log;
+
+use strict;
+use base qw( FS::Record );
+use FS::Record qw( qsearch qsearchs dbdef );
+use FS::UID qw( dbh driver_name );
+use FS::log_context;
+
+=head1 NAME
+
+FS::log - Object methods for log records
+
+=head1 SYNOPSIS
+
+ use FS::log;
+
+ $record = new FS::log \%hash;
+ $record = new FS::log { 'column' => 'value' };
+
+ $error = $record->insert;
+
+ $error = $new_record->replace($old_record);
+
+ $error = $record->delete;
+
+ $error = $record->check;
+
+=head1 DESCRIPTION
+
+An FS::log object represents a log entry. FS::log inherits from
+FS::Record. The following fields are currently supported:
+
+=over 4
+
+=item lognum - primary key
+
+=item _date - Unix timestamp
+
+=item agentnum - L<FS::agent> to which the log pertains. If it involves a
+specific customer, package, service, invoice, or other agent-specific object,
+this will be set to that agentnum.
+
+=item tablename - table name to which the log pertains, if any.
+
+=item tablenum - foreign key to that table.
+
+=item level - log level: 'debug', 'info', 'notice', 'warning', 'error',
+'critical', 'alert', 'emergency'.
+
+=item message - contents of the log entry
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item new HASHREF
+
+Creates a new log entry. Use FS::Log instead of calling this directly,
+please.
+
+=cut
+
+sub table { 'log'; }
+
+=item insert [ CONTEXT... ]
+
+Adds this record to the database. If there is an error, returns the error,
+otherwise returns false.
+
+CONTEXT may be a list of context tags to attach to this record.
+
+=cut
+
+sub insert {
+ # not using process_o2m for this, because we don't have a web interface
+ my $self = shift;
+ my $error = $self->SUPER::insert;
+ return $error if $error;
+ foreach ( @_ ) {
+ my $context = FS::log_context->new({
+ 'lognum' => $self->lognum,
+ 'context' => $_
+ });
+ $error = $context->insert;
+ return $error if $error;
+ }
+ '';
+}
+
+# the insert method can be inherited from FS::Record
+
+sub delete { die "Log entries can't be modified." };
+
+sub replace { die "Log entries can't be modified." };
+
+=item check
+
+Checks all fields to make sure this is a valid example. If there is
+an error, returns the error, otherwise returns false. Called by the insert
+and replace methods.
+
+=cut
+
+sub check {
+ my $self = shift;
+
+ my $error =
+ $self->ut_numbern('lognum')
+ || $self->ut_number('_date')
+ || $self->ut_numbern('agentnum')
+ || $self->ut_foreign_keyn('agentnum', 'agent', 'agentnum')
+ || $self->ut_textn('tablename')
+ || $self->ut_numbern('tablenum')
+ || $self->ut_number('level')
+ || $self->ut_text('message')
+ ;
+ return $error if $error;
+
+ if ( my $tablename = $self->tablename ) {
+ my $dbdef_table = dbdef->table($tablename)
+ or return "tablename '$tablename' does not exist";
+ $error = $self->ut_foreign_key('tablenum',
+ $tablename,
+ $dbdef_table->primary_key);
+ return $error if $error;
+ }
+
+ $self->SUPER::check;
+}
+
+=item context
+
+Returns the context for this log entry, as an array, from least to most
+specific.
+
+=cut
+
+sub context {
+ my $self = shift;
+ map { $_->context } qsearch({
+ table => 'log_context',
+ hashref => { lognum => $self->lognum },
+ order_by => 'ORDER BY logcontextnum ASC',
+ });
+}
+
+=back
+
+=head1 CLASS METHODS
+
+=over 4
+
+=item search HASHREF
+
+Returns a qsearch hash expression to search for parameters specified in
+HASHREF. Valid parameters are:
+
+=over 4
+
+=item agentnum
+
+=item date - arrayref of start and end date
+
+=item level - either a specific level, or an arrayref of min and max level
+
+=item context - a context string that the log entry must have. This may
+change in the future to allow searching for combinations of context strings.
+
+=item object - any database object, to find log entries related to it.
+
+=item tablename, tablenum - alternate way of specifying 'object'.
+
+=item custnum - a customer number, to find log entries related to the customer
+or any of their subordinate objects (invoices, packages, etc.).
+
+=item message - a text string to search in messages. The search will be
+a case-insensitive LIKE with % appended at both ends.
+
+=back
+
+=cut
+
+# used for custnum search: all tables with custnums
+my @table_stubs;
+
+sub _setup_table_stubs {
+ foreach my $table (
+ qw(
+ contact
+ cust_attachment
+ cust_bill
+ cust_credit
+ cust_location
+ cust_main
+ cust_main_exemption
+ cust_main_note
+ cust_msg
+ cust_pay
+ cust_pay_batch
+ cust_pay_pending
+ cust_pay_void
+ cust_pkg
+ cust_refund
+ cust_statement
+ cust_tag
+ cust_tax_adjustment
+ cust_tax_exempt
+ did_order_item
+ qual
+ queue ) )
+ {
+ my $pkey = dbdef->table($table)->primary_key;
+ push @table_stubs,
+ "log.tablename = '$table' AND ".
+ "EXISTS(SELECT 1 FROM $table WHERE log.tablenum = $table.$pkey AND ".
+ "$table.custnum = "; # needs a closing )
+ }
+ # plus this case
+ push @table_stubs,
+ "(log.tablename LIKE 'svc_%' OR log.tablename = 'cust_svc') AND ".
+ "EXISTS(SELECT 1 FROM cust_svc JOIN cust_pkg USING (svcnum) WHERE ".
+ "cust_pkg.custnum = "; # needs a closing )
+}
+
+sub search {
+ my ($class, $params) = @_;
+ my @where;
+
+ ##
+ # parse agent
+ ##
+
+ if ( $params->{'agentnum'} =~ /^(\d+)$/ ) {
+ push @where,
+ "log.agentnum = $1";
+ }
+
+ ##
+ # parse custnum
+ ##
+
+ if ( $params->{'custnum'} =~ /^(\d+)$/ ) {
+ _setup_table_stubs() unless @table_stubs;
+ my $custnum = $1;
+ my @orwhere = map { "( $_ $custnum) )" } @table_stubs;
+ push @where, join(' OR ', @orwhere);
+ }
+
+ ##
+ # parse level
+ ##
+
+ if ( ref $params->{'level'} eq 'ARRAY' ) {
+ my ($min, $max) = @{ $params->{'level'} };
+ if ( $min =~ /^\d+$/ ) {
+ push @where, "log.level >= $min";
+ }
+ if ( $max =~ /^\d+$/ ) {
+ push @where, "log.level <= $max";
+ }
+ } elsif ( $params->{'level'} =~ /^(\d+)$/ ) {
+ push @where, "log.level = $1";
+ }
+
+ ##
+ # parse date
+ ##
+
+ if ( ref $params->{'date'} eq 'ARRAY' ) {
+ my ($beg, $end) = @{ $params->{'date'} };
+ if ( $beg =~ /^\d+$/ ) {
+ push @where, "log._date >= $beg";
+ }
+ if ( $end =~ /^\d+$/ ) {
+ push @where, "log._date <= $end";
+ }
+ }
+
+ ##
+ # parse object
+ ##
+
+ if ( $params->{'object'} and $params->{'object'}->isa('FS::Record') ) {
+ my $table = $params->{'object'}->table;
+ my $pkey = dbdef->table($table)->primary_key;
+ my $tablenum = $params->{'object'}->get($pkey);
+ if ( $table and $tablenum ) {
+ push @where, "log.tablename = '$table'", "log.tablenum = $tablenum";
+ }
+ } elsif ( $params->{'tablename'} =~ /^(\w+)$/ ) {
+ my $table = $1;
+ if ( $params->{'tablenum'} =~ /^(\d+)$/ ) {
+ push @where, "log.tablename = '$table'", "log.tablenum = $1";
+ }
+ }
+
+ ##
+ # parse message
+ ##
+
+ if ( $params->{'message'} ) { # can be anything, really, so escape it
+ my $quoted_message = dbh->quote('%' . $params->{'message'} . '%');
+ my $op = (driver_name eq 'Pg' ? 'ILIKE' : 'LIKE');
+ push @where, "log.message $op $quoted_message";
+ }
+
+ ##
+ # parse context
+ ##
+
+ if ( $params->{'context'} ) {
+ my $quoted = dbh->quote($params->{'context'});
+ push @where,
+ "EXISTS(SELECT 1 FROM log_context WHERE log.lognum = log_context.lognum ".
+ "AND log_context.context = $quoted)";
+ }
+
+ # agent virtualization
+ my $access_user = $FS::CurrentUser::CurrentUser;
+ push @where, $access_user->agentnums_sql(
+ table => 'log',
+ viewall_right => 'Configuration',
+ null => 1,
+ );
+
+ # put it together
+ my $extra_sql = '';
+ $extra_sql .= 'WHERE ' . join(' AND ', @where) if @where;
+ my $count_query = 'SELECT COUNT(*) FROM log '.$extra_sql;
+ my $sql_query = {
+ 'table' => 'log',
+ 'hashref' => {},
+ 'select' => 'log.*',
+ 'extra_sql' => $extra_sql,
+ 'count_query' => $count_query,
+ 'order_by' => 'ORDER BY _date ASC',
+ #addl_from, not needed
+ };
+}
+
+=back
+
+=head1 BUGS
+
+=head1 SEE ALSO
+
+L<FS::Record>, schema.html from the base documentation.
+
+=cut
+
+1;
+
diff --git a/FS/FS/log_context.pm b/FS/FS/log_context.pm
new file mode 100644
index 0000000..372bdaa
--- /dev/null
+++ b/FS/FS/log_context.pm
@@ -0,0 +1,145 @@
+package FS::log_context;
+
+use strict;
+use base qw( FS::Record );
+use FS::Record qw( qsearch qsearchs );
+
+my @contexts = ( qw(
+ test
+ bill_and_collect
+ Cron::bill
+ Cron::upload
+ spool_upload
+ daily
+ queue
+) );
+
+=head1 NAME
+
+FS::log_context - Object methods for log_context records
+
+=head1 SYNOPSIS
+
+ use FS::log_context;
+
+ $record = new FS::log_context \%hash;
+ $record = new FS::log_context { 'column' => 'value' };
+
+ $error = $record->insert;
+
+ $error = $new_record->replace($old_record);
+
+ $error = $record->delete;
+
+ $error = $record->check;
+
+=head1 DESCRIPTION
+
+An FS::log_context object represents a context tag attached to a log entry
+(L<FS::log>). FS::log_context inherits from FS::Record. The following
+fields are currently supported:
+
+=over 4
+
+=item logcontextnum - primary key
+
+=item lognum - lognum (L<FS::log> foreign key)
+
+=item context - context
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item new HASHREF
+
+Creates a new context tag. To add the example to the database, see
+L<"insert">.
+
+Note that this stores the hash reference, not a distinct copy of the hash it
+points to. You can ask the object for a copy with the I<hash> method.
+
+=cut
+
+# the new method can be inherited from FS::Record, if a table method is defined
+
+sub table { 'log_context'; }
+
+=item insert
+
+Adds this record to the database. If there is an error, returns the error,
+otherwise returns false.
+
+=cut
+
+# the insert method can be inherited from FS::Record
+
+=item delete
+
+Delete this record from the database.
+
+=cut
+
+# the delete method can be inherited from FS::Record
+
+=item replace OLD_RECORD
+
+Replaces the OLD_RECORD with this one in the database. If there is an error,
+returns the error, otherwise returns false.
+
+=cut
+
+# the replace method can be inherited from FS::Record
+
+=item check
+
+Checks all fields to make sure this is a valid example. If there is
+an error, returns the error, otherwise returns false. Called by the insert
+and replace methods.
+
+=cut
+
+# the check method should currently be supplied - FS::Record contains some
+# data checking routines
+
+sub check {
+ my $self = shift;
+
+ my $error =
+ $self->ut_numbern('logcontextnum')
+ || $self->ut_number('lognum')
+ || $self->ut_enum('context', \@contexts)
+ ;
+ return $error if $error;
+
+ $self->SUPER::check;
+}
+
+=back
+
+=head1 CLASS METHODS
+
+=over 4
+
+=item contexts
+
+Returns a list of all valid contexts.
+
+=cut
+
+sub contexts { @contexts }
+
+=back
+
+=head1 BUGS
+
+=head1 SEE ALSO
+
+L<FS::Log>, L<FS::Record>, schema.html from the base documentation.
+
+=cut
+
+1;
+
diff --git a/FS/MANIFEST b/FS/MANIFEST
index 9c444be..f954fe8 100644
--- a/FS/MANIFEST
+++ b/FS/MANIFEST
@@ -675,3 +675,7 @@ FS/svc_export_machine.pm
t/svc_export_machine.t
FS/GeocodeCache.pm
t/GeocodeCache.t
+FS/log.pm
+t/log.t
+FS/log_context.pm
+t/log_context.t
diff --git a/FS/bin/freeside-daily b/FS/bin/freeside-daily
index 8e8ae4f..65e3ebd 100755
--- a/FS/bin/freeside-daily
+++ b/FS/bin/freeside-daily
@@ -4,6 +4,7 @@ use strict;
use Getopt::Std;
use FS::UID qw(adminsuidsetup);
use FS::Conf;
+use FS::Log;
&untaint_argv; #what it sounds like (eww)
use vars qw(%opt);
@@ -11,6 +12,8 @@ getopts("p:a:d:vl:sy:nmrkg:o", \%opt);
my $user = shift or die &usage;
adminsuidsetup $user;
+my $log = FS::Log->new('daily');
+$log->info('start');
#you can skip this by not having a NetworkMonitoringSystem configured
use FS::Cron::nms_report qw(nms_report);
@@ -74,6 +77,8 @@ unlink <${deldir}.CGItemp*>;
use FS::Cron::backup qw(backup);
backup();
+$log->info('finish');
+
###
# subroutines
###
diff --git a/FS/bin/freeside-queued b/FS/bin/freeside-queued
index f136c39..2fd8025 100644
--- a/FS/bin/freeside-queued
+++ b/FS/bin/freeside-queued
@@ -11,6 +11,7 @@ use FS::Conf;
use FS::Record qw(qsearch);
use FS::queue;
use FS::queue_depend;
+use FS::Log;
# no autoloading for non-FS classes...
use Net::SSH 0.07;
@@ -45,6 +46,7 @@ while ( $@ ) {
}
}
+my $log = FS::Log->new('queue');
logfile( "%%%FREESIDE_LOG%%%/queuelog.". $FS::UID::datasrc );
warn "completing daemonization (detaching))\n" if $DEBUG;
@@ -135,6 +137,8 @@ while (1) {
foreach my $job ( @jobs ) {
+ $log->debug('locking queue job', object => $job);
+
my %hash = $job->hash;
$hash{'status'} = 'locked';
my $ljob = new FS::queue ( \%hash );
@@ -205,6 +209,8 @@ while (1) {
}
my $eval = "&". $ljob->job. '(@args);';
+ # don't put @args in the log, may expose passwords
+ $log->info('starting job ('.$ljob->job.')');
warn 'running "&'. $ljob->job. '('. join(', ', @args). ")\n" if $DEBUG;
eval $eval; #throw away return value? suppose so
if ( $@ ) {
diff --git a/FS/t/log.t b/FS/t/log.t
new file mode 100644
index 0000000..42c604b
--- /dev/null
+++ b/FS/t/log.t
@@ -0,0 +1,5 @@
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::log;
+$loaded=1;
+print "ok 1\n";
diff --git a/FS/t/log_context.t b/FS/t/log_context.t
new file mode 100644
index 0000000..57c3b34
--- /dev/null
+++ b/FS/t/log_context.t
@@ -0,0 +1,5 @@
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::log_context;
+$loaded=1;
+print "ok 1\n";
diff --git a/httemplate/elements/menu.html b/httemplate/elements/menu.html
index bfbc179..66e8bf6 100644
--- a/httemplate/elements/menu.html
+++ b/httemplate/elements/menu.html
@@ -346,6 +346,14 @@ if($curuser->access_right('Financial reports')) {
} # else $report_financial contains nothing.
+tie my %report_logs, 'Tie::IxHash';
+ $report_logs{'System log'} = [ $fsurl.'search/log.html', 'View system events and debugging information.' ],
+ if $curuser->access_right('View system logs')
+ || $curuser->access_right('Configuration');
+ $report_logs{'Outgoing messages'} = [ $fsurl.'search/cust_msg.html', 'View outgoing message log' ]
+ if $curuser->access_right('View email logs')
+ || $curuser->access_right('Configuration');
+
tie my %report_menu, 'Tie::IxHash';
$report_menu{'Prospects'} = [ \%report_prospects, 'Prospect reports' ]
if $curuser->access_right('List prospects');
@@ -375,6 +383,8 @@ $report_menu{'Billing events'} = [ \%report_bill_event, 'Billing events' ]
$report_menu{'Financial'} = [ \%report_financial, 'Financial reports' ]
if $curuser->access_right('Financial reports')
or $curuser->access_right('Receivables report');
+$report_menu{'Logs'} = [ \%report_logs, 'System and email logs' ]
+ if (keys %report_logs); # empty if the user has no rights to it
$report_menu{'SQL Query'} = [ $fsurl.'search/report_sql.html', 'SQL Query' ]
if $curuser->access_right('Raw SQL');
@@ -440,8 +450,6 @@ $tools_menu{'Time Queue'} = [ $fsurl.'search/report_timeworked.html', 'View pen
if $curuser->access_right('Time queue');
$tools_menu{'Attachments'} = [ $fsurl.'browse/cust_attachment.html', 'View customer attachments' ]
if !$conf->config('disable_cust_attachment') and $curuser->access_right('View attachments') and $curuser->access_right('Browse attachments');
-$tools_menu{'Outgoing messages'} = [ $fsurl.'search/cust_msg.html', 'View outgoing message log' ] #shouldn't this be in the reports menu?
- if $curuser->access_right('View email logs');
$tools_menu{'Importing'} = [ \%tools_importing, 'Import tools' ]
if $curuser->access_right('Import');
$tools_menu{'Exporting'} = [ \%tools_exporting, 'Export tools' ]
diff --git a/httemplate/search/elements/search-html.html b/httemplate/search/elements/search-html.html
index 5c8001f..7ccf356 100644
--- a/httemplate/search/elements/search-html.html
+++ b/httemplate/search/elements/search-html.html
@@ -259,6 +259,7 @@
%
% my $links = $opt{'links'} ? [ @{$opt{'links'}} ] : '';
% my $onclicks = $opt{'link_onclicks'} ? [ @{$opt{'link_onclicks'}} ] : [];
+% my $tooltips = $opt{'tooltips'} ? [ @{$opt{'tooltips'}} ] : [];
% my $aligns = $opt{'align'} ? [ @{$opt{'align'}} ] : '';
% my $colors = $opt{'color'} ? [ @{$opt{'color'}} ] : [];
% my $sizes = $opt{'size'} ? [ @{$opt{'size'}} ] : [];
@@ -360,6 +361,7 @@
% if ( $links ) {
% my $link = shift @$links;
% my $onclick = shift @$onclicks;
+% my $tooltip = shift @$tooltips;
%
% if ( ! $opt{'agent_virt'}
% || ( $null_link && ! $row->agentnum )
@@ -374,6 +376,14 @@
% if ref($onclick) eq 'CODE';
% $onclick = qq( onClick="$onclick") if $onclick;
%
+% $tooltip = &{$tooltip}($row)
+% if ref($tooltip) eq 'CODE';
+% $tooltip = qq! id="a$id" !.
+% qq! onmouseover="return overlib(!.
+% $m->interp->apply_escapes($tooltip, 'h', 'js_string').
+% qq!, FGCLASS, 'tooltip', REF, 'a$id', !.
+% qq!REFC, 'LL', REFP, 'UL')"! if $tooltip;
+%
% if ( $link ) {
% my( $url, $method ) = @{$link};
% if ( ref($method) eq 'CODE' ) {
@@ -381,11 +391,16 @@
% } else {
% $a = $url. $row->$method();
% }
-% $a = qq(<A HREF="$a"$onclick>);
+% $a = qq(<A HREF="$a"$onclick$tooltip>);
% }
% elsif ( $onclick ) {
% $a = qq(<A HREF="javascript:void(0);"$onclick>);
% }
+% elsif ( $tooltip ) {
+% $a = qq(<A $tooltip>);
+% }
+% $id++;
+
% }
%
% }
@@ -499,4 +514,5 @@ $count_sth->execute
my $count_arrayref = $count_sth->fetchrow_arrayref;
my $total = $count_arrayref->[0];
+my $id = 0;
</%init>
diff --git a/httemplate/search/log.html b/httemplate/search/log.html
new file mode 100644
index 0000000..d1bfb6c
--- /dev/null
+++ b/httemplate/search/log.html
@@ -0,0 +1,221 @@
+<& elements/search.html,
+ 'title' => 'System Log',
+ 'name_singular' => 'event',
+ 'html_init' => include('.head'),
+ 'query' => $query,
+ 'count_query' => $count_query,
+ 'header' => [ #'#', # lognum, probably not useful
+ 'Date',
+ 'Level',
+ 'Context',
+ 'Applies To',
+ 'Message',
+ ],
+ 'fields' => [ #'lognum',
+ $date_sub,
+ $level_sub,
+ $context_sub,
+ $object_sub,
+ $message_sub,
+ ],
+ 'sort_fields' => [
+ '_date',
+ 'level',
+ '',
+ 'tablename,tablenum',
+ 'message',
+ ],
+ 'links' => [
+ '', #date
+ '', #level
+ '', #context
+ $object_link_sub,
+ '', #message
+ ],
+ 'tooltips' => [
+ '', #date
+ '', #level
+ $tt_sub,
+ '', #object
+ $tt_sub,
+ ],
+ 'color' => [
+ $color_sub,
+ $color_sub,
+ '',
+ '',
+ '',
+ ],
+ # aligns
+ 'download_label' => 'Download this log',
+&>\
+<%def .head>
+<STYLE type="text/css">
+a:link {text-decoration: none}
+a:visited {text-decoration: none}
+.tooltip {
+ background-color: #ffffff;
+ font-size: 100%;
+ font-weight: bold;
+}
+</STYLE>
+<FORM ACTION="<%$p%>search/log.html" METHOD="GET">
+<TABLE CELLSPACING="10">
+<TR>
+ <TD>From
+ <& /elements/input-date-field.html, {
+ name => 'beginning',
+ value => $cgi->param('beginning'),
+ } &>
+ </TD>
+ <TD>To
+ <& /elements/input-date-field.html, {
+ name => 'ending',
+ value => $cgi->param('ending') || '',
+ noinit => 1,
+ } &>
+ </TD>
+</TR>
+<TR>
+ <TD>Level
+ <& /elements/select.html,
+ field => 'min_level',
+ options => [ 0..7 ],
+ labels => { map {$_ => $FS::Log::LEVELS[$_]} 0..7 },
+ curr_value => $cgi->param('min_level'),
+ &>
+ to
+ <& /elements/select.html,
+ field => 'max_level',
+ options => [ 0..7 ],
+ labels => { map {$_ => $FS::Log::LEVELS[$_]} 0..7 },
+ curr_value => $cgi->param('max_level'),
+ &>
+ </TD>
+ <TD>
+ Context
+ <& /elements/select.html,
+ field => 'context',
+ options => \@contexts,
+ labels => { map {$_, $_} @contexts },
+ curr_value => ($cgi->param('context') || ''),
+ &>
+ </TD>
+</TR>
+<TR>
+ <TD COLSPAN=2>
+ Containing text
+ <& /elements/input-text.html,
+ field => 'message',
+ size => 30,
+ size => 30,
+ curr_value => ($cgi->param('message') || ''),
+ &>
+ <DIV STYLE="display:inline; float:right">
+ <INPUT TYPE="submit" VALUE="Refresh">
+ </DIV>
+ </TD>
+</TR>
+</TABLE>
+</%def>
+<%once>
+my $date_sub = sub { time2str('%Y-%m-%d %T', $_[0]->_date) };
+
+my $level_sub = sub { $FS::Log::LEVELS[$_[0]->level] };
+
+my $context_sub = sub {
+ my $log = shift;
+ ($log->context)[-1] . (scalar($log->context) > 1 ? '...' : '') ;
+ # XXX find a way to make this use less space (dropdown?)
+};
+
+my $tt_sub = sub {
+ my $log = shift;
+ my @context = $log->context;
+ # don't create a tooltip if there's only one context entry and the
+ # message isn't cut off
+ return '' if @context == 1 and length($log->message) <= 60;
+ my $html = '<DIV CLASS="tooltip">'.(shift @context).'</DIV>';
+ my $pre = '&#8627;';
+ foreach (@context, $log->message) {
+ $html .= "<DIV>$pre$_</DIV>";
+ $pre = '&nbsp;&nbsp;&nbsp;'.$pre;
+ }
+ $html;
+};
+
+my $object_sub = sub {
+ my $log = shift;
+ return '' unless $log->tablename;
+ # this is a sysadmin log; anyone reading it should be able to understand
+ # 'cust_main #2319' with no trouble.
+ $log->tablename . ' #' . $log->tablenum;
+};
+
+my $message_sub = sub {
+ my $log = shift;
+ my $message = $log->message;
+ if ( length($message) > 60 ) { # pretty arbitrary
+ $message = substr($message, 0, 57) . '...';
+ }
+ $message;
+};
+
+my $object_link_sub = sub {
+ my $log = shift;
+ my $table = $log->tablename or return;
+ # sigh
+ if ( grep {$_ eq $table} (qw( cust_bill cust_main cust_pkg cust_svc ))
+ or $table =~ /^svc_/ )
+ {
+
+ return [ $fsurl.'view/'.$table.'.cgi?'. $log->tablenum ];
+
+ } elsif ( grep {$_ eq $table} (qw( cust_msg cust_pay cust_pay_void
+ cust_refund cust_statement )) )
+ {
+
+ return [ $fsurl.'view/'.$table.'.html?', $log->tablenum ];
+
+ } else { # you're on your own
+
+ return '';
+
+ }
+};
+
+my @colors = (
+ '404040', #debug
+ '0000aa', #info
+ '00aa00', #notice
+ 'aa0066', #warning
+ '000000', #error
+ 'aa0000', #critical
+ 'ff0000', #alert
+ 'ff0000', #emergency
+);
+
+my $color_sub = sub { $colors[ $_[0]->level ]; };
+
+my @contexts = ('', sort FS::log_context->contexts);
+</%once>
+<%init>
+my $curuser = $FS::CurrentUser::CurrentUser;
+die "access denied"
+ unless $curuser->access_right([ 'View system logs', 'Configuration' ]);
+
+$cgi->param('min_level', 0) unless defined($cgi->param('min_level'));
+$cgi->param('max_level', 7) unless defined($cgi->param('max_level'));
+
+my %search = ();
+$search{'date'} = [ FS::UI::Web::parse_beginning_ending($cgi) ];
+$search{'level'} = [ $cgi->param('min_level'), $cgi->param('max_level') ];
+foreach my $param (qw(agentnum context tablename tablenum custnum message)) {
+ if ( $cgi->param($param) ) {
+ $search{$param} = $cgi->param($param);
+ }
+}
+my $query = FS::log->search(\%search); # validates everything
+my $count_query = delete $query->{'count_query'};
+
+</%init>
generated by cgit v1.1 at 2024-06-14 16:07:17 +0000