File Coverage

blib/lib/FR24/Utils.pm
Criterion Covered Total %
statement 78 147 53.0
branch 27 70 38.5
condition 8 12 66.6
subroutine 10 15 66.6
pod 7 9 77.7
total 130 253 51.3


line stmt bran cond sub pod time code
1             #ABSTRACT: Subroutines for FR24-Bot
2 7     7   3102 use v5.12;
  7         34  
3 7     7   37 use warnings;
  7         27  
  7         250  
4             package FR24::Utils;
5 7     7   3129 use JSON::PP;
  7         58424  
  7         497  
6 7     7   55 use Exporter qw(import);
  7         11  
  7         194  
7 7     7   3058 use HTTP::Tiny;
  7         170501  
  7         276  
8 7     7   2048 use File::Which;
  7         3945  
  7         12909  
9             # Export version
10             our @EXPORT = qw($VERSION);
11             our @EXPORT_OK = qw(loadconfig saveconfig url_exists authorized parse_flights systeminfo);
12              
13             sub fr24_installed {
14 0     0 1 0 my $cmd = qq(fr24feed-status);
15 0         0 my $fr24feed_status = which($cmd);
16 0 0       0 if (!defined $fr24feed_status) {
17 0         0 return 0;
18             }
19 0         0 return $fr24feed_status;
20             }
21             sub fr24_info {
22             # [ ok ] FR24 Feeder/Decoder Process: running.
23             # [ ok ] FR24 Stats Timestamp: 2023-07-13 06:39:30.
24             # [ ok ] FR24 Link: connected [UDP].
25             # [ ok ] FR24 Radar: T-EGSH204.
26             # [ ok ] FR24 Tracked AC: 31.
27             # [ ok ] Receiver: connected (28824914 MSGS/0 SYNC).
28             # [ ok ] FR24 MLAT: ok [UDP].
29             # [ ok ] FR24 MLAT AC seen: 27.
30 0     0 1 0 my $info = {
31             'radar' => 0,
32             'seen' => 0,
33             'tracked' => 0,
34             'connected' => 0,
35             'running' => 0,
36             };
37 0 0       0 return $info if !fr24_installed();
38 0         0 my $cmd = qq(fr24feed-status);
39 0         0 my @output = `$cmd`;
40 0         0 for my $line (@output) {
41 0         0 chomp $line;
42 0 0       0 if ($line =~ /FR24 Radar: (.*)/) {
43 0         0 $info->{'radar'} = $1;
44             }
45 0 0       0 if ($line =~ /FR24 Tracked AC: (.*)/) {
46 0         0 $info->{'tracked'} = $1;
47             }
48 0 0       0 if ($line =~ /FR24 Stats Timestamp: (.*)/) {
49 0         0 $info->{'timestamp'} = $1;
50             }
51 0 0       0 if ($line =~ /FR24 Link: (.*)/) {
52 0         0 $info->{'connected'} = $1;
53             }
54 0 0       0 if ($line =~ /FR24 MLAT AC seen: (.*)/) {
55 0         0 $info->{'seen'} = $1;
56             }
57 0 0       0 if ($line =~ /FR24 Feeder\/Decoder Process: (.*)/) {
58 0         0 $info->{'running'} = $1;
59             }
60             }
61             }
62             sub parse_flights {
63 3     3 1 632 my ($json_text, $test) = @_;
64 3 100 66     22 if (defined $test and $test > 0) {
65 2         4 $json_text = '{"485789":["485789",51.94,0.9666,64.76496,38275,539,"6250",0,"","",1689143721,"","","",false,-1216,"KLM100"],"4067ef":["4067ef",0,0,0,37000,0,"0000",0,"","",1689143713,"","","",false,0,""],"4bb28f":["4bb28f",0,0,96.47746,19450,460,"4730",0,"","",1689143721,"","","",false,2240,""],"4cac55":["4cac55",0,0,0,34175,488,"3416",0,"","",1689143721,"","","",false,960,""],"3c5eee":["3c5eee",0,0,0,11775,0,"0000",0,"","",1689143665,"","","",false,0,""],"4ca848":["4ca848",51.35,1.024,90.472534,26025,482,"0572",0,"","",1689143719,"","","",false,-992,"RYR60UD"],"40775c":["40775c",53.42,-1.145,101.46763,23475,429,"3426",0,"","",1689143722,"","","",false,2112,"RUK000"],"406d4e":["406d4e",0,0,123.77186,16475,388,"6226",0,"","",1689143698,"","","",false,-1472,""],"4d21ee":["4d21ee",51.99,1.463,65.96107,25875,464,"3460",0,"","",1689143712,"","","",false,2176,"RYR000"],"4070e1":["4070e1",53.92,-1.082,139.22684,30100,478,"3446",0,"","",1689143721,"","","",false,2304,"EXS000"],"4791a0":["4791a0",51.94,1.264,73.30076,39225,512,"6241",0,"","",1689143722,"","","",false,640,"MDT000"],"4ca640":["4ca640",53.23,-0.6868,96.604836,34975,478,"4646",0,"","",1689143719,"","","",false,-64,"EIN000"],"4cadf4":["4cadf4",53.9,-0.5286,119.27368,37000,482,"3451",0,"","",1689143721,"","","",false,0,"RYR000"],"406d90":["406d90",0,0,0,21000,0,"3423",0,"","",1689143706,"","","",false,0,""],"4079f7":["4079f7",51.7,0.9323,263.7267,15700,276,"4632",0,"","",1689143707,"","","",false,-1536,"BAW000"],"4019f0":["4019f0",0,0,0,2300,0,"7000",0,"","",1689143721,"","","",false,0,""],"4076b1":["4076b1",52.36,0.4034,92.24087,32300,500,"4740",0,"","",1689143712,"","","",false,1184,"TOM000"],"4ca621":["4ca621",52.32,0.2067,100.06673,26950,451,"4653",0,"","",1689143722,"","","",false,1728,"RYR000"],"40769a":["40769a",52.24,1.311,99.09946,32450,500,"4741",0,"","",1689143722,"","","",false,896,"TOM000"],"3c6753":["3c6753",53.29,0.1518,279.62204,36000,413,"2544",0,"","",1689143722,"","","",false,0,"DLH000"],"40756e":["40756e",53.2,-0.1399,103.48089,25050,450,"6342",0,"","",1689143722,"","","",false,0,"EZY000"],"aaf968":["aaf968",53,1.002,96.21782,36950,518,"6315",0,"","",1689143721,"","","",false,-2560,"DAL000"],"40799b":["40799b",0,0,0,37700,0,"4447",0,"","",1689143719,"","","",false,0,""],"471f35":["471f35",0,0,276.65442,13275,241,"6605",0,"","",1689143689,"","","",false,-64,"WZZ000"],"485e30":["485e30",53.01,0.8713,110.196785,34850,503,"6251",0,"","",1689143722,"","","",false,-1344,"KLM000"],"ab4c1d":["ab4c1d",52.77,1.862,85.17478,27300,462,"6330",0,"","",1689143672,"","","",false,-960,"DAL000"],"3c6708":["3c6708",53.21,0.913,110.19787,43000,524,"2027",0,"","",1689143717,"","","",false,0,"DLH000"],"a4ffb7":["a4ffb7",0,0,98.704956,26850,420,"6312",0,"","",1689143674,"","","",false,-960,"DAL000"]}';
66             }
67 3         13 my $answer = {
68             'status' => 'UNKNOWN',
69             'id' => 0,
70             'total' => 0,
71             'uploaded' => 0,
72             'data' => {},
73             'raw' => {},
74             'callsigns' => {},
75             };
76              
77 3 50       9 if (length($json_text) == 0) {
78 0         0 return $answer;
79             }
80              
81 3         20 my $json = JSON::PP->new->utf8->pretty->canonical;
82 3         458 my $json_data;
83 3         8 eval {
84 3         11 $json_data = $json->decode($json_text);
85             };
86 3 100       66311 if ($@) {
87 1         3 $answer->{'status'} = 'JSON_ERROR';
88 1         11 return $answer;
89             }
90              
91 2         5 $answer->{'status'} = 'OK';
92 2 50       6 $answer->{'total'} = scalar keys %{$json_data} if defined $json_data;
  2         17  
93            
94 2 50       7 if (not defined $json_data) {
95 0         0 return $answer;
96             }
97 2         5 for my $flight (sort keys %{$json_data}) {
  2         26  
98              
99 56         87 my $info = $json_data->{$flight};
100 56         229 my $flight_hash = {
101             'id' => $flight,
102             'lat' => 0 + $info->[1],
103             'long' => 0 +$info->[2],
104             'alt' => 0 + $info->[4],
105             'callsign' => $info->[16],
106             };
107             #my $FLIGHT_ID = $flight;
108             #if (length($info->[16]) > 0) {
109             # $answer->{'uploaded'}++;
110             # #TODO - check duplicates
111             # $FLIGHT_ID = $info->[16];
112             #}
113            
114 56         97 $answer->{'data'}->{$flight} = $flight_hash;
115 56         70 $answer->{'raw'}->{$flight} = $info;
116 56 100       156 $answer->{'callsigns'}->{$info->[16]} = $flight if ( length($info->[16]) > 0 );
117             }
118 2         30 return $answer;
119             }
120              
121              
122              
123             sub loadconfig {
124 6     6 1 2299 my $filename = shift;
125 6 50       135 if (! -e "$filename") {
126 0         0 return {};
127             }
128 6 50       259 open my $fh, '<', $filename or Carp::croak "Can't open $filename: $!";
129 6         33 my $config = {
130             'server' => {
131             'ip' => 'localhost',
132             },
133             'users' => {
134             'everyone' => 1,
135             },
136             };
137              
138 6         14 my $section = "default";
139 6         230 while (my $line = readline($fh)) {
140 58         99 chomp $line;
141            
142             # Skip comment lines
143            
144 58 50       108 next if $line =~ /^#/;
145 58 100       234 if ($line =~ /^\[(.*)\]$/) {
    100          
146 18         64 $config->{lc("$1")} = {};
147 18         39 $section = lc("$1");
148 18         54 next;
149             } elsif ($line =~/=/) {
150 24         71 my ($key, $value) = split /=/, $line;
151 24         119 $config->{"$section"}->{lc("$key")} = $value;
152             }
153            
154             }
155 6         106 return $config;
156             }
157              
158             sub authorized {
159 9     9 1 3608 my ($config, $user) = @_;
160 9         36 my $authorized = 0;
161 9 50       26 return $authorized if !defined $user;
162 9 100       52 return $authorized if $user !~ /^[0-9]+$/;
163             # If there is no "users" section, everyone is authorized
164 8 50       19 if (!defined $config->{'users'}) {
165 0         0 print STDERR "[WARNING] Bad configuration file: no 'users' section\n";
166 0         0 return 1;
167             }
168 8 100       18 if (defined $config->{'users'}->{'everyone'}) {
169 4         7 $authorized = 1;
170             }
171 8 100 100     31 if (defined $config->{'users'}->{$user} and $config->{'users'}->{$user} == 1 ) {
172 1         3 $authorized = 1;
173             }
174             # Banned?
175 8 100 100     25 if (defined $config->{'users'}->{$user} and $config->{'users'}->{$user} == 0 ) {
176 2         4 $authorized = 0;
177             }
178 8         18 return $authorized;
179             }
180             sub saveconfig {
181 1     1 1 3650 my ($filename, $config) = @_;
182 1 50       119 open my $fh, '>', $filename or Carp::croak "Can't open $filename: $!";
183              
184 1         6 foreach my $section (keys %$config) {
185 3         20 print $fh "[$section]\n";
186 3         5 foreach my $key (keys %{$config->{$section}}) {
  3         8  
187 4         7 my $value = $config->{$section}->{$key};
188 4         11 print $fh "$key=$value\n";
189             }
190 3         7 print $fh "\n";
191             }
192            
193 1         58 close $fh;
194             }
195              
196             sub url_exists {
197 0     0 1   my ($url) = @_;
198              
199             # Create an HTTP::Tiny object
200 0           my $http = HTTP::Tiny->new;
201              
202             # Send a HEAD request to check the URL
203 0           my $response = $http->head($url);
204            
205             # If the response status is success (2xx), the URL exists
206 0 0         if ($response->{success}) {
    0          
207 0           return 1;
208             } elsif ($response->{status} == 599) {
209             # Try anothe method: SSLeay 1.49 or higher required
210 0           my $response = undef;
211 0           eval {
212 0           require LWP::UserAgent;
213 0           my $ua = LWP::UserAgent->new;
214 0           $ua->ssl_opts(verify_hostname => 0); # Disable SSL verification (optional)
215 0           $response = $ua->get($url);
216            
217              
218            
219             };
220 0 0         if ($response->is_success) {
221 0           return 1;
222             }
223            
224            
225 0           my $cmd = qq(curl --silent -L -I "$url");
226 0           my @output = `$cmd`;
227 0           for my $line (@output) {
228 0           chomp $line;
229 0 0 0       if ($line =~ /^HTTP/ and $line =~ /200/) {
230 0           return 1;
231             }
232             }
233 0           return 0;
234              
235             } else {
236 0           return 0;
237             }
238            
239             }
240              
241             sub curl {
242 0     0 0   my $url = shift;
243 0           my $cmd = qq(curl --silent -L "$url");
244 0           my @output = `$cmd`;
245 0 0         if ($? != 0) {
246 0           return undef;
247             }
248 0           return join("\n", @output);
249             }
250             sub systeminfo {
251 0     0 0   my ($config) = @_;
252 0 0         return {} if !defined $config->{'server'}->{'port'};
253 0 0         return {} if !defined $config->{'server'}->{'ip'};
254              
255 0           my $url = $config->{'server'}->{'ip'} . ':' . $config->{'server'}->{'port'} . '/monitor.json';
256 0           my $json_text = curl($url);
257 0 0         if (!defined $json_text) {
258 0           return {};
259             }
260 0           my $json_data;
261 0           eval {
262 0           my $json = JSON::PP->new->allow_nonref;
263 0           $json_data = $json->decode($json_text);
264             };
265 0 0         if ($@) {
266 0           return {};
267             }
268 0           return $json_data;
269              
270             }
271             1;
272              
273             __END__