qemu/roms/ipxe/src/util/relicense.pl

   1 #!/usr/bin/perl -w
   2
   3 =head1 NAME
   4
   5 relicense.pl
   6
   7 =head1 SYNOPSIS
   8
   9 relicense.pl [options] -p <permissions file> <file> [<file>...]
  10
  11 Option:
  12
  13     -p,--permitted=FILE Specify file of emails with relicensing permission
  14     -f,--force          Manually force relicensing
  15     -h,--help           Display brief help message
  16     -v,--verbose        Increase verbosity
  17     -q,--quiet          Decrease verbosity
  18
  19 =cut
  20
  21 use File::Slurp;
  22 use IPC::Run qw ( run );
  23 use Getopt::Long;
  24 use Pod::Usage;
  25 use strict;
  26 use warnings;
  27
  28 # Parse command-line options
  29 my $verbosity = 0;
  30 my $permfile;
  31 my $force;
  32 Getopt::Long::Configure ( "bundling", "auto_abbrev" );
  33 GetOptions (
  34   'permitted|p=s' => \$permfile,
  35   'force|f' => \$force,
  36   'verbose|v+' => sub { $verbosity++; },
  37   'quiet|q+' => sub { $verbosity--; },
  38   'help|h' => sub { pod2usage ( 1 ); },
  39 ) or die "Could not parse command-line options";
  40 pod2usage ( 1 ) unless @ARGV;
  41
  42 # Read permitted emails file
  43 my @emails = ( $permfile ? read_file ( $permfile ) : () );
  44 chomp @emails;
  45 my $permitted = { map { /^.*<(\S+)>$/; ( $1 || $_ ) => 1 } @emails };
  46
  47 # Define list of relicensable licences
  48 my $relicensable = {
  49   GPL2_OR_LATER => 1,
  50 };
  51
  52 # Define blurb to be added to copyright notice
  53 my $blurb = '
  54  *
  55  * You can also choose to distribute this program under the terms of
  56  * the Unmodified Binary Distribution Licence (as given in the file
  57  * COPYING.UBDL), provided that you have satisfied its requirements.';
  58
  59 # Process files
  60 my @succeeded;
  61 my @failed;
  62 while ( my $filename = shift @ARGV ) {
  63
  64   # Read file to determine existing licence
  65   my $file = read_file ( $filename );
  66   my @licences = ( $file =~ /^\s*FILE_LICENCE\s*\(\s*(\S+)\s*\)\s*;?$/mg );
  67   die "No licence declaration in $filename\n" unless @licences;
  68   die "Multiple licence declarations in $filename\n" if @licences > 1;
  69   my $licence = $licences[0];
  70
  71   # Skip if file is already UBDL-licensed
  72   next if $licence =~ /_OR_UBDL$/;
  73
  74   # Fail immediately if file is not a candidate for relicensing
  75   if ( ! exists $relicensable->{$licence} ) {
  76     print "Non-relicensable licence $licence in $filename\n";
  77     push @failed, $filename;
  78     next;
  79   }
  80
  81   # Run git-blame
  82   my $stdout;
  83   my $stderr;
  84   run [ "git", "blame", "-M", "-C", "-p", "-w", $filename ],
  85       \undef, \$stdout, \$stderr
  86       or die "git-blame $filename: $?";
  87   die $stderr if $stderr;
  88
  89   # Process output
  90   my @stdout = split ( /\n/, $stdout );
  91   chomp @stdout;
  92   my $details = {};
  93   my $failures = 0;
  94   while ( @stdout ) {
  95
  96     # Parse output
  97     my $commit_line = shift @stdout;
  98     ( my $commit, undef, my $lineno, undef, my $count ) =
  99         ( $commit_line =~
 100           /^([0-9a-f]{40})\s+([0-9]+)\s+([0-9]+)(\s+([0-9]+))?$/ )
 101         or die "Malformed commit line \"$commit_line\"\n";
 102     if ( $count ) {
 103       $details->{$commit} ||= {};
 104       while ( ! ( $stdout[0] =~ /^\t/ ) ) {
 105         my $detail_line = shift @stdout;
 106         ( my $key, undef, my $value ) =
 107             ( $detail_line =~ /^([a-z-]+)(\s+(.+))?$/ )
 108             or die "Malformed detail line \"$detail_line\" for $commit_line\n";
 109         $details->{$commit}->{$key} = $value;
 110       }
 111     }
 112     die "Missing commit details for $commit_line\n"
 113         unless %{$details->{$commit}};
 114     my $code_line = shift @stdout;
 115     ( my $line ) = ( $code_line =~ /^\t(.*)$/ )
 116         or die "Malformed code line \"$code_line\" for $commit_line\n";
 117
 118     # Skip trivial lines and lines so common that they are likely to
 119     # be misattributed by git-blame
 120     next if $line =~ /^\s*$/;           # Empty lines
 121     next if $line =~ /^\s*\/\*/;        # Start of comments
 122     next if $line =~ /^\s*\*/;          # Middle (or end) of comments
 123     next if $line =~ /^\s*\{\s*$/;      # Standalone opening braces
 124     next if $line =~ /^\s*\};?\s*$/;    # Standalone closing braces
 125     next if $line =~ /^\#include/;      # Header inclusions
 126     next if $line =~ /^\s*return\s+0;/; # return 0;
 127     next if $line =~ /^\s*return\s+rc;/; # return rc;
 128     next if $line =~ /^\s*PCI_ROM\s*\(.*\)\s*,\s*$/;    # PCI IDs
 129     next if $line =~ /^\s*FILE_LICENCE\s*\(.*\)\s*;$/; # Licence declarations
 130
 131     # Identify author
 132     my $author_mail = $details->{$commit}->{"author-mail"}
 133     or die "Missing author email for $commit_line\n";
 134     ( my $email ) = ( $author_mail =~ /^<(\S+)>$/ )
 135         or die "Malformed author email \"$author_mail\" for $commit_line\n";
 136     undef $email if exists $details->{$commit}->{boundary};
 137
 138     # Check for relicensing permission
 139     next if defined $email && exists $permitted->{$email};
 140
 141     # Print out lines lacking permission
 142     printf $filename."\n" unless $failures;
 143     printf "%4d %-30s %s\n", $lineno, ( $email || "<root>" ), $line;
 144     $failures++;
 145   }
 146
 147   # Fail if there are any non-trivial lines lacking relicensing permission
 148   if ( $failures && ! $force ) {
 149     push @failed, $filename;
 150     next;
 151   }
 152
 153   # Modify FILE_LICENCE() line
 154   $file =~ s/(^\s*FILE_LICENCE\s*\(\s*${licence})(\s*\)\s*;?$)/$1_OR_UBDL$2/m
 155       or die "Could not modify FILE_LICENCE() in $filename\n";
 156
 157   # Modify copyright notice, if present
 158   if ( $file =~ /GNU General Public License/i ) {
 159     $file =~ s/(02110-1301, USA.$)/$1${blurb}/m
 160         or die "Could not modify copyright notice in $filename\n";
 161   }
 162
 163   # Write out modified file
 164   write_file ( $filename, { atomic => 1 }, $file );
 165   push @succeeded, $filename;
 166 }
 167
 168 print "Relicensed: ".join ( " ", @succeeded )."\n" if @succeeded;
 169 die "Cannot relicense: ".join ( " ", @failed )."\n" if @failed;