Blame |
Last modification |
View Log
| RSS feed
#!/usr/bin/perl
#!/usr/bin/perl -d:ptkdb
###############################################################################
#
# geserver.pl - Google Earth Server for MK Mission Cockpit
#
# Copyright (C) 2009 Rainer Walther (rainerwalther-mail@web.de)
#
# Creative Commons Lizenz mit den Zusaetzen (by, nc, sa)
#
# Es ist Ihnen gestattet:
# * das Werk vervielfältigen, verbreiten und öffentlich zugänglich machen
# * Abwandlungen bzw. Bearbeitungen des Inhaltes anfertigen
#
# Zu den folgenden Bedingungen:
# * Namensnennung.
# Sie müssen den Namen des Autors/Rechteinhabers in der von ihm festgelegten Weise nennen.
# * Keine kommerzielle Nutzung.
# Dieses Werk darf nicht für kommerzielle Zwecke verwendet werden.
# * Weitergabe unter gleichen Bedingungen.
# Wenn Sie den lizenzierten Inhalt bearbeiten oder in anderer Weise umgestalten,
# verändern oder als Grundlage für einen anderen Inhalt verwenden,
# dürfen Sie den neu entstandenen Inhalt nur unter Verwendung von Lizenzbedingungen
# weitergeben, die mit denen dieses Lizenzvertrages identisch oder vergleichbar sind.
#
# Im Falle einer Verbreitung müssen Sie anderen die Lizenzbedingungen, unter welche dieses
# Werk fällt, mitteilen. Am Einfachsten ist es, einen Link auf diese Seite einzubinden.
#
# Jede der vorgenannten Bedingungen kann aufgehoben werden, sofern Sie die Einwilligung
# des Rechteinhabers dazu erhalten.
#
# Diese Lizenz lässt die Urheberpersönlichkeitsrechte unberührt.
#
# Weitere Details zur Lizenzbestimmung gibt es hier:
# Kurzform: http://creativecommons.org/licenses/by-nc-sa/3.0/de/
# Komplett: http://creativecommons.org/licenses/by-nc-sa/3.0/de/legalcode
#
###############################################################################
#
# 20090317 0.0.1 rw created
# 20090401 0.1.0 rw RC1
# 20091215 0.1.1 rw Move cfg to "logging"-section
#
###############################################################################
$Version{'geserver.pl'} = "0.1.1 - 2009-12-15";
#
# Parameter
#
$port_listen = $Cfg->{'logging'}->{'HttpPort'} || 8080;
use Socket
;
use IO
::Select;
use threads
;
use threads
::shared;
$| = 1;
# "Lon, Lat, Alt"
share
(@GeCoords);
sub GeServer
()
{
local *S;
socket (S
, PF_INET
, SOCK_STREAM
, getprotobyname('tcp')) or die "couldn't open socket: $!";
setsockopt (S
, SOL_SOCKET
, SO_REUSEADDR
, 1);
bind (S
, sockaddr_in
($port_listen, INADDR_ANY
));
listen (S
, 5) or die "don't hear anything: $!";
my $ss = IO
::Select->new();
$ss -> add (*S);
while(1)
{
my @connections_pending = $ss->can_read();
foreach (@connections_pending)
{
my $fh;
my $remote = accept($fh, $_);
my($port,$iaddr) = sockaddr_in
($remote);
my $peeraddress = inet_ntoa
($iaddr);
# memory-leak in threads!!! Process only one request in parallel
# my $t = threads->create(\&new_connection, $fh);
&new_connection ($fh);
}
}
}
sub new_connection
{
my $fh = shift;
binmode $fh;
my %req;
$req{HEADER
}={};
my $request_line = <$fh>;
my $first_line = "";
while ($request_line ne "\r\n")
{
unless ($request_line)
{
close $fh;
}
chomp $request_line;
unless ($first_line)
{
$first_line = $request_line;
my @parts = split(" ", $first_line);
if (@parts != 3)
{
close $fh;
}
$req{METHOD
} = $parts[0];
$req{OBJECT
} = $parts[1];
}
else
{
my ($name, $value) = split(": ", $request_line);
$name = lc $name;
$req{HEADER
}{$name} = $value;
}
$request_line = <$fh>;
}
&http_request_handler($fh, \%req);
close $fh;
}
sub http_request_handler
{
my $fh = shift;
my $req_ = shift;
my %req = %$req_;
my %header = %{$req{HEADER
}};
print $fh "HTTP/1.0 200 OK\n";
print $fh "Content-Type: application/vnd.google-earth.kml+xml; charset=iso-8859-1\n";
print $fh "Connection: close\n\n";
# KML Header
print $fh <<EOF;
<?xml version="1.0" encoding="UTF-8"?>
<kml xmlns="http://earth.google.com/kml/2.2">
<Document>
<name>Mikrokopter GPS logging</name>
<Style id="MK_gps-style">
<LineStyle>
<color>ff0000ff</color>
<width>2</width>
</LineStyle>
</Style>
<Placemark>
<name>Flight live</name>
<styleUrl>MK_gps-style</styleUrl>
<LineString>
<tessellate>1</tessellate>
<altitudeMode>relativeToGround</altitudeMode>
<coordinates>
EOF
# send all KML Coords for each request
for $i (0 .. $#GeCoords)
{
print $fh "$GeCoords[$i]\n";
}
# KML Trailler
print $fh <<EOF;
</coordinates>
</LineString>
</Placemark>
</Document>
</kml>
EOF
# Debug:
# print "Method: $req{METHOD}\n";
# print "Object: $req{OBJECT}\n>";
# foreach my $r (keys %header)
# {
# print $r, " = ", $header{$r} , "\n";
# }
}
1;
__END__