| 0,0 → 1,208 |
|---|
| #!/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 |
| # |
| ############################################################################### |
| |
| $Version{'geserver.pl'} = "0.1.0 - 2009-04-01"; |
| |
| # |
| # Parameter |
| # |
| |
| $port_listen = $Cfg->{'geserver'}->{'HttpPort'}; |
| |
| |
| 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__ |