#!/usr/bin/env perl

# mt-aws-glacier - Amazon Glacier sync client
# Copyright (C) 2012-2014  Victor Efimov
# http://mt-aws.com (also http://vs-dev.com) vs@vs-dev.com
# License: GPLv3
#
# This file is part of "mt-aws-glacier"
#
#    mt-aws-glacier is free software: you can redistribute it and/or modify
#    it under the terms of the GNU General Public License as published by
#    the Free Software Foundation, either version 3 of the License, or
#    (at your option) any later version.
#
#    mt-aws-glacier is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU General Public License for more details.
#
#    You should have received a copy of the GNU General Public License
#    along with this program.  If not, see <http://www.gnu.org/licenses/>.


# Original authors of some code
# (c) 1995-2010 Gisle Aas. All rights reserved.
# (c) 1995 Martijn Koster. All rights reserved.

use strict;
use warnings;
use FindBin;
use lib map { "$FindBin::RealBin/$_" } qw{../lib ../../lib};
use TestUtils 'w_fatal';
use Carp;
use URI;
use Test::More;
use HTTP::Daemon;
use App::MtAws;

print "# LWP Versions:".LWP->VERSION().",".HTTP::Message->VERSION.",".HTTP::Daemon->VERSION()."\n" unless @ARGV;



my $proto = 'http';

my $test_size = 3_000_000 - 1;


my $throttling_exception = '{"message":"The security token included in the request is invalid.","code":"ThrottlingException","type":"Client"}';
my %common_options = (region => 'r', key => 'k', secret => 's', protocol => $proto, timeout => 40);
my ($base) = initialize_processes();
	plan tests => 42;

	my $mtroot = get_temp_dir();

	my $tmpfile = "$mtroot/lwp.tmp";


	sub make_glacier_request
	{
		my ($method, $url, $glacier_options, $merge_keys) = @_;
		my $g = App::MtAws::GlacierRequest->new($glacier_options);
		$g->{$_} = $merge_keys->{$_} for (keys %$merge_keys);
		$g->{method} = $method;
		$g->{url} = '/'.$url;
		local $ENV{MTGLACIER_FAKE_HOST} = $base;
		my $resp = eval {
			$g->perform_lwp();
		};
		return $resp ? ($g, $resp, undef) : ($g, undef, $@);
	}

	sub httpd_content_length
	{
		my($c, $req, $size, $header_size) = @_;
		$c->send_basic_header(200);

		my $s = 'x' x $size;
		print $c "Content-Length: $header_size\015\012";
		$c->send_crlf;
		print $c $s;
	}

	sub httpd_content_length_400
	{
		my($c, $req) = @_;
		$c->send_basic_header(400);

		my $s = $throttling_exception;
		my $truncated = length($s) + 1;
		print $c "Content-Length: $truncated\015\012";
		print $c "Content-Type: application/json\015\012";
		$c->send_crlf;
		print $c $s;
	}

	sub httpd_check_user_agent
	{
		my($c, $req) = @_;
		$c->send_basic_header(200);

		my $ua = $req->header('User-Agent');
		my $ua_len = length($ua);
		print $c "Content-Length: $ua_len\015\012";
		$c->send_crlf;
		print $c $ua;
	}

	sub httpd_empty_response
	{
		my($c, $req, $size, $header_size) = @_;
		$c->send_basic_header(200);
	}

	sub httpd_without_content_length
	{
		my($c, $req, $size) = @_;
		my $resp = HTTP::Response->new(200, 'Fine');
		my $sent = 0;
		# force chunked-response
		$resp->content(sub {
			if (!$sent) {
				$sent = 1;
				return 'x' x $size;
			} else {
				return '';
			}
		});
		$c->send_response($resp);
	}

	# success with size defined
	{
		open F, ">$tmpfile";
		close F;
		my $writer = App::MtAws::HttpFileWriter->new(tempfile => $tmpfile);
		my (undef, $resp, undef) = make_glacier_request('GET', "content_length/$test_size/$test_size", {%common_options},
			{writer => $writer, expected_size => $test_size});
		is -s $tmpfile, $test_size;
		ok($resp->is_success);
	}

	sub httpd_chunked_throttling_exception
	{
		my($c, $req) = @_;
		my $resp = HTTP::Response->new(400);
		$resp->content_type('application/json');
		my $s = $throttling_exception;
		my $sent = 0;
		# force chunked-response
		$resp->content(sub {
			if (!$sent) {
				$sent = 1;
				return $s;
			} else {
				return '';
			}
		});
		$c->send_response($resp);
	}

	sub httpd_throttling_exception
	{
		my($c, $req, $size, $header_size) = @_;
		$c->send_basic_header(400);
		my $s = $throttling_exception;
		print $c "Content-Length: ".length($s)."\015\012";
		print $c "Content-Type: application/json\015\012";
		$c->send_crlf;
		print $c $s;
	}
	# correct request, but HTTP 400 with exception in JSON
	{
		# TODO: seems some versions of LWP raise this warnign, actually move to GlacierRequest
		open F, ">$tmpfile";
		close F;
		no warnings 'redefine';
		local *App::MtAws::GlacierRequest::_max_retries = sub { 1 };
		local *App::MtAws::GlacierRequest::_sleep = sub { };
		for my $method (qw/GET PUT POST DELETE/) {
			for my $action (qw/chunked_throttling_exception/) {
				my $writer = App::MtAws::HttpFileWriter->new(tempfile => $tmpfile);
				my ($g, $resp, $err) = make_glacier_request($method, $action, {%common_options},
					{writer => $writer, expected_size => $test_size, dataref => \''});
				is -s $tmpfile, 0;
				is $err->{code}, 'too_many_tries'; # TODO: test with cmp_deep and exception()
				is $g->{last_retry_reason}, 'ThrottlingException', "ThrottlingException for $method,$action";
			}
		}
	}

	# success with no size defined
	{
		open F, ">$tmpfile";
		close F;
		my $writer = App::MtAws::HttpFileWriter->new(tempfile => $tmpfile);
		my (undef, $resp, undef) = make_glacier_request('GET', "content_length/$test_size/$test_size", {%common_options},
			{writer => $writer});
		is -s $tmpfile, $test_size;
		ok($resp->is_success);
	}

	# truncated response, no size is defined
	{
		no warnings 'redefine';
		local *App::MtAws::GlacierRequest::_max_retries = sub { 1 };
		local *App::MtAws::GlacierRequest::_sleep = sub { };
		my $writer = App::MtAws::HttpFileWriter->new(tempfile => $tmpfile);
		my ($g, $resp, $err) = make_glacier_request('GET', "content_length/".($test_size-1)."/$test_size", {%common_options},
			{writer => $writer});
		is $err->{code}, 'too_many_tries'; # TODO: test with cmp_deep and exception()
		is $g->{last_retry_reason}, 'Unexpected end of data';
		is -s $tmpfile, $test_size;
	}

	# user_agent
	{
		no warnings 'redefine';
		my ($g, $resp, $err) = make_glacier_request('GET', "check_user_agent", {%common_options});
		is  $resp->content, "mt-aws-glacier/$App::MtAws::VERSION$App::MtAws::VERSION_MATURITY (http://mt-aws.com/) libwww-perl/".LWP->VERSION();
	}

	# truncated response for HTTP 400
	{
		no warnings 'redefine';
		local *App::MtAws::GlacierRequest::_max_retries = sub { 1 };
		local *App::MtAws::GlacierRequest::_sleep = sub { };
		my $writer = App::MtAws::HttpFileWriter->new(tempfile => $tmpfile);
		my ($g, $resp, $err) = make_glacier_request('GET', "content_length_400", {%common_options},
			{writer => $writer});
		is $err->{code}, 'too_many_tries'; # TODO: test with cmp_deep and exception()
		is $g->{last_retry_reason}, 'ThrottlingException'; # TODO: BUG actually need to detect truncated response as well, and this is actually bug
		is -s $tmpfile, $test_size;
	}

	# truncated response, size is defined
	{
		no warnings 'redefine';
		local *App::MtAws::GlacierRequest::_max_retries = sub { 1 };
		local *App::MtAws::GlacierRequest::_sleep = sub { };
		my $writer = App::MtAws::HttpFileWriter->new(tempfile => $tmpfile);
		my ($g, $resp, $err) = make_glacier_request('GET', "content_length/".($test_size-1)."/$test_size", {%common_options},
			{writer => $writer, expected_size => $test_size});
		is $err->{code}, 'too_many_tries'; # TODO: test with cmp_deep and exception()
		is $g->{last_retry_reason}, 'Unexpected end of data';
		is -s $tmpfile, $test_size;
	}

	# correct response, expected size is wrong
	{
		open F, ">$tmpfile";
		close F;
		no warnings 'redefine';
		local *App::MtAws::GlacierRequest::_max_retries = sub { 1 };
		local *App::MtAws::GlacierRequest::_sleep = sub { };
		my $writer = App::MtAws::HttpFileWriter->new(tempfile => $tmpfile);
		my ($g, $resp, $err) = make_glacier_request('GET', "content_length/$test_size/$test_size", {%common_options},
			{writer => $writer, expected_size => $test_size+1});
		is $err->{code}, 'wrong_file_size_in_journal'; # TODO: test with cmp_deep and exception()
		is -s $tmpfile, 0;
	}

	# correct response, size is zero
	{
		no warnings 'redefine';
		local *App::MtAws::GlacierRequest::_sleep = sub { die };
		for (qw/GET PUT POST DELETE/) {
			my ($g, $resp, $err) = make_glacier_request($_, "empty_response", {%common_options}, {dataref=>\''});
			ok $resp && !$err, "empty response should work for $_ method";
		}
	}

	# data truncated, writer not used
	{
		no warnings 'redefine';
		local *App::MtAws::GlacierRequest::_max_retries = sub { 1 };
		local *App::MtAws::GlacierRequest::_sleep = sub { };
		for (qw/GET PUT POST DELETE/) {
			my ($g, $resp, $err) = make_glacier_request($_, "content_length/499/501", {%common_options}, {dataref=>\''});
			is $err->{code}, 'too_many_tries', "Code for $_";
			is $g->{last_retry_reason}, 'Unexpected end of data', "Reason for $_";
		}
	}

	# correct response, no size header sent (chunked response? or maybe http/1.0)
	{
		open F, ">$tmpfile";
		close F;
		no warnings 'redefine';
		local *App::MtAws::GlacierRequest::_max_retries = sub { 1 };
		local *App::MtAws::GlacierRequest::_sleep = sub { };
		my $writer = App::MtAws::HttpFileWriter->new(tempfile => $tmpfile);
		my ($g, $resp, $err) = make_glacier_request('GET', "without_content_length/$test_size", {%common_options},
			{writer => $writer, expected_size => $test_size});
		is $err->{code}, 'wrong_file_size_in_journal';
		is -s $tmpfile, 0;
	}

	sub httpd_quit
	{
		my($c) = @_;
		$c->send_error(503, "Bye, bye");
		exit;  # terminate HTTP server
	}

	my $ua = new LWP::UserAgent;
	my $req = new HTTP::Request GET => "$proto://$base/quit";
	my $resp = $ua->request($req);

sub initialize_processes
{
	if (@ARGV && $ARGV[0] eq 'daemon') {
		my $d = $proto eq 'http' ?
			HTTP::Daemon->new(Timeout => 20, LocalAddr => '127.0.0.1') :
			HTTP::Daemon::SSL->new(Timeout => 20, LocalAddr => '127.0.0.1'); # need certs/ dir
		$SIG{PIPE}='IGNORE';
		$| = 1;
		print "Please to meet you at: <URL:", $d->url, ">\n";

		$!=0;
		while (my $c = $d->accept) {
			my $r = $c->get_request;
			if ($r) {
				my @p = $r->uri->path_segments;
				shift @p;
				my $p = shift @p;
				my $func = lc("httpd_$p");
				if (defined &$func) {
					no strict 'refs';
					&$func($c, $r, @p);
				} else {
					$c->send_error(404);
				}
			}
			$c = undef;  # close connection
		}
		my $errno_i = $!+0;
		my $errno_s = "$!";
		print STDERR "HTTP Server terminated (errno=$errno_i [$errno_s])\n";
		exit;
	} else {
		use Config;
		my $perl = $Config{'perlpath'};
		open(DAEMON, "'$perl' $0 daemon |") or die "Can't exec daemon: $!";
		my $greeting = <DAEMON>;
		$greeting =~ m!<URL:https?://([^/]+)/>! or die;
		my $base = $1;
		require LWP::UserAgent;
		require HTTP::Request;
		require App::MtAws::GlacierRequest;
		require App::MtAws;
		return $base;
	}
}

1;
