line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package APNS::Agent; |
2
|
2
|
|
|
2
|
|
187545
|
use 5.010; |
|
2
|
|
|
|
|
7
|
|
|
2
|
|
|
|
|
94
|
|
3
|
2
|
|
|
2
|
|
12
|
use strict; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
68
|
|
4
|
2
|
|
|
2
|
|
11
|
use warnings; |
|
2
|
|
|
|
|
12
|
|
|
2
|
|
|
|
|
109
|
|
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
our $VERSION = "0.06"; |
7
|
|
|
|
|
|
|
|
8
|
2
|
|
|
2
|
|
2181
|
use AnyEvent::APNS; |
|
2
|
|
|
|
|
378515
|
|
|
2
|
|
|
|
|
77
|
|
9
|
2
|
|
|
2
|
|
2006
|
use Cache::LRU; |
|
2
|
|
|
|
|
1445
|
|
|
2
|
|
|
|
|
64
|
|
10
|
2
|
|
|
2
|
|
13
|
use Encode qw/decode_utf8/; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
208
|
|
11
|
2
|
|
|
2
|
|
12
|
use JSON::XS; |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
108
|
|
12
|
2
|
|
|
2
|
|
1870
|
use Log::Minimal; |
|
2
|
|
|
|
|
75591
|
|
|
2
|
|
|
|
|
15
|
|
13
|
2
|
|
|
2
|
|
2354
|
use Plack::Request; |
|
2
|
|
|
|
|
1026583
|
|
|
2
|
|
|
|
|
77
|
|
14
|
2
|
|
|
2
|
|
1931
|
use Router::Boom::Method; |
|
2
|
|
|
|
|
20559
|
|
|
2
|
|
|
|
|
394
|
|
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
use Class::Accessor::Lite::Lazy 0.03 ( |
17
|
|
|
|
|
|
|
new => 1, |
18
|
|
|
|
|
|
|
ro => [qw/ |
19
|
|
|
|
|
|
|
certificate |
20
|
|
|
|
|
|
|
private_key |
21
|
|
|
|
|
|
|
sandbox |
22
|
|
|
|
|
|
|
debug_port |
23
|
|
|
|
|
|
|
/], |
24
|
|
|
|
|
|
|
ro_lazy => { |
25
|
|
|
|
|
|
|
on_error_response => sub { |
26
|
|
|
|
|
|
|
sub { |
27
|
0
|
|
|
|
|
0
|
my $self = shift; |
28
|
0
|
|
|
|
|
0
|
my %d = %{$_[0]}; |
|
0
|
|
|
|
|
0
|
|
29
|
0
|
|
0
|
|
|
0
|
warnf "identifier:%s\tstate:%s\ttoken:%s", $d{identifier}, $d{state}, $d{token} || ''; |
30
|
|
|
|
|
|
|
} |
31
|
0
|
|
|
|
|
0
|
}, |
32
|
1
|
|
|
|
|
19
|
disconnect_interval => sub { 60 }, |
33
|
1
|
|
|
|
|
11
|
send_interval => sub { 0.01 }, |
34
|
1
|
|
|
|
|
18
|
_sent_cache => sub { Cache::LRU->new(size => 10000) }, |
35
|
1
|
|
|
|
|
11
|
_queue => sub { [] }, |
36
|
|
|
|
|
|
|
__apns => '_build_apns', |
37
|
1
|
|
|
|
|
11
|
_sent => sub { 0 }, |
38
|
|
|
|
|
|
|
}, |
39
|
2
|
|
|
|
|
42
|
rw => [qw/_last_sent_at _disconnect_timer/], |
40
|
2
|
|
|
2
|
|
1982
|
); |
|
2
|
|
|
|
|
2286
|
|
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
sub to_app { |
43
|
1
|
|
|
1
|
0
|
10314
|
my $self = shift; |
44
|
|
|
|
|
|
|
|
45
|
1
|
|
|
|
|
13
|
my $router = Router::Boom::Method->new; |
46
|
1
|
|
|
|
|
12
|
$router->add(POST => '/' => '_do_main'); |
47
|
1
|
|
|
|
|
26
|
$router->add(GET => '/monitor' => '_do_monitor'); |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
sub { |
50
|
3
|
|
|
3
|
|
35331
|
my $env = shift; |
51
|
3
|
|
|
|
|
33
|
my ($target_method) = $router->match(@$env{qw/REQUEST_METHOD PATH_INFO/}); |
52
|
|
|
|
|
|
|
|
53
|
3
|
50
|
|
|
|
1117
|
return [404, [], ['NOT FOUND']] unless $target_method; |
54
|
|
|
|
|
|
|
|
55
|
3
|
|
|
|
|
38
|
my $req = Plack::Request->new($env); |
56
|
3
|
|
|
|
|
46
|
$self->$target_method($req); |
57
|
1
|
|
|
|
|
25
|
}; |
58
|
|
|
|
|
|
|
} |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
sub _do_main { |
61
|
1
|
|
|
1
|
|
3
|
my ($self, $req) = @_; |
62
|
|
|
|
|
|
|
|
63
|
1
|
50
|
|
|
|
7
|
my $token = $req->param('token') or return [400, [], ['Bad Request']]; |
64
|
|
|
|
|
|
|
|
65
|
1
|
|
|
|
|
882
|
my $payload; |
66
|
1
|
50
|
|
|
|
5
|
if (my $payload_json = $req->param('payload') ) { |
|
|
50
|
|
|
|
|
|
67
|
0
|
|
|
|
|
0
|
state $json_driver = JSON::XS->new->utf8; |
68
|
0
|
|
|
|
|
0
|
local $@; |
69
|
0
|
|
|
|
|
0
|
$payload = eval { $json_driver->decode($payload_json) }; |
|
0
|
|
|
|
|
0
|
|
70
|
0
|
0
|
|
|
|
0
|
return [400, [], ['BAD REQUEST']] if $@; |
71
|
|
|
|
|
|
|
} |
72
|
|
|
|
|
|
|
elsif (my $alert = $req->param('alert')) { |
73
|
1
|
|
|
|
|
37
|
$payload = +{ |
74
|
|
|
|
|
|
|
alert => decode_utf8($alert), |
75
|
|
|
|
|
|
|
}; |
76
|
|
|
|
|
|
|
} |
77
|
1
|
50
|
|
|
|
76
|
return [400, [], ['BAD REQUEST']] unless $payload; |
78
|
|
|
|
|
|
|
|
79
|
1
|
|
|
|
|
4
|
my @payloads = map {[$_, $payload]} split /,/, $token; |
|
1
|
|
|
|
|
5
|
|
80
|
1
|
|
|
|
|
2
|
push @{$self->_queue}, @payloads; |
|
1
|
|
|
|
|
8
|
|
81
|
|
|
|
|
|
|
|
82
|
1
|
|
|
|
|
7
|
infof "event:payload queued\ttoken:%s", $token; |
83
|
1
|
50
|
|
|
|
46
|
if ($self->__apns->connected) { |
84
|
0
|
|
|
|
|
0
|
$self->_sending; |
85
|
|
|
|
|
|
|
} |
86
|
|
|
|
|
|
|
else { |
87
|
1
|
|
|
|
|
16
|
$self->_connect_to_apns; |
88
|
|
|
|
|
|
|
} |
89
|
1
|
|
|
|
|
30
|
return [200, [], ['Accepted']]; |
90
|
|
|
|
|
|
|
} |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
sub _do_monitor { |
93
|
2
|
|
|
2
|
|
6
|
my ($self, $req) = @_; |
94
|
|
|
|
|
|
|
|
95
|
2
|
|
|
|
|
17
|
my $result = { |
96
|
|
|
|
|
|
|
sent => $self->_sent, |
97
|
2
|
|
|
|
|
13
|
queued => scalar( @{ $self->_queue } ), |
98
|
|
|
|
|
|
|
}; |
99
|
2
|
|
|
|
|
45
|
my $body = encode_json($result); |
100
|
|
|
|
|
|
|
|
101
|
2
|
|
|
|
|
28
|
return [200, [ |
102
|
|
|
|
|
|
|
'Content-Type' => 'application/json; charset=utf-8', |
103
|
|
|
|
|
|
|
'Content-Length' => length($body), |
104
|
|
|
|
|
|
|
], [$body]]; |
105
|
|
|
|
|
|
|
} |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
sub _build_apns { |
108
|
1
|
|
|
1
|
|
34031
|
my $self = shift; |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
AnyEvent::APNS->new( |
111
|
|
|
|
|
|
|
certificate => $self->certificate, |
112
|
|
|
|
|
|
|
private_key => $self->private_key, |
113
|
|
|
|
|
|
|
sandbox => $self->sandbox, |
114
|
|
|
|
|
|
|
on_error => sub { |
115
|
0
|
|
|
0
|
|
0
|
my ($handle, $fatal, $message) = @_; |
116
|
|
|
|
|
|
|
|
117
|
0
|
|
|
|
|
0
|
my $t; $t = AnyEvent->timer( |
118
|
|
|
|
|
|
|
after => 0, |
119
|
|
|
|
|
|
|
interval => 10, |
120
|
|
|
|
|
|
|
cb => sub { |
121
|
0
|
|
|
|
|
0
|
undef $t; |
122
|
0
|
|
|
|
|
0
|
infof "event:reconnect"; |
123
|
0
|
|
|
|
|
0
|
$self->_connect_to_apns; |
124
|
|
|
|
|
|
|
}, |
125
|
0
|
|
|
|
|
0
|
); |
126
|
0
|
|
|
|
|
0
|
warnf "event:error\tfatal:$fatal\tmessage:$message"; |
127
|
|
|
|
|
|
|
}, |
128
|
|
|
|
|
|
|
on_connect => sub { |
129
|
1
|
|
|
1
|
|
4338
|
infof "event:on_connect"; |
130
|
1
|
|
|
|
|
19
|
$self->_disconnect_timer($self->_build_disconnect_timer); |
131
|
|
|
|
|
|
|
|
132
|
1
|
50
|
|
|
|
32
|
if (@{$self->_queue}) { |
|
1
|
|
|
|
|
5
|
|
133
|
1
|
|
|
|
|
22
|
$self->_sending; |
134
|
|
|
|
|
|
|
} |
135
|
|
|
|
|
|
|
}, |
136
|
|
|
|
|
|
|
on_error_response => sub { |
137
|
0
|
|
|
0
|
|
0
|
my ($identifier, $state) = @_; |
138
|
0
|
|
0
|
|
|
0
|
my $data = $self->_sent_cache->get($identifier) || {}; |
139
|
0
|
|
|
|
|
0
|
$self->on_error_response->($self, { |
140
|
|
|
|
|
|
|
identifier => $identifier, |
141
|
|
|
|
|
|
|
state => $state, |
142
|
|
|
|
|
|
|
token => $data->{token}, |
143
|
|
|
|
|
|
|
payload => $data->{payload}, |
144
|
|
|
|
|
|
|
}); |
145
|
|
|
|
|
|
|
}, |
146
|
1
|
50
|
|
|
|
8
|
($self->debug_port ? (debug_port => $self->debug_port) : ()), |
147
|
|
|
|
|
|
|
); |
148
|
|
|
|
|
|
|
} |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
sub _apns { |
151
|
2
|
|
|
2
|
|
5
|
my $self = shift; |
152
|
|
|
|
|
|
|
|
153
|
2
|
|
|
|
|
9
|
my $apns = $self->__apns; |
154
|
2
|
100
|
|
|
|
29
|
$apns->connect unless $apns->connected; |
155
|
2
|
|
|
|
|
900
|
$apns; |
156
|
|
|
|
|
|
|
} |
157
|
1
|
|
|
1
|
|
5
|
sub _connect_to_apns { goto \&_apns } |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
sub _build_disconnect_timer { |
160
|
1
|
|
|
1
|
|
3
|
my $self = shift; |
161
|
|
|
|
|
|
|
|
162
|
1
|
50
|
|
|
|
5
|
if (my $interval = $self->disconnect_interval) { |
163
|
|
|
|
|
|
|
AnyEvent->timer( |
164
|
|
|
|
|
|
|
after => $interval, |
165
|
|
|
|
|
|
|
interval => $interval, |
166
|
|
|
|
|
|
|
cb => sub { |
167
|
0
|
0
|
0
|
0
|
|
0
|
if ($self->{__apns} && (time - ($self->_last_sent_at || 0) > $interval)) { |
|
|
|
0
|
|
|
|
|
168
|
0
|
|
|
|
|
0
|
delete $self->{__apns}; |
169
|
0
|
|
|
|
|
0
|
delete $self->{_disconnect_timer}; |
170
|
0
|
|
|
|
|
0
|
infof "event:close apns"; |
171
|
|
|
|
|
|
|
} |
172
|
|
|
|
|
|
|
}, |
173
|
1
|
|
|
|
|
22
|
); |
174
|
|
|
|
|
|
|
} |
175
|
0
|
|
|
|
|
0
|
else { undef } |
176
|
|
|
|
|
|
|
} |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
sub _sending { |
179
|
1
|
|
|
1
|
|
2
|
my $self = shift; |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
$self->{_send_timer} ||= AnyEvent->timer( |
182
|
|
|
|
|
|
|
after => $self->send_interval, |
183
|
|
|
|
|
|
|
interval => $self->send_interval, |
184
|
|
|
|
|
|
|
cb => sub { |
185
|
1
|
|
|
1
|
|
9459
|
my $msg = shift @{ $self->_queue }; |
|
1
|
|
|
|
|
11
|
|
186
|
1
|
50
|
|
|
|
24
|
if ($msg) { |
187
|
1
|
|
|
|
|
7
|
$self->_send(@$msg); |
188
|
|
|
|
|
|
|
} |
189
|
|
|
|
|
|
|
else { |
190
|
0
|
|
|
|
|
0
|
delete $self->{_send_timer}; |
191
|
|
|
|
|
|
|
} |
192
|
|
|
|
|
|
|
}, |
193
|
1
|
|
33
|
|
|
11
|
); |
194
|
|
|
|
|
|
|
} |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
sub _send { |
197
|
1
|
|
|
1
|
|
5
|
my ($self, $token, $payload) = @_; |
198
|
|
|
|
|
|
|
|
199
|
1
|
|
|
|
|
3
|
local $@; |
200
|
1
|
|
|
|
|
2
|
my $identifier; |
201
|
1
|
|
|
|
|
3
|
eval { |
202
|
1
|
|
|
|
|
7
|
$identifier = $self->_apns->send(pack("H*", $token) => { |
203
|
|
|
|
|
|
|
aps => $payload, |
204
|
|
|
|
|
|
|
}); |
205
|
|
|
|
|
|
|
}; |
206
|
|
|
|
|
|
|
|
207
|
1
|
50
|
|
|
|
2095
|
if (my $err = $@) { |
208
|
0
|
0
|
|
|
|
0
|
if ($err =~ m!Can't call method "push_write" on an undefined value!) { |
209
|
|
|
|
|
|
|
# AnyEvent::APNS->handle is missing |
210
|
0
|
|
|
|
|
0
|
delete $self->{_send_timer}; |
211
|
0
|
|
|
|
|
0
|
unshift @{ $self->_queue }, [$token, $payload]; |
|
0
|
|
|
|
|
0
|
|
212
|
0
|
|
|
|
|
0
|
$self->_connect_to_apns; |
213
|
|
|
|
|
|
|
} |
214
|
|
|
|
|
|
|
else { |
215
|
0
|
|
|
|
|
0
|
die $err; |
216
|
|
|
|
|
|
|
} |
217
|
|
|
|
|
|
|
} |
218
|
|
|
|
|
|
|
else { |
219
|
1
|
|
|
|
|
7
|
$self->_sent_cache->set($identifier => { |
220
|
|
|
|
|
|
|
token => $token, |
221
|
|
|
|
|
|
|
payload => $payload, |
222
|
|
|
|
|
|
|
}); |
223
|
1
|
|
|
|
|
58
|
$self->_last_sent_at(time); |
224
|
1
|
|
|
|
|
23
|
infof "event:send\ttoken:$token\tidentifier:$identifier"; |
225
|
1
|
|
|
|
|
13
|
$self->{_sent}++; |
226
|
1
|
|
|
|
|
13
|
$identifier; |
227
|
|
|
|
|
|
|
} |
228
|
|
|
|
|
|
|
} |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
sub parse_options { |
231
|
0
|
|
|
0
|
0
|
|
my ($class, @argv) = @_; |
232
|
|
|
|
|
|
|
|
233
|
0
|
|
|
|
|
|
require Getopt::Long; |
234
|
0
|
|
|
|
|
|
require Pod::Usage; |
235
|
0
|
|
|
|
|
|
require Hash::Rename; |
236
|
|
|
|
|
|
|
|
237
|
0
|
|
|
|
|
|
my $p = Getopt::Long::Parser->new( |
238
|
|
|
|
|
|
|
config => [qw/posix_default no_ignore_case auto_help pass_through bundling/] |
239
|
|
|
|
|
|
|
); |
240
|
0
|
0
|
|
|
|
|
$p->getoptionsfromarray(\@argv, \my %opt, qw/ |
241
|
|
|
|
|
|
|
certificate=s |
242
|
|
|
|
|
|
|
private-key=s |
243
|
|
|
|
|
|
|
disconnect-interval=i |
244
|
|
|
|
|
|
|
sandbox! |
245
|
|
|
|
|
|
|
debug-port=i |
246
|
|
|
|
|
|
|
/) or Pod::Usage::pod2usage(); |
247
|
0
|
0
|
0
|
|
|
|
Pod::Usage::pod2usage() if !$opt{certificate} || !$opt{'private-key'}; |
248
|
|
|
|
|
|
|
|
249
|
0
|
|
|
0
|
|
|
Hash::Rename::hash_rename(\%opt, code => sub {tr/-/_/}); |
|
0
|
|
|
|
|
|
|
250
|
0
|
|
|
|
|
|
(\%opt, \@argv); |
251
|
|
|
|
|
|
|
} |
252
|
|
|
|
|
|
|
|
253
|
|
|
|
|
|
|
sub run { |
254
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
255
|
0
|
0
|
|
|
|
|
my %args = @_ == 1 ? %{$_[0]} : @_; |
|
0
|
|
|
|
|
|
|
256
|
0
|
0
|
0
|
|
|
|
if (!$args{listen} && !$args{port} && !$ENV{SERVER_STARTER_PORT}) { |
|
|
|
0
|
|
|
|
|
257
|
0
|
|
|
|
|
|
$args{port} = 4905; |
258
|
|
|
|
|
|
|
} |
259
|
0
|
|
|
|
|
|
require Plack::Loader; |
260
|
0
|
|
|
|
|
|
Plack::Loader->load(Twiggy => %args)->run($self->to_app); |
261
|
|
|
|
|
|
|
} |
262
|
|
|
|
|
|
|
|
263
|
|
|
|
|
|
|
1; |
264
|
|
|
|
|
|
|
__END__ |