#!/usr/bin/perl
# takes a properly formatted file, finds the update content for each build
# and compares two update content servers to make sure they match
# the file must be in the following format, seperated by the pipe | character
# Header
# %Product%|%Version%|%Platform%|%BuildID%|%Locale%|%Channel%|%UpdateVersion%
use strict;
use warnings;
use LWP::UserAgent;

sub HTTPResponse;

if (!defined($ARGV[0])) {
    print "USEAGE : perl $0 filename\n";
    exit 1;
}

open FILEHANDLE, "<$ARGV[0]";

# first line is a header. Discard it
<FILEHANDLE>;

$| = 1; # force a flush after each write

my $ua = LWP::UserAgent->new;

while (<FILEHANDLE>) {
    my $response_main;  #aus2
    my $response_test;  #aus2-test
    my $line = $_;
    my @params = split /\|/;
    
    $response_main = HTTPResponse(@params,
            'https://aus2.mozillamessaging.com/update/');
    $response_test = HTTPResponse(@params,
            'https://63.245.217.185/update/');

    # build up a union of all headers
    my @all_headers = ();
    my %count = ();
    foreach my $element (keys(%{$response_main->headers()}), 
                         keys(%{$response_test->headers()})) { 
        $count{$element}++;
    }
    @all_headers = keys(%count);

    # ensure that headers only differ in the ways we expect
    my @allowed_undefined = ('keep-alive', 'expires', 'set-cookie', 'x-backend-server',
                             'x-varnish', 'x-varnish-ip', 'via', 'age');
    my @allowed_mismatch = ('cache-control', 'connection', 'client-peer',
                            # these are different after we follow the 302
                            'client-ssl-cert-issuer', 'client-ssl-cert-subject',
                            'date', 'client-date', 'server',
                            'keep-alive');
    my $fail = 0;
    foreach my $name (@all_headers) {
        if (! defined($response_main->header($name))) {
            if (grep( { $_ eq $name } @allowed_undefined)) {
                next;
            }
            print STDERR "FAIL Header check failed for main $name: NOT DEFINED\n";
            $fail++; 
            next;
        }
        if (! defined($response_test->header($name))) {
            if (grep( { $_ eq $name } @allowed_undefined)) {
                next;
            }
            print STDERR "FAIL Header check failed for test $name: NOT DEFINED\n";
            $fail++; 
            next;
        }
        if ($response_main->header($name) ne $response_test->header($name)) {
            if (grep( { $_ eq $name } @allowed_mismatch)) {
                next;
            }
            print STDERR "FAIL Header check failed for $name NO MATCH, " .
                "main: " . $response_main->header($name) .
                ", test: " . $response_test->header($name) . "\n";
            $fail++; 
        }
    }
    chomp($line);
    if (!defined($response_main)) {
        print STDERR "FAIL no response from main server\n";
        $fail++; 
    } elsif (!defined($response_test)) {
        print STDERR "FAIL no response from main server\n";
        $fail++; 
    } elsif ($response_main->content_type ne $response_test->content_type) {
        print STDERR "FAIL Content type check failed; main=" .
             $response_main->content_type . ", test=" .
             $response_test->content_type . "\n";
        $fail++; 
    } elsif ($response_main->content_length ne
             $response_test->content_length) {
        print STDERR "FAIL Content length check failed; main=" .
             $response_main->content_length . ", test=" .
             $response_test->content_length . "\n";
        $fail++; 
    } elsif ($response_main->content ne $response_test->content) {
        print STDERR "FAIL Content check failed\n";
        $fail++; 
    }

    if ($fail) {
        print 'FAIL ' . $line . " - $fail errors \n";
    } else {
        print 'PASS ' . $line . ' ' . 
            ($response_main->header('x-backend-server') || 'n/a') . ' ' . 
            ($response_test->header('x-backend-server') || 'n/a') . ' ' .
            $response_main->content_length . "B\n";
    }

    #sleep 1;
}

# This returns an instance of HTTP::Response
# Reference : http://search.cpan.org/~gaas/libwww-perl-5.803/lib/HTTP/Response.pm
sub HTTPResponse() {
    my ($product, $version, $platform,
        $build, $locale, $channel, $major_version, $server) = @_;
    # example url
    #https://aus2.mozilla.org/update/1/Firefox/1.5.0.3/2006042618/Linux_x86-gcc3/en-US/release/update.xml
    my $url;        # the full url
    my $response;
    chomp $major_version;     # removes newline characer
    $url = $server . "$major_version/" .
           "$product/" . "$version/" . "$build/" . "$platform/" .
           "$locale/" . "$channel/";
    
    # fake out %OS_VERSION%
    if ($major_version >= 2) {
        $url = $url . "AUS_Checker/";
    }
    # fake out %DISTRIBUTION%/%DISTRIBUTION_VERSION%/
    if ($major_version >= 3) {
        $url = $url . "default/default/";
    }
    $url = $url . "update.xml";
#    print "$url\n";
    
    my $req = HTTP::Request->new(GET => $url);
    if ($server =~ '63\.245\.217\.185') {
      $req->header("Host" => "aus2.mozillamessaging.com");
    }

    $response = $ua->request($req);

    unless ($response->is_success) {
        print STDERR "FAIL " . $response->status_line ."\n";
        return;
    }

    $response;
}
