]>
git.ipfire.org Git - thirdparty/squid.git/blob - scripts/boiler-mgr.pl
3 ## Copyright (C) 1996-2020 The Squid Software Foundation and contributors
5 ## Squid software is distributed under GPLv2+ license and includes
6 ## contributions from numerous individuals and organizations.
7 ## Please see the COPYING and CONTRIBUTORS files for details.
10 # Adds or adjusts the source file boilerplate, such as a Copyright statement.
11 # The boilerplate is meant to remain constant from one source file to another.
13 # The old boilerplate is assumed to be the first /* comment */ in a source
14 # file, before the first #include statement other than #include "squid.h".
15 # Common old boilerplates are removed, with copyright-related claims contained
16 # in them logged on stdout for recording in CONTRIBUTORS or some such.
17 # Copyright and (C) (but not AUTHOR-like) lines are left in sources except
18 # when we have a permission to move them to CONTRIBUTORS.
20 # The new boilerplate comment is placed at the very beginning of the file,
21 # followed by old copyright lines, "inspired by" lines, and DEBUG section
22 # comments (if any were found in the old boilerplate).
24 # The script tries hard to detect files with unusual old boilerplates. When
25 # detected, the script warns about the problem and leaves the file "as is".
30 die("usage: $0 <boilerplate-file> <source-file> ...\n") unless @ARGV >= 2;
31 my ($BoilerName, @FileNames) = @ARGV;
33 my $CorrectBoiler = `cat $BoilerName` or
34 die("cannot load boilerplate from $BoilerName: $!, stopped");
35 $CorrectBoiler = &trimL
(&trimR
($CorrectBoiler)) . "\n\n";
37 # the first /* comment */
42 # Debugging section inside a boilerplate comment.
47 # Same as $reDebug, but does not match empty DEBUG: statements.
49 ^[\s
*]*(DEBUG
:[^\S
\n]*\S
.*?
)\s
*$
52 # Copyright-related claims inside a boilerplate comment
56 AUTHOR
\b(?
:.|\n)*?\
*[/\s
]*$| # all authors until an "empty" line
57 ORIGINAL\s
+AUTHOR
\b| # or not the latest author
58 COPYRIGHT
\b(?
!\sfile
)| # or copyright (except "COPYRIGHT file")
59 Portions\scopyright
| # or partial copyright
60 (?
<!Squid
.is
.Copyrighted
.)\
(C\
)\s
| # or (C) (except "Squid is ...")
61 Based
.upon
.original
.+code
.by\s
*\n| # or this common pearl
62 Modified\sby\s
| # or this
63 BASED\sON
:\s
# or this
65 .*?
# and the claim content itself
69 # removes common claim prefixes to minimize claim noise
70 my $reClaimPrefix = qr{
71 (?
:ORIGINAL\s
)?AUTHOR
:?
|
77 # We have persmission to move these frequent claims to CONTRIBUTORS.
78 my $reClaimsOkToMove = qr{
79 Robert
.Collins
|<robertc\
@squid-cache
.org
>|<rbtcollins\
@hotmail.com
>|
83 Francesco
.Chemolli
|<kinkie\
@squid-cache
.org
>|<kinkie\
@kame.usr
.dsi
.unimi
.it
>|
85 Amos
.Jeffries
|<amosjeffries\
@squid-cache
.org
>|<squid3\
@treenet.co
.nz
>|
86 Treehouse
.Networks
.Ltd
.|
87 GPL
.version
.2,..C
.2007-2013|
89 Henrik
.Nordstrom
|<henrik\
@henriknordstrom.net
>|
92 Guido
.Serassio
|<serassio\
@squid-cache
.org
>|<guido
.serassio\
@acmeconsulting.it
>|
95 # inspirations are not copyright claims but should be preserved
96 my $reInspiration = qr/^[\s*]*(inspired by previous work.*?)$/mi;
98 # The most common GPL text, with some address variations.
100 "This program is free software; you can redistribute it and/or modify".
101 "([^*]|[*][^/])+". # not a /* comment */ closure
102 "Foundation, Inc., [^\\n]+MA\\s+[-\\d]+, USA\\.";
103 my $reGpl = qr{$strGpl}s;
105 # Two most common Squid (C) statements.
106 my $strSqCopyStart1 =
107 "SQUID Web Proxy Cache\\s+http://www.squid-cache.org/";
108 my $strSqCopyStart2 =
109 "SQUID Internet Object Cache\\s+http://squid.nlanr.net/Squid/";
112 "numerous individuals".
114 "file for full details.";
115 my $reSquidCopy = qr{($strSqCopyStart1|$strSqCopyStart2)$strSqCopyEnd}s;
118 my $FileName; # for Warn()ings
119 my %ReportedClaims; # to minimize noise in claims reporting
120 $| = 1; # report claims ASAP (but on STDOUT)
122 # process each file in-place; do not touch files on known failures
123 foreach my $fname (@FileNames) {
126 my $code = &readFile
($fname) or next;
127 my $virginCode = $code;
129 &WarnQuiet
("Correct boilerplate already present, skipping:", $code), next if
130 $code =~ /\Q$CorrectBoiler\E/s;
134 if ($code =~ m/$reComment/) {
135 my $beforeComment = $`;
138 # Is the matched comment a boilerplate?
139 if ($comment !~ m/\n/) {
140 # A single line comment is not a boilerplate.
141 } elsif ($beforeComment =~ m/^\s*\#\s*include\s+(?!"squid.h")/m) {
142 # A comment after include is not a boilerplate,
143 # but we make an exception for #include "squid.h" common in lib/
144 } elsif ($comment =~ m@^/\*\*\s@){
145 # A Doxygen comment is not a boilerplate.
146 } elsif ($comment =~ m/internal declarations|stub file|unit test/i) {
147 # These relatively common comments are not boilerplates.
148 } elsif (&digestable($comment)) {
149 # Something we can safely replace.
152 &Warn("Unrecognized boilerplate, skipping:", $comment);
157 my $extras = ''; # DEBUG section, inspired by ..., etc.
159 if (defined $boiler) {
160 my $copyClaims = ''; # formatted Copyright claims extracted from sources
161 my $preserveClaims = 0; # whether to preserve them or not
163 if (my @rawClaims = ($boiler =~ m/$reClaims/g)) {
164 my @claims = map { &claimList($_) } @rawClaims;
166 foreach my $claim (@claims) {
167 $claim =~ s/\n+/ /gs; # streamline multiline claims
168 $claim =~ s@\*/?@ @g; # clean comment leftovers
169 $claim =~ s/$reClaimPrefix/ /g; # remove common prefixes
170 # this one is sucked in from the old standard boilerplate
171 $claim =~ s/by the Regents of the University of//;
172 $claim =~ s/\s\s+/ /gs; # clean excessive whitespace
173 $claim =~ s/^\s+|\s+$//gs; # remove excessive whitespace
174 next unless length $claim;
176 # preserve Copyright claims
177 if ($claim =~ m/Copyright|\(c\)/i) {
178 $copyClaims .= sprintf(" * %s\n", $claim);
180 # Ignore certain claims, assuming we have their permission.
182 $c =~ s/^\s*(Copyright)?[:\s]*([(c)]+)?\s*([0-9,-]+)?\s*(by)?\s*//i; # prefix
183 $c =~ s/$reClaimsOkToMove/ /g;
184 $c =~ s/[,]//g; # markup leftovers
186 # But if one claim is preserved, all must be preserved.
187 $preserveClaims = 1 if $c =~ /\S/;
188 warn($c) if $c =~ /\S/;
191 next if exists $ReportedClaims{$claim};
192 print("$fname: INFO: Found new claim(s):\n") unless $count++;
193 print("Claim: $claim\n");
194 $ReportedClaims{$claim} = $fname;
198 if ($preserveClaims) {
199 die("Internal error: $copyClaims") unless length($copyClaims);
200 my $prefix = " * Portions of this code are copyrighted and released under GPLv2+ by:";
201 my $suffix = " * Please add new claims to the CONTRIBUTORS file instead.";
202 $extras .= sprintf("/*\n%s\n%s%s\n */\n\n",
203 $prefix, $copyClaims, $suffix);
206 if ($boiler =~ m/$reInspiration/) {
207 $extras .= sprintf("/* %s */\n\n", ucfirst($1));
210 if ($boiler =~ m/$reDebugFull/) {
211 $extras .= "/* $1 */\n\n";
214 $code =~ s/\s*$reComment\s*/\n\n/ or
215 die("internal error: failed to remove expected comment, stopped");
217 die("internal error: unsafe comment removal, stopped");
219 } else { # no boilerplate found
220 #&Warn("Cannot find old boilerplate, adding new boilerplate.", $code);
223 # Some files have license declarations way down in the code so we may not
224 # find a boilerplate at all or find an "empty" boilerplate preceding them.
227 "This program is free software|".
228 "Permission to use|".
229 "Redistribution and use";
230 if ($code =~ m@/\*.*?($license).*?\*/@is) {
231 # If we replaced what we thought is an old boiler, do not use $` for
232 # context because it is based on modified $code and will often mislead.
233 my $context = defined $boiler ?
$& : ($` . $&);
234 &Warn("Suspected boilerplate in an unusual location, skipping:",
239 $code = $CorrectBoiler . $extras . &trimL($code);
240 &writeFile($fname, $code) unless $code eq $virginCode;
250 &Warn("Skipping directory or a special file.");
255 open(IF, "<$fname") or die("cannot open $fname: $!, stopped");
261 &Warn("empty file") unless length $code;
266 my ($fname, $code) = @_;
267 open(OF, ">$fname") or die("cannot open $fname for writing: $!, stopped");
269 print(OF $code) or die("cannot write to $fname: $!, stopped");
271 close(OF) or die("cannot finish updating $fname: $!, stopped");
274 # split multiclaim claims into an array of single claims
276 my $multiClaim = shift;
278 $multiClaim =~ s/$reDebug//g; # may pretend to continue AUTHORs list
279 $multiClaim =~ s/$reInspiration//g; # does not affect (C) claims
281 # remove \n that is not used to separate two claims
282 $multiClaim =~ s/(Based.upon.original.+code.by\s*)\n/$1 /g;
284 return split(/\n/, $multiClaim);
285 # return grep { /\S/ } split($reClaimSplitter, $multiClaim);
288 # checks whether a comment contains nothing but the stuff we can either
289 # safely remove, replace, or move (e.g., DEBUG sections and copyright claims)
293 # Remove common text to detect an otherwise empty boilerplate.
294 $comment =~ s/$reDebug//;
295 $comment =~ s/$reClaims//g;
296 $comment =~ s/^[\s*]*(Created on.*?)$//mig;
297 $comment =~ s/^[\s*]*(Windows support\s*)$//mig;
298 $comment =~ s/^[\s*]*(History added by .*)$//mig;
299 $comment =~ s/$reGpl//;
300 $comment =~ s/$reSquidCopy//;
301 $comment =~ s/$reInspiration//g;
302 $comment =~ s/\* Stubs for.*?$//m; # e.g., Stubs for calls to stuff defined in...
303 $comment =~ s/\$Id(:.*)?\$//g; # CVS tags
304 $comment =~ s/-{60,}//g; # decorations such as -----------...---------
305 $comment =~ s/\b\w+\.(h|c|cc|cci)\b//; # Next to last step: a file name.
306 $comment =~ s@[\s*/]@@sg; # Last step: whitespace and comment characters.
307 return !length($comment);
310 # removes all opening whitespace
313 $code =~ s/^\n[\n\s]*//s;
317 # removes all trailing whitespace
320 $code =~ s/\n[\n\s]*$//s;
325 my ($msg, $context) = @_;
327 if (defined $context) {
329 $context =~ s/$reGpl/... [GPL] .../;
330 $context =~ s/$reSquidCopy/... [Standard Squid "numerous individuals" text] .../;
331 $context = substr($context, 0, $MaxLen);
332 $context = &trimR($context);
337 $msg = sprintf("%s: WARNING: %s\n%s", $FileName, $msg, $context) if defined $FileName;
342 my ($msg, $context) = @_;
344 $msg = sprintf("%s: WARNING: %s\n", $FileName, $msg) if defined $FileName;