Subversion Repositories Projects

Rev

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__