# $Id: Client.pm 1627 2008-01-18 19:28:30Z augie $ # Provides an interface to communicate with PowerDNS::Control::Server which # is used to control both the Authoritative and Recursive servers. package PowerDNS::Control::Client; use warnings; use strict; use IO::Socket; use English; use Carp; =head1 NAME PowerDNS::Control::Client - Provides an interface to control the PowerDNS daemon. =head1 VERSION Version 0.02 =cut our $VERSION = '0.02'; =head1 SYNOPSIS use PowerDNS::Control::Client; # Setting parameters and their default values. my $params = { servers => ['localhost:988'], auth_cred => 'pa55word', }; my $pdns = PowerDNS::Control::Client->new($params); =head1 DESCRIPTION PowerDNS::Control::Client provides a client interface to interact with the PowerDNS::Control::Server server. It is maintained in tandem with PowerDNS::Control::Server and is intended to be used with that code; it also serves as a point of reference for anyone who wishes to create their own client code. The methods described below are based on those available in the PowerDNS::Control::Server module which are in turn based on the pdns_control and rec_control programs. Documentation for these programs can be found at: http://docs.powerdns.com/ Note: All the commands may not be supported in this module, but the list of supported commands is listed in the Methods section below. Methods that begin with 'auth' control the Authoritative PowerDNS Server and methods that begin with 'rec' control the Recursive PowerDNS Server. =head1 METHODS =head2 new(\%params) my $params = { servers => ['localhost:988'], auth_cred => 'pa55word', }; my $pdns = PowerDNS::Control::Client->new($params); Creates a new PowerDNS::Control::Client object. =over 4 =item servers A list of servers and ports to connect to. Default is 'localhost:988'. =item auth_cred The authentication credentials the client should provide when the server asks for authentication. =back =cut sub new { my $class = shift; my $params= shift; my $self = {}; $OUTPUT_AUTOFLUSH = 1; bless $self , ref $class || $class; $self->{'servers'} = defined $params->{'servers'} ? $params->{'servers'} : ['localhost:988']; $self->{'auth_cred'} = defined $params->{'auth_cred'} ? $params->{'auth_cred'} : undef; return $self; } =head2 tell($command_string) Internal method. Expects a scalar command string to send to all of the servers in the 'servers' param; i.e. tell the servers what to do. Returns 0 on success and an Error Message if there was a problem. =cut sub tell { my $self = shift; my $command = shift; my $errmsg = ''; for my $server ( @{ $self->{'servers'} } ) { # Try and connect to the server. my $conn = $self->connect(\$server); if ( ! defined $conn ) { $errmsg .= "Could not connect to server ($server), trying next server if there is one.\n"; next; } # Tell the server what to do. print $conn "$command\n"; # Check what the server returned for errors. my $line = <$conn>; chomp $line; if ( $line =~ /^-ERR/ ) { $errmsg .= "Command ($command) on server ($server) failed: $line\n"; } # Tell the server we are done sending data. print $conn "quit\n"; } return $errmsg ? $errmsg : 0 ; } =head2 connect(\$server) Internal method. Connects to a server and handle authentication if need be. Expects a scalar reference to a single server to connect to. Returns a socket object that can be used to communicate with the server or undef if there was a problem. =cut sub connect { my $self = shift; my $server = shift; my $sock = new IO::Socket::INET ( PeerAddr => $$server, Proto => 'tcp'); if ( ! $sock ) { carp "Could not connect to $$server : $!"; return undef; } my $line = <$sock>; chomp $line; # Check to see if we need to provide authentication. if ( $line eq '+OK ready for authentication' ) { print $sock "AUTH $self->{'auth_cred'}\n"; $line = <$sock>; chomp $line; # Check if we were authenticated. if ( ! $line eq '+OK Auth sucessful' ) { carp "Authentication failed\n"; return undef; } } elsif ($line !~ /^\+OK Welcome/ ) #check that we got the proper banner. { carp "Did not receive proper banner from server; got '$line' instead.\n"; return undef; } return $sock; } =head2 auth_retrieve($domain) Tells the Authoritative PowerDNS Server to retrieve a domain. Expects a scalar domain name. Returns 0 on success, error message otherwise. =cut sub auth_retrieve { my $self = shift; my $domain = shift; return $self->tell("auth_retrieve $domain"); } =head2 rec_wipe_cache($domain) Tells the Recursive PowerDNS server to wipe $domain out of its cache. Expects a scalar domain name. Returns 0 on success, error message otherwise. =cut sub rec_wipe_cache { my $self = shift; my $domain = shift; return $self->tell("rec_wipe_cache $domain"); } =head2 rec_ping Asks the server if the recursor is running. Expects nothing. Returns 0 on success, error message otherwise. =cut sub rec_ping { my $self = shift; my $domain = shift; return $self->tell("rec_ping"); } =head2 auth_ping Asks the server if the authoritative server is running. Expects nothing. Returns 0 on success, error message otherwise. =cut sub auth_ping { my $self = shift; my $domain = shift; return $self->tell("auth_ping"); } =head1 AUTHOR Augie Schwer, C<< >> http://www.schwer.us =head1 BUGS Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 SUPPORT You can find documentation for this module with the perldoc command. perldoc PowerDNS::Control::Client You can also look for information at: =over 4 =item * AnnoCPAN: Annotated CPAN documentation L =item * CPAN Ratings L =item * RT: CPAN's request tracker L =item * Search CPAN L =back =head1 ACKNOWLEDGEMENTS I would like to thank Sonic.net for allowing me to release this to the public. =head1 COPYRIGHT & LICENSE Copyright 2007 Augie Schwer, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 VERSION 0.02 $Id: Client.pm 1627 2008-01-18 19:28:30Z augie $ =cut 1; # End of PowerDNS::Control::Client