| #!/usr/bin/perl |
| # |
| # Licensed to the Apache Software Foundation (ASF) under one |
| # or more contributor license agreements. See the NOTICE file |
| # distributed with this work for additional information |
| # regarding copyright ownership. The ASF licenses this file |
| # to you under the Apache License, Version 2.0 (the |
| # "License"); you may not use this file except in compliance |
| # with the License. You may obtain a copy of the License at |
| # |
| # http://www.apache.org/licenses/LICENSE-2.0 |
| # |
| # Unless required by applicable law or agreed to in writing, software |
| # distributed under the License is distributed on an "AS IS" BASIS, |
| # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. |
| # See the License for the specific language governing permissions and |
| # limitations under the License. |
| |
| use strict; |
| use warnings; |
| use Getopt::Long; |
| use Data::Dumper; |
| use Net::hostent; |
| use Socket; |
| use LWP::UserAgent; |
| use Digest::SHA1; |
| |
| my $verbose = 0; |
| |
| #---------------------------------------------------------------------------- |
| sub usage() |
| { |
| print STDERR "USAGE: compare_hosts.pl --verbose level --host1 testing_host --host2 valid_host --file url_file\n\n"; |
| print STDERR "\t--host1 The host running the newest version\n"; |
| print STDERR "\t--host2 The host running the older version\n"; |
| print STDERR "\t--file A file that contains a list of URLs\n"; |
| print STDERR "\t--verbose verbose level 1-3, 1 is the least verbose\n\n"; |
| print STDERR "Example:\n"; |
| print STDERR "\tcompare_hosts.pl --host1 new_ats --host2 old_ats --file top_1000_urls\n"; |
| exit 1; |
| } |
| |
| #---------------------------------------------------------------------------- |
| sub compareHeaderNames($$) |
| { |
| my ($response1, $response2) = @_; |
| |
| my @names1 = $response1->header_field_names; |
| my @names2 = $response2->header_field_names; |
| |
| my %hash2; |
| $hash2{$_} = 1 for (@names2); |
| my %hash1; |
| $hash1{$_} = 1 for (@names1); |
| |
| my $return_val = 0; # header names match |
| |
| foreach my $name (@names1) { |
| if (!defined $hash2{$name}) { |
| print "\t\t- $name header not found on host2\n" if $verbose >= 2; |
| $return_val = 1; |
| } |
| } |
| |
| foreach my $name (@names2) { |
| if (!defined $hash1{$name}) { |
| print "\t\t- $name header not found on host1\n" if $verbose >= 2; |
| $return_val = 1; |
| } |
| } |
| |
| return $return_val; |
| } |
| |
| #---------------------------------------------------------------------------- |
| sub compareHeaderValues($$) |
| { |
| my ($response1, $response2) = @_; |
| |
| my @test_headers = |
| qw(ETag Cache-Control Connection Accept-Ranges Server Content-Type Access-Control-Allow-Methods Access-Control-Allow-Origin Strict-Transport-Security); |
| my $return_val = 0; # header value match |
| |
| if ($verbose >= 3) { |
| foreach my $field ($response1->header_field_names) { |
| print "\t\t\t~ " . $field . ": " . $response1->header($field) . "\n"; |
| } |
| |
| print "\t\tHost2: \n"; |
| |
| foreach my $field ($response2->header_field_names) { |
| print "\t\t\t~ " . $field . ": " . $response2->header($field) . "\n"; |
| } |
| } |
| |
| # Test specific headers that are defined above |
| foreach my $field (@test_headers) { |
| my $value1 = $response1->header($field); |
| my $value2 = $response2->header($field); |
| |
| if (defined $value1 && defined $value2) { |
| if ($value1 ne $value2) { |
| print "\t\t- $field: $value1 ne $value2\n" if $verbose; |
| print "\t\t\t - Via host1: " . $response1->header('Via') . " host2: " . $response2->header('Via') . "\n" |
| if $verbose; |
| print "\t\t\t - Last-Modified host1: " |
| . $response1->header('Last-Modified') |
| . " host2: " |
| . $response2->header('Last-Modified') . "\n" |
| if $verbose; |
| if (defined $response2->header('Content-Encoding')) { |
| print "\t\t\t - Content-Encoding host1: " |
| . $response1->header('Content-Encoding') |
| . " host2: " |
| . $response2->header('Content-Encoding') . "\n"; |
| } else { |
| print "\t\t\t - Content-Encoding host1: " . $response1->header('Content-Encoding') . " host2: ''\n"; |
| } |
| $return_val = 1; |
| } else { |
| print "\t\t- $field: $value1 eq $value2\n" if $verbose >= 2; |
| } |
| } |
| } |
| return $return_val; |
| } |
| |
| #---------------------------------------------------------------------------- |
| { |
| my %stats; |
| |
| $ENV{PERL_LWP_SSL_VERIFY_HOSTNAME} = '0'; |
| my ($host1, $host2, $file); |
| GetOptions( |
| "host1=s" => \$host1, |
| "host2=s" => \$host2, |
| "file=s" => \$file, |
| "verbose=f" => \$verbose |
| ) || die $!; |
| |
| usage() if (!defined $host1 || !defined $host2 || !defined $file); |
| |
| my $count = 0; |
| my $status_error = 0; |
| my $sha_error = 0; |
| my $header_names_mismatch = 0; |
| my $header_values_mismatch = 0; |
| |
| my $host1_addr = inet_ntoa(inet_aton($host1)); |
| my $host2_addr = inet_ntoa(inet_aton($host2)); |
| |
| print "Testing with host1: $host1 ($host1_addr) - host2: $host2 ($host2_addr)\n"; |
| print '-' x 78, "\n"; |
| |
| open(FILE, $file) || die $!; |
| |
| # Create a user agent object |
| my $ua1 = LWP::UserAgent->new(keep_alive => 100); |
| $ua1->agent("MyApp/0.1 "); |
| |
| # Create a user agent object |
| my $ua2 = LWP::UserAgent->new(keep_alive => 100); |
| $ua2->agent("MyApp/0.1 "); |
| |
| while (my $url = <FILE>) { |
| next if ($url =~ m|hc.l.yimg.com|); |
| chomp $url; |
| my $exit = 0; |
| |
| if ($url =~ m|(https?)://([^/]+)(.+)|) { |
| |
| my $scheme = $1; |
| my $host = $2; |
| my $path = $3; |
| |
| $count++; |
| print "Test $count - URL: $url\n"; |
| |
| my $port = 80; |
| $port = 443 if $scheme eq 'https'; |
| |
| my $request1 = HTTP::Request->new(GET => "${scheme}://${host1_addr}${path}"); |
| $request1->header('Host' => $host); |
| my $response1 = $ua1->request($request1); |
| |
| my $request2 = HTTP::Request->new(GET => "${scheme}://${host2_addr}${path}"); |
| $request2->header('Host' => $host); |
| $request2->header('Accept-Encoding' => 'deflate'); |
| my $response2 = $ua2->request($request2); |
| |
| print "\tStatus code for host1: " . $response1->code . " - host2: " . $response2->code . "\n" if $verbose; |
| |
| my $sha1 = Digest::SHA1->new; |
| $sha1->add($response1->content); |
| my $digest1 = $sha1->hexdigest; |
| open(FILE1, "> /tmp/tmp1"); |
| open(FILE2, "> /tmp/tmp2"); |
| print FILE1 $response1->content; |
| print FILE2 $response2->content; |
| close FILE1; |
| close FILE2; |
| #print $response1->content, "\n"; # for internal debugging |
| #print $response2->content, "\n"; # for internal debugging |
| |
| my $sha2 = Digest::SHA1->new; |
| $sha2->add($response2->content); |
| my $digest2 = $sha2->hexdigest; |
| |
| print "\tSHA hash for host1: $digest1 - host2: $digest2\n" if $verbose; |
| |
| # Build up stats |
| if ($response1->status_line eq $response2->status_line) { |
| |
| # Do the hashes |
| if ($digest1 eq $digest2) { |
| $stats{stat_line_match}->{$response1->code}->{sha_match}++; |
| print "\tResponse code: " . $response1->code . " - Status lines and SHA1 of response bodies match\n"; |
| } else { |
| $stats{stat_line_match}->{$response1->code}->{sha_nomatch}++; |
| print "\tResponse code: " . $response1->code . " - Status lines match SHA1 doesn't match\n"; |
| $sha_error++; |
| #$exit = 1 if $response1->code == 200; # for internal debugging |
| } |
| |
| # Compare the header field names |
| if (compareHeaderNames($response1, $response2) == 0) { |
| $stats{stat_line_match}->{$response1->code}->{field_names_match}++; |
| } else { |
| $stats{stat_line_match}->{$response1->code}->{field_names_nomatch}++; |
| $header_names_mismatch++; |
| } |
| |
| # Compare the values of the header fields |
| if (compareHeaderValues($response1, $response2) == 0) { |
| $stats{stat_line_match}->{$response1->code}->{field_values_match}++; |
| } else { |
| $stats{stat_line_match}->{$response1->code}->{field_values_nomatch}++; |
| $header_values_mismatch++; |
| } |
| } else { |
| $status_error++; |
| $stats{stat_line_nomatch}++; |
| print "\tERROR: status lines don't match\n"; |
| } |
| |
| last if $exit; |
| } |
| } |
| |
| print '-' x 78, "\n"; |
| print "SUMMARY:\n"; |
| print "URLs tested: $count\n"; |
| print "Status line mismatches: $status_error\n"; |
| print "SHA1 mismatches: $sha_error\n"; |
| print "Responses with header names mismatches: $header_names_mismatch\n"; |
| print "Responses with header values mismatches: $header_values_mismatch\n"; |
| print Dumper \%stats if $verbose; |
| } |
| |
