You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

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