source: josm/trunk/scripts/TestHTTPS.pl@ 14273

Last change on this file since 14273 was 14188, checked in by stoecker, 6 years ago

drop fixed HTTPS issue

  • Property svn:executable set to *
File size: 2.8 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;
10
11my %known = map {$_ => 1} qw(
12 e-mapa.net
13 ge.ch
14 gis.mapa.lodz.pl
15 hikebikemap.org
16 osmdata.asitvd.ch
17 siglon.londrina.pr.gov.br
18 tiles.itoworld.com
19 tms.cadastre.openstreetmap.fr
20 wms.openstreetmap.de
21 www.jgoodies.com
22 www.osm-tools.org
23 www.webatlasde.de
24 zibi.openstreetmap.org.pl
25);
26
27sub getmaps
28{
29 my $dom = XML::LibXML->load_xml(location => "imagery_josm.imagery.xml");
30 my $xpc = XML::LibXML::XPathContext->new($dom);
31 $xpc->registerNs('j', 'http://josm.openstreetmap.de/maps-1.0');
32 foreach my $entry ($xpc->findnodes("//j:entry"))
33 {
34 my $name = $xpc->findvalue("./j:name", $entry);
35 for my $e ($xpc->findnodes(".//j:*", $entry))
36 {
37 if($e->textContent =~ /^http:\/\/(.*?)[\/]/)
38 {
39 my $u = $1;
40 if($u =~ /^(.*)\{switch:(.*)\}(.*)$/)
41 {
42 my ($f,$switch,$e) = ($1, $2, $3);
43 for my $s (split(",", $switch))
44 {
45 $urls{"$f$s$e"}{"MAP:$name"}++;
46 }
47 }
48 else
49 {
50 $urls{$u}{"MAP:$name"}++;
51 }
52 }
53 }
54 }
55}
56
57sub getfile($$)
58{
59 my ($type, $file) = @_;
60 open FILE,"<:encoding(utf-8)",$file or die;
61 my $name;
62 for my $line (<FILE>)
63 {
64 if($line =~ /^([^ \t].*);/)
65 {
66 $name = $1;
67 }
68 if($line =~ /http:\/\/(.*?)[\/]/)
69 {
70 $urls{$1}{"$type:$name"}++;
71 }
72 }
73}
74
75print "Options: PLUGIN STYLE RULE PRESET MAP GETPLUGIN GETSTYLE GETRULE GETPRESET GETMAP LOCAL\n" if !@ARGV;
76
77my $local = 0;
78for my $ARG (@ARGV)
79{
80 if($ARG eq "LOCAL") {$local = 1; }
81 if($ARG eq "GETMAP") { system "curl https://josm.openstreetmap.de/maps -o imagery_josm.imagery.xml"; getmaps();}
82 if($ARG eq "MAP") { getmaps(); }
83 for my $x ("PLUGIN", "STYLE", "RULE", "PRESET")
84 {
85 my $t = lc($x);
86 my $url = $x eq "PLUGIN" ? $t : "${t}s";
87 my $file = "josm_$t.xml";
88 if($ARG eq "GET$x") { system "curl https://josm.openstreetmap.de/$url -o $file"; getfile($x, $file);}
89 if($ARG eq $x) { getfile($x, $file); }
90 }
91}
92
93for my $url (sort keys %urls)
94{
95 my $i = join(" # ", sort keys %{$urls{$url}});
96 if($local) # skip test
97 {
98 print "* ".($known{$url} ? "~~" : "")."$url:$i\n";
99 next;
100 }
101 eval
102 {
103 local $SIG{ALRM} = sub {die "--Alarm--"};
104
105 alarm(5);
106 my $s = Net::HTTPS->new(Host => $url) || die $@;
107 $s->write_request(GET => "/", 'User-Agent' => "TestHTTPS/1.0");
108 my($code, $mess, %h) = $s->read_response_headers;
109 alarm(0);
110 print "* ".($known{$url} ? "~~" : "")."$url [$code $mess]: $i\n";
111 };
112 if($@ && $@ !~ "(--Alarm--|Connection refused)")
113 {
114 my $e = $@;
115 $e =~ s/[\r\n]//g;
116 $e =~ s/ at scripts\/TestHTTPS.pl .*//;
117 print "* ".($known{$url} ? "~~" : "")."$url [Error $e] :$i\n";
118 }
119}
Note: See TracBrowser for help on using the repository browser.