|
Packit |
e6c7a3 |
#!/usr/bin/perl
|
|
Packit |
e6c7a3 |
#
|
|
Packit |
e6c7a3 |
# Check URLs in source files.
|
|
Packit |
e6c7a3 |
#
|
|
Packit |
e6c7a3 |
# Examine all source files in a distribution for bad URL patterns and report
|
|
Packit |
e6c7a3 |
# on files that fail this check. Currently, this just checks that all the
|
|
Packit |
e6c7a3 |
# links to www.eyrie.org are https.
|
|
Packit |
e6c7a3 |
#
|
|
Packit |
e6c7a3 |
# The canonical version of this file is maintained in the rra-c-util package,
|
|
Packit |
e6c7a3 |
# which can be found at <https://www.eyrie.org/~eagle/software/rra-c-util/>.
|
|
Packit |
e6c7a3 |
#
|
|
Packit |
e6c7a3 |
# Copyright 2016 Russ Allbery <eagle@eyrie.org>
|
|
Packit |
e6c7a3 |
#
|
|
Packit |
e6c7a3 |
# Permission is hereby granted, free of charge, to any person obtaining a
|
|
Packit |
e6c7a3 |
# copy of this software and associated documentation files (the "Software"),
|
|
Packit |
e6c7a3 |
# to deal in the Software without restriction, including without limitation
|
|
Packit |
e6c7a3 |
# the rights to use, copy, modify, merge, publish, distribute, sublicense,
|
|
Packit |
e6c7a3 |
# and/or sell copies of the Software, and to permit persons to whom the
|
|
Packit |
e6c7a3 |
# Software is furnished to do so, subject to the following conditions:
|
|
Packit |
e6c7a3 |
#
|
|
Packit |
e6c7a3 |
# The above copyright notice and this permission notice shall be included in
|
|
Packit |
e6c7a3 |
# all copies or substantial portions of the Software.
|
|
Packit |
e6c7a3 |
#
|
|
Packit |
e6c7a3 |
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
|
Packit |
e6c7a3 |
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
|
Packit |
e6c7a3 |
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
|
|
Packit |
e6c7a3 |
# THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
|
Packit |
e6c7a3 |
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
|
|
Packit |
e6c7a3 |
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
|
|
Packit |
e6c7a3 |
# DEALINGS IN THE SOFTWARE.
|
|
Packit |
e6c7a3 |
|
|
Packit |
e6c7a3 |
use 5.006;
|
|
Packit |
e6c7a3 |
use strict;
|
|
Packit |
e6c7a3 |
use warnings;
|
|
Packit |
e6c7a3 |
|
|
Packit |
e6c7a3 |
use lib 't/lib';
|
|
Packit |
e6c7a3 |
|
|
Packit |
e6c7a3 |
use File::Find qw(find);
|
|
Packit |
e6c7a3 |
use Test::More;
|
|
Packit |
e6c7a3 |
use Test::RRA qw(skip_unless_automated);
|
|
Packit |
e6c7a3 |
|
|
Packit |
e6c7a3 |
# Bad patterns to search for.
|
|
Packit |
e6c7a3 |
my @BAD_REGEXES = (qr{ http:// \S+ [.]eyrie[.]org }xms);
|
|
Packit |
e6c7a3 |
my @BAD_STRINGS = qw(rra@stanford.edu);
|
|
Packit |
e6c7a3 |
|
|
Packit |
e6c7a3 |
# File or directory names to always skip.
|
|
Packit |
e6c7a3 |
my %SKIP = map { $_ => 1 } qw(.git _build blib cover_db);
|
|
Packit |
e6c7a3 |
|
|
Packit |
e6c7a3 |
# Only run this test during automated testing, since failure doesn't indicate
|
|
Packit |
e6c7a3 |
# any user-noticable flaw in the package itself.
|
|
Packit |
e6c7a3 |
skip_unless_automated('Documentation URL tests');
|
|
Packit |
e6c7a3 |
|
|
Packit |
e6c7a3 |
# Scan files for bad URL patterns. This is meant to be run as the wanted
|
|
Packit |
e6c7a3 |
# function from File::Find.
|
|
Packit |
e6c7a3 |
sub check_file {
|
|
Packit |
e6c7a3 |
my $filename = $_;
|
|
Packit |
e6c7a3 |
|
|
Packit |
e6c7a3 |
# Ignore this check itself (or the non-Perl version of it). Ignore any
|
|
Packit |
e6c7a3 |
# directories or binary files. Ignore and prune any skipped files.
|
|
Packit |
e6c7a3 |
if ($SKIP{$filename}) {
|
|
Packit |
e6c7a3 |
$File::Find::prune = 1;
|
|
Packit |
e6c7a3 |
return;
|
|
Packit |
e6c7a3 |
}
|
|
Packit |
e6c7a3 |
return if -d $filename;
|
|
Packit |
e6c7a3 |
return if !-T $filename;
|
|
Packit |
e6c7a3 |
return if ($filename eq 'urls.t' || $filename eq 'urls-t');
|
|
Packit |
e6c7a3 |
|
|
Packit |
e6c7a3 |
# Scan the file.
|
|
Packit |
e6c7a3 |
open(my $fh, '<', $filename) or BAIL_OUT("Cannot open $File::Find::name");
|
|
Packit |
e6c7a3 |
while (defined(my $line = <$fh>)) {
|
|
Packit |
e6c7a3 |
for my $regex (@BAD_REGEXES) {
|
|
Packit |
e6c7a3 |
if ($line =~ $regex) {
|
|
Packit |
e6c7a3 |
ok(0, "$File::Find::name contains $regex");
|
|
Packit |
e6c7a3 |
close($fh) or BAIL_OUT("Cannot close $File::Find::name");
|
|
Packit |
e6c7a3 |
return;
|
|
Packit |
e6c7a3 |
}
|
|
Packit |
e6c7a3 |
}
|
|
Packit |
e6c7a3 |
for my $string (@BAD_STRINGS) {
|
|
Packit |
e6c7a3 |
if (index($line, $string) != -1) {
|
|
Packit |
e6c7a3 |
ok(0, "$File::Find::name contains $string");
|
|
Packit |
e6c7a3 |
close($fh) or BAIL_OUT("Cannot close $File::Find::name");
|
|
Packit |
e6c7a3 |
return;
|
|
Packit |
e6c7a3 |
}
|
|
Packit |
e6c7a3 |
}
|
|
Packit |
e6c7a3 |
}
|
|
Packit |
e6c7a3 |
close($fh) or BAIL_OUT("Cannot close $File::Find::name");
|
|
Packit |
e6c7a3 |
ok(1, $File::Find::name);
|
|
Packit |
e6c7a3 |
return;
|
|
Packit |
e6c7a3 |
}
|
|
Packit |
e6c7a3 |
|
|
Packit |
e6c7a3 |
# Use File::Find to scan all files from the top of the directory.
|
|
Packit |
e6c7a3 |
find(\&check_file, q{.});
|
|
Packit |
e6c7a3 |
done_testing();
|