Generated: Sat Oct 24 16:35:24 2020 from mptelnet.pl 2018/01/10 17.1 KB. text copy
#!/usr/bin/perl -w # NAME: mptelnet.pl # AIM: Establish telnet connection with fgms host and get repsonse # 2018-01-10 - review and small spelling mistake # 2017-06-15 - default to mpserver14.flightgear.org # 07/10/2013 - rename from telnet2.pl to mptelnet.pl # 25/04/2013 geoff mclane http://geoffair.net/mperl use strict; use warnings; use File::Basename; # split path ($name,$dir,$ext) = fileparse($file [, qr/\.[^.]*/] ) use Net::Telnet(); use Data::Dumper; use Cwd; my $os = $^O; my $perl_dir = '/home/geoff/bin'; my $PATH_SEP = '/'; my $temp_dir = '/tmp'; if ($os =~ /win/i) { $perl_dir = 'C:\GTools\perl'; $temp_dir = $perl_dir; $PATH_SEP = "\\"; } unshift(@INC, $perl_dir); require 'lib_utils.pl' or die "Unable to load 'lib_utils.pl' Check paths in \@INC...\n"; # log file stuff our ($LF); my $pgmname = $0; if ($pgmname =~ /(\\|\/)/) { my @tmpsp = split(/(\\|\/)/,$pgmname); $pgmname = $tmpsp[-1]; } my $outfile = $temp_dir.$PATH_SEP."temp.$pgmname.txt"; open_log($outfile); # user variables my $VERS = "0.0.3 2018-01-10"; #my $VERS = "0.0.2 2013-10-07"; #my $VERS = "0.0.1 2013-03-17"; my $load_log = 0; my $in_file = ''; my $verbosity = 0; my $out_file = $temp_dir.$PATH_SEP."temptelnet14.txt"; my $HOST = "mpserver14.flightgear.org"; ##my $out_file = $temp_dir.$PATH_SEP."temptelnet01.txt"; ##my $HOST = "mpserver01.flightgear.org"; #my $HOST = "fgx.ch"; my $PORT = 5001; # ### DEBUG ### my $debug_on = 0; my $def_file = 'def_file'; ### program variables my @warnings = (); my $cwd = cwd(); my $from_string = ''; sub VERB1() { return $verbosity >= 1; } sub VERB2() { return $verbosity >= 2; } sub VERB5() { return $verbosity >= 5; } sub VERB9() { return $verbosity >= 9; } sub show_warnings($) { my ($val) = @_; if (@warnings) { prt( "\nGot ".scalar @warnings." WARNINGS...\n" ); foreach my $itm (@warnings) { prt("$itm\n"); } prt("\n"); } else { prt( "\nNo warnings issued.\n\n" ) if (VERB9()); } } sub pgm_exit($$) { my ($val,$msg) = @_; if (length($msg)) { $msg .= "\n" if (!($msg =~ /\n$/)); prt($msg); } show_warnings($val); close_log($outfile,$load_log); exit($val); } sub prtw($) { my ($tx) = shift; $tx =~ s/\n$//; prt("$tx\n"); push(@warnings,$tx); } sub process_in_file($) { my ($inf) = @_; if (! open INF, "<$inf") { pgm_exit(1,"ERROR: Unable to open file [$inf]\n"); } my @lines = <INF>; close INF; my $lncnt = scalar @lines; prt("Processing $lncnt lines, from [$inf]...\n"); my ($line,$inc,$lnn); $lnn = 0; foreach $line (@lines) { chomp $line; $lnn++; if ($line =~ /\s*#\s*include\s+(.+)$/) { $inc = $1; prt("$lnn: $inc\n"); } } } sub escape_strs { my ($str) = @_; $str =~ s/"/\"/g; $str =~ s/'/\'/g; $str =~ s/\&/\&/g; $str =~ s/>/\>/g; $str =~ s/</\</g; return $str; } my %model_hash = (); my %cs_hash = (); my $FG_MAP_CRAFT_ICON_HELI = "heli/heli"; my @FG_MAP_CRAFT_MODELS_HELI = ( "bo105", "sikorsky76c", "ec135", "r22", "s76c", "Lynx-WG13", "S51-sikorsky", "CH47", "R22", "apache-model", "uh-1", "uh60", "OH-1" ); my $FG_MAP_CRAFT_ICON_SINGLEPROP = "singleprop/singleprop"; my @FG_MAP_CRAFT_MODELS_SINGLEPROP = ( "c150", "c172p", "c172-dpm", "c182-dpm", "c310-dpm", "c310u3a", "dhc2floats", "pa28-161", "pc7", "j3cub" ); my $FG_MAP_CRAFT_ICON_TWINPROP = "twinprop/twinprop"; my @FG_MAP_CRAFT_MODELS_TWINPROP = ( "Boeing314Clipper", "Lockheed1049_twa", "TU-114-model", "b1900d-anim", "b29-model", "beech99-model", "dc3-dpm", "fokker50" ); my $FG_MAP_CRAFT_ICON_SMALLJET = "smalljet/smalljet"; my @FG_MAP_CRAFT_MODELS_SMALLJET = ( "Citation-II", "Bravo", "fokker100", "tu154B" ); my $FG_MAP_CRAFT_ICON_HEAVYJET = "heavyjet/heavyjet"; my @FG_MAP_CRAFT_MODELS_HEAVYJET = ( "boeing733", "boeing747-400-jw", "a320-fb", "A380", "AN-225-model", "B-52F-model", "Concorde-ba", "FINNAIRmd11", "MD11", "KLMmd11", "737-300", "787", "777-200", "747-400", "737-100", "737-400" ); my $FG_MAP_CRAFT_ICON_GLIDER = "glider/glider"; my @FG_MAP_CRAFT_MODELS_GLIDER = ( "hgldr-cs-model", "paraglider_model", "colditz-model", "sgs233" ); my $FG_MAP_CRAFT_ICON_BLIMP = "blimp/blimp"; my @FG_MAP_CRAFT_MODELS_BLIMP = ( "ZLT-NT", "ZF-balloon", "Submarine_Scout", "LZ-129", "Excelsior-model" ); my $FG_MAP_CRAFT_ICON_CARRIER = "carrier/fg_carrier"; my @FG_MAP_CRAFT_MODELS_CARRIER = ( "mp-nimitz", "mp-eisenhower", "mp-foch" ); ###/* Specific aircraft (non-photo) icons */ my $FG_MAP_CRAFT_ICON_OV10 = "ov10/ov10"; my @FG_MAP_CRAFT_MODELS_OV10 = ( "OV10", "OV10_USAFE" ); my $FG_MAP_CRAFT_ICON_KC135 = "kc135/kc135"; my @FG_MAP_CRAFT_MODELS_KC135 = ( "KC135" ); my $FG_MAP_CRAFT_ICON_CH53E = "ch53e/ch53e"; my @FG_MAP_CRAFT_MODELS_CH53E = ( "ch53e-model" ); my $FG_MAP_CRAFT_ICON_E3B = "e3b/e3b"; my @FG_MAP_CRAFT_MODELS_E3B = ( "E3B" ); my $FG_MAP_CRAFT_ICON_ATC = "atc/atc"; my @FG_MAP_CRAFT_MODELS_ATC = ( "atc-tower", "atc-tower2", "mibs", "atc", "OpenRadar" ); my %aircraft_hash = ( $FG_MAP_CRAFT_ICON_HELI => \@FG_MAP_CRAFT_MODELS_HELI, $FG_MAP_CRAFT_ICON_SINGLEPROP => \@FG_MAP_CRAFT_MODELS_SINGLEPROP, $FG_MAP_CRAFT_ICON_TWINPROP => \@FG_MAP_CRAFT_MODELS_TWINPROP, $FG_MAP_CRAFT_ICON_SMALLJET => \@FG_MAP_CRAFT_MODELS_SMALLJET, $FG_MAP_CRAFT_ICON_HEAVYJET => \@FG_MAP_CRAFT_MODELS_HEAVYJET, $FG_MAP_CRAFT_ICON_GLIDER => \@FG_MAP_CRAFT_MODELS_GLIDER, $FG_MAP_CRAFT_ICON_BLIMP => \@FG_MAP_CRAFT_MODELS_BLIMP, $FG_MAP_CRAFT_ICON_CARRIER => \@FG_MAP_CRAFT_MODELS_CARRIER, ###/* Specific aircraft (non-photo) icons */ $FG_MAP_CRAFT_ICON_OV10 => \@FG_MAP_CRAFT_MODELS_OV10, $FG_MAP_CRAFT_ICON_KC135 => \@FG_MAP_CRAFT_MODELS_KC135, $FG_MAP_CRAFT_ICON_CH53E => \@FG_MAP_CRAFT_MODELS_CH53E, $FG_MAP_CRAFT_ICON_E3B => \@FG_MAP_CRAFT_MODELS_E3B, $FG_MAP_CRAFT_ICON_ATC => \@FG_MAP_CRAFT_MODELS_ATC ); sub get_model_path($$) { my ($mod,$rp) = @_; my ($key,$ra,$val); foreach $key (keys %aircraft_hash) { $ra = $aircraft_hash{$key}; foreach $val (@{$ra}) { if ($mod eq $val) { ${$rp} = $key; return 1; } } } return 0; } # ========================================= # lines like # # This is mpserver01 # # FlightGear Multiplayer Server v0.11.6 # # using protocol version v1.1 (LazyRelay enabled) # # This server is tracked: 123.202.160.230 # # 21 pilot(s) online # thuko48@LOCAL: 3338140.932918 4687140.327377 2763670.301623 25.804114 54.541858 31125.581875 -1.609009 -2.153843 1.666942 Aircraft/A330-300/Models/A330-343.xml # CR1270@mpserver02: 1142877.508865 -4817317.040438 4007515.346877 39.176092 -76.653690 127.823505 -2.058308 -0.978330 -0.178290 Aircraft/A320-family/XMLs/A320-211.xml sub process_lines($) { my $ra = shift; my ($l,$tl,$len); my $ret = ""; my $pilot_total = 0; my $pilot_cnt = 0; my $server_name = ''; my $mp_version = ''; my $tracker_ip = ''; my $proto_version = ''; my ($server); my @mdnf = (); my %hash = (); my %servers = (); my %modsnf = (); foreach $l (@{$ra}) { chomp($l); $tl = trim_all($l); $len = length($tl); next if ($len == 0); if (substr($l, 0, 1) eq "#") { if ($l =~ /^\# (\d+) .*? online/) { $pilot_total = $1; $hash{pilot_total} = $pilot_total; ###$ret .= $ocs{'header'}->($pilot_total); } elsif ($l =~ /^\#\s+This\s+is\s+(.+)$/) { $server_name = $1; $hash{server_name} = $server_name; } elsif ($l =~ /^\#\s+FlightGear\s+Multiplayer\s+Server\s+v(.+)$/) { $mp_version = $1; $hash{protcol_version} = $mp_version; } elsif ($l =~ /^\#\s+This\s+server\s+is\s+tracked:\s+(.+)$/) { $tracker_ip = $1; $hash{tracker_ip} = $tracker_ip; } elsif ($l =~ /^\#\s+using\s+protocol\s+version\s+v(.+)$/ ) { $proto_version = $1; $hash{protocol_version} = $proto_version; } else { prtw("WARNING: line unparsed [$l]- FIX ME 1!\n"); } } #elsif($l =~ m/^(.*)@(.*?): (-?[0-9]+\.[0-9]+) (-?[0-9]+\.[0-9]+) (-?[0-9]+\.[0-9]+) (-?[0-9]+\.[0-9]+) (-?[0-9]+\.[0-9]+) (-?[0-9]+\.[0-9]+) (-?[0-9]+\.[0-9]+) (-?[0-9]+\.[0-9]+) (-?[0-9]+\.[0-9]+) (.*?)$/) elsif($l =~ m/^(.*)@(.*?): (-?[0-9\.]+) (-?[0-9\.]+) (-?[0-9\.]+) (-?[0-9\.]+) (-?[0-9\.]+) (-?[0-9\.]+) (-?[0-9\.]+) (-?[0-9\.]+) (-?[0-9\.]+) (.*?)$/) { my ($callsign, $server_ip, $x, $y, $z, $lat, $lon, $alt, $ox, $oy, $oz, $model) = ($1, $2, $3, $4, $5, $6, $7, $8, $9, $10, $11, $12); $callsign = &escape_strs(${callsign}); $callsign =~ s/^# //g; if ($server_ip) { if (defined $servers{$server_ip}) { $servers{$server_ip}++; } else { $servers{$server_ip} = 1; } } if ($callsign and $model) { #$model =~ s#.*/(.*?)\..*?$#$1#; $model =~ s#.*/(.*?)#$1#; $model =~ s/\..*?$//; my $path = 'NOT FOUND'; if (get_model_path($model,\$path)) { $model_hash{$model} = $path; } else { $model_hash{$model} = $path; if (defined $modsnf{$model}) { $modsnf{$model}++; } else { $modsnf{$model} = 1; push(@mdnf,$model); } } $cs_hash{$callsign} = 1; #my($head, $pitch, $roll) = &sgmath::euler_get($lat, $lon, # $ox, $oy, $oz); my($head, $pitch, $roll); $head = $ox; $pitch = $oy; $roll = $oz; # $ret .= $ocs{'single'}->($callsign, $server_ip, $model, # $lat, $lon, $alt, # $head, $pitch, $roll); $pilot_cnt++; if ($pilot_cnt >= $pilot_total) { #close($socket); #undef($socket); #last; prt("Should be last line...\n"); } } else { prtw("WARNING: Failed to get callsign or model [$l] - FIX ME 3!\n"); } } else { prtw("WARNING: line unparsed [$l]- FIX ME 2!\n"); } } my @cs = sort keys(%cs_hash); my @md = sort keys(%model_hash); my @sa = sort keys(%servers); my $ccnt = scalar @cs; my $mcnt = scalar @md; my $scnt = scalar @sa; my $lcnt = 0; if (defined $servers{'LOCAL'}) { $lcnt = $servers{'LOCAL'}; } prt("Got $pilot_cnt of $pilot_total pilots, $ccnt callsigns, using $mcnt models, $scnt servers, $lcnt local\n"); foreach $server (@sa) { $lcnt = $servers{$server}; prt("$server $lcnt "); } prt("\n"); if (VERB5()) { prt("Callsigns $ccnt seen...\n"); prt(join(", ",@cs)."\n"); prt("Models $mcnt seen...\n"); prt(join(", ",@md)."\n"); $mcnt = scalar @mdnf; if ($mcnt) { prt("NOTE: $mcnt model paths NOT found!\n"); prt(join(", ",sort @mdnf)."\n"); } else { prt("All $mcnt found...\n"); } } } sub get_input_lines($) { my $ra = shift; $from_string = 'FAILED'; if (length($in_file)) { if (open INF, "<$in_file") { @{$ra} = <INF>; close INF; $from_string = "file [$in_file]"; } else { prtw("WARNING: Failed to open file [$in_file]\n"); } } else { prt("Doing telnet to $HOST $PORT...\n"); my $t = new Net::Telnet( 'Port' => $PORT, 'Timeout' => 2 ); if ($t->open($HOST)) { @{$ra} = $t->getlines( 'All' => 1 ); $t->close(); $from_string = "host [$HOST], port [$PORT]"; } else { prtw("WARNING: Failed to open host [$HOST], on port [$PORT]\n"); } } } sub get_telnet_reply() { my @lines = (); get_input_lines(\@lines); my $cnt = scalar @lines; prt("Processing $cnt lines, from $from_string...\n"); my $line = join("",@lines)."\n"; prt($line) if (VERB9()); process_lines(\@lines); write2file($line,$out_file); prt("Written to [$out_file]\n"); } sub get_telnet_reply2() { my $t = new Net::Telnet( 'Port' => $PORT, 'Timeout' => 2 ); $t->open($HOST); #my @lines = $t->cmd(""); #my $ref = $t->buffer(); my $ref = $t->get(); ###my @reply = $t->getlines( 'All' => true ); $t->close(); my $type = ref($ref); if ($type eq 'ARRAY') { my @lines = @{$ref}; my $cnt = scalar @lines; prt("Lines $cnt...\n"); prt(join("",@lines)."\n"); } else { prt(Dumper($ref)); } } ######################################### ### MAIN ### parse_args(@ARGV); get_telnet_reply(); ##process_in_file($in_file); pgm_exit(0,""); ######################################## sub need_arg { my ($arg,@av) = @_; pgm_exit(1,"ERROR: [$arg] must have a following argument!\n") if (!@av); } sub parse_args { my (@av) = @_; my ($arg,$sarg); while (@av) { $arg = $av[0]; if ($arg =~ /^-/) { $sarg = substr($arg,1); $sarg = substr($sarg,1) while ($sarg =~ /^-/); if (($sarg =~ /^h/i)||($sarg eq '?')) { give_help(); pgm_exit(0," Help exit(0)"); } elsif ($sarg =~ /^v/) { if ($sarg =~ /^v.*(\d+)$/) { $verbosity = $1; } else { while ($sarg =~ /^v/) { $verbosity++; $sarg = substr($sarg,1); } } prt("Verbosity = $verbosity\n") if (VERB1()); } elsif ($sarg =~ /^l/) { if ($sarg =~ /^ll/) { $load_log = 2; } else { $load_log = 1; } prt("Set to load log at end. ($load_log)\n") if (VERB1()); } elsif ($sarg =~ /^o/) { need_arg(@av); shift @av; $sarg = $av[0]; $out_file = $sarg; prt("Set out file to [$out_file].\n") if (VERB1()); } elsif ($sarg =~ /^s/) { need_arg(@av); shift @av; $sarg = $av[0]; $HOST = $sarg; prt("Set server as [$HOST].\n") if (VERB1()); } elsif ($sarg =~ /^p/) { need_arg(@av); shift @av; $sarg = $av[0]; $PORT = $sarg; prt("Set port to [$PORT].\n") if (VERB1()); } else { pgm_exit(1,"ERROR: Invalid argument [$arg]! Try -?\n"); } } else { $in_file = $arg; if (! -f $in_file) { pgm_exit(1,"ERROR: Can NOT locate input file $in_file\n"); } prt("Set input to [$in_file]\n") if (VERB1()); } shift @av; } #if ($debug_on) { # prtw("WARNING: DEBUG is ON!\n"); # if ((length($in_file) == 0) && $debug_on) { # $in_file = $def_file; # prt("Set DEFAULT input to [$in_file]\n"); # } #} #if (length($in_file) == 0) { # pgm_exit(1,"ERROR: No input files found in command!\n"); #} #if (! -f $in_file) { # pgm_exit(1,"ERROR: Unable to find in file [$in_file]! Check name, location...\n"); #} } sub give_help { prt("$pgmname: version $VERS\n"); prt("Usage: $pgmname [options] [in-file]\n"); prt("Options:\n"); prt(" --help (-h or -?) = This help, and exit 0.\n"); prt(" --verb[n] (-v) = Bump [or set] verbosity. def=$verbosity\n"); prt(" --load (-l) = Load LOG at end. ($outfile)\n"); prt(" --out <file> (-o) = Write output to this file. (def=$out_file)\n"); prt(" --serv addr (-s) = Set server name. (def=$HOST)\n"); prt(" --port num (-p) = Set port number. (def=$PORT)\n"); prt("\n"); prt(" If an 'in-file' is given, will be read and parsed as a previous\n"); prt(" telnet $HOST $PORT output, and information shown.\n"); prt(" Otherwise, will do a 'Net::Telnet' query on the port $PORT,\n"); prt(" and read all lines from the $HOST, writing results to $out_file\n"); } # eof - mptelnet.pl