line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Bot::Cobalt::Plugin::WWW; |
2
|
|
|
|
|
|
|
$Bot::Cobalt::Plugin::WWW::VERSION = '0.021003'; |
3
|
1
|
|
|
1
|
|
755
|
use strictures 2; |
|
1
|
|
|
|
|
4
|
|
|
1
|
|
|
|
|
30
|
|
4
|
1
|
|
|
1
|
|
128
|
use Scalar::Util 'reftype'; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
40
|
|
5
|
|
|
|
|
|
|
|
6
|
1
|
|
|
1
|
|
4
|
use Bot::Cobalt; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
4
|
|
7
|
1
|
|
|
1
|
|
565
|
use Bot::Cobalt::Common; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
6
|
|
8
|
|
|
|
|
|
|
|
9
|
1
|
|
|
|
|
6
|
use POE qw/ |
10
|
|
|
|
|
|
|
Component::Client::HTTP |
11
|
|
|
|
|
|
|
Component::Client::Keepalive |
12
|
1
|
|
|
1
|
|
445
|
/; |
|
1
|
|
|
|
|
23805
|
|
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
sub opts { |
16
|
0
|
|
|
0
|
0
|
0
|
my $opts = core->get_plugin_cfg($_[0])->{Opts}; |
17
|
0
|
0
|
0
|
|
|
0
|
return +{} unless ref $opts and reftype $opts eq 'HASH'; |
18
|
0
|
|
|
|
|
0
|
$opts |
19
|
|
|
|
|
|
|
} |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
sub bindaddr { |
22
|
|
|
|
|
|
|
$_[0]->opts->{BindAddr} |
23
|
0
|
|
|
0
|
0
|
0
|
} |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
sub proxy { |
26
|
|
|
|
|
|
|
$_[0]->opts->{Proxy} |
27
|
0
|
|
|
0
|
0
|
0
|
} |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
sub timeout { |
30
|
0
|
0
|
|
0
|
0
|
0
|
$_[0]->opts->{Timeout} || 90 |
31
|
|
|
|
|
|
|
} |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
sub max_per_host { |
34
|
0
|
0
|
|
0
|
0
|
0
|
$_[0]->opts->{MaxPerHost} || 5 |
35
|
|
|
|
|
|
|
} |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
sub max_workers { |
38
|
0
|
0
|
|
0
|
0
|
0
|
$_[0]->opts->{MaxWorkers} || 25 |
39
|
|
|
|
|
|
|
} |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
sub Requests { |
42
|
|
|
|
|
|
|
return($_[0]->{REQS}//={}) |
43
|
0
|
|
0
|
0
|
0
|
0
|
} |
44
|
|
|
|
|
|
|
|
45
|
1
|
|
|
1
|
0
|
335
|
sub new { bless {}, shift } |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
sub Cobalt_register { |
48
|
0
|
|
|
0
|
0
|
|
my ($self, $core) = splice @_, 0, 2; |
49
|
|
|
|
|
|
|
|
50
|
0
|
|
|
|
|
|
register( $self, 'SERVER', |
51
|
|
|
|
|
|
|
'www_request', |
52
|
|
|
|
|
|
|
); |
53
|
|
|
|
|
|
|
|
54
|
0
|
|
|
|
|
|
POE::Session->create( |
55
|
|
|
|
|
|
|
object_states => [ |
56
|
|
|
|
|
|
|
$self => [ |
57
|
|
|
|
|
|
|
'_start', |
58
|
|
|
|
|
|
|
'ht_response', |
59
|
|
|
|
|
|
|
'ht_post_request', |
60
|
|
|
|
|
|
|
], |
61
|
|
|
|
|
|
|
], |
62
|
|
|
|
|
|
|
); |
63
|
|
|
|
|
|
|
|
64
|
0
|
|
|
|
|
|
logger->info("Loaded WWW interface"); |
65
|
|
|
|
|
|
|
|
66
|
0
|
|
|
|
|
|
return PLUGIN_EAT_NONE |
67
|
|
|
|
|
|
|
} |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
sub Cobalt_unregister { |
70
|
0
|
|
|
0
|
0
|
|
my ($self, $core) = splice @_, 0, 2; |
71
|
|
|
|
|
|
|
|
72
|
0
|
|
|
|
|
|
delete $core->Provided->{www_request}; |
73
|
|
|
|
|
|
|
|
74
|
0
|
|
|
|
|
|
my $ht_alias = 'ht_'.$core->get_plugin_alias($self); |
75
|
0
|
|
|
|
|
|
$poe_kernel->call( $ht_alias, 'shutdown' ); |
76
|
|
|
|
|
|
|
|
77
|
0
|
|
|
|
|
|
my $sess_alias = 'www_'.$core->get_plugin_alias($self); |
78
|
0
|
|
|
|
|
|
$poe_kernel->alias_remove( $sess_alias ); |
79
|
|
|
|
|
|
|
|
80
|
0
|
|
|
|
|
|
logger->info("Unregistered"); |
81
|
|
|
|
|
|
|
|
82
|
0
|
|
|
|
|
|
return PLUGIN_EAT_NONE |
83
|
|
|
|
|
|
|
} |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
sub Bot_www_request { |
86
|
0
|
|
|
0
|
0
|
|
my ($self, $core) = splice @_, 0, 2; |
87
|
0
|
|
|
|
|
|
my $request = ${ $_[0] }; |
|
0
|
|
|
|
|
|
|
88
|
0
|
0
|
|
|
|
|
my $event = defined $_[1] ? ${$_[1]} : undef ; |
|
0
|
|
|
|
|
|
|
89
|
0
|
0
|
|
|
|
|
my $args = defined $_[2] ? ${$_[2]} : undef ; |
|
0
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
|
91
|
0
|
0
|
0
|
|
|
|
unless ($request && $request->isa('HTTP::Request')) { |
92
|
0
|
|
|
|
|
|
logger->warn( |
93
|
|
|
|
|
|
|
"www_request received but no request at " |
94
|
|
|
|
|
|
|
.join ' ', (caller)[0,2] |
95
|
|
|
|
|
|
|
); |
96
|
|
|
|
|
|
|
} |
97
|
|
|
|
|
|
|
|
98
|
0
|
0
|
|
|
|
|
unless ($event) { |
99
|
|
|
|
|
|
|
## no event at all is legitimate |
100
|
0
|
|
|
|
|
|
$event = 'www_not_handled'; |
101
|
|
|
|
|
|
|
} |
102
|
|
|
|
|
|
|
|
103
|
0
|
0
|
|
|
|
|
$args = [] unless $args; |
104
|
0
|
|
|
|
|
|
my @p = ( 'a' .. 'f', 1 .. 9 ); |
105
|
0
|
|
|
|
|
|
my $tag = join '', map { $p[rand@p] } 1 .. 5; |
|
0
|
|
|
|
|
|
|
106
|
0
|
|
|
|
|
|
$tag .= $p[rand@p] while exists $self->Requests->{$tag}; |
107
|
|
|
|
|
|
|
|
108
|
0
|
|
|
|
|
|
$self->Requests->{$tag} = { |
109
|
|
|
|
|
|
|
Event => $event, |
110
|
|
|
|
|
|
|
Args => $args, |
111
|
|
|
|
|
|
|
Request => $request, |
112
|
|
|
|
|
|
|
Time => time(), |
113
|
|
|
|
|
|
|
}; |
114
|
|
|
|
|
|
|
|
115
|
0
|
|
|
|
|
|
logger->debug("www_request issue $tag -> $event"); |
116
|
|
|
|
|
|
|
|
117
|
0
|
|
|
|
|
|
my $sess_alias = 'www_'.$core->get_plugin_alias($self); |
118
|
0
|
|
|
|
|
|
$poe_kernel->call( $sess_alias, |
119
|
|
|
|
|
|
|
'ht_post_request', |
120
|
|
|
|
|
|
|
$request, $tag |
121
|
|
|
|
|
|
|
); |
122
|
|
|
|
|
|
|
|
123
|
0
|
|
|
|
|
|
return PLUGIN_EAT_ALL |
124
|
|
|
|
|
|
|
} |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
sub ht_post_request { |
127
|
|
|
|
|
|
|
## Bridge to make sure response gets delivered to correct session |
128
|
0
|
|
|
0
|
0
|
|
my ($self, $kernel) = @_[OBJECT, KERNEL]; |
129
|
0
|
|
|
|
|
|
my ($request, $tag) = @_[ARG0, ARG1]; |
130
|
|
|
|
|
|
|
## Post the ::Request |
131
|
0
|
|
|
|
|
|
my $ht_alias = 'ht_'. core()->get_plugin_alias($self); |
132
|
0
|
|
|
|
|
|
$kernel->post( $ht_alias, |
133
|
|
|
|
|
|
|
'request', 'ht_response', |
134
|
|
|
|
|
|
|
$request, $tag |
135
|
|
|
|
|
|
|
); |
136
|
|
|
|
|
|
|
} |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
sub ht_response { |
139
|
0
|
|
|
0
|
0
|
|
my ($self, $kernel) = @_[OBJECT, KERNEL]; |
140
|
0
|
|
|
|
|
|
my ($req_pk, $resp_pk) = @_[ARG0, ARG1]; |
141
|
|
|
|
|
|
|
|
142
|
0
|
|
|
|
|
|
my $response = $resp_pk->[0]; |
143
|
0
|
|
|
|
|
|
my $tag = $req_pk->[1]; |
144
|
|
|
|
|
|
|
|
145
|
0
|
|
|
|
|
|
my $this_req = delete $self->Requests->{$tag}; |
146
|
0
|
0
|
|
|
|
|
return unless $this_req; |
147
|
|
|
|
|
|
|
|
148
|
0
|
|
|
|
|
|
my $event = $this_req->{Event}; |
149
|
0
|
|
|
|
|
|
my $args = $this_req->{Args}; |
150
|
|
|
|
|
|
|
|
151
|
0
|
|
|
|
|
|
core->log->debug("ht_response dispatch: $event ($tag)"); |
152
|
|
|
|
|
|
|
|
153
|
0
|
0
|
|
|
|
|
my $content = $response->is_success ? |
154
|
|
|
|
|
|
|
$response->decoded_content |
155
|
|
|
|
|
|
|
: $response->message; |
156
|
|
|
|
|
|
|
|
157
|
0
|
|
|
|
|
|
broadcast($event, $content, $response, $args); |
158
|
|
|
|
|
|
|
} |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
sub _start { |
161
|
0
|
|
|
0
|
|
|
my ($self, $kernel) = @_[OBJECT, KERNEL]; |
162
|
|
|
|
|
|
|
|
163
|
0
|
|
|
|
|
|
my $sess_alias = 'www_'. core()->get_plugin_alias($self); |
164
|
0
|
|
|
|
|
|
$kernel->alias_set( $sess_alias ); |
165
|
|
|
|
|
|
|
|
166
|
0
|
|
|
|
|
|
my %opts; |
167
|
0
|
0
|
|
|
|
|
$opts{BindAddr} = $self->bindaddr if $self->bindaddr; |
168
|
0
|
0
|
|
|
|
|
$opts{Proxy} = $self->proxy if $self->proxy; |
169
|
0
|
|
|
|
|
|
$opts{Timeout} = $self->timeout; |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
## Create "ht_${plugin_alias}" session |
172
|
0
|
|
|
|
|
|
POE::Component::Client::HTTP->spawn( |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
FollowRedirects => 5, |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
Agent => __PACKAGE__, |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
Alias => 'ht_'. core()->get_plugin_alias($self), |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
ConnectionManager => POE::Component::Client::Keepalive->new( |
181
|
|
|
|
|
|
|
keep_alive => 1, |
182
|
|
|
|
|
|
|
max_per_host => $self->max_per_host, |
183
|
|
|
|
|
|
|
max_open => $self->max_workers, |
184
|
|
|
|
|
|
|
timeout => $self->timeout, |
185
|
|
|
|
|
|
|
), |
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
%opts, |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
); |
190
|
|
|
|
|
|
|
|
191
|
0
|
|
|
|
|
|
core()->Provided->{www_request} = __PACKAGE__ ; |
192
|
|
|
|
|
|
|
} |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
1; |
195
|
|
|
|
|
|
|
__END__ |