Просмотр исходного кода

[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>
tags/v1.20.1
Michael Brown 9 лет назад
Родитель
Сommit
d454d98d35
1 измененных файлов: 169 добавлений и 0 удалений
  1. 169
    0
      src/util/relicense.pl

+ 169
- 0
src/util/relicense.pl Просмотреть файл

@@ -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;

Загрузка…
Отмена
Сохранить