1package SVN::Hooks::DenyFilenames; 2# ABSTRACT: Deny some file names. 3$SVN::Hooks::DenyFilenames::VERSION = '1.34'; 4use strict; 5use warnings; 6 7use Carp; 8use Data::Util qw(:check); 9use SVN::Hooks; 10 11use Exporter qw/import/; 12my $HOOK = 'DENY_FILENAMES'; 13our @EXPORT = ($HOOK, 'DENY_FILENAMES_PER_PATH'); 14 15 16sub _grok_check { 17 my ($directive, $check) = @_; 18 if (is_rx($check)) { 19 return [$check => 'filename not allowed']; 20 } elsif (is_array_ref($check)) { 21 @$check == 2 or croak "$directive: array arguments must have two arguments.\n"; 22 is_rx($check->[0]) or croak "$directive: got \"$check->[0]\" while expecting a qr/Regex/.\n"; 23 is_string($check->[1]) or croak "$directive: got \"$check->[1]\" while expecting a string.\n"; 24 return $check; 25 } else { 26 croak "$directive: got \"$check\" while expecting a qr/Regex/ or a [qr/Regex/, 'message'].\n"; 27 } 28} 29 30my @Checks; # default restrictions 31 32sub DENY_FILENAMES { 33 foreach my $check (@_) { 34 push @Checks, _grok_check('DENY_FILENAMES', $check); 35 } 36 37 PRE_COMMIT(\&pre_commit); 38 39 return 1; 40} 41 42 43my @Per_path_checks; # per path restrictions 44 45sub DENY_FILENAMES_PER_PATH { 46 47 my (@rules) = @_; 48 49 @rules % 2 == 0 50 or croak "DENY_FILENAMES_PER_PATH: got odd number of arguments.\n"; 51 52 while (@rules) { 53 my ($match, $check) = splice @rules, 0, 2; 54 is_rx($match) or croak "DENY_FILENAMES_PER_PATH: rule prefix isn't a Regexp.\n"; 55 56 push @Per_path_checks, [$match => _grok_check('DENY_FILENAMES_PER_PATH', $check)]; 57 } 58 59 PRE_COMMIT(\&pre_commit); 60 61 return 1; 62} 63 64sub pre_commit { 65 my ($svnlook) = @_; 66 my $errors; 67 ADDED: 68 foreach my $added ($svnlook->added()) { 69 foreach my $rule (@Per_path_checks) { 70 if ($added =~ $rule->[0]) { 71 $errors .= "$HOOK: $rule->[1][1]: $added\n" 72 if $added =~ $rule->[1][0]; 73 next ADDED; 74 } 75 } 76 foreach my $check (@Checks) { 77 if ($added =~ $check->[0]) { 78 $errors .= "$HOOK: $check->[1]: $added\n"; 79 next ADDED; 80 } 81 } 82 } 83 84 croak $errors if $errors; 85} 86 871; # End of SVN::Hooks::DenyFilenames 88 89__END__ 90 91=pod 92 93=encoding UTF-8 94 95=head1 NAME 96 97SVN::Hooks::DenyFilenames - Deny some file names. 98 99=head1 VERSION 100 101version 1.34 102 103=head1 SYNOPSIS 104 105This SVN::Hooks plugin is used to disallow the addition of some file 106names. 107 108It's active in the C<pre-commit> hook. 109 110It's configured by the following directives. 111 112=head2 DENY_FILENAMES(REGEXP, [REGEXP => MESSAGE], ...) 113 114This directive denies the addition of new files matching the Regexps 115passed as arguments. If any file or directory added in the commit 116matches one of the specified Regexps the commit is aborted with an 117error message telling about every denied file. 118 119The arguments may be compiled Regexps or two-element arrays consisting 120of a compiled Regexp and a specific error message. If a file matches 121one of the lone Regexps an error message like this is produced: 122 123 DENY_FILENAMES: filename not allowed: filename 124 125If a file matches a Regexp associated with an error message, the 126specified error message is substituted for the 'filename not allowed' 127default. 128 129Note that this directive specifies a default restriction. If there are 130any B<DENY_FILENAMES_PER_PATH> directives (see below) being used, this 131one is only used for files that don't match any specific rules there. 132 133Example: 134 135 DENY_FILENAMES( 136 qr/\.(doc|xls|ppt)$/i, # ODF only, please 137 [qr/\.(exe|zip|jar)/i => 'No binaries, please!'], 138 ); 139 140=head2 DENY_FILENAMES_PER_PATH(REGEXP => REGEXP, REGEXP => [REGEXP => MESSAGE], ...) 141 142This directive is more specific than the B<DENY_FILENAMES>, because it 143allows one to specify different restrictions in different regions of 144the repository tree. 145 146Its arguments are a sequence of rules, each one consisting of a 147pair. The first element of each pair is a regular expression 148specifying where in the repository this rule applies. It applies if 149any file being added matches the regexp. The second element specifies 150the restrictions that should be imposed, just like the arguments to 151B<DENY_FILENAMES>. 152 153The first rule matching an added file is used to check it. The 154following rules aren't tried. 155 156Only if no rules match a particular file will the restrictions defined 157by B<DENY_FILENAMES> be imposed. 158 159Example: 160 161 DENY_FILENAMES_PER_PATH( 162 qr:/src/: => [qr/[^\w.-]/ => 'source files must be strict'], 163 qr:/doc/: => qr/[^\w\s.-]/i, # document files allow spaces too. 164 qr:/notes/: => qr/^$/, # notes directory allows anything. 165 ); 166 167=for Pod::Coverage pre_commit 168 169=head1 AUTHOR 170 171Gustavo L. de M. Chaves <gnustavo@cpan.org> 172 173=head1 COPYRIGHT AND LICENSE 174 175This software is copyright (c) 2016 by CPqD <www.cpqd.com.br>. 176 177This is free software; you can redistribute it and/or modify it under 178the same terms as the Perl 5 programming language system itself. 179 180=cut 181