File Coverage

blib/lib/MHFS/Settings.pm
Criterion Covered Total %
statement 41 245 16.7
branch 0 108 0.0
condition 0 104 0.0
subroutine 14 18 77.7
pod 0 4 0.0
total 55 479 11.4


line stmt bran cond sub pod time code
1             package MHFS::Settings v0.7.0;
2 1     1   45 use 5.014;
  1         6  
3 1     1   7 use strict; use warnings;
  1     1   2  
  1         32  
  1         6  
  1         2  
  1         80  
4 1     1   8 use feature 'say';
  1         2  
  1         180  
5 1     1   9 use Scalar::Util qw(reftype);
  1         28  
  1         140  
6 1     1   10 use MIME::Base64 qw(encode_base64url);
  1         2  
  1         68  
7 1     1   7 use File::Basename;
  1         3  
  1         94  
8 1     1   7 use Digest::MD5 qw(md5);
  1         3  
  1         73  
9 1     1   8 use Storable qw(freeze);
  1         3  
  1         105  
10 1     1   10 use Cwd qw(abs_path);
  1         2  
  1         102  
11 1     1   806 use File::ShareDir qw(dist_dir);
  1         40855  
  1         89  
12 1     1   11 use File::Path qw(make_path);
  1         2  
  1         68  
13 1     1   591 use File::Spec::Functions qw(rel2abs);
  1         1142  
  1         98  
14 1     1   9 use MHFS::Util qw(write_text_file parse_ipv4);
  1         2  
  1         4040  
15              
16             sub write_settings_file {
17 0     0 0   my ($SETTINGS, $filepath) = @_;
18 0           my $indentcnst = 4;
19 0           my $indentspace = '';
20 0           my $settingscontents = "#!/usr/bin/perl\nuse strict; use warnings;\n\nmy \$SETTINGS = ";
21              
22             # we only encode SCALARS. Loop through expanding HASH and ARRAY refs into SCALARS
23 0           my @values = ($SETTINGS);
24 0           while(@values) {
25 0           my $value = shift @values;
26 0           my $type = reftype($value);
27 0   0       say "value: $value type: " . ($type // 'undef');
28 0           my $raw;
29             my $noindent;
30 0 0         if(! defined $type) {
31 0 0         if(defined $value) {
32             # process lead control code if provided
33 0           $raw = ($value eq '__raw');
34 0           $noindent = ($value eq '__noindent');
35 0 0 0       if($raw || $noindent) {
36 0           $value = shift @values;
37             }
38             }
39              
40 0 0         if(! defined $value) {
    0          
41 0           $raw = 1;
42 0           $value = 'undef';
43 0           $type = 'SCALAR';
44             }
45             elsif($value eq '__indent-') {
46 0           substr($indentspace, -4, 4, '');
47             # don't actually encode anything
48 0           $value = '';
49 0           $type = 'NOP';
50             }
51             else {
52 0   0       $type = reftype($value) // 'SCALAR';
53             }
54             }
55              
56 0           say "v2: $value type $type";
57 0 0         if($type eq 'NOP') {
58 0           next;
59             }
60              
61 0 0         $settingscontents .= $indentspace if(! $noindent);
62 0 0         if($type eq 'SCALAR') {
    0          
    0          
63             # encode the value
64 0 0         if(! $raw) {
65 0           $value =~ s/'/\\'/g;
66 0           $value = "'".$value."'";
67             }
68              
69             # add the value to the buffer
70 0           $settingscontents .= $value;
71 0 0         $settingscontents .= ",\n" if(! $raw);
72             }
73             elsif($type eq 'HASH') {
74 0           $settingscontents .= "{\n";
75 0           $indentspace .= (' ' x $indentcnst);
76 0           my @toprepend;
77 0           foreach my $key (keys %{$value}) {
  0            
78 0           push @toprepend, '__raw', "'$key' => ", '__noindent', $value->{$key};
79             }
80 0           push @toprepend, '__indent-', '__raw', "},\n";
81 0           unshift(@values, @toprepend);
82             }
83             elsif($type eq 'ARRAY') {
84 0           $settingscontents .= "[\n";
85 0           $indentspace .= (' ' x $indentcnst);
86 0           my @toprepend = @{$value};
  0            
87 0           push @toprepend, '__indent-', '__raw', "],\n";
88 0           unshift(@values, @toprepend);
89             }
90             else {
91 0           die("Unknown type: $type");
92             }
93             }
94 0           chop $settingscontents;
95 0           chop $settingscontents;
96 0           $settingscontents .= ";\n\n\$SETTINGS;\n";
97 0           say "making settings folder $filepath";
98 0           make_path(dirname($filepath));
99 0           write_text_file($filepath, $settingscontents);
100             }
101              
102             sub calc_source_id {
103 0     0 0   my ($source) = @_;
104 0 0         if($source->{'type'} ne 'local') {
105 0           say "only local sources supported right now";
106 0           return undef;
107             }
108 0           return encode_base64url(md5('local:'.$source->{folder}));
109             }
110              
111             sub add_source {
112 0     0 0   my ($sources, $source) = @_;
113 0           my $id = calc_source_id($source);
114 0           my $len = 6;
115 0           my $shortid = substr($id, 0, $len);
116 0 0         if (exists $sources->{$shortid}) {
117 0           my $oldid = calc_source_id($sources->{$shortid});
118 0           while(1) {
119 0           $len++;
120 0 0         substr($oldid, 0, $len) eq substr($id, 0, $len) or last;
121 0 0         length($id) > $len or die "matching hash";
122             }
123 0           $sources->{substr($oldid, 0, $len)} = $sources->{$shortid};
124 0           delete $sources->{$shortid};
125 0           $shortid = substr($id, 0, $len);
126             }
127 0           $sources->{$shortid} = $source;
128 0           return $shortid;
129             }
130              
131             sub load {
132 0     0 0   my ($launchsettings) = @_;
133 0           my $scriptpath = abs_path(__FILE__);
134              
135             # settings are loaded with the following precedence
136             # $launchsettings (@ARGV) > settings.pl > General environment vars
137             # Directory preference goes from declared to defaults and specific to general:
138             # For example $CFGDIR > $XDG_CONFIG_HOME > $XDG_CONFIG_DIRS > $FALLBACK_DATA_ROOT
139              
140             # load in the launchsettings
141 0           my ($CFGDIR, $APPDIR, $FALLBACK_DATA_ROOT);
142 0 0         if(exists $launchsettings->{CFGDIR}) {
143 0           make_path($launchsettings->{CFGDIR});
144 0           $CFGDIR = $launchsettings->{CFGDIR};
145             }
146 0 0         if(exists $launchsettings->{APPDIR}) {
147 0 0         -d $launchsettings->{APPDIR} or die("Bad APPDIR provided");
148 0           $APPDIR = $launchsettings->{APPDIR};
149             }
150 0 0         if(exists $launchsettings->{FALLBACK_DATA_ROOT}) {
151 0           make_path($launchsettings->{FALLBACK_DATA_ROOT});
152 0           $FALLBACK_DATA_ROOT = $launchsettings->{FALLBACK_DATA_ROOT};
153             }
154              
155             # determine the settings dir
156 0 0         if(! $CFGDIR){
157 0   0       my $cfg_fallback = $FALLBACK_DATA_ROOT // $ENV{'HOME'};
158 0 0 0       $cfg_fallback //= ($ENV{APPDATA}.'/mhfs') if($ENV{APPDATA}); # Windows
159             # set the settings dir to the first that exists of $XDG_CONFIG_HOME and $XDG_CONFIG_DIRS
160             # https://specifications.freedesktop.org/basedir-spec/basedir-spec-latest.html
161 0           my $XDG_CONFIG_HOME = $ENV{'XDG_CONFIG_HOME'};
162 0 0 0       $XDG_CONFIG_HOME //= ($cfg_fallback . '/.config') if($cfg_fallback);
163 0           my @configdirs;
164 0 0         push @configdirs, $XDG_CONFIG_HOME if($XDG_CONFIG_HOME);
165 0   0       my $XDG_CONFIG_DIRS = $ENV{'XDG_CONFIG_DIRS'} || '/etc/xdg';
166 0           push @configdirs, split(':', $XDG_CONFIG_DIRS);
167 0           foreach my $cfgdir (@configdirs) {
168 0 0         if(-d "$cfgdir/mhfs") {
169 0           $CFGDIR = "$cfgdir/mhfs";
170 0           last;
171             }
172             }
173 0 0 0       $CFGDIR //= ($XDG_CONFIG_HOME.'/mhfs') if($XDG_CONFIG_HOME);
174 0 0         defined($CFGDIR) or die("Failed to find valid candidate for \$CFGDIR");
175             }
176 0           $CFGDIR = rel2abs($CFGDIR);
177              
178             # load from the settings file
179 0           my $SETTINGS_FILE = rel2abs($CFGDIR . '/settings.pl');
180 0           my $SETTINGS = do ($SETTINGS_FILE);
181 0 0         if(! $SETTINGS) {
182 0 0         die "Error parsing settingsfile: $@" if($@);
183 0 0         die "Cannot read settingsfile: $!" if(-e $SETTINGS_FILE);
184 0           warn("No settings file found, using default settings");
185 0           $SETTINGS = {};
186             }
187              
188             # load defaults for unset values
189 0   0       $SETTINGS->{'HOST'} ||= "127.0.0.1";
190 0   0       $SETTINGS->{'PORT'} ||= 8000;
191              
192 0   0       $SETTINGS->{'ALLOWED_REMOTEIP_HOSTS'} ||= [
193             ['127.0.0.1'],
194             ];
195              
196             # write the default settings
197 0 0         if(! -f $SETTINGS_FILE) {
198 0           write_settings_file($SETTINGS, $SETTINGS_FILE);
199             }
200 0           $SETTINGS->{'CFGDIR'} = $CFGDIR;
201 0 0         $SETTINGS->{flush} = $launchsettings->{flush} if(exists $launchsettings->{flush});
202              
203             # locate files based on appdir
204 0   0       $APPDIR ||= $SETTINGS->{'APPDIR'} || dist_dir('App-MHFS');
      0        
205 0           $APPDIR = abs_path($APPDIR);
206 0           say __PACKAGE__.": using APPDIR " . $APPDIR;
207 0           $SETTINGS->{'APPDIR'} = $APPDIR;
208              
209             # determine the fallback data root
210 0   0       $FALLBACK_DATA_ROOT ||= $SETTINGS->{'FALLBACK_DATA_ROOT'} || $ENV{'HOME'};
      0        
211 0 0 0       $FALLBACK_DATA_ROOT ||= ($ENV{APPDATA}.'/mhfs') if($ENV{APPDATA}); # Windows
212 0 0         if($FALLBACK_DATA_ROOT) {
213 0           $FALLBACK_DATA_ROOT = abs_path($FALLBACK_DATA_ROOT);
214             }
215             # determine the allowed remoteip host combos. only ipv4 now sorry
216 0           $SETTINGS->{'ARIPHOSTS_PARSED'} = [];
217 0           foreach my $rule (@{$SETTINGS->{'ALLOWED_REMOTEIP_HOSTS'}}) {
  0            
218             # parse IPv4 with optional CIDR
219 0 0         $rule->[0] =~ /^([^\/]+)(?:\/(\d{1,2}))?$/ or die("Invalid rule: " . $rule->[0]);
220 0   0       my $ipstr = $1; my $cidr = $2 // 32;
  0            
221 0           my $ip = parse_ipv4($ipstr);
222 0 0 0       $cidr >= 0 && $cidr <= 32 or die("Invalid rule: " . $rule->[0]);
223 0           my $mask = (0xFFFFFFFF << (32-$cidr)) & 0xFFFFFFFF;
224 0           my %ariphost = (
225             'ip' => $ip,
226             'subnetmask' => $mask
227             );
228             # store the server hostname if verification is required for this rule
229 0 0         $ariphost{'hostname'} = $rule->[1] if($rule->[1]);
230             # store overriding absurl from this host if provided
231 0 0         if($rule->[2]) {
232 0           my $absurl = $rule->[2];
233 0 0         chop $absurl if(index($absurl, '/', length($absurl)-1) != -1);
234 0           $ariphost{'absurl'} = $absurl;
235             }
236             # store whether to trust connections with this host
237 0 0         if($rule->[3]) {
238 0           $ariphost{'X-MHFS-PROXY-KEY'} = $rule->[3];
239             }
240 0           push @{ $SETTINGS->{'ARIPHOSTS_PARSED'}}, \%ariphost;
  0            
241             }
242              
243 0 0         if( ! $SETTINGS->{'DOCUMENTROOT'}) {
244 0           $SETTINGS->{'DOCUMENTROOT'} = "$APPDIR/public_html";
245             }
246 0   0       $SETTINGS->{'XSEND'} //= 0;
247 0           my $tmpdir = $SETTINGS->{'TMPDIR'};
248 0 0 0       $tmpdir ||= ($ENV{'XDG_CACHE_HOME'}.'/mhfs') if($ENV{'XDG_CACHE_HOME'});
249 0 0 0       $tmpdir ||= "$FALLBACK_DATA_ROOT/.cache/mhfs" if($FALLBACK_DATA_ROOT);
250 0 0         defined($tmpdir) or die("Failed to find valid candidate for \$tmpdir");
251 0           delete $SETTINGS->{'TMPDIR'}; # Use specific temp dir instead
252 0 0         if(!$SETTINGS->{'RUNTIME_DIR'} ) {
253 0           my $RUNTIMEDIR = $ENV{'XDG_RUNTIME_DIR'};
254 0 0         if(! $RUNTIMEDIR ) {
255 0           $RUNTIMEDIR = $tmpdir;
256 0           warn("XDG_RUNTIME_DIR not defined!, using $RUNTIMEDIR instead");
257             }
258 0           $SETTINGS->{'RUNTIME_DIR'} = $RUNTIMEDIR.'/mhfs';
259             }
260 0           my $datadir = $SETTINGS->{'DATADIR'};
261 0 0 0       $datadir ||= ($ENV{'XDG_DATA_HOME'}.'/mhfs') if($ENV{'XDG_DATA_HOME'});
262 0 0 0       $datadir ||= "$FALLBACK_DATA_ROOT/.local/share/mhfs" if($FALLBACK_DATA_ROOT);
263 0 0         defined($datadir) or die("Failed to find valid candidate for \$datadir");
264 0           $SETTINGS->{'DATADIR'} = $datadir;
265 0   0       $SETTINGS->{'MHFS_TRACKER_TORRENT_DIR'} ||= $SETTINGS->{'DATADIR'}.'/torrent';
266 0   0       $SETTINGS->{'VIDEO_TMPDIR'} ||= $tmpdir.'/video';
267 0   0       $SETTINGS->{'MUSIC_TMPDIR'} ||= $tmpdir.'/music';
268 0   0       $SETTINGS->{'GENERIC_TMPDIR'} ||= $tmpdir.'/tmp';
269 0   0       $SETTINGS->{'SECRET_TMPDIR'} ||= $tmpdir.'/secret';
270             $SETTINGS->{'MEDIALIBRARIES'}{'movies'} ||= $SETTINGS->{'DOCUMENTROOT'} . "/media/movies",
271             $SETTINGS->{'MEDIALIBRARIES'}{'tv'} ||= $SETTINGS->{'DOCUMENTROOT'} . "/media/tv",
272 0   0       $SETTINGS->{'MEDIALIBRARIES'}{'music'} ||= $SETTINGS->{'DOCUMENTROOT'} . "/media/music",
      0        
      0        
273             my %sources;
274 0           my %mediasources;
275 0           foreach my $lib ('movies', 'tv', 'music') {
276 0           my $srcs = $SETTINGS->{'MEDIALIBRARIES'}{$lib};
277 0 0         if(ref($srcs) ne 'ARRAY') {
278 0           $srcs = [$srcs];
279             }
280 0           my @subsrcs;
281 0           foreach my $source (@$srcs) {
282 0           my $stype = ref($source);
283 0           my $tohash = $source;
284 0 0         if($stype ne 'HASH') {
285 0 0         if($stype ne '') {
286 0           say __PACKAGE__.": skipping source";
287 0           next;
288             }
289 0           $tohash = {type => 'local', folder => $source};
290             }
291 0 0         if ($tohash->{type} eq 'local') {
292 0           my $absfolder = abs_path($tohash->{folder});
293 0   0       $absfolder // do {
294 0           say __PACKAGE__.": skipping source $tohash->{folder} - abs_path failed";
295 0           next;
296             };
297 0           $tohash->{folder} = $absfolder;
298             }
299 0           my $sid = add_source(\%sources, $tohash);
300 0           push @subsrcs, $sid;
301             }
302 0           $mediasources{$lib} = \@subsrcs;
303             }
304 0           $SETTINGS->{'MEDIASOURCES'} = \%mediasources;
305              
306 0           my $videotmpdirsrc = {type => 'local', folder => $SETTINGS->{'VIDEO_TMPDIR'}};
307 0           my $vtempsrcid = add_source(\%sources, $videotmpdirsrc);
308 0           $SETTINGS->{'VIDEO_TMPDIR_QS'} = 'sid='.$vtempsrcid;
309 0           $SETTINGS->{'SOURCES'} = \%sources;
310              
311 0   0       $SETTINGS->{'BINDIR'} ||= $APPDIR . '/bin';
312 0   0       $SETTINGS->{'DOCDIR'} ||= $APPDIR . '/doc';
313              
314             # specify timeouts in seconds
315 0   0       $SETTINGS->{'TIMEOUT'} ||= 75;
316             # time to recieve the requestline and headers before closing the conn
317 0   0       $SETTINGS->{'recvrequestimeout'} ||= 10;
318             # maximum time allowed between sends
319 0   0       $SETTINGS->{'sendresponsetimeout'} ||= $SETTINGS->{'TIMEOUT'};
320              
321 0 0 0       $SETTINGS->{'Torrent'}{'pyroscope'} ||= $FALLBACK_DATA_ROOT .'/.local/pyroscope' if($FALLBACK_DATA_ROOT);
322              
323 0           return $SETTINGS;
324             }
325              
326             1;