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

Last change on this file since 14900 was 14900, checked in by stoecker, 20 months ago

show unused ignores

  • Property svn:executable set to *
File size: 4.0 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;
10my %known;
11
12sub getignores
13{
14  open FILE,"<:encoding(utf-8)","josm_httpsignores.txt" or die;
15  for my $line (<FILE>)
16  {
17    if($line =~ /\|\| TestHTTPS \|\| \{\{\{(.*)\}\}\} \|\|/)
18    {
19      $known{$1} = 1;
20    }
21  }
22  close FILE;
23}
24
25sub getmaps
26{
27  my $dom = XML::LibXML->load_xml(location => "imagery_josm.imagery.xml");
28  my $xpc = XML::LibXML::XPathContext->new($dom);
29  $xpc->registerNs('j',  'http://josm.openstreetmap.de/maps-1.0');
30  foreach my $entry ($xpc->findnodes("//j:entry"))
31  {
32    my $name = $xpc->findvalue("./j:name", $entry);
33    for my $e ($xpc->findnodes(".//j:*", $entry))
34    {
35      if($e->textContent =~ /^http:\/\/(.*?)[\/]/)
36      {
37        my $u = $1;
38        if($u =~ /^(.*)\{switch:(.*)\}(.*)$/)
39        {
40          my ($f,$switch,$e) = ($1, $2, $3);
41          for my $s (split(",", $switch))
42          {
43            $urls{"$f$s$e"}{"MAP:$name"}++;
44          }
45        }
46        else
47        {
48          $urls{$u}{"MAP:$name"}++;
49        }
50      }
51    }
52  }
53}
54
55sub getfile($$)
56{
57  my ($type, $file) = @_;
58  open FILE,"<:encoding(utf-8)",$file or die;
59  my $name;
60  for my $line (<FILE>)
61  {
62    if($line =~ /^([^ \t].*);(.*)/)
63    {
64      my ($n, $url) = ($1, $2);
65      if($url =~ /josm\.openstreetmap\.de/)
66      {
67        $name = "WIKI$type:$n";
68      }
69      else
70      {
71        $name = "$type:$n";
72      }
73    }
74    if($line =~ /http:\/\/(.*?)[\/]/)
75    {
76      $urls{$1}{$name}++;
77    }
78  }
79  close FILE;
80}
81
82sub getdump()
83{
84  open FILE,"<:encoding(utf-8)","josm_dump.txt" or die;
85  local $/;
86  undef $/;
87  my $file = <FILE>;
88  close FILE;
89  eval $file;
90}
91
92print "Options: \n PLUGIN STYLE RULE PRESET MAP DUMP\n GETPLUGIN GETSTYLE GETRULE GETPRESET GETMAP GETDUMP\n LOCAL\n IGNORES GETIGNORES\n ALL GETALL\n" if !@ARGV;
93
94open OUTFILE,">","josm_https.txt" or die "Could not open output file";
95
96sub doprint($)
97{
98  my $t = $_[0];
99  for my $k (sort keys %known)
100  {
101    $known{$k}++ if($t =~ s/(\Q$k\E)/~~$1~~/g);
102  }
103  print OUTFILE $t;
104  print $t;
105}
106
107my $local = 0;
108for my $ARG (@ARGV)
109{
110  if($ARG eq "ALL") {push(@ARGV, "PLUGIN", "STYLE", "RULE", "PRESET", "MAP", "DUMP", "IGNORES");}
111  if($ARG eq "GETALL") {push(@ARGV, "GETPLUGIN", "GETSTYLE", "GETRULE", "GETPRESET", "GETMAP", "GETDUMP", "GETIGNORES");}
112}
113my %ARGS = map {$_ => 1} @ARGV; # prevent double arguments by passing through a hash
114for my $ARG (sort keys %ARGS)
115{
116  if($ARG eq "GETIGNORES") { system "curl https://josm.openstreetmap.de/wiki/IntegrationTestIgnores?format=txt -o josm_httpsignores.txt"; getignores();}
117  if($ARG eq "IGNORES") { getignores(); }
118  if($ARG eq "LOCAL") {$local = 1; }
119  if($ARG eq "GETDUMP") { system "scp josm\@josm.openstreetmap.de:auto/httpinfo.dump josm_dump.txt"; getdump();}
120  if($ARG eq "DUMP") { getdump(); }
121  if($ARG eq "GETMAP") { system "curl https://josm.openstreetmap.de/maps -o imagery_josm.imagery.xml"; getmaps();}
122  if($ARG eq "MAP") { getmaps(); }
123  for my $x ("PLUGIN", "STYLE", "RULE", "PRESET")
124  {
125    my $t = lc($x);
126    my $url = $x eq "PLUGIN" ? $t : "${t}s";
127    my $file = "josm_$t.xml";
128    if($ARG eq "GET$x") { system "curl https://josm.openstreetmap.de/$url -o $file"; getfile($x, $file);}
129    if($ARG eq $x) { getfile($x, $file); }
130  }
131}
132
133for my $url (sort keys %urls)
134{
135  my $i = join(" # ", sort keys %{$urls{$url}});
136  if($local) # skip test
137  {
138    doprint "* $url:$i\n";
139    next;
140  }
141  eval
142  {
143    local $SIG{ALRM} = sub {die "--Alarm--"};
144
145    alarm(5);
146    my $s = Net::HTTPS->new(Host => $url) || die $@;
147    $s->write_request(GET => "/", 'User-Agent' => "TestHTTPS/1.0");
148    my($code, $mess, %h) = $s->read_response_headers;
149    alarm(0);
150    doprint "* $url [$code $mess]: $i\n";
151  };
152  if($@ && $@ !~ "(--Alarm--|Connection refused)")
153  {
154    my $e = $@;
155    $e =~ s/[\r\n]//g;
156    $e =~ s/ at scripts\/TestHTTPS.pl .*//;
157    doprint "* $url [Error $e] :$i\n";
158  }
159}
160
161for my $k (sort keys %known)
162{
163  print "Unused ignores $k\n" if $known{$k} == 1;
164}
Note: See TracBrowser for help on using the repository browser.