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

Last change on this file since 14620 was 14620, checked in by stoecker, 4 months ago

see #16123 - don't append logfile output

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