line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Bootylicious::Plugin::Pingback; |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
516
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
25
|
|
4
|
1
|
|
|
1
|
|
5
|
use warnings; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
23
|
|
5
|
|
|
|
|
|
|
|
6
|
1
|
|
|
1
|
|
4
|
use base 'Mojolicious::Plugin'; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
68
|
|
7
|
|
|
|
|
|
|
|
8
|
1
|
|
|
1
|
|
6
|
use Mojo::DOM; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
702
|
|
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
sub register { |
11
|
1
|
|
|
1
|
1
|
39
|
my ($self, $app, $conf) = @_; |
12
|
|
|
|
|
|
|
|
13
|
1
|
|
50
|
|
|
5
|
$conf ||= {}; |
14
|
|
|
|
|
|
|
|
15
|
1
|
|
|
|
|
7
|
$app->routes->route('/pingback')->to(cb => \&_pingback)->name('pingback'); |
16
|
1
|
|
|
|
|
348
|
unshift @{$app->renderer->classes}, __PACKAGE__; |
|
1
|
|
|
|
|
4
|
|
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
$app->plugins->on( |
19
|
|
|
|
|
|
|
after_dispatch => sub { |
20
|
17
|
|
|
17
|
|
104462
|
my ($c) = @_; |
21
|
|
|
|
|
|
|
|
22
|
17
|
100
|
|
|
|
54
|
return unless $c->req->method =~ m/GET|HEAD/; |
23
|
|
|
|
|
|
|
|
24
|
6
|
100
|
66
|
|
|
123
|
return unless $c->res->code && $c->res->code == 200; |
25
|
|
|
|
|
|
|
|
26
|
4
|
50
|
|
|
|
98
|
return unless $c->match->endpoint->name eq 'article'; |
27
|
|
|
|
|
|
|
|
28
|
0
|
|
|
|
|
0
|
$c->res->headers->header( |
29
|
|
|
|
|
|
|
'X-Pingback' => $c->url_for('pingback', format => undef)->to_abs); |
30
|
|
|
|
|
|
|
} |
31
|
1
|
|
|
|
|
11
|
); |
32
|
|
|
|
|
|
|
} |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
sub _pingback { |
35
|
12
|
|
|
12
|
|
95949
|
my $self = shift; |
36
|
|
|
|
|
|
|
|
37
|
12
|
|
|
|
|
37
|
my ($source_uri, $target_uri) = _parse_xmlrpc($self); |
38
|
12
|
100
|
66
|
|
|
387
|
return _render_bad_request($self) unless $source_uri && $target_uri; |
39
|
|
|
|
|
|
|
|
40
|
7
|
100
|
|
|
|
38
|
return _render_target_invalid($self) |
41
|
|
|
|
|
|
|
unless $target_uri =~ m{^/articles/(\d+)/(\d+)/(.*)}; |
42
|
|
|
|
|
|
|
|
43
|
6
|
|
|
|
|
25
|
my ($year, $month, $name) = ($1, $2, $3); |
44
|
6
|
|
|
|
|
18
|
$name =~ s/\..*$//; |
45
|
|
|
|
|
|
|
|
46
|
6
|
|
|
|
|
51
|
my $article = $self->get_article($year, $month, $name); |
47
|
6
|
100
|
|
|
|
23
|
return _render_target_not_found($self) unless $article; |
48
|
|
|
|
|
|
|
|
49
|
5
|
|
|
|
|
18
|
$self->app->log->debug("Fetching $source_uri..."); |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
$self->ua->get( |
52
|
|
|
|
|
|
|
$source_uri => sub { |
53
|
5
|
|
|
5
|
|
10946
|
my $tx = pop; |
54
|
|
|
|
|
|
|
|
55
|
5
|
|
|
|
|
20
|
$self->app->log->debug("Fetched $source_uri"); |
56
|
|
|
|
|
|
|
|
57
|
5
|
100
|
66
|
|
|
150
|
return _render_source_not_found($self) |
58
|
|
|
|
|
|
|
unless $tx->res->code && $tx->res->code == 200; |
59
|
|
|
|
|
|
|
|
60
|
4
|
100
|
|
|
|
66
|
return _render_source_invalid($self) |
61
|
|
|
|
|
|
|
unless $tx->res->body =~ m{\Q$target_uri\E}; |
62
|
|
|
|
|
|
|
|
63
|
3
|
100
|
|
|
|
108
|
return _render_pingback_already_registered($self) |
64
|
|
|
|
|
|
|
if $article->has_pingback($source_uri); |
65
|
|
|
|
|
|
|
|
66
|
1
|
|
|
|
|
10
|
$article->pingback($source_uri); |
67
|
|
|
|
|
|
|
|
68
|
1
|
|
|
|
|
173
|
return _render_success($self); |
69
|
|
|
|
|
|
|
} |
70
|
5
|
|
|
|
|
177
|
); |
71
|
|
|
|
|
|
|
} |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
sub _parse_xmlrpc { |
74
|
12
|
|
|
12
|
|
25
|
my $self = shift; |
75
|
|
|
|
|
|
|
|
76
|
12
|
100
|
66
|
|
|
40
|
return unless $self->req->method eq 'POST' && $self->req->body; |
77
|
|
|
|
|
|
|
|
78
|
11
|
|
|
|
|
502
|
my $dom = Mojo::DOM->new; |
79
|
11
|
|
|
|
|
175
|
$dom = $dom->parse($self->req->body); |
80
|
|
|
|
|
|
|
|
81
|
11
|
|
|
|
|
9297
|
my $method = $dom->at('methodCall'); |
82
|
11
|
100
|
|
|
|
2553
|
return unless $method; |
83
|
|
|
|
|
|
|
|
84
|
10
|
|
|
|
|
79
|
my $method_name = $method->at('methodName'); |
85
|
10
|
100
|
|
|
|
1619
|
return unless $method_name->text eq 'pingback.ping'; |
86
|
|
|
|
|
|
|
|
87
|
9
|
|
|
|
|
361
|
my ($source_uri, $target_uri) = |
88
|
|
|
|
|
|
|
$method->find('params > param > value > string')->each; |
89
|
9
|
100
|
66
|
|
|
5727
|
return unless $source_uri && $target_uri; |
90
|
|
|
|
|
|
|
|
91
|
8
|
|
|
|
|
125
|
$source_uri = $source_uri->text; |
92
|
8
|
|
|
|
|
266
|
$target_uri = $target_uri->text; |
93
|
|
|
|
|
|
|
|
94
|
8
|
|
|
|
|
234
|
my $url = $self->url_for('/')->to_abs; |
95
|
8
|
100
|
|
|
|
3172
|
return unless $target_uri =~ s/^\Q$url\E//; |
96
|
|
|
|
|
|
|
|
97
|
7
|
50
|
|
|
|
1298
|
$target_uri = "/$target_uri" unless $target_uri =~ m{^/}; |
98
|
|
|
|
|
|
|
|
99
|
7
|
|
|
|
|
100
|
return ($source_uri, $target_uri); |
100
|
|
|
|
|
|
|
} |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
sub _render_success { |
103
|
1
|
|
|
1
|
|
4
|
my $self = shift; |
104
|
1
|
|
|
|
|
2
|
my $message = shift; |
105
|
|
|
|
|
|
|
|
106
|
1
|
|
50
|
|
|
19
|
$message ||= 'Success'; |
107
|
|
|
|
|
|
|
|
108
|
1
|
|
|
|
|
6
|
$self->render( |
109
|
|
|
|
|
|
|
'success', |
110
|
|
|
|
|
|
|
message => $message, |
111
|
|
|
|
|
|
|
layout => undef |
112
|
|
|
|
|
|
|
); |
113
|
|
|
|
|
|
|
} |
114
|
|
|
|
|
|
|
|
115
|
5
|
|
|
5
|
|
15
|
sub _render_bad_request { _render_error(shift, 0 => 'Bad request') } |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
sub _render_target_not_found { |
118
|
1
|
|
|
1
|
|
5
|
_render_error(shift, 32 => 'The specified target URI does not exist.'); |
119
|
|
|
|
|
|
|
} |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
sub _render_target_invalid { |
122
|
1
|
|
|
1
|
|
4
|
_render_error(shift, |
123
|
|
|
|
|
|
|
33 => 'The specified target URI cannot be used as a target.'); |
124
|
|
|
|
|
|
|
} |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
sub _render_source_not_found { |
127
|
1
|
|
|
1
|
|
27
|
_render_error(shift, 16 => 'The source URI does not exist.'); |
128
|
|
|
|
|
|
|
} |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
sub _render_source_invalid { |
131
|
1
|
|
|
1
|
|
37
|
_render_error(shift, |
132
|
|
|
|
|
|
|
17 => |
133
|
|
|
|
|
|
|
'The source URI does not contain a link to the target URI, and so cannot be used as a source.' |
134
|
|
|
|
|
|
|
); |
135
|
|
|
|
|
|
|
} |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
sub _render_pingback_already_registered { |
138
|
2
|
|
|
2
|
|
7
|
_render_error(shift, 48 => 'The pingback has already been registered.'); |
139
|
|
|
|
|
|
|
} |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
sub _render_error { |
142
|
11
|
|
|
11
|
|
23
|
my $self = shift; |
143
|
11
|
|
|
|
|
316
|
my ($code, $message) = @_; |
144
|
|
|
|
|
|
|
|
145
|
11
|
100
|
|
|
|
49
|
$self->res->code(400) unless $code; |
146
|
|
|
|
|
|
|
|
147
|
11
|
|
|
|
|
113
|
$self->render( |
148
|
|
|
|
|
|
|
'fault', |
149
|
|
|
|
|
|
|
code => $code, |
150
|
|
|
|
|
|
|
message => $message, |
151
|
|
|
|
|
|
|
layout => undef |
152
|
|
|
|
|
|
|
); |
153
|
|
|
|
|
|
|
} |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
1; |
156
|
|
|
|
|
|
|
__DATA__ |