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__ |