use MIME::Base64;
use WWW::Mechanize;



my $agent = WWW::Mechanize->new();
my @args = (
       Authorization => "Basic " .
           MIME::Base64::encode( 'root:root' )
);

say $agent->post( "http://localhost/r", @args );

$ua->get("http://localhost/")->res->headers->header('www-authenticate');
#'Digest realm="uNikeE", nonce="fcb91c6a03b1d9b9781e680df6110133"'

Authorization: Digest username="root", realm="uNikeE", nonce="c0577f2f50430a0ebb16171b4a481c15", uri="/", response="c845052cedc394b918ec05f1064e8401"

use strict;
use utf8;

use WWW::Mechanize;
use HTTP::Cookies;

binmode(STDOUT, ":utf8");
binmode(STDIN, ":utf8");
binmode(STDERR, ":utf8");

# credentials
my $EMAIL = 'blablabla@blablabla.com';
my $PASSWD = 'blablabla';

# login page
my $LOGIN_PAGE = "https://somepage.com";
my $TARGET_PAGE = "https://somepage.com/index.html";

# path to save cookie
my $path = '/home/username/Desktop';
my $cookie_file = "$path/cookie";

my $cookie_jar = HTTP::Cookies->new;
my $mech = WWW::Mechanize->new(stack_depth => 0, cookie_jar => $cookie_jar, agent_alias => 'Windows Mozilla');

# if cookie doesn't exist
if (!(-e $cookie_file)) {
	print "No cookie found!\n";
	getCookie();
}

# got cookie! 
# getting required page
my $content = $mech->get($TARGET_PAGE);
print $content, "\n";

##########################################################
# login and get cookie
##########################################################
sub getCookie {
	# go to login page
	$mech->get($LOGIN_PAGE);
	
	# form fields
	my $fields = {'email' => $EMAIL, 'password' => $PASSWD};
	$mech->submit_form(form_id => 'login_form', fields => $fields);
	#$mech->submit_form(form_number => 1, fields => $fields);

	die "[ERROR]: Failed to login!\n" unless ($mech->success);
	# save cookies
	$cookie_jar->save($cookie_file);
}

my $ua = Mojo::UserAgent->new;
my $r = $ua->get("http://localhost/")->res->headers->header('www-authenticate');
$ua->post("http://localhost/r", {Authorization => _create_digest_str($r, 'GET', '/', 'root', 'root')});



=head Digest Auth
Полностью описание метода можно прочитать в RFC 2069, а если вкратце, то метод работает так. Когда сервер получает запрос, относящийся к защищенной области, он выдает ошибку 401 Authorization Required и заголовок с запросом аутентификации такого вида:

WWW-Authenticate: Digest realm="secure area", nonce="123456123456"

realm - это название защищенной области, а nonce - одноразовое значение. Есть еще необязательные параметры, которые мы обсуждать не будем. Клиент повторяет запрос, добавив к нему заголовок такого вида:

Authorization: Digest realm="secure area", username="123", uri="/index.php", nonce="123456123456", response="1234567890abcdef1234567890abcdef"

Параметр uri должен совпадать с URI в запросе, а response - это ответ, который вычисляется так:

response = H(H(A1) + ":" + nonce + ":" + H(A2))
H - хеш-функция, по умолчанию MD5
A1 = логин + ":" + realm + ":" + пароль
A2 = метод запроса + ":" + URI
метод запроса - это GET, POST и тд.

#Authorization: Digest username="root", realm="uNikeE", nonce="5500b9c9bd6c1fe5785800de7263aa46",
#uri="/", response="58b1a21fdc2577512584e00fe40db785"

=cut

=head _create_digest_str
$_[0] - 'Digest realm="uNikeE", nonce="e0088aaa358bc6723801e18d7bd2b756"';
$_[1] - Method (GET, POST, ETC)
$_[2] - Uri (/ or /r or etc)
$_[3] - login
$_[4] - password
=cut
sub _create_digest_str { #ToDo: optimize
    return undef unless $_[0];
    my %hash;
    for(split(/\,\s+/ => $r)){
        s/\"//og;
        my ($k, $v) = split /\=/, $_;
        $hash{$k} = $v;
    }
    my $res = md5_hex(join('' => (
                md5_hex(join ':' => ($_[3], $hash{'Digest realm'}, $_[4])),
                ':', $hash{'nonce'}, ':'),
                md5_hex(join ':' => ($_[1], $_[2]))));
    return sprintf(qq(Digest username="%s", realm="%s", nonce="%s", uri="%s", response="%s"),
                   $_[3], $hash{'Digest realm'}, $hash{'nonce'}, $_[2], $res,);

}