contrib/hook-scripts/check-mime-type.pl - subversion - Git at Google

 #!/usr/bin/env perl

 # ====================================================================
 # check-mime-type.pl: check that every added or property-modified file
 # has the svn:mime-type property set and every added or property-modified
 # file with a mime-type matching text/* also has svn:eol-style set.
 # If any file fails this test the user is sent a verbose error message
 # suggesting solutions and the commit is aborted.
 #
 # Usage: check-mime-type.pl REPOS TXN-NAME
 # ====================================================================
 # Most of check-mime-type.pl was taken from
 # commit-access-control.pl, Revision 9986, 2004-06-14 16:29:22 -0400.
 # ====================================================================
 # Copyright (c) 2000-2009 CollabNet.  All rights reserved.
 # Copyright (c) 2010-2020 Apache Software Foundation (ASF).
 # ====================================================================
 #    Licensed to the Apache Software Foundation (ASF) under one
 #    or more contributor license agreements.  See the NOTICE file
 #    distributed with this work for additional information
 #    regarding copyright ownership.  The ASF licenses this file
 #    to you under the Apache License, Version 2.0 (the
 #    "License"); you may not use this file except in compliance
 #    with the License.  You may obtain a copy of the License at
 #
 #      http://www.apache.org/licenses/LICENSE-2.0
 #
 #    Unless required by applicable law or agreed to in writing,
 #    software distributed under the License is distributed on an
 #    "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
 #    KIND, either express or implied.  See the License for the
 #    specific language governing permissions and limitations
 #    under the License.
 # ====================================================================

 # Turn on warnings the best way depending on the Perl version.
 BEGIN {
   if ( $] >= 5.006_000)
     { require warnings; import warnings; }
   else
     { $^W = 1; }
 }

 use strict;
 use Carp;


 ######################################################################
 # Configuration section.

 # Toggle: Check files of mime-type text/* for svn:eol-style property.
 my $check_text_eol = 1;

 # Toggle: Check property-modified files too.
 my $check_prop_modified_files = 0;

 # Svnlook path.
 my $svnlook = "/usr/bin/svnlook";

 # Since the path to svnlook depends upon the local installation
 # preferences, check that the required program exists to insure that
 # the administrator has set up the script properly.
 {
   my $ok = 1;
   foreach my $program ($svnlook)
     {
       if (-e $program)
         {
           unless (-x $program)
             {
               warn "$0: required program `$program' is not executable, ",
                    "edit $0.\n";
               $ok = 0;
             }
         }
       else
         {
           warn "$0: required program `$program' does not exist, edit $0.\n";
           $ok = 0;
         }
     }
   exit 1 unless $ok;
 }

 ######################################################################
 # Initial setup/command-line handling.

 &usage unless @ARGV == 2;

 my $repos        = shift;
 my $txn          = shift;

 unless (-e $repos)
   {
     &usage("$0: repository directory `$repos' does not exist.");
   }
 unless (-d $repos)
   {
     &usage("$0: repository directory `$repos' is not a directory.");
   }

 # Define two constant subroutines to stand for read-only or read-write
 # access to the repository.
 sub ACCESS_READ_ONLY  () { 'read-only' }
 sub ACCESS_READ_WRITE () { 'read-write' }


 ######################################################################
 # Harvest data using svnlook.

 # Change into /tmp so that svnlook diff can create its .svnlook
 # directory.
 my $tmp_dir = '/tmp';
 chdir($tmp_dir)
   or die "$0: cannot chdir `$tmp_dir': $!\n";

 # Figure out what files have been added/property-modified using svnlook.
 my $regex_files_to_check;
 if ($check_prop_modified_files)
   {
     $regex_files_to_check = qr/^(?:A.|.U)  (.*[^\/])$/;
   }
 else
   {
     $regex_files_to_check = qr/^A.  (.*[^\/])$/;
   }
 my @files_to_check;
 foreach my $line (&read_from_process($svnlook, 'changed', $repos, '-t', $txn))
   {
     # Add only files that were added/property-modified to @files_to_check
     if ($line =~ /$regex_files_to_check/)
       {
         push(@files_to_check, $1);
       }
   }

 my @errors;
 foreach my $path ( @files_to_check )
 	{
 		my $mime_type;
 		my $eol_style;

 		# Parse the complete list of property values of the file $path to extract
 		# the mime-type and eol-style

 		my @output = &read_from_process($svnlook, 'proplist', $repos, '-t',
 					$txn, '--verbose', '--', $path);
 		my $output_line = 0;

 		foreach my $prop (@output)
 			{
 				if ($prop =~ /^\s*svn:mime-type( : (\S+))?/)
 					{
 						$mime_type = $2;
 						# 1.7.8 (r1416637) onwards changed the format of svnloop proplist --verbose
 						# from propname : propvalue format, to values in an indent list on following lines
 						if (not $mime_type)
 							{
 								if ($output_line + 1 >= scalar(@output))
 									{
 										die "$0: Unexpected EOF reading proplist.\n";
 									}
 								my $next_line_pval_indented = $output[$output_line + 1];
 								if ($next_line_pval_indented =~ /^\s{4}(.*)/)
 									{
 										$mime_type = $1;
 									}
 							}
 					}
 				elsif ($prop =~ /^\s*svn:eol-style( : (\S+))?/)
 					{
 						$eol_style = $2;
 						if (not $eol_style)
 							{
 								if ($output_line + 1 >= scalar(@output))
 									{
 										die "$0: Unexpected EOF reading proplist.\n";
 									}
 								my $next_line_pval_indented = $output[$output_line + 1];
 								if ($next_line_pval_indented =~ /^\s{4}(.*)/)
 									{
 										$eol_style = $1;
 									}
 							}
 					}
 				$output_line++;
 			}

 		# Detect error conditions and add them to @errors
 		if (not $mime_type)
 			{
 				push @errors, "$path : svn:mime-type is not set";
 			}
 		elsif ($check_text_eol and $mime_type =~ /^text\// and not $eol_style)
 			{
 				push @errors, "$path : svn:mime-type=$mime_type but svn:eol-style is not set";
 			}
 	}

 # If there are any errors list the problem files and give information
 # on how to avoid the problem. Hopefully people will set up auto-props
 # and will not see this verbose message more than once.
 if (@errors)
   {
     my $addition1 = '';
     my $addition2 = '';
     my $addition3 = '';
     if ($check_prop_modified_files)
       {
         $addition1 = '/property-modified';
       }
     if ($check_text_eol)
       {
         $addition2 = "    In addition text files must have the svn:eol-style property set.\n";
         $addition3 = "    svn propset svn:eol-style native path/of/file\n";
       }
     warn "$0:\n\n",
          join("\n", @errors), "\n\n",
                  <<"EOS";

     Every added$addition1 file must have the svn:mime-type property set.
 $addition2
     For binary files try running
     svn propset svn:mime-type application/octet-stream path/of/file

     For text files try
     svn propset svn:mime-type text/plain path/of/file
 $addition3
     You may want to consider uncommenting the auto-props section
     in your ~/.subversion/config file. Read the Subversion book
     (https://svnbook.red-bean.com/), Chapter 7, Properties section,
     Automatic Property Setting subsection for more help.
 EOS
     exit 1;
   }
 else
   {
     exit 0;
   }

 sub usage
 {
   warn "@_\n" if @_;
   die "usage: $0 REPOS TXN-NAME\n";
 }

 sub safe_read_from_pipe
 {
   unless (@_)
     {
       croak "$0: safe_read_from_pipe passed no arguments.\n";
     }
   print "Running @_\n";
   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";
     }
   my @output;
   while (<SAFE_READ>)
     {
       chomp;
       push(@output, $_);
     }
   close(SAFE_READ);
   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;
     }
 }

 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;
     }
 }
	#!/usr/bin/env perl

	# ====================================================================
	# check-mime-type.pl: check that every added or property-modified file
	# has the svn:mime-type property set and every added or property-modified
	# file with a mime-type matching text/* also has svn:eol-style set.
	# If any file fails this test the user is sent a verbose error message
	# suggesting solutions and the commit is aborted.
	#
	# Usage: check-mime-type.pl REPOS TXN-NAME
	# ====================================================================
	# Most of check-mime-type.pl was taken from
	# commit-access-control.pl, Revision 9986, 2004-06-14 16:29:22 -0400.
	# ====================================================================
	# Copyright (c) 2000-2009 CollabNet. All rights reserved.
	# Copyright (c) 2010-2020 Apache Software Foundation (ASF).
	# ====================================================================
	# Licensed to the Apache Software Foundation (ASF) under one
	# or more contributor license agreements. See the NOTICE file
	# distributed with this work for additional information
	# regarding copyright ownership. The ASF licenses this file
	# to you under the Apache License, Version 2.0 (the
	# "License"); you may not use this file except in compliance
	# with the License. You may obtain a copy of the License at
	#
	# http://www.apache.org/licenses/LICENSE-2.0
	#
	# Unless required by applicable law or agreed to in writing,
	# software distributed under the License is distributed on an
	# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
	# KIND, either express or implied. See the License for the
	# specific language governing permissions and limitations
	# under the License.
	# ====================================================================

	# Turn on warnings the best way depending on the Perl version.
	BEGIN {
	if ( $] >= 5.006_000)
	{ require warnings; import warnings; }
	else
	{ $^W = 1; }
	}

	use strict;
	use Carp;


	######################################################################
	# Configuration section.

	# Toggle: Check files of mime-type text/* for svn:eol-style property.
	my $check_text_eol = 1;

	# Toggle: Check property-modified files too.
	my $check_prop_modified_files = 0;

	# Svnlook path.
	my $svnlook = "/usr/bin/svnlook";

	# Since the path to svnlook depends upon the local installation
	# preferences, check that the required program exists to insure that
	# the administrator has set up the script properly.
	{
	my $ok = 1;
	foreach my $program ($svnlook)
	{
	if (-e $program)
	{
	unless (-x $program)
	{
	warn "$0: required program `$program' is not executable, ",
	"edit $0.\n";
	$ok = 0;
	}
	}
	else
	{
	warn "$0: required program `$program' does not exist, edit $0.\n";
	$ok = 0;
	}
	}
	exit 1 unless $ok;
	}

	######################################################################
	# Initial setup/command-line handling.

	&usage unless @ARGV == 2;

	my $repos = shift;
	my $txn = shift;

	unless (-e $repos)
	{
	&usage("$0: repository directory `$repos' does not exist.");
	}
	unless (-d $repos)
	{
	&usage("$0: repository directory `$repos' is not a directory.");
	}

	# Define two constant subroutines to stand for read-only or read-write
	# access to the repository.
	sub ACCESS_READ_ONLY () { 'read-only' }
	sub ACCESS_READ_WRITE () { 'read-write' }


	######################################################################
	# Harvest data using svnlook.

	# Change into /tmp so that svnlook diff can create its .svnlook
	# directory.
	my $tmp_dir = '/tmp';
	chdir($tmp_dir)
	or die "$0: cannot chdir `$tmp_dir': $!\n";

	# Figure out what files have been added/property-modified using svnlook.
	my $regex_files_to_check;
	if ($check_prop_modified_files)
	{
	$regex_files_to_check = qr/^(?:A.\|.U) (.*[^\/])$/;
	}
	else
	{
	$regex_files_to_check = qr/^A. (.*[^\/])$/;
	}
	my @files_to_check;
	foreach my $line (&read_from_process($svnlook, 'changed', $repos, '-t', $txn))
	{
	# Add only files that were added/property-modified to @files_to_check
	if ($line =~ /$regex_files_to_check/)
	{
	push(@files_to_check, $1);
	}
	}

	my @errors;
	foreach my $path ( @files_to_check )
	{
	my $mime_type;
	my $eol_style;

	# Parse the complete list of property values of the file $path to extract
	# the mime-type and eol-style

	my @output = &read_from_process($svnlook, 'proplist', $repos, '-t',
	$txn, '--verbose', '--', $path);
	my $output_line = 0;

	foreach my $prop (@output)
	{
	if ($prop =~ /^\s*svn:mime-type( : (\S+))?/)
	{
	$mime_type = $2;
	# 1.7.8 (r1416637) onwards changed the format of svnloop proplist --verbose
	# from propname : propvalue format, to values in an indent list on following lines
	if (not $mime_type)
	{
	if ($output_line + 1 >= scalar(@output))
	{
	die "$0: Unexpected EOF reading proplist.\n";
	}
	my $next_line_pval_indented = $output[$output_line + 1];
	if ($next_line_pval_indented =~ /^\s{4}(.*)/)
	{
	$mime_type = $1;
	}
	}
	}
	elsif ($prop =~ /^\s*svn:eol-style( : (\S+))?/)
	{
	$eol_style = $2;
	if (not $eol_style)
	{
	if ($output_line + 1 >= scalar(@output))
	{
	die "$0: Unexpected EOF reading proplist.\n";
	}
	my $next_line_pval_indented = $output[$output_line + 1];
	if ($next_line_pval_indented =~ /^\s{4}(.*)/)
	{
	$eol_style = $1;
	}
	}
	}
	$output_line++;
	}

	# Detect error conditions and add them to @errors
	if (not $mime_type)
	{
	push @errors, "$path : svn:mime-type is not set";
	}
	elsif ($check_text_eol and $mime_type =~ /^text\// and not $eol_style)
	{
	push @errors, "$path : svn:mime-type=$mime_type but svn:eol-style is not set";
	}
	}

	# If there are any errors list the problem files and give information
	# on how to avoid the problem. Hopefully people will set up auto-props
	# and will not see this verbose message more than once.
	if (@errors)
	{
	my $addition1 = '';
	my $addition2 = '';
	my $addition3 = '';
	if ($check_prop_modified_files)
	{
	$addition1 = '/property-modified';
	}
	if ($check_text_eol)
	{
	$addition2 = " In addition text files must have the svn:eol-style property set.\n";
	$addition3 = " svn propset svn:eol-style native path/of/file\n";
	}
	warn "$0:\n\n",
	join("\n", @errors), "\n\n",
	<<"EOS";

	Every added$addition1 file must have the svn:mime-type property set.
	$addition2
	For binary files try running
	svn propset svn:mime-type application/octet-stream path/of/file

	For text files try
	svn propset svn:mime-type text/plain path/of/file
	$addition3
	You may want to consider uncommenting the auto-props section
	in your ~/.subversion/config file. Read the Subversion book
	(https://svnbook.red-bean.com/), Chapter 7, Properties section,
	Automatic Property Setting subsection for more help.
	EOS
	exit 1;
	}
	else
	{
	exit 0;
	}

	sub usage
	{
	warn "@_\n" if @_;
	die "usage: $0 REPOS TXN-NAME\n";
	}

	sub safe_read_from_pipe
	{
	unless (@_)
	{
	croak "$0: safe_read_from_pipe passed no arguments.\n";
	}
	print "Running @_\n";
	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";
	}
	my @output;
	while (<SAFE_READ>)
	{
	chomp;
	push(@output, $_);
	}
	close(SAFE_READ);
	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;
	}
	}

	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;
	}
	}