#!/usr/bin/env perl
# Copyright (c) 2000-2008 CollabNet. All rights reserved.
#
# This software is licensed as described in the file COPYING, which
# you should have received as part of this distribution. The terms
# are also available at http://subversion.tigris.org/license.html.
# If newer versions of this license are posted there, you may use a
# newer version instead, at your option.
#
# This software consists of voluntary contributions made by many
# individuals. For exact contribution history, see the revision
# history and logs, available at http://subversion.tigris.org/.
# ====================================================================
# This pre-commit hook script will check the files that are are listed
# in "svnlook changed" (except deleted files) for possible problems
# with svn:keywords set on binary files. By default, this script will
# allow binary files if they have the fixed width format of the
# keyword in the file. If you want to disallow all keywords in binary
# files, regardless of fixed width format or not, pass --disallowall
# to the script.
#
# The way it determines if the file is binary is it takes the paranoid
# approach that all files are binary, unless proven otherwise. If a
# file has svn:eol-style set, it considers this file text. If the
# file has a svn:mime-type of text/*, it is text. Then, the script can
# be passed file extensions to always consider text.
#
# Command line options are:
#
# --revision (-r) = The revision to pass in on svnlook to inspect. To
# be used for testing only, use --transaction in the
# hook script.
#
# --transaction (-t) = The transaction to inspect. $2 in pre-commit
# scripts.
#
# --repos = The path to the repository. $1 in pre-commit scripts.
#
# --svnlook = Path to svnlook. Default: (/usr/bin/svnlook)
#
# --text (-x) = Declared multiple times for each extension.
# -x .txt -x .html -x .htm
#
# --disallowall = Dissallow all svn:keywords from binary files.
#
# Example usage (inside pre-commit hook script)
#
# REPOS="$1"
# TXN="$2"
# svn-keyword-check.pl --repos $REPOS --transaction $TXT --text .java --text .txt
#
# $HeadURL: http://svn.apache.org/repos/asf/subversion/branches/1.6.x/contrib/hook-scripts/svn-keyword-check.pl $
# $LastChangedRevision: 871287 $
# $LastChangedDate: 2008-05-15 18:24:14 +0000 (Thu, 15 May 2008) $
# $LastChangedBy: blair $
BEGIN {
if ( $] >= 5.006_000) {
require warnings; import warnings;
} else {
$^W = 1;
}
}
use strict;
use Getopt::Long;
use Carp;
# Command line option parsing
my $transaction;
my $revision;
my $repos;
my $svnlook = "/usr/bin/svnlook";
my @text;
my $disallowall = 0;
GetOptions(
'revision|r=s' => \$revision,
'transaction|t=s' => \$transaction,
'repos=s' => \$repos,
'svnlook=s' => \$svnlook,
'disallowall' => \$disallowall,
'text|x=s' => \@text,
);
if (defined($transaction) and !defined($revision)) {
croak "Can't define both revision and transaction!\n";
}
if (!defined($transaction) and !defined($revision)) {
croak "Need to pass a revision or a transaction!\n";
}
if (!defined($repos)) {
croak "Need to pass in repos path!\n";
}
my $flag = (defined($revision)) ? "-r" : "-t";
my $value = (defined($revision)) ? $revision : $transaction;
# Get a list of what has changed.
my @changed = read_from_process("$svnlook changed $flag $value $repos");
# Loop over changed entries, checking each one, except deleted paths.
my @errors;
foreach my $change (@changed) {
chomp($change);
if ($change =~ m/^D /) {
next;
}
$change =~ s/^(?:A |U |UU| U)\s+(.*)/$1/;
if (check($change)) {
push(@errors, $change);
}
}
# Report any errors to STDERR to be marsheled back to the client, and
# exit 1.
if (@errors) {
warn "The following files appear to be binary, and have svn:keywords set,\n";
warn "yet are not in the fixed width format. Please either fix the keyword,\n";
warn "or if the file is text, please set the right svn:mime-type or svn:eol-style\n";
foreach my $error (@errors) {
warn "\t$error\n";
}
exit 1;
}
# Subroutine that checks the paths passed to it. Checks if it has
# "svn:keywords" and if the file is binary, and greps the output of
# svnlook cat of the file for keywords, while trying to do that inside
# a loop to keep memory usage down.
sub check {
my $file = shift;
if (has_svn_property($file, "svn:keywords")) {
if (file_is_binary($file)) {
if ($disallowall) {
return 1;
} else {
my @keywords = get_svnkeywords($file);
my $fh = _pipe("$svnlook cat $flag $value $repos $file");
while (my $line = <$fh>) {
foreach my $keyword (@keywords) {
if ($line =~ m/$keyword/) {
close($fh);
return 1;
}
}
}
}
}
}
return 0;
}
# Heruistics to determine if file is binary.
#
# Take the paranoid approch, everything is binary, unless otherwise
# stated If svn:eol-style is set, it is text If svn:mime-type is
# text/*, it is text a configurable file glob list (extensions, *.txt,
# etc) that are text (defined on the command line)
sub file_is_binary {
my $file = shift;
if (has_svn_property($file, "svn:eol-style")) {
return 0;
}
if (has_svn_property($file, "svn:mime-type")) {
my ($mimetype) = read_from_process("$svnlook propget $flag $value $repos svn:mime-type $file");
chomp($mimetype);
$mimetype =~ s/^\s*(.*)/$1/;
if ($mimetype =~ m/^text\//) {
return 0;
}
}
foreach my $ext (@text) {
if ($file =~ m/\Q$ext\E$/) {
return 0;
}
}
return 1;
}
# Return a list of svn:keywords on a file
sub get_svnkeywords {
my $file = shift;
my @lines = read_from_process("$svnlook propget $flag $value $repos svn:keywords $file");
my @returnlines;
foreach my $line (@lines) {
$line =~ s/\s+/ /;
push(@returnlines, split(/ /, $line));
}
return @returnlines;
}
# Checks if a Subversion property is set on a file.
sub has_svn_property {
my $file = shift;
my $keyword = shift;
my @proplist = read_from_process("$svnlook proplist $flag $value $repos $file");
foreach my $prop (@proplist) {
chomp($prop);
if ($prop =~ m/\b$keyword\b/) {
return 1;
}
}
return 0;
}
# Copied from contrib/hook-scripts/check-mime-type.pl, with some
# modifications. Moved the actual pipe creation to another subroutine
# (_pipe), so I can use _pipe in this code, and the part of the code
# that loops over the output of svnlook cat.
sub safe_read_from_pipe {
unless (@_) {
croak "$0: safe_read_from_pipe passed no arguments.\n";
}
my $fh = _pipe(@_);
my @output;
while (<$fh>) {
chomp;
push(@output, $_);
}
close($fh);
my $result = $?;
my $exit = $result >> 8;
my $signal = $result & 127;
my $cd = $result & 128 ? "with core dump" : "";
if ($signal or $cd) {
warn "$0: pipe from `@_' failed $cd: exit=$exit signal=$signal\n";
}
if (wantarray) {
return ($result, @output);
} else {
return $result;
}
}
# Return the filehandle as a glob so we can loop over it elsewhere.
sub _pipe {
local *SAFE_READ;
my $pid = open(SAFE_READ, '-|');
unless (defined $pid) {
die "$0: cannot fork: $!\n";
}
unless ($pid) {
open(STDERR, ">&STDOUT") or die "$0: cannot dup STDOUT: $!\n";
exec(@_) or die "$0: cannot exec `@_': $!\n";
}
return *SAFE_READ;
}
# Copied from contrib/hook-scripts/check-mime-type.pl
sub read_from_process {
unless (@_) {
croak "$0: read_from_process passed no arguments.\n";
}
my ($status, @output) = &safe_read_from_pipe(@_);
if ($status) {
if (@output) {
die "$0: `@_' failed with this output:\n", join("\n", @output), "\n";
} else {
die "$0: `@_' failed with no output.\n";
}
} else {
return @output;
}
}