<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">#!/usr/bin/perl -w
#
## Copyright (C) 1996-2023 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.
##

use strict;
use warnings;
use Getopt::Long;

# Reads (presumed to be previously vetted) CONTRIBUTORS file.
# Reads untrusted CONTIBUTORS-like new input (without the preamble).
# Reports and ignores invalid new contributor entries.
# Reports and ignores valid new entries already covered by CONTRIBUTORS.
# Prints CONTRIBUTORS preamble, vetted entries, and imported new contributors
# using CONTRIBUTORS file format.

my $VettedLinesIn = 0;
my $NewLinesIn = 0;
my $LinesOut = 0;
my $SkippedBanned = 0;
my $SkippedAlreadyVetted = 0;
my $SkippedNewDuplicates = 0;
my $SkippedEmptyLines = 0;
my $SkippedBadLines = 0;

# Brief display by default.
# Use --quiet for no output
# Use -v or --verbose for more details, repeating them for even more details.
my $VerboseOutput = 1;

GetOptions(
    'quiet' =&gt; sub { $VerboseOutput = 0 },
    'verbose+' =&gt; \$VerboseOutput, 'v+' =&gt; \$VerboseOutput,
    ) or die("$0: Bad command line arguments\n");

my @VettedContributors = ();
my @NewContributors = ();
my %Problems = ();

exit &amp;main();

# whether the new entry is already sufficiently represented by the vetted one
sub similarToVetted
{
    my ($c, $vetted) = @_;

    # It is not critical (and is probably impossible) to get this right for
    # every single use case. When the script gets it wrong, a human can always
    # update CONTRIBUTORS manually. Rare mistakes are not a big deal.

    # same email is enough, regardless of name differences
    if (defined($c-&gt;{email}) &amp;&amp; defined($vetted-&gt;{email})) {
        my $diff = &amp;caseCmp($c-&gt;{email}, $vetted-&gt;{email});
        return 1 if $diff == 0;
    }

    # same name is enough, regardless of email differences
    if (defined($c-&gt;{name}) &amp;&amp; defined($vetted-&gt;{name})) {
        my $diff = &amp;caseCmp($c-&gt;{name}, $vetted-&gt;{name});
        return 1 if $diff == 0;
    }

    return 0;
}

# ensures final, stable order while guaranteeing no duplicates
sub cmpContributorsForPrinting
{
    my ($l, $r) = @_;

    my $diff = &amp;cmpContributors($l, $r);
    return $diff if $diff;

    # now case-sensitively
    $diff = &amp;contributorToString($l) cmp &amp;contributorToString($r);
    return $diff if $diff;
    die("duplicates in output");
}

# case-insensitive comparison
# for list stability, use cmpContributorsForPrinting() when ordering entries
sub cmpContributors
{
    my ($l, $r) = @_;

    # Compare based on the first field (name or, if nameless, email)
    # Do not use &amp;contributorToString() on nameless entries because the
    # leading "&lt;" in such entries will group them all together. We want
    # nameless entries to use email (without brackets) for this comparison.
    my $lRep = defined($l-&gt;{name}) ? $l-&gt;{name} : $l-&gt;{email};
    my $rRep = defined($r-&gt;{name}) ? $r-&gt;{name} : $r-&gt;{email};
    die() unless defined($lRep) &amp;&amp; defined($rRep);
    my $diff = &amp;caseCmp($lRep, $rRep);
    return $diff if $diff;

    # nameless entries go after (matching) named entries
    return -1 if defined($l-&gt;{name}) &amp;&amp; !defined($r-&gt;{name});
    return +1 if !defined($l-&gt;{name}) &amp;&amp; defined($r-&gt;{name});
    return 0 if !defined($l-&gt;{name}) &amp;&amp; !defined($r-&gt;{name});

    # we are left with the same-name entries
    die() unless defined($l-&gt;{name}) &amp;&amp; defined($r-&gt;{name});

    # email-less entries go after (same-name) with-email entries
    return -1 if defined($l-&gt;{email}) &amp;&amp; !defined($r-&gt;{email});
    return +1 if !defined($l-&gt;{email}) &amp;&amp; defined($r-&gt;{email});
    return 0 if !defined($l-&gt;{email}) &amp;&amp; !defined($r-&gt;{email});

    # we are left with same-name entries with emails
    return &amp;caseCmp($l-&gt;{email}, $r-&gt;{email});
}

# whether the given entry is (better) represented by the other one
sub worseThan
{
    my ($l, $r) = @_;

    return 1 if &amp;cmpContributors($l, $r) == 0; # pure duplicate

    return 1 if !defined($l-&gt;{name}) &amp;&amp; defined($r-&gt;{email}) &amp;&amp;
        $l-&gt;{email} eq $r-&gt;{email};

    return 1 if !defined($l-&gt;{email}) &amp;&amp; defined($r-&gt;{name}) &amp;&amp;
        $l-&gt;{name} eq $r-&gt;{name};

    return 0;
}

# whether the entry should be excluded based on some out-of-band rules
sub isManuallyExcluded
{
    my ($c) = @_;
    return lc(contributorToString($c)) =~ /squidadm/; # a known bot
}

sub contributorToString
{
    my ($c) = @_;

    if (defined($c-&gt;{name}) &amp;&amp; defined($c-&gt;{email})) {
        return sprintf("%s &lt;%s&gt;", $c-&gt;{name}, $c-&gt;{email});
    }

    if (defined $c-&gt;{name}) {
        return $c-&gt;{name};
    }

    die() unless defined $c-&gt;{email};
    return sprintf("&lt;%s&gt;", $c-&gt;{email});
}

sub printContributors
{
    foreach my $c (sort { &amp;cmpContributorsForPrinting($a, $b) } (@VettedContributors, @NewContributors)) {
        my $entry = &amp;contributorToString($c);
        die() unless defined $entry &amp;&amp; length $entry;
        &amp;lineOut("    $entry\n");
    }
}

# convert an unvetted/raw input line into a {name, email, ...} object
sub parseContributor
{
    s/^\s+|\s+$//g; # trim
    my $trimmedRaw = $_;

    s/\s+/ /g; # canonical space characters
    die() unless length $_;

    return "entry with strange characters" if /[^-,_+'" a-zA-Z0-9@&lt;&gt;().]/;

    my $name = undef();
    my $email = undef();

    if (s/\s*&lt;(.*)&gt;$//) {
        $email = $1 if length $1;

        return "multiple emails" if defined($email) &amp;&amp; $email =~ /,/;
        return "suspicious email" if defined($email) &amp;&amp; !&amp;isEmail($email);
    }

    # convert: name@example.com &lt;&gt;
    # into:    &lt;name@example.com&gt;
    if (!defined($email) &amp;&amp; &amp;isEmail($_)) {
        $email = $_;
        $_ = '';
    }

    $name = $_ if length $_;

    if (defined($name)) {
        return "name that looks like email" if $name =~ /@|&lt;|\sat\s|^unknown$/;

        # strip paired surrounding quotes
        if ($name =~ /^'\s*(.*)\s*'$/ || $name =~ /^"\s*(.*)\s*"$/) {
            $name = $1;
        }
    }

    return "nameless, email-less entry" if !defined($name) &amp;&amp; !defined($email);

    return {
        name =&gt; $name,
        email =&gt; $email,
        raw =&gt; $trimmedRaw,
    };
}

# Handle CONTRIBUTORS file, printing preamble and loading vetted entries. The
# parsing rules here are a lot more relaxed because we know that this vetted
# content might contain manual entries that violate our automated rules.
sub loadVettedContributors
{
    my ($vettedFilename) = @_;
    open(IF, "&lt;$vettedFilename") or die("Cannot open $vettedFilename: $!\n");
    while (&lt;IF&gt;) {
        my $original = $_;
        ++$VettedLinesIn;

        if (s/^\S// || s/^\s*$//) {
            # preamble and its terminator (a more-or-less empty line)
            &amp;lineOut($original);
            next;
        }

        chomp;

        s/^\s+|\s+$//g; # trim
        my $trimmedRaw = $_;

        my ($name, $email);
        if (s/\s*&lt;(.+)&gt;$//) {
            $email = $1;
        }
        if (length $_) {
            $name = $_;
            die("Malformed vetted entry name: ", $name) if $name =~ /[@&lt;&gt;]/;
        }

        die("Malformed $vettedFilename entry:", $original) if !defined($name) &amp;&amp; !defined($email);

        push @VettedContributors, {
            name =&gt; $name,
            email =&gt; $email,
            raw =&gt; $trimmedRaw,
        };
    }
    close(IF) or die();
    die() unless @VettedContributors;
}

# import contributor (name, email) pairs from CONTRIBUTOR-like input
# skip unwanted entries where the decision can be made w/o knowing all entries
sub loadCandidates
{
    while (&lt;&gt;) {
        ++$NewLinesIn;
        my $original = $_;
        chomp;

        s/^\s+|\s+$//g; # trim

        if (!length $_) {
            ++$SkippedEmptyLines;
            next;
        }

        my $c = &amp;parseContributor();
        die() unless $c;

        if (!ref($c)) {
            &amp;noteProblem("Skipping %s: %s", $c, $original);
            ++$SkippedBadLines;
            next;
        }
        die(ref($c)) unless ref($c) eq 'HASH';

        if (&amp;isManuallyExcluded($c)) {
            &amp;noteProblem("Skipping banned entry: %s\n", $c-&gt;{raw}) if ($VerboseOutput &gt; 0);
            ++$SkippedBanned;
            next;
        }

        if (my ($vettedC) = grep { &amp;similarToVetted($c, $_) } @VettedContributors) {
            if ($VerboseOutput &gt; 1) {
                &amp;noteProblem("Skipping already vetted:\n    %s\n    %s\n", $vettedC-&gt;{raw}, $c-&gt;{raw})
                    unless &amp;contributorToString($vettedC) eq &amp;contributorToString($c);
            }
            ++$SkippedAlreadyVetted;
            next;
        }

        push @NewContributors, $c;
    }
}

sub pruneCandidates
{
    my @ngContributors = ();

    while (@NewContributors) {
        my $c = pop @NewContributors;
        if (my ($otherC) = grep { &amp;worseThan($c, $_) } (@VettedContributors, @NewContributors, @ngContributors)) {
            if ($VerboseOutput &gt; 0) {
                &amp;noteProblem("Skipping very similar:\n    %s\n    %s\n", $otherC-&gt;{raw}, $c-&gt;{raw})
                    unless &amp;contributorToString($otherC) eq &amp;contributorToString($c);
            }
            ++$SkippedNewDuplicates;
            next;
        }
        push @ngContributors, $c;
    }

    @NewContributors = @ngContributors;
}

sub lineOut {
    print(@_);
    ++$LinesOut;
}

# report the given problem, once
sub noteProblem {
    my $format = shift;
    my $problem = sprintf($format, @_);
    return if exists $Problems{$problem};
    $Problems{$problem} = undef();
    print(STDERR $problem);
}

sub isEmail
{
    my ($raw) = @_;
    return $raw =~ /^\S+@\S+[.]\S+$/;
}

sub caseCmp
{
    my ($l, $r) = @_;
    return (uc $l) cmp (uc $r);
}

sub main
{
    &amp;loadVettedContributors("CONTRIBUTORS");
    &amp;loadCandidates();
    &amp;pruneCandidates();

    my $loadedNewContributors = scalar @NewContributors;
    die("$NewLinesIn != $SkippedEmptyLines + $SkippedBadLines + $SkippedBanned + $SkippedAlreadyVetted + $SkippedNewDuplicates + $loadedNewContributors; stopped")
        unless $NewLinesIn == $SkippedEmptyLines + $SkippedBadLines + $SkippedBanned + $SkippedAlreadyVetted + $SkippedNewDuplicates + $loadedNewContributors;

    &amp;printContributors();

    if ($VerboseOutput &gt; 1) {
        printf(STDERR "Vetted lines in:     %4d\n", $VettedLinesIn);
        printf(STDERR "Updated lines out:   %4d\n", $LinesOut);
        printf(STDERR "\n");
    }
    if ($VerboseOutput &gt; 2) {
        printf(STDERR "New lines in:        %4d\n", $NewLinesIn);
        printf(STDERR "Skipped empty lines: %4d\n", $SkippedEmptyLines) unless ($SkippedEmptyLines == 0);
        printf(STDERR "Skipped duplicates:  %4d\n", $SkippedNewDuplicates) unless ($SkippedNewDuplicates == 0);
    }
    if ($VerboseOutput &gt; 1) {
        printf(STDERR "Skipped banned:      %4d\n", $SkippedBanned) unless ($SkippedBanned == 0);
        printf(STDERR "Skipped similar:     %4d\n", $SkippedAlreadyVetted) unless ($SkippedAlreadyVetted == 0);
    }
    if ($VerboseOutput &gt; 0) {
        printf(STDERR "Skipped bad lines:   %4d\n", $SkippedBadLines) unless ($SkippedBadLines == 0);
        printf(STDERR "\n");
        printf(STDERR "Vetted contributors: %3d\n", scalar @VettedContributors) if ($VerboseOutput &gt; 1);
        printf(STDERR "New contributors:    %3d\n", scalar @NewContributors) unless (scalar @NewContributors == 0);
        printf(STDERR "Contributors out:    %3d\n", @VettedContributors + @NewContributors) if ($VerboseOutput &gt; 1);
    }

    return 0;
}

</pre></body></html>