|
@@ -0,0 +1,169 @@
|
|
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;
|