From: Mark Wells Date: Tue, 11 Dec 2012 22:38:07 +0000 (-0800) Subject: system log, #18333 X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=commitdiff_plain;h=913bd0405d6eb0db41b9944dfd42eb1f97d18ca9 system log, #18333 --- diff --git a/FS/FS/AccessRight.pm b/FS/FS/AccessRight.pm index b38c2671d..66624e179 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 0aafd2531..d11916faf 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 a9df376dc..6e110e852 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 ccf8e1a9a..628c6801b 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 000000000..b11630bc9 --- /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. + +=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, but OPTIONS may include: + +- agentnum +- object (an 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 000000000..18d7f1b43 --- /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 4b1f800b6..2bc1596f2 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 9eb59a09a..172ac8296 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 11247a28f..3dc8f9cad 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 000000000..a4ad214d0 --- /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 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, 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 000000000..372bdaa39 --- /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_context inherits from FS::Record. The following +fields are currently supported: + +=over 4 + +=item logcontextnum - primary key + +=item lognum - lognum (L 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 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, L, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/MANIFEST b/FS/MANIFEST index 9c444be58..f954fe8dd 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 8e8ae4ff9..65e3ebd97 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 f136c3910..2fd80255e 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 000000000..42c604b88 --- /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 000000000..57c3b340b --- /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 bfbc179b9..66e8bf669 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 5c8001fad..7ccf356ea 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 = qq(); % } % elsif ( $onclick ) { % $a = qq(); % } +% elsif ( $tooltip ) { +% $a = qq(); +% } +% $id++; + % } % % } @@ -499,4 +514,5 @@ $count_sth->execute my $count_arrayref = $count_sth->fetchrow_arrayref; my $total = $count_arrayref->[0]; +my $id = 0; diff --git a/httemplate/search/log.html b/httemplate/search/log.html new file mode 100644 index 000000000..d1bfb6cc9 --- /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> + +
+ + + + + + + + + + + + +
From + <& /elements/input-date-field.html, { + name => 'beginning', + value => $cgi->param('beginning'), + } &> + To + <& /elements/input-date-field.html, { + name => 'ending', + value => $cgi->param('ending') || '', + noinit => 1, + } &> +
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'), + &> + + Context + <& /elements/select.html, + field => 'context', + options => \@contexts, + labels => { map {$_, $_} @contexts }, + curr_value => ($cgi->param('context') || ''), + &> +
+ Containing text + <& /elements/input-text.html, + field => 'message', + size => 30, + size => 30, + curr_value => ($cgi->param('message') || ''), + &> +
+ +
+
+ +<%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 = '
'.(shift @context).'
'; + my $pre = '↳'; + foreach (@context, $log->message) { + $html .= "
$pre$_
"; + $pre = '   '.$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); + +<%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'}; + +