source: josm/trunk/scripts/TestHTTPS.pl

Last change on this file was 18737, checked in by stoecker, 16 months ago

small script fix to ignore non-URLs

  • Property svn:executable set to *
File size: 4.1 KB
Line 
1#! /usr/bin/perl -w
2
3use strict;
4use utf8;
5use open qw/:std :encoding(utf8)/;
6use Net::HTTPS;
7use XML::LibXML;
8
9my %urls;
10my %known;
11
12sub getignores
13{
14 open FILE,"<:encoding(utf-8)","josm_httpsignores.txt" or die;
15 for my $line (<FILE>)
16 {
17 if($line =~ /\|\| TestHTTPS \|\| \{\{\{(.*)\}\}\} \|\|/)
18 {
19 $known{$1} = 1;
20 }
21 }
22 close FILE;
23}
24
25sub getmaps
26{
27 my $dom = XML::LibXML->load_xml(location => "imagery_josm.imagery.xml");
28 my $xpc = XML::LibXML::XPathContext->new($dom);
29 $xpc->registerNs('j', 'http://josm.openstreetmap.de/maps-1.0');
30 foreach my $entry ($xpc->findnodes("//j:entry"))
31 {
32 my $name = $xpc->findvalue("./j:name", $entry);
33 for my $e ($xpc->findnodes(".//j:*", $entry))
34 {
35 if($e->textContent =~ /^http:\/\/([^ ]+?)(:\d+)?[\/]/)
36 {
37 my $u = $1;
38 if($u =~ /^(.*)\{switch:(.*)\}(.*)$/)
39 {
40 my ($f,$switch,$e) = ($1, $2, $3);
41 for my $s (split(",", $switch))
42 {
43 $urls{"$f$s$e"}{"MAP:$name"}++;
44 }
45 }
46 else
47 {
48 $urls{$u}{"MAP:$name"}++;
49 }
50 }
51 }
52 }
53}
54
55sub getfile($$)
56{
57 my ($type, $file) = @_;
58 open FILE,"<:encoding(utf-8)",$file or die;
59 my $name;
60 for my $line (<FILE>)
61 {
62 if($line =~ /^([^ \t].*);(.*)/)
63 {
64 my ($n, $url) = ($1, $2);
65 if($url =~ /josm\.openstreetmap\.de/)
66 {
67 $name = "WIKI$type:$n";
68 }
69 else
70 {
71 $name = "$type:$n";
72 }
73 }
74 if($line =~ /http:\/\/([^ ]+?)(:\d+)?[\/]/)
75 {
76 $urls{$1}{$name}++;
77 }
78 }
79 close FILE;
80}
81
82sub getdump()
83{
84 open FILE,"<:encoding(utf-8)","josm_dump.txt" or die;
85 local $/;
86 undef $/;
87 my $file = <FILE>;
88 close FILE;
89 eval $file;
90}
91
92print "Options: \n PLUGIN STYLE RULE PRESET MAP DUMP\n GETPLUGIN GETSTYLE GETRULE GETPRESET GETMAP GETDUMP\n LOCAL\n IGNORES GETIGNORES\n ALL GETALL\n" if !@ARGV;
93
94open OUTFILE,">","josm_https.txt" or die "Could not open output file";
95open OUTFILENH,">","josm_no_https.txt" or die "Could not open no-https output file";
96
97sub doprint($)
98{
99 my $t = $_[0];
100 for my $k (sort keys %known)
101 {
102 $known{$k}++ if($t =~ s/(\Q$k\E)/~~$1~~/g);
103 }
104 print OUTFILE $t;
105 print $t;
106}
107
108my $local = 0;
109for my $ARG (@ARGV)
110{
111 if($ARG eq "ALL") {push(@ARGV, "PLUGIN", "STYLE", "RULE", "PRESET", "MAP", "DUMP", "IGNORES");}
112 if($ARG eq "GETALL") {push(@ARGV, "GETPLUGIN", "GETSTYLE", "GETRULE", "GETPRESET", "GETMAP", "GETDUMP", "GETIGNORES");}
113}
114my %ARGS = map {$_ => 1} @ARGV; # prevent double arguments by passing through a hash
115for my $ARG (sort keys %ARGS)
116{
117 if($ARG eq "GETIGNORES") { system "curl https://josm.openstreetmap.de/wiki/IntegrationTestIgnores?format=txt -o josm_httpsignores.txt"; getignores();}
118 if($ARG eq "IGNORES") { getignores(); }
119 if($ARG eq "LOCAL") {$local = 1; }
120 if($ARG eq "GETDUMP") { system "scp josm\@josm.openstreetmap.de:auto/httpinfo.dump josm_dump.txt"; getdump();}
121 if($ARG eq "DUMP") { getdump(); }
122 if($ARG eq "GETMAP") { system "curl https://josm.openstreetmap.de/maps -o imagery_josm.imagery.xml"; getmaps();}
123 if($ARG eq "MAP") { getmaps(); }
124 for my $x ("PLUGIN", "STYLE", "RULE", "PRESET")
125 {
126 my $t = lc($x);
127 my $url = $x eq "PLUGIN" ? $t : "${t}s";
128 my $file = "josm_$t.xml";
129 if($ARG eq "GET$x") { system "curl https://josm.openstreetmap.de/$url -o $file"; getfile($x, $file);}
130 if($ARG eq $x) { getfile($x, $file); }
131 }
132}
133
134for my $url (sort keys %urls)
135{
136 my $i = join(" # ", sort keys %{$urls{$url}});
137 if($local) # skip test
138 {
139 doprint "* $url:$i\n";
140 next;
141 }
142 eval
143 {
144 local $SIG{ALRM} = sub {die "--Alarm--"};
145
146 alarm(5);
147 my $s = Net::HTTPS->new(Host => $url) || die $@;
148 $s->write_request(GET => "/", 'User-Agent' => "TestHTTPS/1.0");
149 my($code, $mess, %h) = $s->read_response_headers;
150 alarm(0);
151 doprint "* $url [$code $mess]: $i\n";
152 };
153 if($@)
154 {
155 my $e = $@||"";
156 $e =~ s/[\r\n]//g;
157 $e =~ s/ at scripts\/TestHTTPS.pl .*//;
158 if($@ !~ "(--Alarm--|Connection refused)")
159 {
160 doprint "* $url [Error $e] :$i\n";
161 }
162 elsif($@)
163 {
164 print OUTFILENH "* $url [$e] :$i\n";
165 }
166 }
167}
168
169for my $k (sort keys %known)
170{
171 print "Unused ignores $k\n" if $known{$k} == 1;
172}
Note: See TracBrowser for help on using the repository browser.