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

Last change on this file since 13592 was 13592, checked in by stoecker, 19 months ago

don't error for tms/wms_endpoint projection diffs

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