contrib/hook-scripts/check-mime-type.pl

   1 #!/usr/bin/env perl
   2
   3 # ====================================================================
   4 # commit-mime-type-check.pl: check that every added file has the
   5 # svn:mime-type property set and every added file with a mime-type
   6 # matching text/* also has svn:eol-style set. If any file fails this
   7 # test the user is sent a verbose error message suggesting solutions and
   8 # the commit is aborted.
   9 #
  10 # Usage: commit-mime-type-check.pl REPOS TXN-NAME
  11 # ====================================================================
  12 # Most of commit-mime-type-check.pl was taken from
  13 # commit-access-control.pl, Revision 9986, 2004-06-14 16:29:22 -0400.
  14 # ====================================================================
  15 # Copyright (c) 2000-2004 CollabNet.  All rights reserved.
  16 #
  17 # This software is licensed as described in the file COPYING, which
  18 # you should have received as part of this distribution.  The terms
  19 # are also available at http://subversion.tigris.org/license.html.
  20 # If newer versions of this license are posted there, you may use a
  21 # newer version instead, at your option.
  22 #
  23 # This software consists of voluntary contributions made by many
  24 # individuals.  For exact contribution history, see the revision
  25 # history and logs, available at http://subversion.tigris.org/.
  26 # ====================================================================
  27
  28 # Turn on warnings the best way depending on the Perl version.
  29 BEGIN {
  30   if ( $] >= 5.006_000)
  31     { require warnings; import warnings; }
  32   else
  33     { $^W = 1; }
  34 }
  35
  36 use strict;
  37 use Carp;
  38
  39
  40 ######################################################################
  41 # Configuration section.
  42
  43 # Svnlook path.
  44 my $svnlook = "/usr/bin/svnlook";
  45
  46 # Since the path to svnlook depends upon the local installation
  47 # preferences, check that the required program exists to insure that
  48 # the administrator has set up the script properly.
  49 {
  50   my $ok = 1;
  51   foreach my $program ($svnlook)
  52     {
  53       if (-e $program)
  54         {
  55           unless (-x $program)
  56             {
  57               warn "$0: required program `$program' is not executable, ",
  58                    "edit $0.\n";
  59               $ok = 0;
  60             }
  61         }
  62       else
  63         {
  64           warn "$0: required program `$program' does not exist, edit $0.\n";
  65           $ok = 0;
  66         }
  67     }
  68   exit 1 unless $ok;
  69 }
  70
  71 ######################################################################
  72 # Initial setup/command-line handling.
  73
  74 &usage unless @ARGV == 2;
  75
  76 my $repos        = shift;
  77 my $txn          = shift;
  78
  79 unless (-e $repos)
  80   {
  81     &usage("$0: repository directory `$repos' does not exist.");
  82   }
  83 unless (-d $repos)
  84   {
  85     &usage("$0: repository directory `$repos' is not a directory.");
  86   }
  87
  88 # Define two constant subroutines to stand for read-only or read-write
  89 # access to the repository.
  90 sub ACCESS_READ_ONLY  () { 'read-only' }
  91 sub ACCESS_READ_WRITE () { 'read-write' }
  92
  93
  94 ######################################################################
  95 # Harvest data using svnlook.
  96
  97 # Change into /tmp so that svnlook diff can create its .svnlook
  98 # directory.
  99 my $tmp_dir = '/tmp';
 100 chdir($tmp_dir)
 101   or die "$0: cannot chdir `$tmp_dir': $!\n";
 102
 103 # Figure out what files have added using svnlook.
 104 my @files_added;
 105 foreach my $line (&read_from_process($svnlook, 'changed', $repos, '-t', $txn))
 106   {
 107                 # Add only files that were added to @files_added
 108     if ($line =~ /^A.  (.*[^\/])$/)
 109       {
 110         push(@files_added, $1);
 111       }
 112   }
 113
 114 my @errors;
 115 foreach my $path ( @files_added )
 116         {
 117                 my $mime_type;
 118                 my $eol_style;
 119
 120                 # Parse the complete list of property values of the file $path to extract
 121                 # the mime-type and eol-style
 122                 foreach my $prop (&read_from_process($svnlook, 'proplist', $repos, '-t',
 123                                   $txn, '--verbose', $path))
 124                         {
 125                                 if ($prop =~ /^\s*svn:mime-type : (\S+)/)
 126                                         {
 127                                                 $mime_type = $1;
 128                                         }
 129                                 elsif ($prop =~ /^\s*svn:eol-style : (\S+)/)
 130                                         {
 131                                                 $eol_style = $1;
 132                                         }
 133                         }
 134
 135                 # Detect error conditions and add them to @errors
 136                 if (not $mime_type)
 137                         {
 138                                 push @errors, "$path : svn:mime-type is not set";
 139                         }
 140                 elsif ($mime_type =~ /^text\// and not $eol_style)
 141                         {
 142                                 push @errors, "$path : svn:mime-type=$mime_type but svn:eol-style is not set";
 143                         }
 144         }
 145
 146 # If there are any errors list the problem files and give information
 147 # on how to avoid the problem. Hopefully people will set up auto-props
 148 # and will not see this verbose message more than once.
 149 if (@errors)
 150   {
 151     warn "$0:\n\n",
 152          join("\n", @errors), "\n\n",
 153                                  <<EOS;
 154
 155     Every added file must have the svn:mime-type property set. In
 156     addition text files must have the svn:eol-style property set.
 157
 158     For binary files try running
 159     svn propset svn:mime-type application/octet-stream path/of/file
 160
 161     For text files try
 162     svn propset svn:mime-type text/plain path/of/file
 163     svn propset svn:eol-style native path/of/file
 164
 165     You may want to consider uncommenting the auto-props section
 166     in your ~/.subversion/config file. Read the Subversion book
 167     (http://svnbook.red-bean.com/), Chapter 7, Properties section,
 168     Automatic Property Setting subsection for more help.
 169 EOS
 170     exit 1;
 171   }
 172 else
 173   {
 174     exit 0;
 175   }
 176
 177 sub usage
 178 {
 179   warn "@_\n" if @_;
 180   die "usage: $0 REPOS TXN-NAME\n";
 181 }
 182
 183 sub safe_read_from_pipe
 184 {
 185   unless (@_)
 186     {
 187       croak "$0: safe_read_from_pipe passed no arguments.\n";
 188     }
 189   print "Running @_\n";
 190   my $pid = open(SAFE_READ, '-|');
 191   unless (defined $pid)
 192     {
 193       die "$0: cannot fork: $!\n";
 194     }
 195   unless ($pid)
 196     {
 197       open(STDERR, ">&STDOUT")
 198         or die "$0: cannot dup STDOUT: $!\n";
 199       exec(@_)
 200         or die "$0: cannot exec `@_': $!\n";
 201     }
 202   my @output;
 203   while (<SAFE_READ>)
 204     {
 205       chomp;
 206       push(@output, $_);
 207     }
 208   close(SAFE_READ);
 209   my $result = $?;
 210   my $exit   = $result >> 8;
 211   my $signal = $result & 127;
 212   my $cd     = $result & 128 ? "with core dump" : "";
 213   if ($signal or $cd)
 214     {
 215       warn "$0: pipe from `@_' failed $cd: exit=$exit signal=$signal\n";
 216     }
 217   if (wantarray)
 218     {
 219       return ($result, @output);
 220     }
 221   else
 222     {
 223       return $result;
 224     }
 225 }
 226
 227 sub read_from_process
 228   {
 229   unless (@_)
 230     {
 231       croak "$0: read_from_process passed no arguments.\n";
 232     }
 233   my ($status, @output) = &safe_read_from_pipe(@_);
 234   if ($status)
 235     {
 236       if (@output)
 237         {
 238           die "$0: `@_' failed with this output:\n", join("\n", @output), "\n";
 239         }
 240       else
 241         {
 242           die "$0: `@_' failed with no output.\n";
 243         }
 244     }
 245   else
 246     {
 247       return @output;
 248     }
 249 }