Index: t/unit_parameter_redact.t =================================================================== --- t/unit_parameter_redact.t (revision 0) +++ t/unit_parameter_redact.t (revision 0) @@ -0,0 +1,42 @@ +#!perl + +use Test::More tests => 2; + +use strict; +use warnings; + +use FindBin; +use lib "$FindBin::Bin/lib"; + +my @MESSAGES = (); + +{ + package Catalyst::Log::Unit; + use base qw/Catalyst::Log/; + +} + +use Catalyst::Test 'TestApp'; + +TestApp->setup; + +my $unit = Catalyst::Log::Unit->new; + +TestApp->log( $unit); + +TestApp->config->{Debug}->{redact_parameters} = [ 'and this' ]; + +TestApp->log_parameters( + 'Query Parameters are', + { + 'this is' => 'a unit test', + 'and this' => 'is hidden' + } +); + +my $body = $unit->body; + +like($body, qr/this is\s*\|\s*a unit test/); +like($body, qr/and this\s*\|\s*\(redacted by config\)/); + + Index: lib/Catalyst.pm =================================================================== --- lib/Catalyst.pm (revision 9082) +++ lib/Catalyst.pm (working copy) @@ -1787,15 +1787,10 @@ $c->prepare_parameters; $c->prepare_uploads; - if ( $c->debug && keys %{ $c->req->body_parameters } ) { - my $t = Text::SimpleTable->new( [ 35, 'Parameter' ], [ 36, 'Value' ] ); - for my $key ( sort keys %{ $c->req->body_parameters } ) { - my $param = $c->req->body_parameters->{$key}; - my $value = defined($param) ? $param : ''; - $t->row( $key, - ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value ); - } - $c->log->debug( "Body Parameters are:\n" . $t->draw ); + if ( $c->debug ) { + $c->log_parameters( + 'Body Parameters are', $c->request->body_parameters + ); } } @@ -1881,15 +1876,65 @@ $c->engine->prepare_query_parameters( $c, @_ ); - if ( $c->debug && keys %{ $c->request->query_parameters } ) { - my $t = Text::SimpleTable->new( [ 35, 'Parameter' ], [ 36, 'Value' ] ); - for my $key ( sort keys %{ $c->req->query_parameters } ) { - my $param = $c->req->query_parameters->{$key}; + if ( $c->debug ) { + $c->log_parameters( + 'Query Parameters are', $c->request->query_parameters + ); + } +} + +=head2 $c->log_parameters($name, $parameters) + +Logs a hash reference of key value pairs, with a caption above the table. + +Looks like: + + [debug] Query Parameters are: + .-------------------------------------+--------------------------------------. + | Parameter | Value | + +-------------------------------------+--------------------------------------+ + | search | Moose | + | searchtype | modules | + '-------------------------------------+--------------------------------------' + +If there are query parameters you don't want to display in this output, such +as passwords or other sensitive input, you can configure your application to +redact those parameters: + + C<< MyApp->config->{Debug}->{redact_parameters} = [ 'password' ] >> + +In that case, the output will look like: + + [debug] Query Parameters are: + .-------------------------------------+--------------------------------------. + | Parameter | Value | + +-------------------------------------+--------------------------------------+ + | password | (redacted by config) | + | username | some_user | + '-------------------------------------+--------------------------------------' + +=cut + +sub log_parameters { + my ( $c, $name, $parameters ) = @_; + + my $skip = $c->config->{Debug}->{redact_parameters}; + if ( + ( not defined $skip or ref $skip eq 'ARRAY' ) + && keys %{ $parameters } + ) { + my $t = Text::SimpleTable->new( + [ 35, 'Parameter' ], [ 36, 'Value' ] ); + my %skip_params = map { $_ => $_ } @{ $skip || [] }; + for my $key ( sort keys %$parameters ) { + my $param = $parameters->{$key}; my $value = defined($param) ? $param : ''; + $value = '(redacted by config)' if exists $skip_params{$key}; + $t->row( $key, ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value ); } - $c->log->debug( "Query Parameters are:\n" . $t->draw ); + $c->log->debug( "$name:\n" . $t->draw ); } }