| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
package MHFS::HTTP::Server v0.7.0; |
|
2
|
1
|
|
|
1
|
|
20
|
use 5.014; |
|
|
1
|
|
|
|
|
4
|
|
|
3
|
1
|
|
|
1
|
|
5
|
use strict; use warnings; |
|
|
1
|
|
|
1
|
|
6
|
|
|
|
1
|
|
|
|
|
30
|
|
|
|
1
|
|
|
|
|
8
|
|
|
|
1
|
|
|
|
|
1
|
|
|
|
1
|
|
|
|
|
66
|
|
|
4
|
1
|
|
|
1
|
|
6
|
use feature 'say'; |
|
|
1
|
|
|
|
|
2
|
|
|
|
1
|
|
|
|
|
165
|
|
|
5
|
1
|
|
|
1
|
|
716
|
use IO::Socket::INET; |
|
|
1
|
|
|
|
|
31745
|
|
|
|
1
|
|
|
|
|
10
|
|
|
6
|
1
|
|
|
1
|
|
668
|
use Socket qw(IPPROTO_TCP TCP_KEEPALIVE TCP_NODELAY); |
|
|
1
|
|
|
|
|
2
|
|
|
|
1
|
|
|
|
|
297
|
|
|
7
|
1
|
|
|
1
|
|
796
|
use IO::Poll qw(POLLIN POLLOUT POLLHUP); |
|
|
1
|
|
|
|
|
1195
|
|
|
|
1
|
|
|
|
|
114
|
|
|
8
|
1
|
|
|
1
|
|
9
|
use Scalar::Util qw(weaken); |
|
|
1
|
|
|
|
|
3
|
|
|
|
1
|
|
|
|
|
67
|
|
|
9
|
1
|
|
|
1
|
|
702
|
use Feature::Compat::Try; |
|
|
1
|
|
|
|
|
523
|
|
|
|
1
|
|
|
|
|
9
|
|
|
10
|
1
|
|
|
1
|
|
135
|
use File::Path qw(make_path); |
|
|
1
|
|
|
|
|
2
|
|
|
|
1
|
|
|
|
|
80
|
|
|
11
|
1
|
|
|
1
|
|
749
|
use Data::Dumper; |
|
|
1
|
|
|
|
|
11916
|
|
|
|
1
|
|
|
|
|
102
|
|
|
12
|
1
|
|
|
1
|
|
9
|
use Carp (); |
|
|
1
|
|
|
|
|
2
|
|
|
|
1
|
|
|
|
|
25
|
|
|
13
|
1
|
|
|
1
|
|
6
|
use Config; |
|
|
1
|
|
|
|
|
2
|
|
|
|
1
|
|
|
|
|
47
|
|
|
14
|
1
|
|
|
1
|
|
670
|
use MHFS::EventLoop::Poll; |
|
|
1
|
|
|
|
|
4
|
|
|
|
1
|
|
|
|
|
75
|
|
|
15
|
1
|
|
|
1
|
|
564
|
use MHFS::FS; |
|
|
1
|
|
|
|
|
4
|
|
|
|
1
|
|
|
|
|
46
|
|
|
16
|
1
|
|
|
1
|
|
671
|
use MHFS::HTTP::Server::Client; |
|
|
1
|
|
|
|
|
6
|
|
|
|
1
|
|
|
|
|
57
|
|
|
17
|
1
|
|
|
1
|
|
794
|
use MHFS::Settings; |
|
|
1
|
|
|
|
|
4
|
|
|
|
1
|
|
|
|
|
63
|
|
|
18
|
1
|
|
|
1
|
|
8
|
use MHFS::Util qw(parse_ipv4 read_text_file); |
|
|
1
|
|
|
|
|
3
|
|
|
|
1
|
|
|
|
|
660
|
|
|
19
|
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
sub new { |
|
21
|
0
|
|
|
0
|
0
|
|
my ($class, $launchsettings, $plugins, $routes) = @_; |
|
22
|
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
local $SIG{PIPE} = sub { |
|
24
|
0
|
|
|
0
|
|
|
print STDERR "SIGPIPE @_\n"; |
|
25
|
0
|
|
|
|
|
|
}; |
|
26
|
0
|
0
|
|
|
|
|
local $SIG{ __DIE__ } = \&Carp::confess if ($launchsettings->{debug}); |
|
27
|
|
|
|
|
|
|
|
|
28
|
0
|
|
|
|
|
|
binmode(STDOUT, ":utf8"); |
|
29
|
0
|
|
|
|
|
|
binmode(STDERR, ":utf8"); |
|
30
|
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
# load settings |
|
32
|
0
|
|
|
|
|
|
say __PACKAGE__.": loading settings"; |
|
33
|
0
|
|
|
|
|
|
my $settings = MHFS::Settings::load($launchsettings); |
|
34
|
0
|
0
|
0
|
|
|
|
if((exists $settings->{'flush'}) && ($settings->{'flush'})) { |
|
35
|
0
|
|
|
|
|
|
say __PACKAGE__.": setting autoflush on STDOUT and STDERR"; |
|
36
|
0
|
|
|
|
|
|
STDOUT->autoflush(1); |
|
37
|
0
|
|
|
|
|
|
STDERR->autoflush(1); |
|
38
|
|
|
|
|
|
|
} |
|
39
|
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
# make the temp dirs |
|
41
|
0
|
|
|
|
|
|
make_path($settings->{'VIDEO_TMPDIR'}, $settings->{'MUSIC_TMPDIR'}, $settings->{'RUNTIME_DIR'}, $settings->{'GENERIC_TMPDIR'}); |
|
42
|
0
|
|
|
|
|
|
make_path($settings->{'SECRET_TMPDIR'}, {chmod => 0600}); |
|
43
|
0
|
|
|
|
|
|
make_path($settings->{'DATADIR'}, $settings->{'MHFS_TRACKER_TORRENT_DIR'}); |
|
44
|
|
|
|
|
|
|
|
|
45
|
0
|
|
|
|
|
|
my $sock = IO::Socket::INET->new(Listen => 10000, LocalAddr => $settings->{'HOST'}, LocalPort => $settings->{'PORT'}, Proto => 'tcp', Reuse => 1, Blocking => 0); |
|
46
|
0
|
0
|
|
|
|
|
if(! $sock) { |
|
47
|
0
|
|
|
|
|
|
say "server: Cannot create self socket"; |
|
48
|
0
|
|
|
|
|
|
return undef; |
|
49
|
|
|
|
|
|
|
} |
|
50
|
|
|
|
|
|
|
|
|
51
|
0
|
0
|
|
|
|
|
if(! $sock->setsockopt( SOL_SOCKET, SO_KEEPALIVE, 1)) { |
|
52
|
0
|
|
|
|
|
|
say "server: cannot setsockopt"; |
|
53
|
0
|
|
|
|
|
|
return undef; |
|
54
|
|
|
|
|
|
|
} |
|
55
|
0
|
|
|
|
|
|
my $TCP_KEEPIDLE = 4; |
|
56
|
0
|
|
|
|
|
|
my $TCP_KEEPINTVL = 5; |
|
57
|
0
|
|
|
|
|
|
my $TCP_KEEPCNT = 6; |
|
58
|
0
|
|
|
|
|
|
my $TCP_USER_TIMEOUT = 18; |
|
59
|
|
|
|
|
|
|
#$SERVER->setsockopt(IPPROTO_TCP, $TCP_KEEPIDLE, 1) or die; |
|
60
|
|
|
|
|
|
|
#$SERVER->setsockopt(IPPROTO_TCP, $TCP_KEEPINTVL, 1) or die; |
|
61
|
|
|
|
|
|
|
#$SERVER->setsockopt(IPPROTO_TCP, $TCP_KEEPCNT, 10) or die; |
|
62
|
|
|
|
|
|
|
#$SERVER->setsockopt(IPPROTO_TCP, $TCP_USER_TIMEOUT, 10000) or die; #doesn't work? |
|
63
|
|
|
|
|
|
|
#$SERVER->setsockopt(SOL_SOCKET, SO_LINGER, pack("II",1,0)) or die; #to stop last ack |
|
64
|
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
# leaving Nagle's algorithm enabled for now as sometimes headers are sent without data |
|
66
|
|
|
|
|
|
|
#$sock->setsockopt(IPPROTO_TCP, TCP_NODELAY, 1) or die("Failed to set TCP_NODELAY"); |
|
67
|
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
# linux specific settings. Check in BEGIN? |
|
69
|
0
|
0
|
|
|
|
|
if(index($Config{osname}, 'linux') != -1) { |
|
70
|
1
|
|
|
1
|
|
9
|
use Socket qw(TCP_QUICKACK); |
|
|
1
|
|
|
|
|
3
|
|
|
|
1
|
|
|
|
|
1754
|
|
|
71
|
0
|
0
|
|
|
|
|
$sock->setsockopt(IPPROTO_TCP, TCP_QUICKACK, 1) or die("Failed to set TCP_QUICKACK"); |
|
72
|
|
|
|
|
|
|
} |
|
73
|
0
|
|
|
|
|
|
my $evp = MHFS::EventLoop::Poll->new; |
|
74
|
0
|
|
|
0
|
|
|
my %self = ( 'settings' => $settings, 'routes' => $routes, 'route_default' => sub { $_[0]->SendDirectory($settings->{'DOCUMENTROOT'}); }, 'plugins' => $plugins, 'sock' => $sock, 'evp' => $evp, 'uploaders' => [], 'sesh' => |
|
|
0
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
{ 'newindex' => 0, 'sessions' => {}}, 'resources' => {}, 'loaded_plugins' => {}); |
|
76
|
0
|
|
|
|
|
|
bless \%self, $class; |
|
77
|
|
|
|
|
|
|
|
|
78
|
0
|
|
|
|
|
|
$evp->set($sock, \%self, POLLIN); |
|
79
|
|
|
|
|
|
|
|
|
80
|
0
|
|
|
|
|
|
my $fs = MHFS::FS->new($settings->{'SOURCES'}); |
|
81
|
0
|
0
|
|
|
|
|
if(! $fs) { |
|
82
|
0
|
|
|
|
|
|
say "failed to open MHFS::FS"; |
|
83
|
0
|
|
|
|
|
|
return undef; |
|
84
|
|
|
|
|
|
|
} |
|
85
|
0
|
|
|
|
|
|
$self{'fs'} = $fs; |
|
86
|
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
# load the plugins |
|
88
|
0
|
|
|
|
|
|
foreach my $pluginname (@{$plugins}) { |
|
|
0
|
|
|
|
|
|
|
|
89
|
0
|
0
|
|
|
|
|
eval "use $pluginname; 1;" or do { |
|
90
|
0
|
|
|
|
|
|
say __PACKAGE__.": module $pluginname not found!"; |
|
91
|
0
|
|
|
|
|
|
next; |
|
92
|
|
|
|
|
|
|
}; |
|
93
|
0
|
0
|
0
|
|
|
|
next if(defined $settings->{$pluginname}{'enabled'} && (!$settings->{$pluginname}{'enabled'})); |
|
94
|
0
|
|
|
|
|
|
my $plugin = $pluginname->new($settings, \%self); |
|
95
|
0
|
0
|
|
|
|
|
next if(! $plugin); |
|
96
|
|
|
|
|
|
|
|
|
97
|
0
|
|
|
|
|
|
foreach my $timer (@{$plugin->{'timers'}}) { |
|
|
0
|
|
|
|
|
|
|
|
98
|
0
|
|
|
|
|
|
say __PACKAGE__.': adding '.ref($plugin).' timer'; |
|
99
|
0
|
|
|
|
|
|
$self{'evp'}->add_timer(@{$timer}); |
|
|
0
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
} |
|
101
|
0
|
0
|
|
|
|
|
if(my $func = $plugin->{'uploader'}) { |
|
102
|
0
|
|
|
|
|
|
say __PACKAGE__.': adding '. ref($plugin) .' uploader'; |
|
103
|
0
|
|
|
|
|
|
push (@{$self{'uploaders'}}, $func); |
|
|
0
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
} |
|
105
|
0
|
|
|
|
|
|
foreach my $route (@{$plugin->{'routes'}}) { |
|
|
0
|
|
|
|
|
|
|
|
106
|
0
|
|
|
|
|
|
say __PACKAGE__.': adding ' . ref($plugin) . ' route ' . $route->[0]; |
|
107
|
0
|
|
|
|
|
|
push @{$self{'routes'}}, $route; |
|
|
0
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
} |
|
109
|
0
|
|
|
|
|
|
$plugin->{'server'} = \%self; |
|
110
|
0
|
|
|
|
|
|
$self{'loaded_plugins'}{$pluginname} = $plugin; |
|
111
|
|
|
|
|
|
|
} |
|
112
|
|
|
|
|
|
|
|
|
113
|
0
|
|
|
|
|
|
$evp->run(); |
|
114
|
|
|
|
|
|
|
|
|
115
|
0
|
|
|
|
|
|
return \%self; |
|
116
|
|
|
|
|
|
|
} |
|
117
|
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
sub GetTextResource { |
|
119
|
0
|
|
|
0
|
0
|
|
my ($self, $filename) = @_; |
|
120
|
0
|
|
0
|
|
|
|
$self->{'resources'}{$filename} //= read_text_file($filename); |
|
121
|
0
|
|
|
|
|
|
return \$self->{'resources'}{$filename}; |
|
122
|
|
|
|
|
|
|
} |
|
123
|
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
sub onReadReady { |
|
125
|
0
|
|
|
0
|
0
|
|
my ($server) = @_; |
|
126
|
|
|
|
|
|
|
# accept the connection |
|
127
|
0
|
|
|
|
|
|
my $csock = $server->{'sock'}->accept(); |
|
128
|
0
|
0
|
|
|
|
|
if(! $csock) { |
|
129
|
0
|
|
|
|
|
|
say "server: cannot accept client"; |
|
130
|
0
|
|
|
|
|
|
return 1; |
|
131
|
|
|
|
|
|
|
} |
|
132
|
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
# gather connection details and verify client host is acceptable |
|
134
|
0
|
|
|
|
|
|
my $peerhost = $csock->peerhost(); |
|
135
|
0
|
0
|
|
|
|
|
if(! $peerhost) { |
|
136
|
0
|
|
|
|
|
|
say "server: no peerhost"; |
|
137
|
0
|
|
|
|
|
|
return 1; |
|
138
|
|
|
|
|
|
|
} |
|
139
|
0
|
|
|
|
|
|
my $peerip = do { |
|
140
|
0
|
|
|
|
|
|
try { parse_ipv4($peerhost) } |
|
|
0
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
catch ($e) { |
|
142
|
0
|
|
|
|
|
|
say "server: error parsing ip $peerhost"; |
|
143
|
0
|
|
|
|
|
|
return 1; |
|
144
|
|
|
|
|
|
|
} |
|
145
|
|
|
|
|
|
|
}; |
|
146
|
0
|
|
|
|
|
|
my $ah; |
|
147
|
0
|
|
|
|
|
|
foreach my $allowedHost (@{$server->{'settings'}{'ARIPHOSTS_PARSED'}}) { |
|
|
0
|
|
|
|
|
|
|
|
148
|
0
|
0
|
|
|
|
|
if(($peerip & $allowedHost->{'subnetmask'}) == $allowedHost->{'ip'}) { |
|
149
|
0
|
|
|
|
|
|
$ah = $allowedHost; |
|
150
|
0
|
|
|
|
|
|
last; |
|
151
|
|
|
|
|
|
|
} |
|
152
|
|
|
|
|
|
|
} |
|
153
|
0
|
0
|
|
|
|
|
if(!$ah) { |
|
154
|
0
|
|
|
|
|
|
say "server: $peerhost not allowed"; |
|
155
|
0
|
|
|
|
|
|
return 1; |
|
156
|
|
|
|
|
|
|
} |
|
157
|
0
|
|
|
|
|
|
my $peerport = $csock->peerport(); |
|
158
|
0
|
0
|
|
|
|
|
if(! $peerport) { |
|
159
|
0
|
|
|
|
|
|
say "server: no peerport"; |
|
160
|
0
|
|
|
|
|
|
return 1; |
|
161
|
|
|
|
|
|
|
} |
|
162
|
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
# finally create the client |
|
164
|
0
|
|
|
|
|
|
say "-------------------------------------------------"; |
|
165
|
0
|
|
|
|
|
|
say "NEW CONN " . $peerhost . ':' . $peerport; |
|
166
|
0
|
|
|
|
|
|
my $cref = MHFS::HTTP::Server::Client->new($csock, $server, $ah, $peerip); |
|
167
|
0
|
|
|
|
|
|
return 1; |
|
168
|
|
|
|
|
|
|
} |
|
169
|
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
1; |