line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
############################################################## |
2
|
|
|
|
|
|
|
package AOLserver::CtrlPort; |
3
|
|
|
|
|
|
|
############################################################## |
4
|
|
|
|
|
|
|
|
5
|
1
|
|
|
1
|
|
32053
|
use 5.006; |
|
1
|
|
|
|
|
5
|
|
|
1
|
|
|
|
|
39
|
|
6
|
1
|
|
|
1
|
|
5
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
40
|
|
7
|
1
|
|
|
1
|
|
5
|
use warnings; |
|
1
|
|
|
|
|
7
|
|
|
1
|
|
|
|
|
46
|
|
8
|
|
|
|
|
|
|
|
9
|
1
|
|
|
1
|
|
5449
|
use Net::Telnet; |
|
1
|
|
|
|
|
63224
|
|
|
1
|
|
|
|
|
57
|
|
10
|
1
|
|
|
1
|
|
1440
|
use Log::Log4perl qw(:easy); |
|
1
|
|
|
|
|
61157
|
|
|
1
|
|
|
|
|
6
|
|
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
our $VERSION = '0.02'; |
13
|
|
|
|
|
|
|
our $CVSVERSION = '$Revision: 1.3 $'; |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
=head1 NAME |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
AOLserver::CtrlPort - Execute Commands on AOLserver's Control Port |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
=head1 SYNOPSIS |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
use AOLserver::CtrlPort; |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
my $conn = AOLserver::CtrlPort->new( |
24
|
|
|
|
|
|
|
Host => 'myhost', |
25
|
|
|
|
|
|
|
Port => 3456, |
26
|
|
|
|
|
|
|
User => 'username', |
27
|
|
|
|
|
|
|
Password => 'password', |
28
|
|
|
|
|
|
|
); |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
my $out = $conn->send_cmds(<
|
31
|
|
|
|
|
|
|
info tclversion |
32
|
|
|
|
|
|
|
EOT |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
print $out, "\n"; |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
=head1 DESCRIPTION |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
C uses C to connect to a running |
39
|
|
|
|
|
|
|
AOLserver's control port, issues commands there and returns the |
40
|
|
|
|
|
|
|
output. |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
It is useful for creating test suites for AOLserver applications which |
43
|
|
|
|
|
|
|
can be controlled via the control port. |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
To configure AOLserver's control port, use settings similar to the following |
46
|
|
|
|
|
|
|
ones: |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
ns_section "ns/server/${servername}/module/nscp" |
49
|
|
|
|
|
|
|
ns_param address myhostname |
50
|
|
|
|
|
|
|
ns_param port 3334 |
51
|
|
|
|
|
|
|
ns_param echopassword 1 |
52
|
|
|
|
|
|
|
ns_param cpcmdlogging 1 |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
ns_section "ns/server/${servername}/module/nscp/users" |
55
|
|
|
|
|
|
|
ns_param user "username:3G5/H31peci.o:" |
56
|
|
|
|
|
|
|
# That's "username:password" |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
ns_section "ns/server/${servername}/modules" |
59
|
|
|
|
|
|
|
ns_param nscp ${bindir}/nscp.so |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
This lets AOLserver enable the control port on server C on port |
62
|
|
|
|
|
|
|
3334. Authentication is on, the username is C and the |
63
|
|
|
|
|
|
|
password is C (hashed to C<3G5/H31peci.o> with a program |
64
|
|
|
|
|
|
|
like C). |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
=head2 METHODS |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
=over 4 |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
=item AOLserver::CtrlPort-Enew(...) |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
Creates a new control port client object. The following options |
73
|
|
|
|
|
|
|
are available to the constructor: |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
=over 4 |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
=item Port |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
The port AOLserver is listening to for control port commands. |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
=item Host |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
The control port C as defined in the configuration. |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
=item Timeout |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
Number of seconds after which the client will time out if the |
88
|
|
|
|
|
|
|
server doesn't send a response. |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
=item User |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
User name for control port login defaults to the empty string |
93
|
|
|
|
|
|
|
for non-protected control ports. |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
=item Password |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
Password for control port login defaults to the empty string |
98
|
|
|
|
|
|
|
for non-protected control ports. |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
=back |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
=cut |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
############################################################ |
105
|
|
|
|
|
|
|
sub new { |
106
|
|
|
|
|
|
|
############################################################ |
107
|
0
|
|
|
0
|
1
|
|
my ($class, @options) = @_; |
108
|
|
|
|
|
|
|
|
109
|
0
|
|
|
|
|
|
my %options = ( |
110
|
|
|
|
|
|
|
Timeout => 10, |
111
|
|
|
|
|
|
|
#Port => '3456', |
112
|
|
|
|
|
|
|
Host => 'localhost', |
113
|
|
|
|
|
|
|
Prompt => '/> $/', |
114
|
|
|
|
|
|
|
User => '', |
115
|
|
|
|
|
|
|
Password => '', |
116
|
|
|
|
|
|
|
@options); |
117
|
|
|
|
|
|
|
|
118
|
0
|
|
|
|
|
|
my $user = $options{User}; |
119
|
0
|
|
|
|
|
|
my $passwd = $options{Password}; |
120
|
|
|
|
|
|
|
|
121
|
0
|
|
|
|
|
|
delete $options{User}; |
122
|
0
|
|
|
|
|
|
delete $options{Password}; |
123
|
|
|
|
|
|
|
|
124
|
0
|
|
|
|
|
|
my $t = Net::Telnet->new(%options); |
125
|
|
|
|
|
|
|
|
126
|
0
|
|
|
|
|
|
DEBUG("Connecting to port=$options{Host}:$options{Port}"); |
127
|
0
|
|
|
|
|
|
$t->open(); |
128
|
|
|
|
|
|
|
|
129
|
0
|
|
|
|
|
|
my $self = { telnet => $t, |
130
|
|
|
|
|
|
|
}; |
131
|
|
|
|
|
|
|
|
132
|
0
|
|
|
|
|
|
$t->login("", ""); |
133
|
|
|
|
|
|
|
|
134
|
0
|
|
|
|
|
|
DEBUG("Waiting for prompt"); |
135
|
0
|
|
|
|
|
|
$t->waitfor(); |
136
|
|
|
|
|
|
|
|
137
|
0
|
|
|
|
|
|
bless $self, $class; |
138
|
|
|
|
|
|
|
} |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
=item $conn->send_cmds("$cmd1\ncmd2\n...") |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
Send one or more commands, separated by newlines, AOLserver's |
143
|
|
|
|
|
|
|
control port. The method will return the server's response as a string. |
144
|
|
|
|
|
|
|
Typically, this will look like |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
$out = $conn->send_cmds(<
|
147
|
|
|
|
|
|
|
info tclversion |
148
|
|
|
|
|
|
|
info commands |
149
|
|
|
|
|
|
|
EOT |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
and return the newline-separated response as a single string. |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
=cut |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
############################################################ |
156
|
|
|
|
|
|
|
sub send_cmds { |
157
|
|
|
|
|
|
|
############################################################ |
158
|
0
|
|
|
0
|
1
|
|
my ($self, $lines) = @_; |
159
|
|
|
|
|
|
|
|
160
|
0
|
|
|
|
|
|
my $output = ""; |
161
|
0
|
|
|
|
|
|
my $line_output; |
162
|
|
|
|
|
|
|
|
163
|
0
|
|
|
|
|
|
for (split "\n", $lines) { |
164
|
0
|
|
|
|
|
|
DEBUG("Send: [$_]"); |
165
|
0
|
|
|
|
|
|
$line_output = join "", $self->{telnet}->cmd("$_"); |
166
|
|
|
|
|
|
|
# Last line is the prompt, scrap it |
167
|
0
|
|
|
|
|
|
$line_output =~ s/^.*\Z//m; |
168
|
0
|
|
|
|
|
|
DEBUG("Recv: [$line_output]"); |
169
|
0
|
|
|
|
|
|
$output .= $line_output; |
170
|
|
|
|
|
|
|
} |
171
|
|
|
|
|
|
|
|
172
|
0
|
|
|
|
|
|
return $output; |
173
|
|
|
|
|
|
|
} |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
1; |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
=back |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
=head1 Debugging |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
AOLserver::CtrlPort is Log4perl enabled. If your scripts don't do |
182
|
|
|
|
|
|
|
what you want and you need to find out which messages are being sent |
183
|
|
|
|
|
|
|
back and forth, you can easily bump up AOLserver::CtrlPort's |
184
|
|
|
|
|
|
|
internal debugging level by saying something like |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
use Log::Log4perl qw(:easy); |
187
|
|
|
|
|
|
|
Log::Log4perl->easy_init($DEBUG); |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
in your test script before any AOLserver::CtrlPort commands are called. |
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
Please check out the Log::Log4perl documentation for details. |
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
=head1 AUTHOR |
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
Mike Schilli, 2004, m@perlmeister.com |
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
=cut |