line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
#!/usr/bin/env perl |
2
|
3
|
|
|
3
|
|
9228
|
use Mojolicious::Lite -signatures; |
|
3
|
|
|
|
|
214717
|
|
|
3
|
|
|
|
|
26
|
|
3
|
|
|
|
|
|
|
|
4
|
3
|
|
|
3
|
|
98748
|
use Mojo::Util qw(network_contains); |
|
3
|
|
|
|
|
8
|
|
|
3
|
|
|
|
|
139
|
|
5
|
3
|
|
|
3
|
|
2037
|
use NetAddr::IP (); |
|
3
|
|
|
|
|
64726
|
|
|
3
|
|
|
|
|
97
|
|
6
|
3
|
|
|
3
|
|
20
|
use Socket qw(AF_INET AF_INET6 inet_ntop getaddrinfo unpack_sockaddr_in unpack_sockaddr_in6); |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
4423
|
|
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
get |
9
|
|
|
|
|
|
|
'/' => {layout => 'pac'}, |
10
|
|
|
|
|
|
|
'index'; |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
get '/pac', [format => [qw(js)]], => 'pac'; |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
post '/v1/gethostbyname' => sub ($c) { |
15
|
|
|
|
|
|
|
return $c->render(text => 'Host missing.', status => 400) unless my $host = $c->param('host'); |
16
|
|
|
|
|
|
|
return $c->render(text => "Invalid host: $host", status => 400) unless $host =~ /[A-Za-z:\.]/; |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
$c->res->headers->cache_control('max-age=600'); |
19
|
|
|
|
|
|
|
return $c->render_later->host_to_ip_p($host)->then(sub ($addr) { |
20
|
|
|
|
|
|
|
return $c->render(text => "No IP found for $host", status => 400) unless $addr; |
21
|
|
|
|
|
|
|
return $c->render(text => $addr); |
22
|
|
|
|
|
|
|
})->catch( |
23
|
|
|
|
|
|
|
sub ($err, @) { |
24
|
|
|
|
|
|
|
return $c->render(text => exception_to_text($err), status => 500); |
25
|
|
|
|
|
|
|
} |
26
|
|
|
|
|
|
|
); |
27
|
|
|
|
|
|
|
}; |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
post '/v1/is-in-net' => sub ($c) { |
30
|
|
|
|
|
|
|
my ($ip, $net, $mask) = map { $c->param($_) } qw(ip net mask); |
31
|
|
|
|
|
|
|
return $c->render(text => 'IP or Net is missing.', status => 400) |
32
|
|
|
|
|
|
|
unless 2 == grep { $_ && $_ =~ /[:\.]/ } $ip, $net; |
33
|
|
|
|
|
|
|
return $c->render(text => 'Mask is invalid or missing.', status => 400) |
34
|
|
|
|
|
|
|
unless $mask and $mask =~ /^\d{1,3}$/; |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
$c->res->headers->cache_control('max-age=600'); |
37
|
|
|
|
|
|
|
return $c->render_later->host_to_ip_p($ip)->then(sub ($resolved) { |
38
|
|
|
|
|
|
|
$c->render(text => $resolved && network_contains("$net/$mask", $resolved) ? 1 : 0); |
39
|
|
|
|
|
|
|
})->catch( |
40
|
|
|
|
|
|
|
sub ($err, @) { |
41
|
|
|
|
|
|
|
$c->render(text => exception_to_text($err), status => 500); |
42
|
|
|
|
|
|
|
} |
43
|
|
|
|
|
|
|
); |
44
|
|
|
|
|
|
|
}; |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
get '/v1/template' => {template => 'template'}; |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
helper host_to_ip_p => sub ($c, $host) { |
49
|
|
|
|
|
|
|
return Mojo::IOLoop->subprocess->run_p(sub (@) { |
50
|
|
|
|
|
|
|
local $SIG{ALRM} = sub { die 'Timeout!' }; |
51
|
|
|
|
|
|
|
alarm 2; |
52
|
|
|
|
|
|
|
my ($err, @info) = getaddrinfo $host; |
53
|
|
|
|
|
|
|
return undef if $err; |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
@info = grep { $_->{family} & (AF_INET6 | AF_INET) } @info; |
56
|
|
|
|
|
|
|
for my $item (@info) { |
57
|
|
|
|
|
|
|
$item->{pri} = $item->{family} == AF_INET6 ? 0 : 1; |
58
|
|
|
|
|
|
|
@$item{qw(port ip)} |
59
|
|
|
|
|
|
|
= $item->{family} == AF_INET6 |
60
|
|
|
|
|
|
|
? unpack_sockaddr_in6($item->{addr}) |
61
|
|
|
|
|
|
|
: unpack_sockaddr_in($item->{addr}); |
62
|
|
|
|
|
|
|
$item->{ip} = inet_ntop @$item{qw(family ip)}; |
63
|
|
|
|
|
|
|
} |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
# IPv4 before IPv6 |
66
|
|
|
|
|
|
|
@info = sort { $b->{pri} <=> $a->{pri} } @info; |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
return @info && $info[0]{ip} || undef; |
69
|
|
|
|
|
|
|
})->catch( |
70
|
|
|
|
|
|
|
sub ($err, @) { |
71
|
|
|
|
|
|
|
return $err =~ m!Timeout! ? undef : Mojo::Promise->reject($err); |
72
|
|
|
|
|
|
|
} |
73
|
|
|
|
|
|
|
); |
74
|
|
|
|
|
|
|
}; |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
if (my $env_base = $ENV{PROXYFORURL_X_REQUEST_BASE}) { |
77
|
|
|
|
|
|
|
$env_base = '' unless $env_base =~ m!^http!; |
78
|
|
|
|
|
|
|
hook before_dispatch => sub ($c) { |
79
|
|
|
|
|
|
|
return unless my $base = $env_base || $c->req->headers->header('X-Request-Base'); |
80
|
|
|
|
|
|
|
$c->req->url->base(Mojo::URL->new($base)); |
81
|
|
|
|
|
|
|
}; |
82
|
|
|
|
|
|
|
} |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
app->renderer->paths([$ENV{PROXYFORURL_TEMPLATES} || 'templates']); |
85
|
|
|
|
|
|
|
app->static->paths([$ENV{PROXYFORURL_PUBLIC} || 'public']); |
86
|
|
|
|
|
|
|
app->config(brand_name => $ENV{PROXYFORURL_BRAND_NAME} || 'ProxyForURL'); |
87
|
|
|
|
|
|
|
app->config(brand_url => $ENV{PROXYFORURL_BRAND_URL} || '/'); |
88
|
|
|
|
|
|
|
app->start; |
89
|
|
|
|
|
|
|
|
90
|
0
|
|
|
0
|
|
|
sub exception_to_text ($err) { |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
91
|
0
|
|
|
|
|
|
$err =~ s!\sat\s\S+.*?line.*!!s; |
92
|
0
|
|
|
|
|
|
return $err; |
93
|
|
|
|
|
|
|
} |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
__DATA__ |