[legal] Add UBDL relicensing tool
The UBDL relicensing tool (util/relicense.pl) is designed to identify files which may be relicensed under a dual GPL+UBDL licence. It uses git-blame to identify the author of each line (using the -M and -C options to track lines moved or copied between files), and relicenses files for which all authors have given permission. The relicensing tool will ignore certain types of lines identified by git-blame: - empty lines - comments - standalone opening or closing braces - "#include ..." - "return 0;" - "return rc;" - "PCI_ROM(...)" - "FILE_LICENCE(...)" These lines either contain no meaningful content (e.g. empty lines), contain only non-copyrightable facts (e.g. PCI ROM IDs) or are sufficiently common within the codebase that git-blame is likely to misattribute their origin (e.g. "return 0"). Signed-off-by: Michael Brown <mcb30@ipxe.org>
This commit is contained in:
Michael Brown
parent
2782ccec41
commit
d454d98d35
|
|
@ -0,0 +1,169 @@
|
|||
#!/usr/bin/perl -w
|
||||
|
||||
=head1 NAME
|
||||
|
||||
relicense.pl
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
relicense.pl [options] -p <permissions file> <file> [<file>...]
|
||||
|
||||
Option:
|
||||
|
||||
-p,--permitted=FILE Specify file of emails with relicensing permission
|
||||
-f,--force Manually force relicensing
|
||||
-h,--help Display brief help message
|
||||
-v,--verbose Increase verbosity
|
||||
-q,--quiet Decrease verbosity
|
||||
|
||||
=cut
|
||||
|
||||
use File::Slurp;
|
||||
use IPC::Run qw ( run );
|
||||
use Getopt::Long;
|
||||
use Pod::Usage;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
# Parse command-line options
|
||||
my $verbosity = 0;
|
||||
my $permfile;
|
||||
my $force;
|
||||
Getopt::Long::Configure ( "bundling", "auto_abbrev" );
|
||||
GetOptions (
|
||||
'permitted|p=s' => \$permfile,
|
||||
'force|f' => \$force,
|
||||
'verbose|v+' => sub { $verbosity++; },
|
||||
'quiet|q+' => sub { $verbosity--; },
|
||||
'help|h' => sub { pod2usage ( 1 ); },
|
||||
) or die "Could not parse command-line options";
|
||||
pod2usage ( 1 ) unless @ARGV;
|
||||
|
||||
# Read permitted emails file
|
||||
my @emails = ( $permfile ? read_file ( $permfile ) : () );
|
||||
chomp @emails;
|
||||
my $permitted = { map { /^.*<(\S+)>$/; ( $1 || $_ ) => 1 } @emails };
|
||||
|
||||
# Define list of relicensable licences
|
||||
my $relicensable = {
|
||||
GPL2_OR_LATER => 1,
|
||||
};
|
||||
|
||||
# Define blurb to be added to copyright notice
|
||||
my $blurb = '
|
||||
*
|
||||
* You can also choose to distribute this program under the terms of
|
||||
* the Unmodified Binary Distribution Licence (as given in the file
|
||||
* COPYING.UBDL), provided that you have satisfied its requirements.';
|
||||
|
||||
# Process files
|
||||
my @succeeded;
|
||||
my @failed;
|
||||
while ( my $filename = shift @ARGV ) {
|
||||
|
||||
# Read file to determine existing licence
|
||||
my $file = read_file ( $filename );
|
||||
my @licences = ( $file =~ /^\s*FILE_LICENCE\s*\(\s*(\S+)\s*\)\s*;?$/mg );
|
||||
die "No licence declaration in $filename\n" unless @licences;
|
||||
die "Multiple licence declarations in $filename\n" if @licences > 1;
|
||||
my $licence = $licences[0];
|
||||
|
||||
# Skip if file is already UBDL-licensed
|
||||
next if $licence =~ /_OR_UBDL$/;
|
||||
|
||||
# Fail immediately if file is not a candidate for relicensing
|
||||
if ( ! exists $relicensable->{$licence} ) {
|
||||
print "Non-relicensable licence $licence in $filename\n";
|
||||
push @failed, $filename;
|
||||
next;
|
||||
}
|
||||
|
||||
# Run git-blame
|
||||
my $stdout;
|
||||
my $stderr;
|
||||
run [ "git", "blame", "-M", "-C", "-p", "-w", $filename ],
|
||||
\undef, \$stdout, \$stderr
|
||||
or die "git-blame $filename: $?";
|
||||
die $stderr if $stderr;
|
||||
|
||||
# Process output
|
||||
my @stdout = split ( /\n/, $stdout );
|
||||
chomp @stdout;
|
||||
my $details = {};
|
||||
my $failures = 0;
|
||||
while ( @stdout ) {
|
||||
|
||||
# Parse output
|
||||
my $commit_line = shift @stdout;
|
||||
( my $commit, undef, my $lineno, undef, my $count ) =
|
||||
( $commit_line =~
|
||||
/^([0-9a-f]{40})\s+([0-9]+)\s+([0-9]+)(\s+([0-9]+))?$/ )
|
||||
or die "Malformed commit line \"$commit_line\"\n";
|
||||
if ( $count ) {
|
||||
$details->{$commit} ||= {};
|
||||
while ( ! ( $stdout[0] =~ /^\t/ ) ) {
|
||||
my $detail_line = shift @stdout;
|
||||
( my $key, undef, my $value ) =
|
||||
( $detail_line =~ /^([a-z-]+)(\s+(.+))?$/ )
|
||||
or die "Malformed detail line \"$detail_line\" for $commit_line\n";
|
||||
$details->{$commit}->{$key} = $value;
|
||||
}
|
||||
}
|
||||
die "Missing commit details for $commit_line\n"
|
||||
unless %{$details->{$commit}};
|
||||
my $code_line = shift @stdout;
|
||||
( my $line ) = ( $code_line =~ /^\t(.*)$/ )
|
||||
or die "Malformed code line \"$code_line\" for $commit_line\n";
|
||||
|
||||
# Skip trivial lines and lines so common that they are likely to
|
||||
# be misattributed by git-blame
|
||||
next if $line =~ /^\s*$/; # Empty lines
|
||||
next if $line =~ /^\s*\/\*/; # Start of comments
|
||||
next if $line =~ /^\s*\*/; # Middle (or end) of comments
|
||||
next if $line =~ /^\s*\{\s*$/; # Standalone opening braces
|
||||
next if $line =~ /^\s*\};?\s*$/; # Standalone closing braces
|
||||
next if $line =~ /^\#include/; # Header inclusions
|
||||
next if $line =~ /^\s*return\s+0;/; # return 0;
|
||||
next if $line =~ /^\s*return\s+rc;/; # return rc;
|
||||
next if $line =~ /^\s*PCI_ROM\s*\(.*\)\s*,\s*$/; # PCI IDs
|
||||
next if $line =~ /^\s*FILE_LICENCE\s*\(.*\)\s*;$/; # Licence declarations
|
||||
|
||||
# Identify author
|
||||
my $author_mail = $details->{$commit}->{"author-mail"}
|
||||
or die "Missing author email for $commit_line\n";
|
||||
( my $email ) = ( $author_mail =~ /^<(\S+)>$/ )
|
||||
or die "Malformed author email \"$author_mail\" for $commit_line\n";
|
||||
undef $email if exists $details->{$commit}->{boundary};
|
||||
|
||||
# Check for relicensing permission
|
||||
next if defined $email && exists $permitted->{$email};
|
||||
|
||||
# Print out lines lacking permission
|
||||
printf $filename."\n" unless $failures;
|
||||
printf "%4d %-30s %s\n", $lineno, ( $email || "<root>" ), $line;
|
||||
$failures++;
|
||||
}
|
||||
|
||||
# Fail if there are any non-trivial lines lacking relicensing permission
|
||||
if ( $failures && ! $force ) {
|
||||
push @failed, $filename;
|
||||
next;
|
||||
}
|
||||
|
||||
# Modify FILE_LICENCE() line
|
||||
$file =~ s/(^\s*FILE_LICENCE\s*\(\s*${licence})(\s*\)\s*;?$)/$1_OR_UBDL$2/m
|
||||
or die "Could not modify FILE_LICENCE() in $filename\n";
|
||||
|
||||
# Modify copyright notice, if present
|
||||
if ( $file =~ /GNU General Public License/i ) {
|
||||
$file =~ s/(02110-1301, USA.$)/$1${blurb}/m
|
||||
or die "Could not modify copyright notice in $filename\n";
|
||||
}
|
||||
|
||||
# Write out modified file
|
||||
write_file ( $filename, { atomic => 1 }, $file );
|
||||
push @succeeded, $filename;
|
||||
}
|
||||
|
||||
print "Relicensed: ".join ( " ", @succeeded )."\n" if @succeeded;
|
||||
die "Cannot relicense: ".join ( " ", @failed )."\n" if @failed;
|
||||
Reference in New Issue