Login
Added support for the -unsafe switch. This is to protect
authorJeffrey Ryan Thalhammer <jeff@imaginative-software.com>
Thu, 15 Oct 2009 21:10:02 +0000 (21:10 +0000)
committerJeffrey Ryan Thalhammer <jeff@imaginative-software.com>
Thu, 15 Oct 2009 21:10:02 +0000 (21:10 +0000)
users from accidentally running unsafe dynamic policies
over untrusted code.  The idea was inspired by Sartak, who
has written several dynamic Moose-related policies.
He said he would release them once we had created some
kind of safety mechanism on dynamic policies like his.

Changes
bin/perlcritic
lib/Perl/Critic.pm
lib/Perl/Critic/Command.pm
lib/Perl/Critic/Config.pm
lib/Perl/Critic/DEVELOPER.pod
lib/Perl/Critic/OptionsProcessor.pm
lib/Perl/Critic/Policy.pm
t/00_modules.t
t/01_config.t
t/99_pod_coverage.t

diff --git a/Changes b/Changes
index 3bae3ce..8128a83 100644 (file)
--- a/Changes
+++ b/Changes
@@ -11,6 +11,10 @@ Next release, whenever it is:
     * The framework that we use to test Perl::Critic has been packaged into
       a convenient module that you can use to test your own Policies.  See
       Test::Perl::Critic::Policy for details.
+    * Added the --unsafe switch.  Without this switch, Perl::Critic will
+      silently refuse to load any Policy that is marked unsafe.  Unsafe
+      Policies are usually ones that may compile or execute untrusted
+      code (see Perl::Critic::DynamicPolicy for an example).
 
     Bug Fixes:
     * The "## no critic" annotations now respect the #line directives.
index b65b3b9..93caa54 100755 (executable)
@@ -53,7 +53,7 @@ C<perlcritic> - Command-line interface to critique Perl source.
              [--exclude pattern] [{-s | --single-policy} pattern]
              [--only | --noonly] [--profile-strictness {warn|fatal|quiet}]
              [--force | --noforce] [--statistics] [--statistics-only]
-             [--count | -C] [--verbose {number | format}]
+             [--count | -C] [--verbose {number | format}] [--unsafe]
              [--color | --nocolor] [--pager pager] [--quiet]
              [--color-severity-highest color_specification]
              [--color-severity-high color_specification]
@@ -511,6 +511,18 @@ names, this just provides a more convenient way to say something like:
 C<"perldoc Perl::Critic::Policy::ValuesAndExpressions::RequireUpperCaseHeredocTerminator">
 at the command prompt.
 
+=item C<--unsafe>
+
+This option directs C<perlcritic> to allow the use of Policies that have been
+marked as "unsafe".  Unsafe Policies may result in risky operations by
+compiling and executing the code they analyze.  All the Policies that ship in
+the core L<Perl::Critic> distribution are safe.  However, third-party
+Policies, such as those in the L<Perl::Critic::Dynamic> distribution are not
+safe.  Note that "safety" is honorary -- if a Policy author marks a Policy as
+safe, it is not a guarantee that it won't do nasty things.  B<If you don't
+trust your Policies and the code you are analyzing, then do not use this
+switch>.
+
 =item C<--quiet>
 
 Suppress the "source OK" message when no violations are found.
index 61b3d36..0d7f005 100644 (file)
@@ -295,7 +295,7 @@ will go through a deprecation cycle.
 
 =over
 
-=item C<< new( [ -profile => $FILE, -severity => $N, -theme => $string, -include => \@PATTERNS, -exclude => \@PATTERNS, -top => $N, -only => $B, -profile-strictness => $PROFILE_STRICTNESS_{WARN|FATAL|QUIET}, -force => $B, -verbose => $N ], -color => $B, -pager => $string, -criticism-fatal => $B) >>
+=item C<< new( [ -profile => $FILE, -severity => $N, -theme => $string, -include => \@PATTERNS, -exclude => \@PATTERNS, -top => $N, -only => $B, -profile-strictness => $PROFILE_STRICTNESS_{WARN|FATAL|QUIET}, -force => $B, -verbose => $N ], -color => $B, -pager => $string, -unsafe => $B, -criticism-fatal => $B) >>
 
 =item C<< new() >>
 
@@ -423,6 +423,10 @@ L<Perl::Critic::Violation|Perl::Critic::Violation> for an explanation
 of format specifications.  You can set the default value for this
 option in your F<.perlcriticrc> file.
 
+B<-unsafe> directs Perl::Critic to allow the use of Policies that are marked
+as "unsafe" by the author.  Such policies may compile untrusted code or do
+other nefarious things.
+
 B<-color> and B<-pager> are not used by Perl::Critic but is provided for the benefit
 of L<perlcritic|perlcritic>.
 
@@ -554,6 +558,7 @@ corresponding constructor argument.
     exclude   = Variables  Modules::RequirePackage    #Space-delimited list
     criticism-fatal = 1                               #Zero or One
     color     = 1                                     #Zero or One
+    unsafe    = 1                                     #Zero or One
     pager     = less                                  #pager to pipe output to
 
 The remainder of the configuration file is a series of blocks like
index 0d9badc..2b4c47d 100644 (file)
@@ -508,6 +508,7 @@ sub _get_option_specification {
         profile-strictness=s
         theme=s
         top:i
+        unsafe
         verbose=s
         color-severity-highest|colour-severity-highest|color-severity-5|colour-severity-5=s
         color-severity-high|colour-severity-high|color-severity-4|colour-severity-4=s
index db546f0..3f92147 100644 (file)
@@ -123,6 +123,7 @@ sub _init {
     $self->{_force} = boolean_to_number( dor( $args{-force}, $options_processor->force() ) );
     $self->{_only}  = boolean_to_number( dor( $args{-only},  $options_processor->only()  ) );
     $self->{_color} = boolean_to_number( dor( $args{-color}, $options_processor->color() ) );
+    $self->{_unsafe} = boolean_to_number( dor( $args{-unsafe}, $options_processor->unsafe() ) );
     $self->{_criticism_fatal} = boolean_to_number( dor( $args{'-criticism-fatal'}, $options_processor->criticism_fatal() ) );
 
 
@@ -223,6 +224,9 @@ sub _load_policies {
             next;
         }
 
+        # Always exclude unsafe policies, unless instructed not to
+        next if not ( $policy->is_safe() or $self->unsafe() );
+
         # To load, or not to load -- that is the question.
         my $load_me = $self->only() ? $FALSE : $TRUE;
 
@@ -871,6 +875,13 @@ sub pager  {
 
 #-----------------------------------------------------------------------------
 
+sub unsafe {
+    my ($self) = @_;
+    return $self->{_unsafe};
+}
+
+#-----------------------------------------------------------------------------
+
 sub criticism_fatal {
     my ($self) = @_;
     return $self->{_criticism_fatal};
@@ -1080,6 +1091,11 @@ Returns the value of the C<-color> attribute for this Config.
 Returns the value of the C<-pager> attribute for this Config.
 
 
+=item C< unsafe() >
+
+Returns the value of the C<-unsafe> attribute for this Config.
+
+
 =item C< criticism_fatal() >
 
 Returns the value of the C<-criticsm-fatal> attribute for this Config.
@@ -1179,6 +1195,7 @@ corresponding Perl::Critic constructor argument.
     include   = NamingConventions ClassHierarchies    #Space-delimited list
     exclude   = Variables  Modules::RequirePackage    #Space-delimited list
     color     = 1                                     #Zero or One
+    unsafe    = 1                                     #Zero or One
     color-severity-highest = bold red                 #Term::ANSIColor
     color-severity-high = magenta                     #Term::ANSIColor
     color-severity-medium =                           #no coloring
index 3c7203b..b7bc030 100644 (file)
@@ -919,6 +919,17 @@ and
 L<Perl::Critic::Policy::TestingAndDebugging::RequireUseWarnings|Perl::Critic::Policy::TestingAndDebugging::RequireUseWarnings>
 for examples.
 
+=head2 C<is_safe()>
+
+Most L<Perl::Critic> Policies are purely I<static>.  In other words, they
+never compile or execute any of the source code that they analyze.  However it
+is possible to write I<dynamic> Policies that do compile or execute code,
+which may result in unsafe operations (see L<Perl::Critic::Dynamic> for an
+example).  So the C<is_safe()> method is used to indicate whether a Policy can
+be trusted to not cause mischief.  By default, C<is_safe()> returns true.  But
+if you are writing a Policy that will compile or execute any of the source
+code that it analyzes, then you should override the C<is_safe()> method to
+return false.
 
 =head1 DISTRIBUTING YOUR POLICIES
 
index bf111f1..63fdd93 100644 (file)
@@ -62,6 +62,8 @@ sub _init {
     $self->{_verbose}         = dor(delete $args{verbose},            $DEFAULT_VERBOSITY);
     $self->{_criticism_fatal} = dor(delete $args{'criticism-fatal'},  $FALSE);
     $self->{_pager}           = dor(delete $args{pager},              $EMPTY);
+    $self->{_unsafe}          = dor(delete $args{unsafe},             $FALSE);
+
     $self->{_color_severity_highest} = dor(
         delete $args{'color-severity-highest'},
         delete $args{'colour-severity-highest'},
@@ -204,6 +206,13 @@ sub pager {
 
 #-----------------------------------------------------------------------------
 
+sub unsafe {
+    my ($self) = @_;
+    return $self->{_unsafe};
+}
+
+#-----------------------------------------------------------------------------
+
 sub criticism_fatal {
     my ($self) = @_;
     return $self->{_criticism_fatal};
@@ -381,6 +390,11 @@ Returns the default C<pager> setting. (Either empty string or the pager
 command string).
 
 
+=item C< unsafe() >
+
+Returns the default C<unsafe> setting. (Either 1 or 0).
+
+
 =item C< criticism_fatal() >
 
 Returns the default C<criticism-fatal> setting (Either 1 or 0).
index 0a1652a..9c25754 100644 (file)
@@ -116,6 +116,12 @@ sub new {
 
 #-----------------------------------------------------------------------------
 
+sub is_safe {
+    return $TRUE;
+}
+
+#-----------------------------------------------------------------------------
+
 sub initialize_if_enabled {
     return $TRUE;
 }
@@ -795,6 +801,14 @@ string depends on the current value returned by C<get_format()>.
 See L<"OVERLOADS"> for the details.
 
 
+=item C<is_safe()>
+
+Returns true if this Policy can be used to analyze untrusted code.  In other
+words, the Policy is purely static and does not compile or execute any of the
+code that it analyzes.  By default, this method returns true.  But if you are
+writing a Policy that does dynamic analysis and/or performs other unsafe
+operations, then you should override this method to return false.
+
 =back
 
 
index 2d48aeb..0f906bb 100644 (file)
@@ -44,9 +44,9 @@ my @concrete_exceptions = qw{
 };
 
 plan tests =>
-        123
+        126
     +   (  9 * scalar @concrete_exceptions  )
-    +   ( 15 * scalar @bundled_policy_names );
+    +   ( 17 * scalar @bundled_policy_names );
 
 # pre-compute for version comparisons
 my $version_string = __PACKAGE__->VERSION;
@@ -84,6 +84,7 @@ can_ok('Perl::Critic::Config', 'theme');
 can_ok('Perl::Critic::Config', 'top');
 can_ok('Perl::Critic::Config', 'verbose');
 can_ok('Perl::Critic::Config', 'color');
+can_ok('Perl::Critic::Config', 'unsafe');
 can_ok('Perl::Critic::Config', 'criticism_fatal');
 can_ok('Perl::Critic::Config', 'site_policy_names');
 can_ok('Perl::Critic::Config', 'color_severity_highest');
@@ -115,6 +116,7 @@ can_ok('Perl::Critic::OptionsProcessor', 'theme');
 can_ok('Perl::Critic::OptionsProcessor', 'top');
 can_ok('Perl::Critic::OptionsProcessor', 'verbose');
 can_ok('Perl::Critic::OptionsProcessor', 'color');
+can_ok('Perl::Critic::OptionsProcessor', 'unsafe');
 can_ok('Perl::Critic::OptionsProcessor', 'criticism_fatal');
 can_ok('Perl::Critic::OptionsProcessor', 'color_severity_highest');
 can_ok('Perl::Critic::OptionsProcessor', 'color_severity_high');
@@ -142,6 +144,7 @@ can_ok('Perl::Critic::Policy', 'set_severity');
 can_ok('Perl::Critic::Policy', 'set_themes');
 can_ok('Perl::Critic::Policy', 'violates');
 can_ok('Perl::Critic::Policy', 'violation');
+can_ok('Perl::Critic::Policy', 'is_safe');
 
 {
     my $policy = Perl::Critic::Policy->new();
@@ -281,10 +284,12 @@ can_ok('Perl::Critic::Command', 'run');
         can_ok($mod, 'set_themes');
         can_ok($mod, 'violates');
         can_ok($mod, 'violation');
+        can_ok($mod, 'is_safe');
 
         my $policy = $mod->new();
         isa_ok($policy, 'Perl::Critic::Policy');
         is($policy->VERSION(), $version_string, "Version of $mod");
+        ok($policy->is_safe(), "CORE policy $mod is marked safe");
     }
 }
 
index f4c5972..b3c884f 100644 (file)
@@ -58,7 +58,7 @@ my $total_policies   = scalar @names_of_policies_willing_to_work;
                 )
                 ->all_policies_enabled_or_not();
 
-    plan tests => 86 + $all_policy_count;
+    plan tests => 92 + $all_policy_count;
 }
 
 #-----------------------------------------------------------------------------
@@ -330,6 +330,7 @@ my $total_policies   = scalar @names_of_policies_willing_to_work;
         -force
         -color
         -pager
+        -unsafe
         -criticism-fatal
         -color-severity-highest
         -color-severity-high
@@ -344,14 +345,15 @@ my $total_policies   = scalar @names_of_policies_willing_to_work;
     my %undef_args = map { $_ => undef } @switches;
     my $c = Perl::Critic::Config->new( %undef_args );
     $c = Perl::Critic::Config->new( %undef_args );
-    is( $c->force(),     0,     'Undefined -force');
-    is( $c->only(),      0,     'Undefined -only');
-    is( $c->severity(),  5,     'Undefined -severity');
+    is( $c->force(),     0,       'Undefined -force');
+    is( $c->only(),      0,       'Undefined -only');
+    is( $c->severity(),  5,       'Undefined -severity');
     is( $c->theme()->rule(),   q{},   'Undefined -theme');
-    is( $c->top(),       0,     'Undefined -top');
-    is( $c->color(),     $color, 'Undefined -color');
-    is( $c->pager(),     q{},   'Undefined -pager');
-    is( $c->verbose(),   4,     'Undefined -verbose');
+    is( $c->top(),       0,       'Undefined -top');
+    is( $c->color(),     $color,  'Undefined -color');
+    is( $c->pager(),     q{},     'Undefined -pager');
+    is( $c->unsafe(),    0,       'Undefined -unsafe');
+    is( $c->verbose(),   4,       'Undefined -verbose');
     is( $c->criticism_fatal(), 0, 'Undefined -criticism-fatal');
     is( $c->color_severity_highest(),
         $PROFILE_COLOR_SEVERITY_HIGHEST_DEFAULT,
@@ -384,7 +386,8 @@ my $total_policies   = scalar @names_of_policies_willing_to_work;
     is( $c->theme()->rule(),     q{},     'zero -theme');
     is( $c->top(),       0,       'zero -top');
     is( $c->color(),     $FALSE,  'zero -color');
-    is( $c->pager(),     $EMPTY,  'empty -pager');
+    is( $c->pager(),     $EMPTY,  'zero -pager');
+    is( $c->unsafe(),    0,       'zero -unsafe');
     is( $c->verbose(),   4,       'zero -verbose');
     is( $c->criticism_fatal(), 0, 'zero -criticism-fatal');
 
@@ -397,6 +400,7 @@ my $total_policies   = scalar @names_of_policies_willing_to_work;
     is( $c->top(),       0,       'empty -top');
     is( $c->color(),     $FALSE,  'empty -color');
     is( $c->pager(),     q{},     'empty -pager');
+    is( $c->unsafe(),    0,       'empty -unsafe');
     is( $c->verbose(),   4,       'empty -verbose');
     is( $c->criticism_fatal(), 0, 'empty -criticism-fatal');
     is( $c->color_severity_highest(), $EMPTY, 'empty -color-severity-highest');
@@ -446,14 +450,15 @@ my $total_policies   = scalar @names_of_policies_willing_to_work;
 # Test interaction between switches and defaults
 
 {
-    my %true_defaults = ( force => 1, only  => 1, top => 10 );
+    my %true_defaults = ( force => 1, only  => 1, top => 10, unsafe => 1);
     my %profile  = ( '__defaults__' => \%true_defaults );
 
-    my %pc_config = (-force => 0, -only => 0, -top => 0, -profile => \%profile);
+    my %pc_config = (-force => 0, -only => 0, -top => 0, -unsafe => 0, -profile => \%profile);
     my $config = Perl::Critic::Config->new( %pc_config );
     is( $config->force, 0, '-force: default is true, arg is false');
     is( $config->only,  0, '-only: default is true, arg is false');
     is( $config->top,   0, '-top: default is true, arg is false');
+    is( $config->unsafe,   0, '-unsafe: default is true, arg is false');
 }
 
 #-----------------------------------------------------------------------------
@@ -516,6 +521,31 @@ my $total_policies   = scalar @names_of_policies_willing_to_work;
 }
 
 #-----------------------------------------------------------------------------
+# Test the -unsafe switch
+{
+    my %profile = (
+        'NamingConventions::Capitalization' => {},
+        'Miscellanea::RequireRcsKeywords' => {},
+    );
+
+    # Pretend that RequireRcsKeywords is actually unsafe
+    no warnings qw(redefine once);  ## no critic qw(ProhibitNoWarnings)
+    local *Perl::Critic::Policy::Miscellanea::RequireRcsKeywords::is_safe = sub {return 0};
+
+    my %safe_pc_config = (-severity => 1, -only => 1, -profile => \%profile);
+    my @p = Perl::Critic::Config->new( %safe_pc_config )->policies();
+    is(scalar @p, 1, 'Only loaded safe policies without -unsafe switch');
+
+    my %unsafe_pc_config = (%safe_pc_config, -unsafe => 1);
+    @p = Perl::Critic::Config->new( %unsafe_pc_config )->policies();
+    is(scalar @p, 2, 'Also loaded unsafe policies with -unsafe switch');
+
+    my %singular_pc_config = ('-single-policy' => 'RequireRcsKeywords');
+    @p = Perl::Critic::Config->new( %singular_pc_config )->policies();
+    is(scalar @p, 1, '-single-policy always loads Policy, even if unsafe');
+}
+
+#-----------------------------------------------------------------------------
 
 # ensure we return true if this test is loaded by
 # t/01_config.t_without_optional_dependencies.t
index a31b132..74feccd 100644 (file)
@@ -59,6 +59,7 @@ sub get_trusted_methods {
         prepare_to_scan_document
         violates
         applies_to
+        is_safe
         default_themes
         default_maximum_violations_per_document
         default_severity