#!/usr/bin/perl -w
+#
+## Copyright (C) 1996-2021 The Squid Software Foundation and contributors
+##
+## Squid software is distributed under GPLv2+ license and includes
+## contributions from numerous individuals and organizations.
+## Please see the COPYING and CONTRIBUTORS files for details.
+##
# Adds or adjusts the source file boilerplate, such as a Copyright statement.
# The boilerplate is meant to remain constant from one source file to another.
#
-# The old boilerplate is assumed to be the first /* comment */ in a source
+# The old boilerplate is assumed to be the first /* comment */ in a source
# file, before the first #include statement other than #include "squid.h".
# Common old boilerplates are removed, with copyright-related claims contained
# in them logged on stdout for recording in CONTRIBUTORS or some such.
my ($BoilerName, @FileNames) = @ARGV;
my $CorrectBoiler = `cat $BoilerName` or
- die("cannot load boilerplate from $BoilerName: $!, stopped");
+ die("cannot load boilerplate from $BoilerName: $!, stopped");
$CorrectBoiler = &trimL(&trimR($CorrectBoiler)) . "\n\n";
# the first /* comment */
my $reComment = qr{
- /\*.*?\*/
+ /\*.*?\*/
}xs;
# Debugging section inside a boilerplate comment.
my $reDebug = qr{
- ^[\s*]*(DEBUG:.*?)$
+ ^[\s*]*(DEBUG:.*?)$
}mx;
# Same as $reDebug, but does not match empty DEBUG: statements.
my $reDebugFull = qr{
- ^[\s*]*(DEBUG:[^\S\n]*\S.*?)\s*$
+ ^[\s*]*(DEBUG:[^\S\n]*\S.*?)\s*$
}mx;
# Copyright-related claims inside a boilerplate comment
my $reClaims = qr{
- (
- (?:
- AUTHOR\b(?:.|\n)*?\*[/\s]*$| # all authors until an "empty" line
- ORIGINAL\s+AUTHOR\b| # or not the latest author
- COPYRIGHT\b(?!\sfile)| # or copyright (except "COPYRIGHT file")
- Portions\scopyright| # or partial copyright
- (?<!Squid.is.Copyrighted.)\(C\)\s| # or (C) (except "Squid is ...")
- Based.upon.original.+code.by\s*\n| # or this common pearl
- Modified\sby\s| # or this
- BASED\sON:\s # or this
- )
- .*? # and the claim content itself
- )$
+ (
+ (?:
+ AUTHOR\b(?:.|\n)*?\*[/\s]*$| # all authors until an "empty" line
+ ORIGINAL\s+AUTHOR\b| # or not the latest author
+ COPYRIGHT\b(?!\sfile)| # or copyright (except "COPYRIGHT file")
+ Portions\scopyright| # or partial copyright
+ (?<!Squid.is.Copyrighted.)\(C\)\s| # or (C) (except "Squid is ...")
+ Based.upon.original.+code.by\s*\n| # or this common pearl
+ Modified\sby\s| # or this
+ BASED\sON:\s # or this
+ )
+ .*? # and the claim content itself
+ )$
}xmi;
# removes common claim prefixes to minimize claim noise
my $reClaimPrefix = qr{
- (?:ORIGINAL\s)?AUTHOR:?|
- based\son\s|
- based\supon\s|
- Portions\s
+ (?:ORIGINAL\s)?AUTHOR:?|
+ based\son\s|
+ based\supon\s|
+ Portions\s
}xi;
# We have persmission to move these frequent claims to CONTRIBUTORS.
my $reClaimsOkToMove = qr{
- Robert.Collins|<robertc\@squid-cache.org>|
+ Robert.Collins|<robertc\@squid-cache.org>|<rbtcollins\@hotmail.com>|
+
+ Duane.Wessels|
- Duane.Wessels|
+ Francesco.Chemolli|<kinkie\@squid-cache.org>|<kinkie\@kame.usr.dsi.unimi.it>|
- Francesco.Chemolli|<kinkie\@squid-cache.org>|<kinkie\@kame.usr.dsi.unimi.it>|
+ Amos.Jeffries|<amosjeffries\@squid-cache.org>|<squid3\@treenet.co.nz>|
+ Treehouse.Networks.Ltd.|
+ GPL.version.2,..C.2007-2013|
- Amos.Jeffries|<amosjeffries\@squid-cache.org>|<squid3\@treenet.co.nz>|
- Treehouse.Networks.Ltd.|
- GPL.version.2,..C.2007-2013|
+ Henrik.Nordstrom|<henrik\@henriknordstrom.net>|
+ MARA.Systems.AB|
- Henrik.Nordstrom|<henrik\@henriknordstrom.net>|
- MARA.Systems.AB|
+ Guido.Serassio|<serassio\@squid-cache.org>|<guido.serassio\@acmeconsulting.it>|
}xi;
# inspirations are not copyright claims but should be preserved
my $reInspiration = qr/^[\s*]*(inspired by previous work.*?)$/mi;
# The most common GPL text, with some address variations.
-my $strGpl =
- "This program is free software; you can redistribute it and/or modify".
- "([^*]|[*][^/])+". # not a /* comment */ closure
- "Foundation, Inc., [^\\n]+MA\\s+[-\\d]+, USA\\.";
+my $strGpl =
+ "This program is free software; you can redistribute it and/or modify".
+ "([^*]|[*][^/])+". # not a /* comment */ closure
+ "Foundation, Inc., [^\\n]+MA\\s+[-\\d]+, USA\\.";
my $reGpl = qr{$strGpl}s;
# Two most common Squid (C) statements.
my $strSqCopyStart1 =
- "SQUID Web Proxy Cache\\s+http://www.squid-cache.org/";
+ "SQUID Web Proxy Cache\\s+http://www.squid-cache.org/";
my $strSqCopyStart2 =
- "SQUID Internet Object Cache\\s+http://squid.nlanr.net/Squid/";
+ "SQUID Internet Object Cache\\s+http://squid.nlanr.net/Squid/";
my $strSqCopyEnd =
- "([^*]|[*][^/])+".
- "numerous individuals".
- "([^*]|[*][^/])+".
- "file for full details.";
+ "([^*]|[*][^/])+".
+ "numerous individuals".
+ "([^*]|[*][^/])+".
+ "file for full details.";
my $reSquidCopy = qr{($strSqCopyStart1|$strSqCopyStart2)$strSqCopyEnd}s;
# process each file in-place; do not touch files on known failures
foreach my $fname (@FileNames) {
- $FileName = $fname;
- my $code = &readFile($fname) or next;
- my $virginCode = $code;
-
- &WarnQuiet("Correct boilerplate already present, skipping:", $code), next if
- $code =~ /\Q$CorrectBoiler\E/s;
-
- my $boiler;
-
- if ($code =~ m/$reComment/) {
- my $beforeComment = $`;
- my $comment = $&;
-
- # Is the matched comment a boilerplate?
- if ($comment !~ m/\n/) {
- # A single line comment is not a boilerplate.
- } elsif ($beforeComment =~ m/^\s*\#\s*include\s+(?!"squid.h")/m) {
- # A comment after include is not a boilerplate,
- # but we make an exception for #include "squid.h" common in lib/
- } elsif ($comment =~ m@^/\*\*\s@){
- # A Doxygen comment is not a boilerplate.
- } elsif ($comment =~ m/internal declarations|stub file|unit test/i) {
- # These relatively common comments are not boilerplates.
- } elsif (&digestable($comment)) {
- # Something we can safely replace.
- $boiler = $comment;
- } else {
- &Warn("Unrecognized boilerplate, skipping:", $comment);
- next;
- }
- }
-
- my $extras = ''; # DEBUG section, inspired by ..., etc.
-
- if (defined $boiler) {
- my $copyClaims = ''; # formatted Copyright claims extraced from sources
- my $preserveClaims = 0; # whether to preserve them or not
-
- if (my @rawClaims = ($boiler =~ m/$reClaims/g)) {
- my @claims = map { &claimList($_) } @rawClaims;
- my $count = 0;
- foreach my $claim (@claims) {
- $claim =~ s/\n+/ /gs; # streamline multiline claims
- $claim =~ s@\*/?@ @g; # clean comment leftovers
- $claim =~ s/$reClaimPrefix/ /g; # remove common prefixes
- # this one is sucked in from the old standard boilerplate
- $claim =~ s/by the Regents of the University of//;
- $claim =~ s/\s\s+/ /gs; # clean excessive whitespace
- $claim =~ s/^\s+|\s+$//gs; # remove excessive whitespace
- next unless length $claim;
-
- # preserve Copyright claims
- if ($claim =~ m/Copyright|\(c\)/i) {
- $copyClaims .= sprintf(" * %s\n", $claim);
-
- # Ignore certain claims, assuming we have their permission.
- my $c = $claim;
- $c =~ s/^\s*(Copyright)?[:\s]*([(c)]+)?\s*([0-9,-]+)?\s*(by)?\s*//i; # prefix
- $c =~ s/$reClaimsOkToMove/ /g;
- $c =~ s/[,]//g; # markup leftovers
-
- # But if one claim is preserved, all must be preserved.
- $preserveClaims = 1 if $c =~ /\S/;
-warn($c) if $c =~ /\S/;
- }
-
- next if exists $ReportedClaims{$claim};
- print("$fname: INFO: Found new claim(s):\n") unless $count++;
- print("Claim: $claim\n");
- $ReportedClaims{$claim} = $fname;
- }
- }
-
- if ($preserveClaims) {
- die("Internal error: $copyClaims") unless length($copyClaims);
- my $prefix = " * Portions of this code are copyrighted and released under GPLv2+ by:";
- my $suffix = " * Please add new claims to the CONTRIBUTORS file instead.";
- $extras .= sprintf("/*\n%s\n%s%s\n */\n\n",
- $prefix, $copyClaims, $suffix);
- }
-
- if ($boiler =~ m/$reInspiration/) {
- $extras .= sprintf("/* %s */\n\n", ucfirst($1));
- }
-
- if ($boiler =~ m/$reDebugFull/) {
- $extras .= "/* $1 */\n\n";
- }
-
- $code =~ s/\s*$reComment\s*/\n\n/ or
- die("internal error: failed to remove expected comment, stopped");
- &digestable($&) or
- die("internal error: unsafe comment removal, stopped");
-
- } else { # no boilerplate found
- #&Warn("Cannot find old boilerplate, adding new boilerplate.", $code);
- }
-
- # Some files have license declarations way down in the code so we may not
- # find a boilerplate at all or find an "empty" boilerplate preceeding them.
- my $license =
- "Copyright|".
- "This program is free software|".
- "Permission to use|".
- "Redistribution and use";
- if ($code =~ m@/\*.*?($license).*?\*/@is) {
- # If we replaced what we thought is an old boiler, do not use $` for
- # context because it is based on modified $code and will often mislead.
- my $context = defined $boiler ? $& : ($` . $&);
- &Warn("Suspected boilerplate in an unusual location, skipping:",
- $context);
- next;
- }
-
- $code = $CorrectBoiler . $extras . &trimL($code);
- &writeFile($fname, $code) unless $code eq $virginCode;
- undef $FileName;
+ $FileName = $fname;
+ my $code = &readFile($fname) or next;
+ my $virginCode = $code;
+
+ &WarnQuiet("Correct boilerplate already present, skipping:", $code), next if
+ $code =~ /\Q$CorrectBoiler\E/s;
+
+ my $boiler;
+
+ if ($code =~ m/$reComment/) {
+ my $beforeComment = $`;
+ my $comment = $&;
+
+ # Is the matched comment a boilerplate?
+ if ($comment !~ m/\n/) {
+ # A single line comment is not a boilerplate.
+ } elsif ($beforeComment =~ m/^\s*\#\s*include\s+(?!"squid.h")/m) {
+ # A comment after include is not a boilerplate,
+ # but we make an exception for #include "squid.h" common in lib/
+ } elsif ($comment =~ m@^/\*\*\s@){
+ # A Doxygen comment is not a boilerplate.
+ } elsif ($comment =~ m/internal declarations|stub file|unit test/i) {
+ # These relatively common comments are not boilerplates.
+ } elsif (&digestable($comment)) {
+ # Something we can safely replace.
+ $boiler = $comment;
+ } else {
+ &Warn("Unrecognized boilerplate, skipping:", $comment);
+ next;
+ }
+ }
+
+ my $extras = ''; # DEBUG section, inspired by ..., etc.
+
+ if (defined $boiler) {
+ my $copyClaims = ''; # formatted Copyright claims extracted from sources
+ my $preserveClaims = 0; # whether to preserve them or not
+
+ if (my @rawClaims = ($boiler =~ m/$reClaims/g)) {
+ my @claims = map { &claimList($_) } @rawClaims;
+ my $count = 0;
+ foreach my $claim (@claims) {
+ $claim =~ s/\n+/ /gs; # streamline multiline claims
+ $claim =~ s@\*/?@ @g; # clean comment leftovers
+ $claim =~ s/$reClaimPrefix/ /g; # remove common prefixes
+ # this one is sucked in from the old standard boilerplate
+ $claim =~ s/by the Regents of the University of//;
+ $claim =~ s/\s\s+/ /gs; # clean excessive whitespace
+ $claim =~ s/^\s+|\s+$//gs; # remove excessive whitespace
+ next unless length $claim;
+
+ # preserve Copyright claims
+ if ($claim =~ m/Copyright|\(c\)/i) {
+ $copyClaims .= sprintf(" * %s\n", $claim);
+
+ # Ignore certain claims, assuming we have their permission.
+ my $c = $claim;
+ $c =~ s/^\s*(Copyright)?[:\s]*([(c)]+)?\s*([0-9,-]+)?\s*(by)?\s*//i; # prefix
+ $c =~ s/$reClaimsOkToMove/ /g;
+ $c =~ s/[,]//g; # markup leftovers
+
+ # But if one claim is preserved, all must be preserved.
+ $preserveClaims = 1 if $c =~ /\S/;
+ warn($c) if $c =~ /\S/;
+ }
+
+ next if exists $ReportedClaims{$claim};
+ print("$fname: INFO: Found new claim(s):\n") unless $count++;
+ print("Claim: $claim\n");
+ $ReportedClaims{$claim} = $fname;
+ }
+ }
+
+ if ($preserveClaims) {
+ die("Internal error: $copyClaims") unless length($copyClaims);
+ my $prefix = " * Portions of this code are copyrighted and released under GPLv2+ by:";
+ my $suffix = " * Please add new claims to the CONTRIBUTORS file instead.";
+ $extras .= sprintf("/*\n%s\n%s%s\n */\n\n",
+ $prefix, $copyClaims, $suffix);
+ }
+
+ if ($boiler =~ m/$reInspiration/) {
+ $extras .= sprintf("/* %s */\n\n", ucfirst($1));
+ }
+
+ if ($boiler =~ m/$reDebugFull/) {
+ $extras .= "/* $1 */\n\n";
+ }
+
+ $code =~ s/\s*$reComment\s*/\n\n/ or
+ die("internal error: failed to remove expected comment, stopped");
+ &digestable($&) or
+ die("internal error: unsafe comment removal, stopped");
+
+ } else { # no boilerplate found
+ #&Warn("Cannot find old boilerplate, adding new boilerplate.", $code);
+ }
+
+ # Some files have license declarations way down in the code so we may not
+ # find a boilerplate at all or find an "empty" boilerplate preceding them.
+ my $license =
+ "Copyright|".
+ "This program is free software|".
+ "Permission to use|".
+ "Redistribution and use";
+ if ($code =~ m@/\*.*?($license).*?\*/@is) {
+ # If we replaced what we thought is an old boiler, do not use $` for
+ # context because it is based on modified $code and will often mislead.
+ my $context = defined $boiler ? $& : ($` . $&);
+ &Warn("Suspected boilerplate in an unusual location, skipping:",
+ $context);
+ next;
+ }
+
+ $code = $CorrectBoiler . $extras . &trimL($code);
+ &writeFile($fname, $code) unless $code eq $virginCode;
+ undef $FileName;
}
exit(0);
sub readFile() {
- my ($fname) = @_;
-
- if (!-f $fname) {
- &Warn("Skipping directory or a special file.");
- return undef();
- }
-
- my $code = '';
- open(IF, "<$fname") or die("cannot open $fname: $!, stopped");
- while (<IF>) {
- $code .= $_;
- }
- close(IF);
-
- &Warn("empty file") unless length $code;
- return $code;
+ my ($fname) = @_;
+
+ if (!-f $fname) {
+ &Warn("Skipping directory or a special file.");
+ return undef();
+ }
+
+ my $code = '';
+ open(IF, "<$fname") or die("cannot open $fname: $!, stopped");
+ while (<IF>) {
+ $code .= $_;
+ }
+ close(IF);
+
+ &Warn("empty file") unless length $code;
+ return $code;
}
sub writeFile() {
- my ($fname, $code) = @_;
- open(OF, ">$fname") or die("cannot open $fname for writing: $!, stopped");
+ my ($fname, $code) = @_;
+ open(OF, ">$fname") or die("cannot open $fname for writing: $!, stopped");
- print(OF $code) or die("cannot write to $fname: $!, stopped");
+ print(OF $code) or die("cannot write to $fname: $!, stopped");
- close(OF) or die("cannot finish updating $fname: $!, stopped");
+ close(OF) or die("cannot finish updating $fname: $!, stopped");
}
# split multiclaim claims into an array of single claims
sub claimList() {
- my $multiClaim = shift;
+ my $multiClaim = shift;
- $multiClaim =~ s/$reDebug//g; # may pretend to continue AUTHORs list
- $multiClaim =~ s/$reInspiration//g; # does not affect (C) claims
+ $multiClaim =~ s/$reDebug//g; # may pretend to continue AUTHORs list
+ $multiClaim =~ s/$reInspiration//g; # does not affect (C) claims
- # remove \n that is not used to separate two claims
- $multiClaim =~ s/(Based.upon.original.+code.by\s*)\n/$1 /g;
+ # remove \n that is not used to separate two claims
+ $multiClaim =~ s/(Based.upon.original.+code.by\s*)\n/$1 /g;
- return split(/\n/, $multiClaim);
- # return grep { /\S/ } split($reClaimSplitter, $multiClaim);
+ return split(/\n/, $multiClaim);
+ # return grep { /\S/ } split($reClaimSplitter, $multiClaim);
}
# checks whether a comment contains nothing but the stuff we can either
# safely remove, replace, or move (e.g., DEBUG sections and copyright claims)
sub digestable() {
- my $comment = shift;
-
- # Remove common text to detect an otherwise empty boilerplate.
- $comment =~ s/$reDebug//;
- $comment =~ s/$reClaims//g;
- $comment =~ s/^[\s*]*(Created on.*?)$//mig;
- $comment =~ s/^[\s*]*(Windows support\s*)$//mig;
- $comment =~ s/^[\s*]*(History added by .*)$//mig;
- $comment =~ s/$reGpl//;
- $comment =~ s/$reSquidCopy//;
- $comment =~ s/$reInspiration//g;
- $comment =~ s/\* Stubs for.*?$//m; # e.g., Stubs for calls to stuff defined in...
- $comment =~ s/\$Id(:.*)?\$//g; # CVS tags
- $comment =~ s/-{60,}//g; # decorations such as -----------...---------
- $comment =~ s/\b\w+\.(h|c|cc|cci)\b//; # Next to last step: a file name.
- $comment =~ s@[\s*/]@@sg; # Last step: whitespace and comment characters.
- return !length($comment);
+ my $comment = shift;
+
+ # Remove common text to detect an otherwise empty boilerplate.
+ $comment =~ s/$reDebug//;
+ $comment =~ s/$reClaims//g;
+ $comment =~ s/^[\s*]*(Created on.*?)$//mig;
+ $comment =~ s/^[\s*]*(Windows support\s*)$//mig;
+ $comment =~ s/^[\s*]*(History added by .*)$//mig;
+ $comment =~ s/$reGpl//;
+ $comment =~ s/$reSquidCopy//;
+ $comment =~ s/$reInspiration//g;
+ $comment =~ s/\* Stubs for.*?$//m; # e.g., Stubs for calls to stuff defined in...
+ $comment =~ s/\$Id(:.*)?\$//g; # CVS tags
+ $comment =~ s/-{60,}//g; # decorations such as -----------...---------
+ $comment =~ s/\b\w+\.(h|c|cc|cci)\b//; # Next to last step: a file name.
+ $comment =~ s@[\s*/]@@sg; # Last step: whitespace and comment characters.
+ return !length($comment);
}
# removes all opening whitespace
sub trimL() {
- my ($code) = @_;
- $code =~ s/^\n[\n\s]*//s;
- return $code;
+ my ($code) = @_;
+ $code =~ s/^\n[\n\s]*//s;
+ return $code;
}
# removes all trailing whitespace
sub trimR() {
- my ($code) = @_;
- $code =~ s/\n[\n\s]*$//s;
- return $code;
+ my ($code) = @_;
+ $code =~ s/\n[\n\s]*$//s;
+ return $code;
}
sub Warn() {
- my ($msg, $context) = @_;
-
- if (defined $context) {
- my $MaxLen = 1000;
- $context =~ s/$reGpl/... [GPL] .../;
- $context =~ s/$reSquidCopy/... [Standard Squid "numerous individuals" text] .../;
- $context = substr($context, 0, $MaxLen);
- $context = &trimR($context);
- $context .= "\n\n";
- } else {
- $context = '';
- }
- $msg = sprintf("%s: WARNING: %s\n%s", $FileName, $msg, $context) if defined $FileName;
- warn($msg);
+ my ($msg, $context) = @_;
+
+ if (defined $context) {
+ my $MaxLen = 1000;
+ $context =~ s/$reGpl/... [GPL] .../;
+ $context =~ s/$reSquidCopy/... [Standard Squid "numerous individuals" text] .../;
+ $context = substr($context, 0, $MaxLen);
+ $context = &trimR($context);
+ $context .= "\n\n";
+ } else {
+ $context = '';
+ }
+ $msg = sprintf("%s: WARNING: %s\n%s", $FileName, $msg, $context) if defined $FileName;
+ warn($msg);
}
sub WarnQuiet() {
- my ($msg, $context) = @_;
+ my ($msg, $context) = @_;
- $msg = sprintf("%s: WARNING: %s\n", $FileName, $msg) if defined $FileName;
- warn($msg);
+ $msg = sprintf("%s: WARNING: %s\n", $FileName, $msg) if defined $FileName;
+ warn($msg);
}