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

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

see #16123 - some HTTPS issues solved

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