#!/usr/bin/perl #------------------------------------------------------------------------------- # This file is part of the FLARM¨-Radar Project. # # Copyright 2013 Netzschmiede GmbH (http://www.netzschmiede.ch) # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. # You may obtain a copy of the License at # # http://www.apache.org/licenses/LICENSE-2.0 # # Unless required by applicable law or agreed to in writing, software # distributed under the License is distributed on an "AS IS" BASIS, # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. # # Project Website: www.flarmradar.ch # Email: info@flarmradar.ch #------------------------------------------------------------------------------- use strict; use warnings; use Getopt::Std; use File::Basename; use Time::HiRes qw(gettimeofday); use POSIX qw(strftime); use POSIX qw(setsid); use LWP::UserAgent; my %config; my %options; my $ua; my $debug = 0; my $trace = 0; my $interval = 3; my $skip = 1; # default values my $cfile = "/etc/flarmclient.conf"; my $log = "$ENV{'HOME'}/flarmclient.trace"; my $fifo = "$ENV{'HOME'}/fifo"; # functions sub usage { print <> $log") || print "Failed to open trace file $log: $!"; } return 1; } sub logit { my ($target, $msg) = @_; if ($trace && $target eq "TRACE") { openlog() && print LOG "$msg\n"; } if ($debug && $target eq "DEBUG") { print "$msg\n"; # if tracing is turned on, write debug messages also to the trace file if ($trace) { openlog() && print LOG "$msg\n"; } } if ($target eq "ALL") { print "$msg\n"; # if tracing is turned on, write debug messages also to the trace file if ($trace) { openlog() && print LOG "$msg\n"; } } } sub cleanup { if (-e "$fifo") { unlink($fifo) || die("unable to remove $fifo: $!"); } close(LOG); } sub readconfig { open(CONF, "< $cfile") || die("failed to open config file for reading: $!"); while(my $line = ) { chomp($line); next if $line =~ /^\s*#/; next if $line =~ /^\s*$/; if ($line =~ /^\s*(\S*)\s*=\s*(\S*)\s*$/) { $config{$1} = $2; } } close(CONF); } sub exact_time { return strftime("%H:%M:%S", localtime()) . "." . (gettimeofday())[1]; } # send the records to the server. We don't make a request for each record for # performance reasons. sub flush { my ($records, $url) = @_; logit("DEBUG", exact_time() . " Start flushing data to server"); my $date = `date -u +%Y/%m/%d`; chomp($date); my $resturl = $url . "/" . $date; logit("DEBUG", exact_time() . " Request resource: " . $resturl); # compose the request my $request = HTTP::Request->new('PUT'); $request->url($resturl); $request->header('stationKey'=>$config{'key'}); my $content = compress($records); logit("DEBUG", exact_time() . " Put on wire: " . $content); $request->content($content); # run the request logit("DEBUG", exact_time() . " Start server push"); my $response = $ua->request($request); logit("DEBUG", exact_time() . " End server push"); # analyze the response my $code = $response->code; $response->code == 200 || logit("DEBUG", "Error processing records (" . $response->code . ") records=[" . $records . "]"); logit("DEBUG", exact_time() . " End flushing data"); } # remove all unused records, debug information, etc. sub compress { my ($records) = @_; my $on_wire; foreach my $record (split(';', $records)) { if ($record =~ /^\$GPGGA,/ || $record =~ /^\$PFLAA,/) { $on_wire = (defined($on_wire)) ? $on_wire . ";" . $record : $record; } } return $on_wire; } # remove old leftovers cleanup(); # parse options getopts('c:di:j:f:th', \%options); # read config file if (defined($options{'c'})) { $cfile = $options{'c'}; } if (defined($options{'d'})) { $debug = 1; } if (defined($options{'i'})) { $interval = $options{'i'}; } if (defined($options{'j'})) { $skip = $options{'j'} } if (defined($options{'h'})) { usage(); } if (defined($options{'t'})) { $trace = 1; } # read config file readconfig(); # validation: key must be present in config file die("no key found in config file " . $cfile . " (option: key)") unless defined($config{'key'}); logit("ALL", "Start client, connect to " . $config{'url'}); # create pipe die("no fifo found in config file (option: fifo)") unless defined($fifo); if (! -d dirname($fifo)) { system("mkdir", "-p", dirname($fifo)) == 0 || die("failed to create fifo directory " . dirname($fifo) . ": $!") } system("mkfifo", $fifo) == 0 || die("failed to create fifo: $!"); # force a flush right away and after every write or print local $| = 1; # let the kernel raper dead childs $SIG{CHLD} = 'IGNORE'; # fork minicom and write to pipe defined( my $pid = fork() ) or die "can't fork: $!"; unless ($pid) { # we're the child # detach from session setsid() or die "can't start a new session: $!"; close(STDIN); close(STDOUT); close(STDERR); if (defined($options{'f'})) { open(DATA, "< $options{'f'}") || die("failed to open data file $options{'f'}: $!"); open(FIFO, "> $fifo") || die("failed to open fifo for writing: $!"); while(my $line = ) { chomp($line); next if ($line =~ /^\s*$/); print FIFO $line, "\n" || die("failed to execute child command: $!"); } close(DATA); close(FIFO); } else { exec("exec minicom -t xterm-color -C $fifo> /dev/null 2>&1") == 0 || die("failed to run minicom: $!"); } exit 0; } # create UserAgent object $ua = new LWP::UserAgent; my $buf; # read data from pipe open(FIFO, "< $fifo") || die("failed to open fifo for reading: $!"); my $i = 0; while(my $record = ) { # send only n-th record to the server (option -s) if ($i % $skip == 0) { chomp($record); logit("TRACE", $record); $buf = (defined($buf)) ? "$buf;$record" : $record; } # a GPGGA record terminates the sequence if ($record =~ /^\$GPGGA,/) { if ($i % ($interval * $skip) == 0) { flush($buf, $config{'url'}) ; $buf = undef; sleep($interval * $skip) if (defined($options{'f'})); } $i++; } } close(FIFO); cleanup(); exit 0;