[Catalyst-commits] r9138 - in Catalyst-Runtime/5.80/trunk: . lib t
t0m at dev.catalyst.perl.org
t0m at dev.catalyst.perl.org
Thu Jan 29 20:12:54 GMT 2009
Author: t0m
Date: 2009-01-29 20:12:53 +0000 (Thu, 29 Jan 2009)
New Revision: 9138
Added:
Catalyst-Runtime/5.80/trunk/t/unit_parameter_redact.t
Modified:
Catalyst-Runtime/5.80/trunk/Changes
Catalyst-Runtime/5.80/trunk/lib/Catalyst.pm
Log:
Apply patch for redacting parameters in the log.
Modified: Catalyst-Runtime/5.80/trunk/Changes
===================================================================
--- Catalyst-Runtime/5.80/trunk/Changes 2009-01-29 09:00:29 UTC (rev 9137)
+++ Catalyst-Runtime/5.80/trunk/Changes 2009-01-29 20:12:53 UTC (rev 9138)
@@ -1,5 +1,9 @@
# This file documents the revision history for Perl extension Catalyst.
+Not yet released
+ - Allow redaction of parameters in debug output by configuration
+ (Byron Young)
+
5.8000_05 2008-29-01 00:00
- Text::SimpleTable's go as wide as $ENV{COLUMNS} (jhannah)
Patch written by Oleg Kostyuk <cub.uanic at gmail.com>
Modified: Catalyst-Runtime/5.80/trunk/lib/Catalyst.pm
===================================================================
--- Catalyst-Runtime/5.80/trunk/lib/Catalyst.pm 2009-01-29 09:00:29 UTC (rev 9137)
+++ Catalyst-Runtime/5.80/trunk/lib/Catalyst.pm 2009-01-29 20:12:53 UTC (rev 9138)
@@ -1806,15 +1806,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
+ );
}
}
@@ -1900,15 +1895,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 );
}
}
@@ -2565,6 +2610,8 @@
bricas: Brian Cassidy <bricas at cpan.org>
+Byron Young <Byron.Young at riverbed.com>
+
Caelum: Rafael Kitover <rkitover at io.com>
chansen: Christian Hansen
Added: Catalyst-Runtime/5.80/trunk/t/unit_parameter_redact.t
===================================================================
--- Catalyst-Runtime/5.80/trunk/t/unit_parameter_redact.t (rev 0)
+++ Catalyst-Runtime/5.80/trunk/t/unit_parameter_redact.t 2009-01-29 20:12:53 UTC (rev 9138)
@@ -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\)/);
+
+
More information about the Catalyst-commits
mailing list