Subversion Repositories Projects

#!/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__