line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# $Id: Server.pm 4430 2012-01-14 00:27:53Z augie $ |
2
|
|
|
|
|
|
|
# Provides an interface to create a server to control both the |
3
|
|
|
|
|
|
|
# PowerDNS Authoritative and Recursive servers. |
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
package PowerDNS::Control::Server; |
6
|
|
|
|
|
|
|
|
7
|
1
|
|
|
1
|
|
34218
|
use warnings; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
33
|
|
8
|
1
|
|
|
1
|
|
6
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
72
|
|
9
|
|
|
|
|
|
|
|
10
|
1
|
|
|
1
|
|
1311
|
use IO::Socket; |
|
1
|
|
|
|
|
36298
|
|
|
1
|
|
|
|
|
4
|
|
11
|
1
|
|
|
1
|
|
1822
|
use POSIX; |
|
1
|
|
|
|
|
17283
|
|
|
1
|
|
|
|
|
9
|
|
12
|
1
|
|
|
1
|
|
4927
|
use Unix::Syslog qw(:subs :macros); |
|
1
|
|
|
|
|
1270
|
|
|
1
|
|
|
|
|
587
|
|
13
|
1
|
|
|
1
|
|
9
|
use Carp; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
71
|
|
14
|
1
|
|
|
1
|
|
1161
|
use English; |
|
1
|
|
|
|
|
2751
|
|
|
1
|
|
|
|
|
6
|
|
15
|
1
|
|
|
1
|
|
5127
|
use Unix::PID; |
|
1
|
|
|
|
|
20
|
|
|
1
|
|
|
|
|
6
|
|
16
|
1
|
|
|
1
|
|
1098
|
use Net::CIDR; |
|
1
|
|
|
|
|
7585
|
|
|
1
|
|
|
|
|
77
|
|
17
|
1
|
|
|
1
|
|
1501
|
use File::Temp qw/ :mktemp /; |
|
1
|
|
|
|
|
18505
|
|
|
1
|
|
|
|
|
2604
|
|
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
=head1 NAME |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
PowerDNS::Control::Server - Provides an interface to control the PowerDNS daemon. |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
=head1 VERSION |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
Version 0.03 |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
=cut |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
our $VERSION = '0.03'; |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
=head1 SYNOPSIS |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
use PowerDNS::Control::Server; |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
# Setting parameters and their default values. |
36
|
|
|
|
|
|
|
my $params = { port => 988, |
37
|
|
|
|
|
|
|
listen_address => '0.0.0.0', |
38
|
|
|
|
|
|
|
allowed_methods => ['auth_retrieve' , 'rec_wipe_cache'], |
39
|
|
|
|
|
|
|
debug => 0, |
40
|
|
|
|
|
|
|
syslog_ident => 'pdns-control-server', |
41
|
|
|
|
|
|
|
syslog_option => LOG_PID | LOG_PERROR, |
42
|
|
|
|
|
|
|
syslog_facility => LOG_LOCAL3, |
43
|
|
|
|
|
|
|
syslog_priority => LOG_INFO, |
44
|
|
|
|
|
|
|
pid_file => '/var/run/pdns-control-server.pid', |
45
|
|
|
|
|
|
|
auth_cred => 'pa55word', |
46
|
|
|
|
|
|
|
allowed_ips => ['127.0.0.1/23' , '192.168.0.1/32'], |
47
|
|
|
|
|
|
|
socket_path => '/var/run/', |
48
|
|
|
|
|
|
|
}; |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
my $pdns = PowerDNS::Control::Server->new($params); |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
=head1 DESCRIPTION |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
PowerDNS::Control::Server provides a way to create a server to control |
55
|
|
|
|
|
|
|
both the PowerDNS Authoritative and Recursive servers. |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
PowerDNS::Control::Server was written in tandem with PowerDNS::Control::Client, |
58
|
|
|
|
|
|
|
but there is no reason why you could not write your own client. |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
The protocol PowerDNS::Control::Server implements is very simple and is based |
61
|
|
|
|
|
|
|
off of SMTP; after successful connection the client can expect a banner, then |
62
|
|
|
|
|
|
|
the client can execute commands agains the server; the server returns "+OK" if |
63
|
|
|
|
|
|
|
all is well and "-ERR " if there was a problem. A sample session |
64
|
|
|
|
|
|
|
showing the protocol in use is below: |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
[augie@augnix Control]$ telnet localhost 10988 |
67
|
|
|
|
|
|
|
Trying 127.0.0.1... |
68
|
|
|
|
|
|
|
Connected to augnix.noc.sonic.net (127.0.0.1). |
69
|
|
|
|
|
|
|
Escape character is '^]'. |
70
|
|
|
|
|
|
|
+OK Welcome 127.0.0.1 |
71
|
|
|
|
|
|
|
auth_retrieve schwer.us |
72
|
|
|
|
|
|
|
+OK |
73
|
|
|
|
|
|
|
quit |
74
|
|
|
|
|
|
|
+OK Bye |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
The commands executed are based on the pdns_control and rec_control programs |
77
|
|
|
|
|
|
|
on the server. Documentation for these programs can be found at: |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
http://docs.powerdns.com/ |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
Note: All the commands may not be supported in this module, but the list of |
82
|
|
|
|
|
|
|
supported commands is listed in the Methods section below. Methods that begin |
83
|
|
|
|
|
|
|
with 'auth' control the Authoritative PowerDNS Server and methods that begin |
84
|
|
|
|
|
|
|
with 'rec' control the Recursive PowerDNS Server. |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
=head1 METHODS |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
=head2 new(\%params) |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
my $params = { port => 988, |
91
|
|
|
|
|
|
|
listen_address => '0.0.0.0', |
92
|
|
|
|
|
|
|
allowed_methods => ['auth_retrieve' , 'rec_wipe_cache'], |
93
|
|
|
|
|
|
|
debug => 0, |
94
|
|
|
|
|
|
|
syslog_ident => 'pdns-control-server', |
95
|
|
|
|
|
|
|
syslog_option => LOG_PID | LOG_PERROR, |
96
|
|
|
|
|
|
|
syslog_facility => LOG_LOCAL3, |
97
|
|
|
|
|
|
|
syslog_priority => LOG_INFO, |
98
|
|
|
|
|
|
|
pid_file => '/var/run/pdns-control-server.pid', |
99
|
|
|
|
|
|
|
auth_cred => 'pa55word', |
100
|
|
|
|
|
|
|
allowed_ips => ['127.0.0.1/23' , '192.168.0.1/32'], |
101
|
|
|
|
|
|
|
socket_path => '/var/run/', |
102
|
|
|
|
|
|
|
}; |
103
|
|
|
|
|
|
|
my $pdns = PowerDNS::Control::Server->new($params); |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
Creates a PowerDNS::Control::Server object. |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
=over 4 |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
=item port |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
Port to listen on. Default is 988. |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
=item listen_address |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
Address to listen on. Default is 0.0.0.0 . |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
=item allowed_methods |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
List of methods the server is allowed to run; if not specified, then none of the |
120
|
|
|
|
|
|
|
control methods are allowed. |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
=item debug |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
Set to 1 to keep the server in the foreground for debugging. The default is 0. |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
=item syslog_ident |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
Use to set the Unix::Syslog::openlog($ident) variable. The default is 'pdns-control-server'. |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
=item syslog_option |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
Use to set the Unix::Syslog::openlog($option) variable. The default is LOG_PID | LOG_PERROR |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
=item syslog_facility |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
Use to set the Unix::Syslog::openlog($facility) variable. The default is LOG_LOCAL3 |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
=item syslog_priority |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
Use to set the Unix::Syslog::syslog($priority) variable. The default is LOG_INFO |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
=item pid_file |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
Where to store the PID file; default is '/var/run/pdns-control-server.pid'. |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
=item auth_cred |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
Set if you want the server to require password authentication. |
149
|
|
|
|
|
|
|
If set, then the client should expect to see |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
"+OK ready for authentication" |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
to which it should reply |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
"AUTH pa55word" |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
Valid authentication will move the server into the main request loop; |
158
|
|
|
|
|
|
|
invalid authentication will disconnect the client. |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
=item allowed_ips |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
Set if you want the server to only accept connections from the IPs in this list. |
163
|
|
|
|
|
|
|
The list elements are IPs in CIDR notation, this means if you want to specify a single |
164
|
|
|
|
|
|
|
IP, then you must give it a '/32' this is an unfortunate bug in Net::CIDR . |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
=item socket_path |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
The path where the PowerDNS recursor and authoritative server control sockets are located. |
169
|
|
|
|
|
|
|
The default is '/var/run/'; this is also where temporary sockets will be placed for |
170
|
|
|
|
|
|
|
communicating with the PowerDNS control sockets, so make sure it is accessible by this |
171
|
|
|
|
|
|
|
program for reading and writing. |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
=item rec_control_socket |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
If the recursor's control socket is located someplace other then in socket_path, then |
176
|
|
|
|
|
|
|
you can set that location here. |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
=item pdns_control_socket |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
If the authoritative server's control socket is located someplace other then in socket_path, then |
181
|
|
|
|
|
|
|
you can set that location here. |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
=back |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
=cut |
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
sub new |
188
|
|
|
|
|
|
|
{ |
189
|
0
|
|
|
0
|
1
|
|
my $class = shift; |
190
|
0
|
|
|
|
|
|
my $params= shift; |
191
|
0
|
|
|
|
|
|
my $self = {}; |
192
|
|
|
|
|
|
|
|
193
|
0
|
|
|
|
|
|
$SIG{CHLD} = 'IGNORE'; # auto. reap zombies. |
194
|
0
|
|
|
|
|
|
$OUTPUT_AUTOFLUSH = 1; |
195
|
|
|
|
|
|
|
|
196
|
0
|
|
0
|
|
|
|
bless $self , ref $class || $class; |
197
|
|
|
|
|
|
|
|
198
|
0
|
0
|
|
|
|
|
$self->{'port'} = defined $params->{'port'} ? $params->{'port'} : 988; |
199
|
0
|
0
|
|
|
|
|
$self->{'listen_address'} = defined $params->{'listen_address'} ? $params->{'listen_address'} : '0.0.0.0'; |
200
|
0
|
0
|
|
|
|
|
$self->{'pdns_control'} = defined $params->{'pdns_control'} ? $params->{'pdns_control'} : '/usr/bin/pdns_control'; |
201
|
0
|
0
|
|
|
|
|
$self->{'rec_control'} = defined $params->{'rec_control'} ? $params->{'rec_control'} : '/usr/bin/rec_control'; |
202
|
0
|
0
|
|
|
|
|
$self->{'debug'} = defined $params->{'debug'} ? $params->{'debug'} : 0; |
203
|
0
|
0
|
|
|
|
|
$self->{'syslog_ident'} = defined $params->{'syslog_ident'} ? $params->{'syslog_ident'} : 'pdns-control-server'; |
204
|
0
|
0
|
|
|
|
|
$self->{'syslog_option'} = defined $params->{'syslog_option'} ? $params->{'syslog_option'} : LOG_PID | LOG_PERROR; |
205
|
0
|
0
|
|
|
|
|
$self->{'syslog_facility'} = defined $params->{'syslog_facility'} ? $params->{'syslog_facility'} : LOG_LOCAL3; |
206
|
0
|
0
|
|
|
|
|
$self->{'syslog_priority'} = defined $params->{'syslog_priority'} ? $params->{'syslog_priority'} : LOG_INFO; |
207
|
0
|
0
|
|
|
|
|
$self->{'pid_file'} = defined $params->{'pid_file'} ? $params->{'pid_file'} : '/var/run/pdns-control-server.pid'; |
208
|
0
|
0
|
|
|
|
|
$self->{'auth_cred'} = defined $params->{'auth_cred'} ? $params->{'auth_cred'} : ''; |
209
|
0
|
0
|
|
|
|
|
$self->{'allowed_ips'} = defined $params->{'allowed_ips'} ? $params->{'allowed_ips'} : undef; |
210
|
0
|
0
|
|
|
|
|
$self->{'socket_path'} = defined $params->{'socket_path'} ? $params->{'socket_path'} : '/var/run/'; |
211
|
0
|
0
|
|
|
|
|
$self->{'pdns_control_socket'} = defined $params->{'pdns_control_socket'} ? $params->{'pdns_control_socket'} : $self->{'socket_path'} . '/pdns.controlsocket'; |
212
|
0
|
0
|
|
|
|
|
$self->{'rec_control_socket'} = defined $params->{'rec_control_socket'} ? $params->{'rec_control_socket'} : $self->{'socket_path'} . '/pdns_recursor.controlsocket'; |
213
|
|
|
|
|
|
|
|
214
|
0
|
|
|
|
|
|
$self->{'pid'} = Unix::PID->new(); |
215
|
|
|
|
|
|
|
|
216
|
0
|
0
|
|
|
|
|
$self->{'sock'} = new IO::Socket::INET ( |
217
|
|
|
|
|
|
|
LocalAddr => $self->{'listen_address'}, |
218
|
|
|
|
|
|
|
LocalPort => $self->{'port'}, |
219
|
|
|
|
|
|
|
Proto => 'tcp', |
220
|
|
|
|
|
|
|
Reuse => 1, |
221
|
|
|
|
|
|
|
Listen => 20 ) or croak "Could not open socket : $!\n"; |
222
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
# populate the allowed_methods list. |
224
|
|
|
|
|
|
|
# the default is to not allow any methods. |
225
|
0
|
0
|
|
|
|
|
if ( defined $params->{'allowed_methods'} ) |
226
|
|
|
|
|
|
|
{ |
227
|
0
|
|
|
|
|
|
for my $method ( @{$params->{'allowed_methods'}} ) |
|
0
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
{ |
229
|
0
|
|
|
|
|
|
$self->{'allowed_methods'}->{$method} = 1; |
230
|
|
|
|
|
|
|
} |
231
|
|
|
|
|
|
|
} |
232
|
|
|
|
|
|
|
|
233
|
0
|
|
|
|
|
|
return $self; |
234
|
|
|
|
|
|
|
} |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
=head2 control_socket_comm($message , $socket) |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
Internal method. |
239
|
|
|
|
|
|
|
Deal with the communication to and from the PowerDNS rec|auth. server. |
240
|
|
|
|
|
|
|
Expects a message to send and a control socket to send to. |
241
|
|
|
|
|
|
|
Returns the message received. |
242
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
=cut |
244
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
sub control_socket_comm |
246
|
|
|
|
|
|
|
{ |
247
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
248
|
0
|
|
|
|
|
|
my $msg = shift; |
249
|
0
|
|
|
|
|
|
my $c_socket = shift; |
250
|
0
|
|
|
|
|
|
my $timeout = 10; |
251
|
0
|
|
|
|
|
|
my $sock_type = ''; |
252
|
|
|
|
|
|
|
|
253
|
|
|
|
|
|
|
# rec_control uses a DGRAM socket and pdns_control uses a STREAM socket. |
254
|
0
|
0
|
|
|
|
|
if ( $c_socket eq $self->{'rec_control_socket'} ) |
255
|
0
|
|
|
|
|
|
{ $sock_type = SOCK_DGRAM; } |
256
|
|
|
|
|
|
|
else |
257
|
0
|
|
|
|
|
|
{ $sock_type = SOCK_STREAM; } |
258
|
|
|
|
|
|
|
|
259
|
0
|
|
|
|
|
|
my $t_socket = $self->{'socket_path'} . '/asockXXXXXX'; |
260
|
0
|
|
|
|
|
|
my $sock_fh; |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
eval |
263
|
0
|
|
|
|
|
|
{ ($sock_fh , $t_socket) = mkstemp($t_socket); }; |
|
0
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
# if the eval above failed. |
266
|
0
|
0
|
|
|
|
|
if ( $@ ) |
267
|
|
|
|
|
|
|
{ |
268
|
0
|
|
|
|
|
|
carp "Could not create temporary socket $t_socket : $!"; |
269
|
0
|
|
|
|
|
|
return "Could not create temporary socket $t_socket : $!"; |
270
|
|
|
|
|
|
|
} |
271
|
|
|
|
|
|
|
|
272
|
0
|
|
|
0
|
|
|
local $SIG{INT} = $SIG{TERM} = sub { unlink($t_socket); croak "Caught SIG_INT or SIG_TERM." }; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
|
274
|
0
|
|
|
|
|
|
socket($sock_fh , PF_UNIX , $sock_type , 0); |
275
|
|
|
|
|
|
|
|
276
|
0
|
|
|
|
|
|
unlink $t_socket; |
277
|
|
|
|
|
|
|
|
278
|
0
|
0
|
|
|
|
|
if ( ! bind($sock_fh , sockaddr_un($t_socket)) ) |
279
|
|
|
|
|
|
|
{ |
280
|
0
|
|
|
|
|
|
unlink($t_socket); |
281
|
0
|
|
|
|
|
|
carp "Cannont bind to temp. socket $t_socket : $!"; |
282
|
0
|
|
|
|
|
|
return "Cannont bind to temp. socket $t_socket : $!"; |
283
|
|
|
|
|
|
|
} |
284
|
|
|
|
|
|
|
|
285
|
0
|
|
|
|
|
|
chmod(0666 , $t_socket); |
286
|
|
|
|
|
|
|
|
287
|
0
|
0
|
|
|
|
|
if ( ! connect($sock_fh , sockaddr_un($c_socket)) ) |
288
|
|
|
|
|
|
|
{ |
289
|
0
|
|
|
|
|
|
unlink($t_socket); |
290
|
0
|
|
|
|
|
|
carp "Cannot connect to control socket $c_socket : $!"; |
291
|
0
|
|
|
|
|
|
return "Cannot connect to control socket $c_socket : $!"; |
292
|
|
|
|
|
|
|
} |
293
|
|
|
|
|
|
|
|
294
|
0
|
|
|
|
|
|
send($sock_fh , "$msg\n" , 0); |
295
|
|
|
|
|
|
|
|
296
|
0
|
|
|
|
|
|
$msg = ''; |
297
|
|
|
|
|
|
|
|
298
|
|
|
|
|
|
|
eval |
299
|
0
|
|
|
|
|
|
{ |
300
|
0
|
|
|
0
|
|
|
local $SIG{ALRM} = sub { $msg = 'Timeout waiting to receive from server.'; carp 'Timeout waiting to receive from server.' }; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
301
|
0
|
|
|
|
|
|
alarm($timeout); |
302
|
0
|
|
|
|
|
|
recv($sock_fh , $msg , 16384 , 0); |
303
|
0
|
|
|
|
|
|
alarm(0); |
304
|
|
|
|
|
|
|
}; |
305
|
|
|
|
|
|
|
|
306
|
0
|
0
|
|
|
|
|
if ( $@ ) # if the eval above failed. |
307
|
|
|
|
|
|
|
{ |
308
|
0
|
|
|
|
|
|
$msg = "Could not get response from server: $@"; |
309
|
0
|
|
|
|
|
|
carp "Could not get response from server: $@"; |
310
|
|
|
|
|
|
|
} |
311
|
|
|
|
|
|
|
|
312
|
0
|
|
|
|
|
|
chomp $msg; |
313
|
|
|
|
|
|
|
|
314
|
0
|
|
|
|
|
|
close($sock_fh); |
315
|
|
|
|
|
|
|
|
316
|
0
|
|
|
|
|
|
unlink($t_socket); |
317
|
|
|
|
|
|
|
|
318
|
0
|
|
|
|
|
|
return $msg; |
319
|
|
|
|
|
|
|
} |
320
|
|
|
|
|
|
|
|
321
|
|
|
|
|
|
|
=head2 auth_retrieve($domain) |
322
|
|
|
|
|
|
|
|
323
|
|
|
|
|
|
|
Expects a scalar domain name to be retrieved. |
324
|
|
|
|
|
|
|
Calls pdns_control retrieve domain . |
325
|
|
|
|
|
|
|
Returns "+OK" if successful or "-ERR error message" otherwise. |
326
|
|
|
|
|
|
|
|
327
|
|
|
|
|
|
|
=cut |
328
|
|
|
|
|
|
|
|
329
|
|
|
|
|
|
|
sub auth_retrieve($) |
330
|
|
|
|
|
|
|
{ |
331
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
332
|
0
|
|
|
|
|
|
my $domain = shift; |
333
|
|
|
|
|
|
|
|
334
|
0
|
|
|
|
|
|
my $msg = $self->control_socket_comm("retrieve $domain" , $self->{'pdns_control_socket'}); |
335
|
|
|
|
|
|
|
|
336
|
0
|
0
|
|
|
|
|
if ( $msg =~ /^Added/ ) |
337
|
|
|
|
|
|
|
{ |
338
|
0
|
|
|
|
|
|
$self->logmsg('+OK'); |
339
|
0
|
|
|
|
|
|
return "+OK\n"; |
340
|
|
|
|
|
|
|
} |
341
|
|
|
|
|
|
|
else |
342
|
|
|
|
|
|
|
{ |
343
|
0
|
|
|
|
|
|
$self->logmsg("Error: $msg"); |
344
|
0
|
|
|
|
|
|
return "-ERR $msg\n"; |
345
|
|
|
|
|
|
|
} |
346
|
|
|
|
|
|
|
} |
347
|
|
|
|
|
|
|
|
348
|
|
|
|
|
|
|
=head2 auth_wipe_cache($domain) |
349
|
|
|
|
|
|
|
|
350
|
|
|
|
|
|
|
Expects a scalar domain name to be wiped out of cache. |
351
|
|
|
|
|
|
|
Calls pdns_control purge domain$ . |
352
|
|
|
|
|
|
|
Returns "+OK" if successful or "-ERR error message" otherwise. |
353
|
|
|
|
|
|
|
|
354
|
|
|
|
|
|
|
=cut |
355
|
|
|
|
|
|
|
|
356
|
|
|
|
|
|
|
sub auth_wipe_cache($) |
357
|
|
|
|
|
|
|
{ |
358
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
359
|
0
|
|
|
|
|
|
my $domain = shift; |
360
|
|
|
|
|
|
|
|
361
|
0
|
|
|
|
|
|
my $msg = $self->control_socket_comm("purge $domain\$" , $self->{'pdns_control_socket'}); |
362
|
|
|
|
|
|
|
|
363
|
0
|
0
|
|
|
|
|
if ( $msg =~ /^\d+/ ) |
364
|
|
|
|
|
|
|
{ |
365
|
0
|
|
|
|
|
|
$self->logmsg('+OK'); |
366
|
0
|
|
|
|
|
|
return "+OK\n"; |
367
|
|
|
|
|
|
|
} |
368
|
|
|
|
|
|
|
else |
369
|
|
|
|
|
|
|
{ |
370
|
0
|
|
|
|
|
|
$self->logmsg("Error: $msg"); |
371
|
0
|
|
|
|
|
|
return "-ERR $msg\n"; |
372
|
|
|
|
|
|
|
} |
373
|
|
|
|
|
|
|
} |
374
|
|
|
|
|
|
|
|
375
|
|
|
|
|
|
|
=head2 rec_wipe_cache($domain) |
376
|
|
|
|
|
|
|
|
377
|
|
|
|
|
|
|
Expects a scalar domain name to be wiped out of cache. |
378
|
|
|
|
|
|
|
Calls rec_control wipe-cache domain . |
379
|
|
|
|
|
|
|
Returns "+OK" if successful or "-ERR error message" otherwise. |
380
|
|
|
|
|
|
|
|
381
|
|
|
|
|
|
|
=cut |
382
|
|
|
|
|
|
|
|
383
|
|
|
|
|
|
|
sub rec_wipe_cache($) |
384
|
|
|
|
|
|
|
{ |
385
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
386
|
0
|
|
|
|
|
|
my $domain = shift; |
387
|
|
|
|
|
|
|
|
388
|
0
|
|
|
|
|
|
my $msg = $self->control_socket_comm("wipe-cache $domain" , $self->{'rec_control_socket'}); |
389
|
|
|
|
|
|
|
|
390
|
0
|
0
|
|
|
|
|
if ( $msg =~ /^wiped/ ) |
391
|
|
|
|
|
|
|
{ |
392
|
0
|
|
|
|
|
|
$self->logmsg('+OK'); |
393
|
0
|
|
|
|
|
|
return "+OK\n"; |
394
|
|
|
|
|
|
|
} |
395
|
|
|
|
|
|
|
else |
396
|
|
|
|
|
|
|
{ |
397
|
0
|
|
|
|
|
|
$self->logmsg("Error: $msg"); |
398
|
0
|
|
|
|
|
|
return "-ERR $msg\n"; |
399
|
|
|
|
|
|
|
} |
400
|
|
|
|
|
|
|
} |
401
|
|
|
|
|
|
|
|
402
|
|
|
|
|
|
|
=head2 rec_ping |
403
|
|
|
|
|
|
|
|
404
|
|
|
|
|
|
|
Does not expect anything. |
405
|
|
|
|
|
|
|
Calls rec_control ping. |
406
|
|
|
|
|
|
|
Returns "+OK" if the recursor is running and "-ERR error message" otherwise. |
407
|
|
|
|
|
|
|
|
408
|
|
|
|
|
|
|
=cut |
409
|
|
|
|
|
|
|
|
410
|
|
|
|
|
|
|
sub rec_ping |
411
|
|
|
|
|
|
|
{ |
412
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
413
|
0
|
|
|
|
|
|
my $msg = $self->control_socket_comm('ping' , $self->{'rec_control_socket'}); |
414
|
|
|
|
|
|
|
|
415
|
0
|
0
|
|
|
|
|
if ( $msg =~ /^pong/ ) |
416
|
|
|
|
|
|
|
{ |
417
|
0
|
|
|
|
|
|
$self->logmsg("+OK"); |
418
|
0
|
|
|
|
|
|
return "+OK\n"; |
419
|
|
|
|
|
|
|
} |
420
|
|
|
|
|
|
|
else |
421
|
|
|
|
|
|
|
{ |
422
|
0
|
|
|
|
|
|
$self->logmsg("Error: $msg"); |
423
|
0
|
|
|
|
|
|
return "-ERR $msg\n"; |
424
|
|
|
|
|
|
|
} |
425
|
|
|
|
|
|
|
} |
426
|
|
|
|
|
|
|
|
427
|
|
|
|
|
|
|
=head2 auth_ping |
428
|
|
|
|
|
|
|
|
429
|
|
|
|
|
|
|
Does not expect anything. |
430
|
|
|
|
|
|
|
Calls pdns_control ping. |
431
|
|
|
|
|
|
|
Returns "+OK" if the auth. server is running and "-ERR error message" otherwise. |
432
|
|
|
|
|
|
|
|
433
|
|
|
|
|
|
|
=cut |
434
|
|
|
|
|
|
|
|
435
|
|
|
|
|
|
|
sub auth_ping |
436
|
|
|
|
|
|
|
{ |
437
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
438
|
0
|
|
|
|
|
|
my $msg = $self->control_socket_comm('ping' , $self->{'pdns_control_socket'}); |
439
|
|
|
|
|
|
|
|
440
|
0
|
0
|
|
|
|
|
if ( $msg eq 'PONG' ) |
441
|
|
|
|
|
|
|
{ |
442
|
0
|
|
|
|
|
|
$self->logmsg("+OK"); |
443
|
0
|
|
|
|
|
|
return "+OK\n"; |
444
|
|
|
|
|
|
|
} |
445
|
|
|
|
|
|
|
else |
446
|
|
|
|
|
|
|
{ |
447
|
0
|
|
|
|
|
|
$self->logmsg("Error: $msg"); |
448
|
0
|
|
|
|
|
|
return "-ERR $msg\n"; |
449
|
|
|
|
|
|
|
} |
450
|
|
|
|
|
|
|
} |
451
|
|
|
|
|
|
|
|
452
|
|
|
|
|
|
|
=head2 start |
453
|
|
|
|
|
|
|
|
454
|
|
|
|
|
|
|
Does not expect anything. |
455
|
|
|
|
|
|
|
Forks the server to the background unless "debug" was set. |
456
|
|
|
|
|
|
|
|
457
|
|
|
|
|
|
|
=cut |
458
|
|
|
|
|
|
|
|
459
|
|
|
|
|
|
|
sub start |
460
|
|
|
|
|
|
|
{ |
461
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
462
|
0
|
|
|
|
|
|
my ($conn , $peer , $pid , $command , $action , $arg1 , $arg2); |
463
|
0
|
0
|
|
|
|
|
&daemonize unless $self->{'debug'}; |
464
|
|
|
|
|
|
|
|
465
|
|
|
|
|
|
|
# Note the PID so we can kill it later and check if another server is already running. |
466
|
0
|
0
|
|
|
|
|
$self->{'pid'}->pid_file_no_unlink($self->{'pid_file'}) or croak "The server is already running: $!"; |
467
|
|
|
|
|
|
|
|
468
|
0
|
|
|
|
|
|
$self->logmsg("Server startup complete, accepting connections on port $self->{'port'}"); |
469
|
|
|
|
|
|
|
|
470
|
0
|
|
|
|
|
|
while ( $conn = $self->{'sock'}->accept() ) |
471
|
|
|
|
|
|
|
{ |
472
|
0
|
|
|
|
|
|
$peer = $conn->peerhost(); |
473
|
|
|
|
|
|
|
|
474
|
0
|
|
|
|
|
|
$self->logmsg("Incoming connection from $peer"); |
475
|
|
|
|
|
|
|
|
476
|
|
|
|
|
|
|
# Check to see if we should validate the client IP against our |
477
|
|
|
|
|
|
|
# allowed_ips list. |
478
|
0
|
0
|
|
|
|
|
if ( defined $self->{'allowed_ips'} ) |
479
|
|
|
|
|
|
|
{ |
480
|
0
|
0
|
|
|
|
|
if ( ! Net::CIDR::cidrlookup( $peer , @{$self->{'allowed_ips'}} ) ) |
|
0
|
|
|
|
|
|
|
481
|
|
|
|
|
|
|
{ |
482
|
0
|
|
|
|
|
|
$self->logmsg("Unauthorized connection from $peer"); |
483
|
0
|
|
|
|
|
|
$conn->shutdown(2); |
484
|
0
|
|
|
|
|
|
next; |
485
|
|
|
|
|
|
|
} |
486
|
|
|
|
|
|
|
} |
487
|
|
|
|
|
|
|
|
488
|
|
|
|
|
|
|
# Parent goes back up to wait for new connections. |
489
|
|
|
|
|
|
|
# Child continues on; handling this session. |
490
|
0
|
0
|
|
|
|
|
$pid = fork(); next if $pid; |
|
0
|
|
|
|
|
|
|
491
|
|
|
|
|
|
|
|
492
|
|
|
|
|
|
|
# Check if we should ask for auth. cred. |
493
|
0
|
0
|
|
|
|
|
if ( $self->{'auth_cred'} ) |
494
|
|
|
|
|
|
|
{ |
495
|
0
|
|
|
|
|
|
print $conn "+OK ready for authentication\n"; |
496
|
0
|
|
|
|
|
|
my $auth = <$conn>; |
497
|
0
|
|
|
|
|
|
$auth =~ s/[\r]//g; |
498
|
|
|
|
|
|
|
|
499
|
0
|
|
|
|
|
|
chomp($auth); |
500
|
0
|
0
|
|
|
|
|
if ( $auth ne "AUTH $self->{'auth_cred'}" ) |
501
|
|
|
|
|
|
|
{ |
502
|
0
|
|
|
|
|
|
$self->logmsg("Invalid authentication from " . $conn->peerhost); |
503
|
0
|
|
|
|
|
|
print $conn "-ERR invalid authentication\n"; |
504
|
0
|
|
|
|
|
|
$conn->shutdown(2); |
505
|
0
|
|
|
|
|
|
exit; |
506
|
|
|
|
|
|
|
} |
507
|
|
|
|
|
|
|
else |
508
|
|
|
|
|
|
|
{ |
509
|
0
|
|
|
|
|
|
$self->logmsg("Auth succesful from " . $conn->peerhost); |
510
|
0
|
|
|
|
|
|
print $conn "+OK Auth sucessful\n"; |
511
|
|
|
|
|
|
|
} |
512
|
|
|
|
|
|
|
} |
513
|
|
|
|
|
|
|
else |
514
|
|
|
|
|
|
|
{ |
515
|
0
|
|
|
|
|
|
print $conn "+OK Welcome $peer\n"; |
516
|
|
|
|
|
|
|
} |
517
|
|
|
|
|
|
|
|
518
|
|
|
|
|
|
|
# Main request loop; try to fulfill requests until the client is done. |
519
|
0
|
|
|
|
|
|
while(1) |
520
|
|
|
|
|
|
|
{ |
521
|
0
|
|
|
|
|
|
$command = <$conn>; |
522
|
0
|
|
|
|
|
|
$command =~ s/[\r\n]//g; |
523
|
0
|
|
|
|
|
|
chomp($command); |
524
|
0
|
|
|
|
|
|
($action,$arg1,$arg2) = split(/ /,$command); |
525
|
|
|
|
|
|
|
|
526
|
0
|
|
|
|
|
|
my $method_is_allowed = $self->method_is_allowed($action); |
527
|
|
|
|
|
|
|
|
528
|
0
|
0
|
0
|
|
|
|
if (!$method_is_allowed && ($action ne 'quit')) |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
529
|
|
|
|
|
|
|
{ |
530
|
0
|
|
|
|
|
|
$self->logmsg("Recieved method ($action) that was not allowed\n"); |
531
|
0
|
|
|
|
|
|
print $conn "-ERR method not allowed\n"; |
532
|
|
|
|
|
|
|
} |
533
|
|
|
|
|
|
|
elsif ($action eq 'auth_retrieve') |
534
|
|
|
|
|
|
|
{ |
535
|
0
|
0
|
|
|
|
|
unless ($arg1) |
536
|
|
|
|
|
|
|
{ |
537
|
0
|
|
|
|
|
|
$self->logmsg("Recieved improper command syntax :: '$command'\n"); |
538
|
0
|
|
|
|
|
|
print $conn "-ERR invalid command syntax\n"; |
539
|
0
|
|
|
|
|
|
next; |
540
|
|
|
|
|
|
|
} |
541
|
0
|
|
|
|
|
|
my $result = $self->auth_retrieve($arg1); |
542
|
0
|
|
|
|
|
|
print $conn $result; |
543
|
|
|
|
|
|
|
|
544
|
|
|
|
|
|
|
} |
545
|
|
|
|
|
|
|
elsif ($action eq 'auth_wipe_cache') |
546
|
|
|
|
|
|
|
{ |
547
|
0
|
0
|
|
|
|
|
unless ($arg1) |
548
|
|
|
|
|
|
|
{ |
549
|
0
|
|
|
|
|
|
$self->logmsg("Recieved improper command syntax :: '$command'\n"); |
550
|
0
|
|
|
|
|
|
print $conn "-ERR invalid command syntax\n"; |
551
|
0
|
|
|
|
|
|
next; |
552
|
|
|
|
|
|
|
} |
553
|
0
|
|
|
|
|
|
my $result = $self->auth_wipe_cache($arg1); |
554
|
0
|
|
|
|
|
|
print $conn $result; |
555
|
|
|
|
|
|
|
} |
556
|
|
|
|
|
|
|
elsif ($action eq 'rec_wipe_cache') |
557
|
|
|
|
|
|
|
{ |
558
|
0
|
0
|
|
|
|
|
unless ($arg1) |
559
|
|
|
|
|
|
|
{ |
560
|
0
|
|
|
|
|
|
$self->logmsg("Recieved improper command syntax :: '$command'\n"); |
561
|
0
|
|
|
|
|
|
print $conn "-ERR invalid command syntax\n"; |
562
|
0
|
|
|
|
|
|
next; |
563
|
|
|
|
|
|
|
} |
564
|
0
|
|
|
|
|
|
my $result = $self->rec_wipe_cache($arg1); |
565
|
0
|
|
|
|
|
|
print $conn $result; |
566
|
|
|
|
|
|
|
} |
567
|
|
|
|
|
|
|
elsif ($action eq 'rec_ping') |
568
|
|
|
|
|
|
|
{ |
569
|
0
|
|
|
|
|
|
my $result = $self->rec_ping; |
570
|
0
|
|
|
|
|
|
print $conn $result; |
571
|
|
|
|
|
|
|
} |
572
|
|
|
|
|
|
|
elsif ($action eq 'auth_ping') |
573
|
|
|
|
|
|
|
{ |
574
|
0
|
|
|
|
|
|
my $result = $self->auth_ping; |
575
|
0
|
|
|
|
|
|
print $conn $result; |
576
|
|
|
|
|
|
|
} |
577
|
|
|
|
|
|
|
elsif ($action eq 'quit') |
578
|
|
|
|
|
|
|
{ |
579
|
0
|
|
|
|
|
|
$self->logmsg("Shutting down."); |
580
|
0
|
|
|
|
|
|
print $conn "+OK Bye\n"; |
581
|
0
|
|
|
|
|
|
$conn->shutdown(2); |
582
|
0
|
|
|
|
|
|
exit; |
583
|
|
|
|
|
|
|
} |
584
|
|
|
|
|
|
|
else |
585
|
|
|
|
|
|
|
{ |
586
|
0
|
|
|
|
|
|
print $conn "-ERR '$action' unknown command.\n"; |
587
|
0
|
|
|
|
|
|
$self->logmsg("'$action' unknown command."); |
588
|
|
|
|
|
|
|
} |
589
|
|
|
|
|
|
|
} |
590
|
|
|
|
|
|
|
} |
591
|
|
|
|
|
|
|
} |
592
|
|
|
|
|
|
|
|
593
|
|
|
|
|
|
|
=head2 stop |
594
|
|
|
|
|
|
|
|
595
|
|
|
|
|
|
|
Does not expect anything. |
596
|
|
|
|
|
|
|
Kills the running server. |
597
|
|
|
|
|
|
|
|
598
|
|
|
|
|
|
|
=cut |
599
|
|
|
|
|
|
|
|
600
|
|
|
|
|
|
|
sub stop |
601
|
|
|
|
|
|
|
{ |
602
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
603
|
|
|
|
|
|
|
|
604
|
0
|
|
|
|
|
|
$self->logmsg("Stopping parent server."); |
605
|
|
|
|
|
|
|
|
606
|
0
|
|
|
|
|
|
my $ret = $self->{'pid'}->kill_pid_file($self->{'pid_file'}); |
607
|
|
|
|
|
|
|
|
608
|
|
|
|
|
|
|
# Check the return value for errors. |
609
|
0
|
0
|
|
|
|
|
if ( $ret == 0) |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
610
|
|
|
|
|
|
|
{ |
611
|
0
|
|
|
|
|
|
$self->logmsg("PID file ($self->{'pid_file'}) exists but could not be opened : $!"); |
612
|
0
|
|
|
|
|
|
croak "PID file ($self->{'pid_file'}) exists but could not be opened : $!"; |
613
|
|
|
|
|
|
|
} |
614
|
|
|
|
|
|
|
elsif ( ! defined $ret ) |
615
|
|
|
|
|
|
|
{ |
616
|
0
|
|
|
|
|
|
$self->logmsg("Server could not be killed from PID file ($self->{'pid_file'}) : $!"); |
617
|
0
|
|
|
|
|
|
croak "Server could not be killed from PID file ($self->{'pid_file'}) : $!"; |
618
|
|
|
|
|
|
|
} |
619
|
|
|
|
|
|
|
elsif ( $ret == -1 ) |
620
|
|
|
|
|
|
|
{ |
621
|
0
|
|
|
|
|
|
$self->logmsg("Could not clean up PID file ($self->{'pid_file'}) after successful termination of server : $!"); |
622
|
0
|
|
|
|
|
|
carp "Could not clean up PID file ($self->{'pid_file'}) after successful termination of server : $!"; |
623
|
|
|
|
|
|
|
} |
624
|
|
|
|
|
|
|
else |
625
|
|
|
|
|
|
|
{ |
626
|
0
|
|
|
|
|
|
$self->logmsg("Abnormal termination: $!"); |
627
|
0
|
|
|
|
|
|
croak "Abnormal termination: $!"; |
628
|
|
|
|
|
|
|
} |
629
|
0
|
|
|
|
|
|
exit; |
630
|
|
|
|
|
|
|
} |
631
|
|
|
|
|
|
|
|
632
|
|
|
|
|
|
|
=head2 daemonize |
633
|
|
|
|
|
|
|
|
634
|
|
|
|
|
|
|
Internal method. |
635
|
|
|
|
|
|
|
Close all file handles and fork to the background. |
636
|
|
|
|
|
|
|
|
637
|
|
|
|
|
|
|
=cut |
638
|
|
|
|
|
|
|
|
639
|
|
|
|
|
|
|
sub daemonize |
640
|
|
|
|
|
|
|
{ |
641
|
|
|
|
|
|
|
# Redirect STDIN, STDOUT and STDERR. |
642
|
0
|
0
|
|
0
|
1
|
|
open STDIN , '/dev/null' or croak "Could not read /dev/null : $!"; |
643
|
0
|
0
|
|
|
|
|
open STDOUT, '>/dev/null' or croak "Could not write to /dev/null : $!"; |
644
|
0
|
|
|
|
|
|
my $pid = fork; |
645
|
0
|
0
|
|
|
|
|
croak "fork: $!" unless defined ($pid); |
646
|
0
|
0
|
|
|
|
|
if ($pid != 0) { exit; } |
|
0
|
|
|
|
|
|
|
647
|
0
|
0
|
|
|
|
|
open STDERR , '>&STDOUT' or croak "Could not dup STDOUT : $!"; |
648
|
|
|
|
|
|
|
} |
649
|
|
|
|
|
|
|
|
650
|
|
|
|
|
|
|
=head2 logmsg($message) |
651
|
|
|
|
|
|
|
|
652
|
|
|
|
|
|
|
Internal method. |
653
|
|
|
|
|
|
|
Logs to syslog if debug is not turned on. |
654
|
|
|
|
|
|
|
If debug is on, then log to STDOUT. |
655
|
|
|
|
|
|
|
|
656
|
|
|
|
|
|
|
=cut |
657
|
|
|
|
|
|
|
|
658
|
|
|
|
|
|
|
sub logmsg |
659
|
|
|
|
|
|
|
{ |
660
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
661
|
0
|
|
|
|
|
|
my $msg = shift; |
662
|
0
|
0
|
|
|
|
|
carp "logmsg: $msg\n" if $self->{'debug'}; |
663
|
0
|
|
|
|
|
|
openlog($self->{'syslog_ident'} , $self->{'syslog_option'} , $self->{'syslog_facility'}); |
664
|
0
|
|
|
|
|
|
eval { syslog($self->{'syslog_priority'} , '%s', $msg); }; |
|
0
|
|
|
|
|
|
|
665
|
0
|
|
|
|
|
|
closelog; |
666
|
0
|
0
|
|
|
|
|
if ( $EVAL_ERROR ) |
667
|
0
|
|
|
|
|
|
{ carp "syslog() failed ($msg) :: $@\n"; } |
668
|
|
|
|
|
|
|
} |
669
|
|
|
|
|
|
|
|
670
|
|
|
|
|
|
|
=head2 method_is_allowed($method) |
671
|
|
|
|
|
|
|
|
672
|
|
|
|
|
|
|
Internal method. |
673
|
|
|
|
|
|
|
Verify that the method is 'allowed'; i.e. that it is in the |
674
|
|
|
|
|
|
|
allowed_methods list. |
675
|
|
|
|
|
|
|
|
676
|
|
|
|
|
|
|
=cut |
677
|
|
|
|
|
|
|
|
678
|
|
|
|
|
|
|
sub method_is_allowed |
679
|
|
|
|
|
|
|
{ |
680
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
681
|
0
|
|
|
|
|
|
my $method = shift; |
682
|
|
|
|
|
|
|
|
683
|
0
|
|
|
|
|
|
return defined $self->{'allowed_methods'}->{$method}; |
684
|
|
|
|
|
|
|
} |
685
|
|
|
|
|
|
|
|
686
|
|
|
|
|
|
|
=head1 AUTHOR |
687
|
|
|
|
|
|
|
|
688
|
|
|
|
|
|
|
Augie Schwer, C<< >> |
689
|
|
|
|
|
|
|
|
690
|
|
|
|
|
|
|
http://www.schwer.us |
691
|
|
|
|
|
|
|
|
692
|
|
|
|
|
|
|
=head1 BUGS |
693
|
|
|
|
|
|
|
|
694
|
|
|
|
|
|
|
Please report any bugs or feature requests to |
695
|
|
|
|
|
|
|
C, or through the web interface at |
696
|
|
|
|
|
|
|
L. |
697
|
|
|
|
|
|
|
I will be notified, and then you'll automatically be notified of progress on |
698
|
|
|
|
|
|
|
your bug as I make changes. |
699
|
|
|
|
|
|
|
|
700
|
|
|
|
|
|
|
=head1 SUPPORT |
701
|
|
|
|
|
|
|
|
702
|
|
|
|
|
|
|
You can find documentation for this module with the perldoc command. |
703
|
|
|
|
|
|
|
|
704
|
|
|
|
|
|
|
perldoc PowerDNS::Control::Server |
705
|
|
|
|
|
|
|
|
706
|
|
|
|
|
|
|
You can also look for information at: |
707
|
|
|
|
|
|
|
|
708
|
|
|
|
|
|
|
=over 4 |
709
|
|
|
|
|
|
|
|
710
|
|
|
|
|
|
|
=item * AnnoCPAN: Annotated CPAN documentation |
711
|
|
|
|
|
|
|
|
712
|
|
|
|
|
|
|
L |
713
|
|
|
|
|
|
|
|
714
|
|
|
|
|
|
|
=item * CPAN Ratings |
715
|
|
|
|
|
|
|
|
716
|
|
|
|
|
|
|
L |
717
|
|
|
|
|
|
|
|
718
|
|
|
|
|
|
|
=item * RT: CPAN's request tracker |
719
|
|
|
|
|
|
|
|
720
|
|
|
|
|
|
|
L |
721
|
|
|
|
|
|
|
|
722
|
|
|
|
|
|
|
=item * Search CPAN |
723
|
|
|
|
|
|
|
|
724
|
|
|
|
|
|
|
L |
725
|
|
|
|
|
|
|
|
726
|
|
|
|
|
|
|
=back |
727
|
|
|
|
|
|
|
|
728
|
|
|
|
|
|
|
=head1 ACKNOWLEDGEMENTS |
729
|
|
|
|
|
|
|
|
730
|
|
|
|
|
|
|
I would like to thank Sonic.net for allowing me to release this to the public. |
731
|
|
|
|
|
|
|
|
732
|
|
|
|
|
|
|
=head1 COPYRIGHT & LICENSE |
733
|
|
|
|
|
|
|
|
734
|
|
|
|
|
|
|
Copyright 2007 Augie Schwer, all rights reserved. |
735
|
|
|
|
|
|
|
|
736
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify it |
737
|
|
|
|
|
|
|
under the same terms as Perl itself. |
738
|
|
|
|
|
|
|
|
739
|
|
|
|
|
|
|
=head1 VERSION |
740
|
|
|
|
|
|
|
|
741
|
|
|
|
|
|
|
0.03 |
742
|
|
|
|
|
|
|
$Id: Server.pm 4430 2012-01-14 00:27:53Z augie $ |
743
|
|
|
|
|
|
|
|
744
|
|
|
|
|
|
|
=cut |
745
|
|
|
|
|
|
|
|
746
|
|
|
|
|
|
|
1; # End of PowerDNS::Control::Server |