source: core/trunk/client/flarmclient.pl @ 274

Last change on this file since 274 was 261, checked in by smoser, 12 years ago

#153

  • Property svn:mime-type set to text/plain
File size: 7.3 KB
Line 
1#!/usr/bin/perl
2#-------------------------------------------------------------------------------
3# This file is part of the FLARM¨-Radar Project.
4#   
5#   Copyright 2013 Netzschmiede GmbH (http://www.netzschmiede.ch)
6#
7# Licensed under the Apache License, Version 2.0 (the "License");
8# you may not use this file except in compliance with the License.
9# You may obtain a copy of the License at
10#
11#   http://www.apache.org/licenses/LICENSE-2.0
12#
13# Unless required by applicable law or agreed to in writing, software
14# distributed under the License is distributed on an "AS IS" BASIS,
15# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
16# See the License for the specific language governing permissions and
17# limitations under the License.
18#
19#   Project Website: www.flarmradar.ch
20#   Email: info@flarmradar.ch
21#-------------------------------------------------------------------------------
22
23use strict;
24use warnings;
25use Getopt::Std;
26use File::Basename;
27use Time::HiRes qw(gettimeofday);
28use POSIX qw(strftime);
29use POSIX qw(setsid);
30use LWP::UserAgent;
31
32my %config;
33my %options;
34my $ua;
35my $debug = 0;
36my $trace = 0;
37my $interval = 3;
38my $skip = 1;
39
40# default values
41my $cfile = "/etc/flarmclient.conf";
42my $log = "$ENV{'HOME'}/flarmclient.trace";
43my $fifo = "$ENV{'HOME'}/fifo";
44
45# functions
46sub usage {
47  print <<EOF;
48NAME
49  $0 -- stream flarm data to server
50
51SYNOPSIS
52  $0 [-c config_file] [-d] [-f data_file] [-i n] [-j m] [-t] [-h]
53
54DESCRIPTION
55  The following options are available:
56 
57  -c    Use the specified configuration file. Use the default configuration
58                file as a starting point for customization.
59               
60  -d    Write debug information. The debug information is written to STDOUT
61                unless tracing (option -t) is turned on. With tracing switched on,
62                the debug information is written to the trace file (see below).                 
63               
64  -f    Read the data from the specified data file. This is mainly used for
65                testing and development.
66
67  -i    Bundle records, send a request to the server every i-th GPGGA record.
68                Used for bandwidth optimization. Defaults to 3.
69               
70  -j    Send every j-th record to the server. Used for bandwidth
71                optimization. Defaults to 1.
72               
73  -t    Trace client operations. A trace file is created in
74                \$HOME/flarmclient.trace
75                WARNING: Do not use that in Production, the trace file is not truncated
76                and might fill up the file system.
77               
78  -h    Print this help.
79
80EOF
81  exit 0;
82}
83
84# print statistic information to logfile
85$SIG{USR1} = sub {
86        if ($trace) {
87                $trace = 0;
88        } else {
89                $trace = 1;
90        }
91};
92
93
94sub openlog {
95        if (tell(LOG) == -1) {
96                open(LOG, ">> $log") || print "Failed to open trace file $log: $!";
97        }
98        return 1;
99}
100
101sub logit {
102        my ($target, $msg) = @_;
103        if ($trace && $target eq "TRACE") {
104                openlog() && print LOG "$msg\n";
105        }
106        if ($debug && $target eq "DEBUG") {
107                print "$msg\n";
108                # if tracing is turned on, write debug messages also to the trace file
109                if ($trace) {
110                        openlog() && print LOG "$msg\n";
111                }
112        }
113        if ($target eq "ALL") {
114                print "$msg\n";
115                # if tracing is turned on, write debug messages also to the trace file
116                if ($trace) {
117                        openlog() && print LOG "$msg\n";
118                }
119        }
120}
121
122sub cleanup {
123        if (-e "$fifo") {
124                unlink($fifo) || die("unable to remove $fifo: $!");
125        }
126        close(LOG);
127}
128
129sub readconfig {
130        open(CONF, "< $cfile") || die("failed to open config file for reading: $!");
131        while(my $line = <CONF>) {
132                chomp($line);
133                next if $line =~ /^\s*#/;
134                next if $line =~ /^\s*$/;
135                if ($line =~ /^\s*(\S*)\s*=\s*(\S*)\s*$/) {
136                        $config{$1} = $2;
137                }
138        }
139        close(CONF);
140}
141
142sub exact_time {
143        return strftime("%H:%M:%S", localtime()) . "." . (gettimeofday())[1];
144}
145
146# send the records to the server. We don't make a request for each record for
147# performance reasons.
148sub flush {
149        my ($records, $url) = @_;
150        logit("DEBUG", exact_time() . " Start flushing data to server");
151       
152        my $date = `date -u +%Y/%m/%d`;
153        chomp($date);
154        my $resturl = $url . "/" . $date;
155        logit("DEBUG", exact_time() . " Request resource: " . $resturl);
156       
157        # compose the request
158        my $request = HTTP::Request->new('PUT');
159        $request->url($resturl);
160        $request->header('stationKey'=>$config{'key'});
161        my $content = compress($records);
162        logit("DEBUG", exact_time() . " Put on wire: " . $content);
163        $request->content($content);
164       
165        # run the request
166        logit("DEBUG", exact_time() . " Start server push");
167        my $response = $ua->request($request);
168        logit("DEBUG", exact_time() . " End server push");
169       
170        # analyze the response
171        my $code = $response->code;
172        $response->code == 200 || logit("DEBUG", "Error processing records (" . $response->code . ") records=[" . $records . "]");
173        logit("DEBUG", exact_time() . " End flushing data");
174}
175
176# remove all unused records, debug information, etc.
177sub compress {
178        my ($records) = @_;
179        my $on_wire;
180        foreach my $record (split(';', $records)) {
181                if ($record =~ /^\$GPGGA,/ || $record =~ /^\$PFLAA,/) {
182                        $on_wire = (defined($on_wire)) ? $on_wire . ";" . $record : $record;
183                }               
184        }
185        return $on_wire;
186}
187
188# remove old leftovers
189cleanup();
190
191# parse options
192getopts('c:di:j:f:th', \%options);
193
194# read config file
195if (defined($options{'c'})) {
196        $cfile = $options{'c'};
197}
198if (defined($options{'d'})) {
199        $debug = 1;
200}
201if (defined($options{'i'})) {
202        $interval = $options{'i'};
203}
204if (defined($options{'j'})) {
205        $skip = $options{'j'}
206}
207if (defined($options{'h'})) {
208        usage();
209}
210if (defined($options{'t'})) {
211        $trace = 1;
212}
213
214# read config file
215readconfig();
216
217# validation: key must be present in config file
218die("no key found in config file " . $cfile . " (option: key)") unless defined($config{'key'});
219
220logit("ALL", "Start client, connect to " . $config{'url'});
221
222# create pipe
223die("no fifo found in config file (option: fifo)") unless defined($fifo);
224if (! -d dirname($fifo)) {
225        system("mkdir", "-p", dirname($fifo)) == 0 || die("failed to create fifo directory " . dirname($fifo) . ": $!")
226}
227system("mkfifo", $fifo) == 0 || die("failed to create fifo: $!");
228
229# force a flush right away and after every write or print
230local $| = 1;
231
232# let the kernel raper dead childs
233$SIG{CHLD} = 'IGNORE';
234
235# fork minicom and write to pipe
236defined( my $pid = fork() ) or die "can't fork: $!";
237unless ($pid) {
238        # we're the child
239        # detach from session
240    setsid() or die "can't start a new session: $!";
241    close(STDIN);
242        close(STDOUT);
243        close(STDERR);
244       
245        if (defined($options{'f'})) {
246                open(DATA, "< $options{'f'}") || die("failed to open data file $options{'f'}: $!");
247                open(FIFO, "> $fifo") || die("failed to open fifo for writing: $!");
248                while(my $line = <DATA>) {
249                        chomp($line);
250                        next if ($line =~ /^\s*$/);
251                        print FIFO $line, "\n" || die("failed to execute child command: $!");
252                }
253                close(DATA);
254                close(FIFO);
255        } else {
256                exec("exec minicom -t xterm-color -C $fifo> /dev/null 2>&1") == 0 || die("failed to run minicom: $!");
257        }
258        exit 0;
259}
260
261# create UserAgent object
262$ua = new LWP::UserAgent;
263my $buf;
264# read data from pipe
265open(FIFO, "< $fifo") || die("failed to open fifo for reading: $!");
266my $i = 0;
267while(my $record = <FIFO>) {
268        # send only n-th record to the server (option -s)
269        if ($i % $skip == 0) {
270                chomp($record);
271                logit("TRACE", $record);
272                $buf = (defined($buf)) ? "$buf;$record" : $record;
273        }
274       
275        # a GPGGA record terminates the sequence
276        if ($record =~ /^\$GPGGA,/) {
277                if ($i % ($interval * $skip) == 0) {
278                        flush($buf, $config{'url'}) ;
279                        $buf = undef;
280                        sleep($interval * $skip) if (defined($options{'f'}));
281                }
282               
283                $i++;
284        }
285}
286close(FIFO);
287
288cleanup();
289exit 0;
290
Note: See TracBrowser for help on using the repository browser.