line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Puncheur::Plugin::JSON; |
2
|
1
|
|
|
1
|
|
526
|
use 5.010; |
|
1
|
|
|
|
|
4
|
|
|
1
|
|
|
|
|
33
|
|
3
|
1
|
|
|
1
|
|
5
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
24
|
|
4
|
1
|
|
|
1
|
|
5
|
use warnings; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
29
|
|
5
|
1
|
|
|
1
|
|
9
|
use JSON; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
9
|
|
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
our @EXPORT = qw/res_json/; |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
sub res_json { |
10
|
1
|
|
|
1
|
0
|
3
|
my ($self, $data) = @_; |
11
|
|
|
|
|
|
|
|
12
|
1
|
|
|
|
|
26
|
state $json = JSON->new->ascii(1); |
13
|
1
|
|
|
|
|
7
|
state $escape = { |
14
|
|
|
|
|
|
|
'+' => '\\u002b', # do not eval as UTF-7 |
15
|
|
|
|
|
|
|
'<' => '\\u003c', # do not eval as HTML |
16
|
|
|
|
|
|
|
'>' => '\\u003e', # ditto. |
17
|
|
|
|
|
|
|
}; |
18
|
1
|
|
|
|
|
28
|
my $body = $json->encode($data); |
19
|
1
|
|
|
|
|
4
|
$body =~ s!([+<>])!$escape->{$1}!g; |
20
|
|
|
|
|
|
|
|
21
|
1
|
|
50
|
|
|
9
|
my $user_agent = $self->req->user_agent || ''; |
22
|
|
|
|
|
|
|
# defense from JSON hijacking |
23
|
1
|
0
|
33
|
|
|
184
|
if ( |
|
|
|
33
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
33
|
|
|
|
|
24
|
|
|
|
|
|
|
(!$self->request->header('X-Requested-With')) && |
25
|
|
|
|
|
|
|
$user_agent =~ /android/i && |
26
|
|
|
|
|
|
|
defined $self->req->header('Cookie') && |
27
|
|
|
|
|
|
|
($self->req->method||'GET') eq 'GET') |
28
|
|
|
|
|
|
|
{ |
29
|
0
|
|
|
|
|
0
|
my $content = "Your request may be JSON hijacking.\nIf you are not an attacker, please add 'X-Requested-With' header to each request."; |
30
|
0
|
|
|
|
|
0
|
return $self->create_response( |
31
|
|
|
|
|
|
|
403, |
32
|
|
|
|
|
|
|
[ |
33
|
|
|
|
|
|
|
'Content-Type' => $self->html_content_type, |
34
|
|
|
|
|
|
|
'Content-Length' => length($content), |
35
|
|
|
|
|
|
|
], |
36
|
|
|
|
|
|
|
[$content], |
37
|
|
|
|
|
|
|
); |
38
|
|
|
|
|
|
|
} |
39
|
|
|
|
|
|
|
|
40
|
1
|
|
|
|
|
64
|
my $encoding = $self->encoding; |
41
|
1
|
50
|
|
|
|
21
|
$encoding = lc $encoding->mime_name if ref $encoding; |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
# add UTF-8 BOM if the client is Safari |
44
|
1
|
50
|
33
|
|
|
1586
|
if ( $user_agent =~ m/Safari/ and $encoding eq 'utf-8' ) { |
45
|
0
|
|
|
|
|
0
|
$body = "\xEF\xBB\xBF" . $body; |
46
|
|
|
|
|
|
|
} |
47
|
|
|
|
|
|
|
|
48
|
1
|
|
|
|
|
12
|
return $self->create_response( |
49
|
|
|
|
|
|
|
200, |
50
|
|
|
|
|
|
|
[ |
51
|
|
|
|
|
|
|
'Content-type' => "application/json; charset=$encoding", |
52
|
|
|
|
|
|
|
'Content-Length' => length($body) |
53
|
|
|
|
|
|
|
], |
54
|
|
|
|
|
|
|
[ $body ] |
55
|
|
|
|
|
|
|
); |
56
|
|
|
|
|
|
|
} |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
1; |