diff --git a/etc/RT_Config.pm.in b/etc/RT_Config.pm.in index 6b945a72ba5..31e31631686 100644 --- a/etc/RT_Config.pm.in +++ b/etc/RT_Config.pm.in @@ -378,6 +378,34 @@ See the L documentation for more information. Set(@LogToSyslogConf, ()); +=item C<$LogScripsForUser> + +Enables logging for each Scrip, and log output can then be found in the +Scrip Admin web interface. Log output is shown for the most recent run +of each scrip. + +Accepts a hashref with username and log level. Output is generated only +when that user performs an action that runs the scrip. Log levels are +the same as for other RT logging. For example: + + Set($LogScripsForUser, { 'Username1' => 'debug', 'Username2' => 'warning' }); + +This allows you to enable debug logging just for yourself as you test +a new scrip. + +If you have set the C option it needs to be writeable by the +webserver user for Scrip logging to work. + +NOTICE: The Ticket Update page that is used to add a Reply or Comment +will run all relevant Scrips in a dry run mode that executes the +Scrip Condition and Scrip Prepare code. This means log files might be +created just by loading the Ticket Update page if Scrip logging is +enabled. + +=cut + +Set($LogScripsForUser, {}); + =back @@ -3961,7 +3989,7 @@ Set(%AdminSearchResultFormat, Scrips => q{'__id__/TITLE:#'} .q{,'__Description__/TITLE:Description'} - .q{,__Condition__, __Action__, __Template__, __Disabled__}, + .q{,__Condition__, __Action__, __Template__, __Disabled__,__HasLogs__}, Templates => q{'__id__/TITLE:#'} diff --git a/lib/RT.pm b/lib/RT.pm index ea47927889b..39461eef13c 100644 --- a/lib/RT.pm +++ b/lib/RT.pm @@ -229,6 +229,24 @@ Create the Logger object and set up signal handlers. =cut +my $simple_cb = sub { + # if this code throw any warnings we can get segfault + no warnings; + my %p = @_; + + # skip Log::* stack frames + my $frame = 0; + $frame++ while caller($frame) && caller($frame) =~ /^Log::/; + my ($package, $filename, $line) = caller($frame); + + # Encode to bytes, so we don't send wide characters + $p{message} = Encode::encode("UTF-8", $p{message}); + + $p{'message'} =~ s/(?:\r*\n)+$//; + return "[$$] [". gmtime(time) ."] [". $p{'level'} ."]: " + . $p{'message'} ." ($filename:$line)\n"; +}; + sub InitLogging { # We have to set the record separator ($, man perlvar) @@ -266,24 +284,6 @@ sub InitLogging { $stack_from_level = 99; # don't log } - my $simple_cb = sub { - # if this code throw any warning we can get segfault - no warnings; - my %p = @_; - - # skip Log::* stack frames - my $frame = 0; - $frame++ while caller($frame) && caller($frame) =~ /^Log::/; - my ($package, $filename, $line) = caller($frame); - - # Encode to bytes, so we don't send wide characters - $p{message} = Encode::encode("UTF-8", $p{message}); - - $p{'message'} =~ s/(?:\r*\n)+$//; - return "[$$] [". gmtime(time) ."] [". $p{'level'} ."]: " - . $p{'message'} ." ($filename:$line)\n"; - }; - my $syslog_cb = sub { # if this code throw any warning we can get segfault no warnings; @@ -412,6 +412,114 @@ sub InitSignalHandlers { }; } +=head2 AddFileLogger + + RT->AddFileLogger( + filename => 'filename.log', # will be created in C<$LogDir> + log_level => 'warn', # Log::Dispatch log level + ); + +Add a new file logger at runtime. Used to add short lived file loggers +that are currently only used for logging Scrip errors. + +Note that the log file will be opened in write mode and will overwrite +an existing file with the same name. + +To remove the file logger use C. + +=cut + +sub AddFileLogger { + my $self = shift; + my %args = ( + log_level => 'warn', + @_ + ); + + return unless $args{filename}; + + # return if there is a already a logger with this name + if ( $RT::Logger->output( $args{filename} ) ) { + RT->Logger->error("File Logger '$args{filename}' already exists."); + return; + } + + my $logdir = RT->Config->Get('LogDir') || File::Spec->catdir( $VarPath, 'log' ); + $logdir = File::Spec->catdir( $logdir, 'scrips' ); + my $filename = File::Spec->catfile( $logdir, $args{filename} ); + + unless ( -e $logdir ) { + require File::Path; + File::Path::make_path($logdir); + } + unless ( -d $logdir && -w $logdir ) { + RT->Logger->error("Log dir '$logdir' is not writeable."); + return; + } + + require Log::Dispatch::File; + $RT::Logger->add( + Log::Dispatch::File->new( + name => $args{filename}, + min_level => $args{log_level}, + filename => $filename, + mode => 'write', + callbacks => [ $simple_cb ], + ) + ); + + return 1; +} + +=head2 RemoveFileLogger + + RT->RemoveFileLogger( + 'filename.log', + 'an optional final log message', + ); + +Remove a file logger that was added at runtime. Used to remove file +loggers added with C. + +Acccepts an optional second argument to add a final log message that is +only appended to the log file if the log file is not empty. + +If the log file is empty it is deleted to avoid empty log files in the +log directory. + +=cut + +sub RemoveFileLogger { + my $self = shift; + my $filename = shift; + my $final_log = shift; + + return unless $filename; + + # return if there is not a logger with this name + return unless $RT::Logger->output($filename); + + $RT::Logger->remove($filename); + + # if the log file is empty delete it + my $logdir = RT->Config->Get('LogDir') || File::Spec->catdir( $VarPath, 'log' ); + $logdir = File::Spec->catdir( $logdir, 'scrips' ); + $filename = File::Spec->catfile( $logdir, $filename ); + + if ( -z $filename ) { + unlink $filename; + } + elsif ( -s $filename && $final_log ) { + # add a final message with log details + if ( open my $fh, '>>', $filename ) { + print $fh $final_log; + close $fh; + } + else { + RT->Logger->error("Cannot write to '$filename': $!"); + } + } +} sub CheckPerlRequirements { eval {require 5.010_001}; diff --git a/lib/RT/Config.pm b/lib/RT/Config.pm index ffd504a36e1..1be99dfa861 100644 --- a/lib/RT/Config.pm +++ b/lib/RT/Config.pm @@ -2245,6 +2245,9 @@ our %META; LogToSyslogConf => { Immutable => 1, }, + LogScripsForUser => { + Type => 'HASH', + }, ShowMobileSite => { Widget => '/Widgets/Form/Boolean', }, diff --git a/lib/RT/Interface/Web/MenuBuilder.pm b/lib/RT/Interface/Web/MenuBuilder.pm index 7a6fa3a4eaf..19d0e689208 100644 --- a/lib/RT/Interface/Web/MenuBuilder.pm +++ b/lib/RT/Interface/Web/MenuBuilder.pm @@ -1571,6 +1571,7 @@ sub _BuildAdminMenu { $page->child( basics => title => loc('Basics') => path => "/Admin/Scrips/Modify.html?id=" . $id . $from_query_param ); $page->child( 'applies-to' => title => loc('Applies to'), path => "/Admin/Scrips/Objects.html?id=" . $id . $from_query_param ); + $page->child( 'logging' => title => loc('Log Output'), path => "/Admin/Scrips/Logging.html?id=" . $id . $from_query_param ); } elsif ( $request_path =~ m{^/Admin/Scrips/(index\.html)?$} ) { HTML::Mason::Commands::PageMenu->child( select => title => loc('Select') => path => "/Admin/Scrips/" ); diff --git a/lib/RT/Scrip.pm b/lib/RT/Scrip.pm index ed56cafc615..0e7bc60ada8 100644 --- a/lib/RT/Scrip.pm +++ b/lib/RT/Scrip.pm @@ -584,6 +584,9 @@ sub IsApplicable { return (undef); } my $ConditionObj = $self->ConditionObj; + + $self->_AddFileLogger('IsApplicable'); + foreach my $TransactionObj ( @Transactions ) { # in TxnBatch stage we can select scrips that are not applicable to all txns my $txn_type = $TransactionObj->Type; @@ -602,6 +605,7 @@ sub IsApplicable { } } }; + $self->_RemoveFileLogger('IsApplicable'); if ($@) { $RT::Logger->error( "Scrip IsApplicable " . $self->Id . " died. - " . $@ ); @@ -635,8 +639,12 @@ sub Prepare { TemplateObj => $self->TemplateObj( $args{'TicketObj'}->Queue ), ); + $self->_AddFileLogger('Prepare'); + $return = $self->ActionObj->Prepare(); }; + $self->_RemoveFileLogger('Prepare'); + if ($@) { $RT::Logger->error( "Scrip Prepare " . $self->Id . " died. - " . $@ ); return (undef); @@ -662,8 +670,11 @@ sub Commit { my $return; eval { + $self->_AddFileLogger('Commit'); + $return = $self->ActionObj->Commit(); }; + $self->_RemoveFileLogger('Commit'); #Searchbuilder caching isn't perfectly coherent. got to reload the ticket object, since it # may have changed @@ -680,9 +691,72 @@ sub Commit { return ($return); } +=head2 _LoggerFilename + +Helper method to generate the filename for a file logger for Scrip +logging. + +=cut + +sub _LoggerFilename { + my $self = shift; + my $mode = shift; + + return 'scrip-' . $self->id . "-$mode.log"; +}; + +=head2 _AddFileLogger + +Checks the C config option to determine if Scrip +logging is enabled for the current user and if so it calls +RT::AddFileLogger to add a short lived file logger used for Scrip +logging. + +=cut + +sub _AddFileLogger { + my $self = shift; + my $mode = shift; + + my $config = RT->Config->Get('LogScripsForUser'); + my $current_user = $HTML::Mason::Commands::session{CurrentUser} || $self->CurrentUser; + + return unless $config; + return unless $current_user; + return unless $config->{ $current_user->Name }; + + RT->AddFileLogger( + filename => $self->_LoggerFilename($mode), + log_level => $config->{ $current_user->Name }, + ); +} + +=head2 _RemoveFileLogger +Calls RT::RemoveFileLogger to remove a short lived file logger used for +Scrip logging. +Passes RT::RemoveFileLogger a final log message that includes the date +the log was created and the user it was created for. +=cut + +sub _RemoveFileLogger { + my $self = shift; + my $mode = shift; + + my $config = RT->Config->Get('LogScripsForUser'); + my $current_user = $HTML::Mason::Commands::session{CurrentUser} || $self->CurrentUser; + + return unless $config; + return unless $current_user; + return unless $config->{ $current_user->Name }; + + my $log_level = $config->{ $current_user->Name }; + my $final_log = "\nLog created on " . gmtime(time) . " for " . $current_user->Name . " at log level $log_level\n"; + + RT->RemoveFileLogger( $self->_LoggerFilename($mode), $final_log ); +} # does an acl check and then passes off the call sub _Set { diff --git a/share/html/Admin/Scrips/Elements/EditCustomCode b/share/html/Admin/Scrips/Elements/EditCustomCode index 201a8c292f4..22fa0758650 100644 --- a/share/html/Admin/Scrips/Elements/EditCustomCode +++ b/share/html/Admin/Scrips/Elements/EditCustomCode @@ -65,6 +65,18 @@ + +% if ( $errors{$method} ) { +
+
+ <% loc('Log Output') %>: +
+
+ +
+
+% } + % } @@ -79,4 +91,32 @@ my @list = ( ); my $min_lines = 10; + +my %errors = ( + 'CustomIsApplicableCode' => '', + 'CustomPrepareCode' => '', + 'CustomCommitCode' => '', +); + +if ( $Scrip->id ) { + my @stages = (); + if ( $Scrip->ConditionObj->ExecModule eq 'UserDefined' ) { + push @stages, 'IsApplicable'; + } + if ( $Scrip->ActionObj->ExecModule eq 'UserDefined' ) { + push @stages, 'Prepare', 'Commit'; + } + + my $logdir = RT->Config->Get('LogDir') || File::Spec->catdir( $RT::VarPath, 'log' ); + $logdir = File::Spec->catdir( $logdir, 'scrips' ); + foreach my $stage ( @stages ) { + my $filename = File::Spec->catfile( $logdir, 'scrip-' . $Scrip->id . '-' . $stage . '.log' ); + if ( -s $filename ) { + local $/; + open ( my $f, '<:encoding(UTF-8)', $filename ) + or die "Cannot open initialdata file '$filename' for read: $@"; + $errors{ 'Custom' . $stage . 'Code' } = <$f>; + } + } +} diff --git a/share/html/Admin/Scrips/Logging.html b/share/html/Admin/Scrips/Logging.html new file mode 100644 index 00000000000..07f4c8e4c4a --- /dev/null +++ b/share/html/Admin/Scrips/Logging.html @@ -0,0 +1,111 @@ +%# BEGIN BPS TAGGED BLOCK {{{ +%# +%# COPYRIGHT: +%# +%# This software is Copyright (c) 1996-2023 Best Practical Solutions, LLC +%# +%# +%# (Except where explicitly superseded by other copyright notices) +%# +%# +%# LICENSE: +%# +%# This work is made available to you under the terms of Version 2 of +%# the GNU General Public License. A copy of that license should have +%# been provided with this software, but in any event can be snarfed +%# from www.gnu.org. +%# +%# This work is distributed in the hope that it will be useful, but +%# WITHOUT ANY WARRANTY; without even the implied warranty of +%# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +%# General Public License for more details. +%# +%# You should have received a copy of the GNU General Public License +%# along with this program; if not, write to the Free Software +%# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA +%# 02110-1301 or visit their web page on the internet at +%# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html. +%# +%# +%# CONTRIBUTION SUBMISSION POLICY: +%# +%# (The following paragraph is not intended to limit the rights granted +%# to you to modify and distribute this software under the terms of +%# the GNU General Public License and is only of importance to you if +%# you choose to contribute your changes and enhancements to the +%# community by submitting them to Best Practical Solutions, LLC.) +%# +%# By intentionally submitting any modifications, corrections or +%# derivatives to this work, or any other work intended for use with +%# Request Tracker, to Best Practical Solutions, LLC, you confirm that +%# you are the copyright holder for those contributions and you grant +%# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable, +%# royalty-free, perpetual, license to use, copy, create derivative +%# works based on those contributions, and sublicense and distribute +%# those contributions and any derivatives thereof. +%# +%# END BPS TAGGED BLOCK }}} +<& /Admin/Elements/Header, Title => loc("Logging for scrip #[_1]", $id) &> +<& /Elements/Tabs &> + +
+ +<&| /Widgets/TitleBox, title => loc('Logging') &> + +
+
+ <% loc('Condition') %>: +
+
+ +
+
+
+
+ <% loc('Action preparation')%>: +
+
+ +
+
+
+
+ <% loc('Action commit') %>: +
+
+ +
+
+ + + +
+ + +<%ARGS> +$id => undef + +<%INIT> +my $scrip = RT::Scrip->new( $session{'CurrentUser'} ); +$scrip->Load( $id ); +Abort(loc("Couldn't load scrip #[_1]", $id)) + unless $scrip->id; + +my %errors = ( + 'IsApplicable' => '', + 'Prepare' => '', + 'Commit' => '', +); + +my $logdir = RT->Config->Get('LogDir') || File::Spec->catdir( $RT::VarPath, 'log' ); +$logdir = File::Spec->catdir( $logdir, 'scrips' ); +foreach my $stage ( qw( IsApplicable Prepare Commit ) ) { + my $filename = File::Spec->catfile( $logdir, 'scrip-' . $scrip->id . '-' . $stage . '.log' ); + if ( -s $filename ) { + local $/; + open ( my $f, '<:encoding(UTF-8)', $filename ) + or die "Cannot open initialdata file '$filename' for read: $@"; + $errors{$stage} = <$f>; + } +} + diff --git a/share/html/Elements/RT__Scrip/ColumnMap b/share/html/Elements/RT__Scrip/ColumnMap index 1edac2a6d97..1ee421f8087 100644 --- a/share/html/Elements/RT__Scrip/ColumnMap +++ b/share/html/Elements/RT__Scrip/ColumnMap @@ -181,6 +181,21 @@ my $COLUMN_MAP = { return $_[0]->loc( $os->FriendlyStage ); }, }, + HasLogs => { + title => 'Log Output', # loc + value => sub { + my $logdir = RT->Config->Get('LogDir') || File::Spec->catdir( $RT::VarPath, 'log' ); + $logdir = File::Spec->catdir( $logdir, 'scrips' ); + foreach my $stage ( qw( IsApplicable Prepare Commit ) ) { + my $filename = File::Spec->catfile( $logdir, 'scrip-' . $_[0]->id . '-' . $stage . '.log' ); + if ( -e $filename && -s $filename ) { + my $return = '' . $_[0]->loc('Has Log') . ''; + return \$return; + } + } + return ''; + }, + }, }; diff --git a/share/static/css/elevator-light/admin.css b/share/static/css/elevator-light/admin.css index d4c703069f0..26d077cf320 100644 --- a/share/static/css/elevator-light/admin.css +++ b/share/static/css/elevator-light/admin.css @@ -186,3 +186,8 @@ table.upgrade-history .upgrade-history-parent .widget a.rolled-up { .configuration > .titlebox-content { margin-top: 20px; } + +div.scrip-log.label, +a.scrip-log { + color: red; +} diff --git a/t/web/scrips.t b/t/web/scrips.t index 1e9ee4e3fcd..fff74c5a891 100644 --- a/t/web/scrips.t +++ b/t/web/scrips.t @@ -2,6 +2,7 @@ use strict; use warnings; use RT::Test tests => undef; +use Test::Warn; RT->Config->Set( UseTransactionBatch => 1 ); @@ -296,4 +297,108 @@ note "apply scrip in different stage to different queues"; is scalar @matches, 1, 'scrip mentioned only once'; } +note "test scrip logging"; +{ + my $logdir = RT->Config->Get('LogDir') || File::Spec->catdir( $RT::VarPath, 'log' ); + $logdir = File::Spec->catdir( $logdir, 'scrips' ); + + my %test_scrips = ( + 'No Errors' => [ 'return 1;', 'return 1;', 'return 1;' ], + 'IsApplicable Error' => [ 'return $undefined;', 'return 1;', 'return 1;' ], + 'Prepare Error' => [ 'return 1;', 'return $undefined;', 'return 1;' ], + 'Commit Error' => [ 'return 1;', 'return 1;', 'return $undefined;' ], + ); + my %test_scrip_logfile_should_exist = ( + 'No Errors' => { IsApplicable => 0, Prepare => 0, Commit => 0, }, + 'IsApplicable Error' => { IsApplicable => 1, Prepare => 0, Commit => 0, }, + 'Prepare Error' => { IsApplicable => 0, Prepare => 1, Commit => 0, }, + 'Commit Error' => { IsApplicable => 0, Prepare => 0, Commit => 1, }, + ); + + my %id_for_scrip; + foreach my $test_scrip ( sort keys %test_scrips ) { + diag "Create Scrip (Test Scrip Logging - $test_scrip)" if $ENV{TEST_VERBOSE}; + $m->follow_link_ok({id => 'admin-global-scrips-create'}); + $m->form_name('CreateScrip'); + $m->set_fields( + 'Description' => "Test Scrip Logging - $test_scrip", + 'ScripCondition' => 'User Defined', + 'ScripAction' => 'User Defined', + 'Template' => 'Blank', + 'CustomIsApplicableCode' => $test_scrips{$test_scrip}->[0], + 'CustomPrepareCode' => $test_scrips{$test_scrip}->[1], + 'CustomCommitCode' => $test_scrips{$test_scrip}->[2], + ); + $m->click('Create'); + $m->content_like(qr{Scrip Created}); + + my ($sid) = ($m->content =~ /Modify scrip #(\d+)/); + ok $sid, "found scrip id on the page"; + + $id_for_scrip{$test_scrip} = $sid; + } + + # creating a ticket should fire off all test scrips + diag "Create Ticket (Test Scrip Logging No Config)" if $ENV{TEST_VERBOSE}; + warnings_like { + RT::Test->create_ticket( + Subject => 'Test Scrip Logging', + Content => 'stuff', + Queue => 1, + ); + } [ qr/Global symbol .* requires explicit package name/, + qr/Global symbol .* requires explicit package name/, + qr/Global symbol .* requires explicit package name/, + qr/Global symbol .* requires explicit package name/, + qr/Global symbol .* requires explicit package name/, + qr/Global symbol .* requires explicit package name/, + ]; + + # without any config specified there should be no log files + foreach my $test_scrip ( sort keys %id_for_scrip ) { + foreach my $mode ( qw( IsApplicable Prepare Commit ) ) { + my $filename = 'scrip-' . $id_for_scrip{$test_scrip} . '-' . $mode . '.log'; + my $fullpath = File::Spec->catfile( $logdir, $filename ); + + ok ! -e $fullpath, "Scrip log file '$filename' should not exist"; + } + } + + # now set config and create another ticket + # need to stop server, change config, restart server + # to avoid warning about changing config with running server + RT::Test->stop_server; + RT->Config->Set( LogScripsForUser => { root => 'warn', RT_System => 'warn' } ); + ( $baseurl, $m ) = RT::Test->started_ok; + ok( $m->login(), 'logged in' ); + + diag "Create Ticket (Test Scrip Logging With Config)" if $ENV{TEST_VERBOSE}; + warnings_like { + RT::Test->create_ticket( + Subject => 'Test Scrip Logging', + Content => 'stuff', + Queue => 1, + ); + } [ qr/Global symbol .* requires explicit package name/, + qr/Global symbol .* requires explicit package name/, + qr/Global symbol .* requires explicit package name/, + qr/Global symbol .* requires explicit package name/, + qr/Global symbol .* requires explicit package name/, + qr/Global symbol .* requires explicit package name/, + ]; + + foreach my $test_scrip ( sort keys %id_for_scrip ) { + foreach my $mode ( qw( IsApplicable Prepare Commit ) ) { + my $filename = 'scrip-' . $id_for_scrip{$test_scrip} . '-' . $mode . '.log'; + my $fullpath = File::Spec->catfile( $logdir, $filename ); + + if ( $test_scrip_logfile_should_exist{$test_scrip}->{$mode} ) { + ok -e $fullpath, "Scrip log file '$filename' should exist"; + } else { + ok ! -e $fullpath, "Scrip log file '$filename' should not exist"; + } + } + } +} + done_testing;