From 913bd0405d6eb0db41b9944dfd42eb1f97d18ca9 Mon Sep 17 00:00:00 2001 From: Mark Wells Date: Tue, 11 Dec 2012 14:38:07 -0800 Subject: system log, #18333 --- FS/FS/AccessRight.pm | 1 + FS/FS/Conf.pm | 9 ++ FS/FS/Cron/bill.pm | 6 + FS/FS/Cron/upload.pm | 16 +- FS/FS/Log.pm | 103 +++++++++++++ FS/FS/Log/Output.pm | 50 +++++++ FS/FS/Mason.pm | 3 + FS/FS/Schema.pm | 27 ++++ FS/FS/cust_main/Billing.pm | 5 + FS/FS/log.pm | 354 +++++++++++++++++++++++++++++++++++++++++++++ FS/FS/log_context.pm | 145 +++++++++++++++++++ FS/MANIFEST | 4 + FS/bin/freeside-daily | 5 + FS/bin/freeside-queued | 6 + FS/t/log.t | 5 + FS/t/log_context.t | 5 + 16 files changed, 743 insertions(+), 1 deletion(-) create mode 100644 FS/FS/Log.pm create mode 100644 FS/FS/Log/Output.pm create mode 100644 FS/FS/log.pm create mode 100644 FS/FS/log_context.pm create mode 100644 FS/t/log.t create mode 100644 FS/t/log_context.t (limited to 'FS') 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. + +=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 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 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 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_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 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"; -- cgit v1.1