#!/usr/bin/perl
#
# Check source files for SPDX-License-Identifier fields.
#
# Examine all source files in a distribution to check that they contain an
# SPDX-License-Identifier field.  This does not check the syntax or whether
# the identifiers are valid.
#
# The canonical version of this file is maintained in the rra-c-util package,
# which can be found at <https://www.eyrie.org/~eagle/software/rra-c-util/>.
#
# Copyright 2018-2020 Russ Allbery <eagle@eyrie.org>
#
# Permission is hereby granted, free of charge, to any person obtaining a
# copy of this software and associated documentation files (the "Software"),
# to deal in the Software without restriction, including without limitation
# the rights to use, copy, modify, merge, publish, distribute, sublicense,
# and/or sell copies of the Software, and to permit persons to whom the
# Software is furnished to do so, subject to the following conditions:
#
# The above copyright notice and this permission notice shall be included in
# all copies or substantial portions of the Software.
#
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
# THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
# DEALINGS IN THE SOFTWARE.
#
# SPDX-License-Identifier: MIT

use 5.008;
use strict;
use warnings;

use lib "$ENV{C_TAP_SOURCE}/tap/perl";

use Test::RRA qw(skip_unless_automated);
use Test::RRA::Automake qw(all_files automake_setup);

use File::Basename qw(basename);
use Test::More;

# File name (the file without any directory component) and path patterns to
# skip for this check.
## no critic (RegularExpressions::ProhibitFixedStringMatches)
my @IGNORE = (
    qr{ \A LICENSE \z }xms,             # Generated file with no license itself
    qr{ \A (NEWS|THANKS|TODO) \z }xms,  # Package license should be fine
    qr{ \A README ( [.] .* )? \z }xms,  # Package license should be fine
    qr{ \A (Makefile|libtool) \z }xms,  # Generated file
    qr{ [.] output \z }xms,             # Test data
);
my @IGNORE_PATHS = (
    qr{ \A debian/ }xms,                       # Found in debian/* branches
    qr{ \A docs/metadata/ }xms,                # Package license should be fine
    qr{ \A docs/protocol[.](html|txt) \z }xms, # Generated by xml2rfc
    qr{ \A m4/ (libtool|lt.*) [.] m4 \z }xms,  # Files from Libtool
    qr{ \A perl/Build \z }xms,                 # Perl build files
    qr{ \A perl/MANIFEST \z }xms,              # Perl build files
    qr{ \A perl/MYMETA [.] }xms,               # Perl build files
    qr{ \A perl/blib/ }xms,                    # Perl build files
    qr{ \A perl/cover_db/ }xms,                # Perl test files
    qr{ \A perl/_build }xms,                   # Perl build files
    qr{ \A php/Makefile [.] global \z }xms,    # Created by phpize
    qr{ \A php/autom4te [.] cache/ }xms,       # Created by phpize
    qr{ \A php/acinclude [.] m4 \z }xms,       # Created by phpize
    qr{ \A php/build/ }xms,                    # Created by phpize
    qr{ \A php/config [.] (guess|sub) \z }xms, # Created by phpize
    qr{ \A php/configure [.] (ac|in) \z }xms,  # Created by phpize
    qr{ \A php/ltmain [.] sh \z }xms,          # Created by phpize
    qr{ \A php/run-tests [.] php \z }xms,      # Created by phpize
    qr{ \A python/ .* [.] egg-info/ }xms,      # Python build files
    qr{ \A tests/config/ (?!README) }xms,      # Test configuration
    qr{ [.] l?a \z }xms,                       # Created by libtool
    qr{ [.] o \z }xms,                         # Compiler objects
);
## use critic

# Only run this test during automated testing, since failure doesn't indicate
# any user-noticable flaw in the package itself.
skip_unless_automated('SPDX identifier tests');

# Set up Automake testing.
automake_setup();

# Check a single file for an occurrence of the string.
#
# $path - Path to the file
#
# Returns: undef
sub check_file {
    my ($path) = @_;
    my $filename = basename($path);

    # Ignore files in the whitelist and binary files.
    for my $pattern (@IGNORE) {
        return if $filename =~ $pattern;
    }
    for my $pattern (@IGNORE_PATHS) {
        return if $path =~ $pattern;
    }
    return if !-T $path;

    # Scan the file.
    my ($saw_legacy_notice, $saw_spdx, $skip_spdx);
    open(my $file, '<', $path) or BAIL_OUT("Cannot open $path: $!");
    while (defined(my $line = <$file>)) {
        if ($line =~ m{ Generated [ ] by [ ] libtool [ ] }xms) {
            close($file) or BAIL_OUT("Cannot close $path: $!");
            return;
        }
        if ($line =~ m{ \b See \s+ LICENSE \s+ for \s+ licensing }xms) {
            $saw_legacy_notice = 1;
        }
        if ($line =~ m{ \b SPDX-License-Identifier: \s+ \S+ }xms) {
            $saw_spdx = 1;
            last;
        }
        if ($line =~ m{ no \s SPDX-License-Identifier \s registered }xms) {
            $skip_spdx = 1;
            last;
        }
    }
    close($file) or BAIL_OUT("Cannot close $path: $!");

    # If there is a legacy license notice, report a failure regardless of file
    # size.  Otherwise, skip files under 1KB.  They can be rolled up into the
    # overall project license and the license notice may be a substantial
    # portion of the file size.
    if ($saw_legacy_notice) {
        ok(!$saw_legacy_notice, "$path has legacy license notice");
    } else {
        ok($saw_spdx || $skip_spdx || -s $path < 1024, $path);
    }
    return;
}

# Scan every file.  We don't declare a plan since we skip a lot of files and
# don't want to precalculate the file list.
my @paths = all_files();
for my $path (@paths) {
    check_file($path);
}
done_testing();