view release on metacpan or  search on metacpan

lib/Net/Fritz/Service.pm  view on Meta::CPAN

	    );
	return $err if $err->error;

	return Net::Fritz::Data->new($args_out);
    }
}

sub _get_initial_auth {
    my $self = shift;

    my $userid = SOAP::Header->name('UserID')
	->value($self->fritz->username);

    return SOAP::Header
	->name('h:InitChallenge')
	->attr({'xmlns:h' => 'http://soap-authentication.org/digest/2001/10/',
		's:mustUnderstand' => '1'})
	->value(\$userid);
}

sub _get_real_auth {
    my $self = shift;

    my $parm = shift;

    my $secret = md5_hex( join (':',
				$self->fritz->username,
				$parm->{Realm},
				$self->fritz->password,
			  ) );

    my $auth = SOAP::Header->name('Auth')
	->value(
	md5_hex( $secret . ':' . $parm->{Nonce} )
	);

    my $nonce = SOAP::Header->name('Nonce')
	->value($parm->{Nonce});

    my $realm = SOAP::Header->name('Realm')
	->value($parm->{Realm});

    my $userid = SOAP::Header->name('UserID')
	->value($self->fritz->username);

    return SOAP::Header
	->name('h:ClientAuth')
	->attr({'xmlns:h' => 'http://soap-authentication.org/digest/2001/10/',
		's:mustUnderstand' => '1'})
	->value(\SOAP::Header->value($nonce, $auth, $userid, $realm));
}

sub _hash_check {
    my ($hash_a, $hash_b, $msg_a, $msg_b) = (@_);

    foreach my $arg (keys %{$hash_a}) {
	if (! exists $hash_b->{$arg}) {
	    return Net::Fritz::Error->new("$msg_a $arg");
	}
    }