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

Last change on this file since 13555 was 13555, checked in by stoecker, 15 months ago

see #16123 - add HTTPS test script

  • Property svn:executable set to *
File size: 1.3 KB
Line 
1#! /usr/bin/perl -w
2
3use strict;
4use utf8;
5use open qw/:std :encoding(utf8)/;
6use Net::HTTPS;
7
8use XML::LibXML;
9
10my $dom = XML::LibXML->load_xml(location => "imagery_josm.imagery.xml");
11my $xpc = XML::LibXML::XPathContext->new($dom);
12$xpc->registerNs('j',  'http://josm.openstreetmap.de/maps-1.0');
13my %urls;
14
15foreach my $entry ($xpc->findnodes("//j:entry"))
16{
17  my $name = $xpc->findvalue("./j:name", $entry);
18  for my $e ($xpc->findnodes(".//j:*", $entry))
19  {
20    if($e->textContent =~ /^http:\/\/(.*?)[\/]/)
21    {
22      my $u = $1;
23      if($u =~ /^(.*)\{switch:(.*)\}(.*)$/)
24      {
25        my ($f,$switch,$e) = ($1, $2, $3);
26        for my $s (split(",", $switch))
27        {
28          $urls{"$f$s$e"}{$name}++;
29        }
30      }
31      else
32      {
33        $urls{$u}{$name}++;
34      }
35    }
36  }
37}
38
39for my $url (sort keys %urls)
40{
41  my $i = join(" # ", sort keys %{$urls{$url}});
42  eval
43  {
44    local $SIG{ALRM} = sub {die "--Alarm--"};
45
46    alarm(5);
47    my $s = Net::HTTPS->new(Host => $url) || die $@;
48    $s->write_request(GET => "/", 'User-Agent' => "TestHTTPS/1.0");
49    my($code, $mess, %h) = $s->read_response_headers;
50    alarm(0);
51    print "* $url [$code $mess]: $i\n";
52  };
53  if($@ && $@ !~ "(--Alarm--|Connection refused)")
54  {
55    my $e = $@;
56    $e =~ s/[\r\n]//g;
57    $e =~ s/ at scripts\/TestHTTPS.pl .*//;
58    print "* $url [Error $e] :$i\n";
59  }
60}
Note: See TracBrowser for help on using the repository browser.