blob: 8b14ff08937ce9aca2523134b41f6de7dd8a6031 (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
|
#!/usr/bin/perl -w
# testvendors.pl - My evil vendor testing script
# You will need wget for this baby to work.
# Is the script evil or the vendors? Let the script decide
# Written by Craig Small <csmall@debian.org>
# Copyright 2000 SPI Inc, released under the GPL if anyone would bother with it
#
# TODO
# - Vendors should be required to include a specific tag in the 'Debian'
# webpages so that the script can easily detect if the page
# (deburl) points to the proper place. For the time being, the
# script just looks for 'Debian' (case-insensitive) in the page
my $dir = '/etc/ssl/ca-global';
my $capath = -d $dir ? "--ca-directory=$dir" : '';
sub sanitize (@)
{
# Sanitize characters in the URL with their encoded entities
my ($url) = @_;
$url =~ s/&/&/g;
$url =~ s/'/%27/g;
$url =~ s/ /%20/g;
$url =~ s/!/%21/g;
return $url;
}
sub test_vendor(@)
{
($name, $url, $deburl,$email) = @_;
if ($name eq "") {
print "E: No vendor name, is something borked?\n";
return;
}
if ($email eq "") {
print "E: Vendor \"$name\" doesn't have an email address!\n";
}
if ($url eq "") {
print "E: Vendor \"$name\" <$email> doesn't have a webpage!\n";
} else {
print "N: Checking $url\n";
my $turl = sanitize($url);
$vendpage = `wget $capath -t 1 -O/dev/null '$turl' 2>&1`;
if ($vendpage =~ /: Host not found./)
{
print "E: Vendor \"$name\" <$email> cannot look up web page $url\n";
} elsif ($vendpage =~ /ERROR 404: Not Found./)
{
print "E: Vendor \"$name\" <$email> $url page not found (404)\n";
}
}
if ($deburl eq "") {
print "W: Vendor \"$name\" <$email> doesn't have a Debian webpage.\n";
} else {
print "N: Checking $deburl\n";
my $turl = sanitize($deburl);
$vendpage = `wget $capath -t 1 -O- '$turl' 2>&1`;
if ($vendpage =~ /: Host not found./)
{
print "E: Vendor \"$name\" <$email> cannot look up web page $deburl\n";
} elsif ($vendpage =~ /ERROR 404: Not Found./)
{
print "E: Vendor \"$name\" <$email> $deburl page not found (404)\n";
} elsif ( $vendpage !~ /[Dd][Ee][Bb][Ii][Aa][Nn]/)
{
print "E: Vendor \"$name\" <$email> $deburl doesn't mention Debian\n";
}
}
}
sub usage
{
print "Usage $0 [-dh] <filename>\n";
exit 1;
}
our($opt_d, $opt_h);
my $debug = 0;
use Getopt::Std;
getopts('dh');
usage() if $opt_h;
$debug = 1 if defined($opt_d);
print STDERR "DEBUG: Enabling debug mode ($debug)\n" if $debug;
$|=1 if $debug;
my $filename;
$filename = $ARGV[0];
if ( $opt_h or ! defined($filename) or $filename eq "")
{
print STDERR "ERROR: Missing filename argument\n";
usage();
}
print STDERR "DEBUG: Reading $filename\n" if $debug;
open IN, $filename or die "Cannot open $filename : $!";
$invendor = 0;
$vendorname = "";
$vendorurl = "";
$vendordeburl = "";
$vendoremail = "";
my $numline = 0;
while ($line = <IN>) {
chomp $line;
$numline++;
print STDERR "DEBUG: Reading line $numline\n" if $debug > 1;
next if $line =~ /^\#/ ; # Skip comments
if ($line =~ /^\s*<vendor name="([^>]+)"/) {
$vendorname = $1;
$invendor = 1;
print STDERR "DEBUG: Found vendor $vendorname ($filename: $numline)\n" if $debug;
}
if ($invendor) { # We are in a vendor entry
if ($line =~ /^[\t ]*url="([^>]+)"/) {
$vendorurl = $1;
print STDERR "DEBUG: Found URL $vendorurl ($filename: $numline)\n" if $debug;
}
if ($line =~ /^[\t ]*deburl="([^>]+)"/) {
$vendordeb = $1;
print STDERR "DEBUG: Found Debian URL $vendordeb ($filename: $numline)\n" if $debug;
}
if ($line =~ /^[\t ]*contacturl="mailto:([^>]+)"/) {
$vendoremail = $1;
print STDERR "DEBUG: Found email $vendoremail ($filename: $numline)\n" if $debug;
}
if ($line =~ /\/>/) {
print STDERR "DEBUG: Testing vendor vendorname ($filename: $numline)\n" if $debug;
test_vendor($vendorname, $vendorurl, $vendordeb,$vendoremail);
$vendorname = "";
$vendorurl = "";
$vendordeburl = "";
$vendoremail = "";
$invendor = 0;
}
if ($line =~ /<country/ ){
die "Unexpected closing of vendor tag in line $numline";
}
}
}
|
