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

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

see #16123 - extend HTTPS test script to plugin/style/rule/preset

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