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

Last change on this file since 14444 was 14444, checked in by stoecker, 2 years ago

see #16123 - not fixed, only network error

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