]> git.ipfire.org Git - thirdparty/squid.git/blobdiff - scripts/boiler-mgr.pl
Source Format Enforcement (#763)
[thirdparty/squid.git] / scripts / boiler-mgr.pl
index 346e6fddc7805acd0f9507b242b0885ae4856a8e..430ae115bfaa43c4ff031c8b46ea47c8a31854ee 100755 (executable)
@@ -1,9 +1,16 @@
 #!/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.
@@ -24,87 +31,87 @@ die("usage: $0 <boilerplate-file> <source-file> ...\n") unless @ARGV >= 2;
 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{
-       Francesco.Chemolli|<kinkie\@squid-cache.org>|
+    Robert.Collins|<robertc\@squid-cache.org>|<rbtcollins\@hotmail.com>|
 
-       Amos.Jeffries|<amosjeffries\@squid-cache.org>|<squid3\@treenet.co.nz>|
-       Treehouse.Networks.Ltd.|
-       GPL.version.2,..C.2007-2013|
+    Duane.Wessels|
 
-       Henrik.Nordstrom|<henrik\@henriknordstrom.net>|
-       MARA.Systems.AB|
-}xi;
-# XXX: We have not gotten permission for some of the entries yet:
-#
-#      Robert.Collins|<robertc\@squid-cache.org>|
-#
-#      the.Regents.of.the.University.of
+    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|
 
+    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;
 
 
@@ -115,218 +122,225 @@ $| = 1; # report claims ASAP (but on STDOUT)
 # 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;
-
-       &Warn("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) = @_;
+
+    $msg = sprintf("%s: WARNING: %s\n", $FileName, $msg) if defined $FileName;
+    warn($msg);
 }