Details | Last modification | View Log | RSS feed
Rev | Author | Line No. | Line |
---|---|---|---|
739 | rain-er | 1 | #!/usr/bin/perl |
2 | #!/usr/bin/perl -d:ptkdb |
||
3 | |||
4 | ############################################################################### |
||
5 | # |
||
6 | # geserver.pl - Google Earth Server for MK Mission Cockpit |
||
7 | # |
||
8 | # Copyright (C) 2009 Rainer Walther (rainerwalther-mail@web.de) |
||
9 | # |
||
10 | # Creative Commons Lizenz mit den Zusaetzen (by, nc, sa) |
||
11 | # |
||
12 | # Es ist Ihnen gestattet: |
||
13 | # * das Werk vervielfältigen, verbreiten und öffentlich zugänglich machen |
||
14 | # * Abwandlungen bzw. Bearbeitungen des Inhaltes anfertigen |
||
15 | # |
||
16 | # Zu den folgenden Bedingungen: |
||
17 | # * Namensnennung. |
||
18 | # Sie müssen den Namen des Autors/Rechteinhabers in der von ihm festgelegten Weise nennen. |
||
19 | # * Keine kommerzielle Nutzung. |
||
20 | # Dieses Werk darf nicht für kommerzielle Zwecke verwendet werden. |
||
21 | # * Weitergabe unter gleichen Bedingungen. |
||
22 | # Wenn Sie den lizenzierten Inhalt bearbeiten oder in anderer Weise umgestalten, |
||
23 | # verändern oder als Grundlage für einen anderen Inhalt verwenden, |
||
24 | # dürfen Sie den neu entstandenen Inhalt nur unter Verwendung von Lizenzbedingungen |
||
25 | # weitergeben, die mit denen dieses Lizenzvertrages identisch oder vergleichbar sind. |
||
26 | # |
||
27 | # Im Falle einer Verbreitung müssen Sie anderen die Lizenzbedingungen, unter welche dieses |
||
28 | # Werk fällt, mitteilen. Am Einfachsten ist es, einen Link auf diese Seite einzubinden. |
||
29 | # |
||
30 | # Jede der vorgenannten Bedingungen kann aufgehoben werden, sofern Sie die Einwilligung |
||
31 | # des Rechteinhabers dazu erhalten. |
||
32 | # |
||
33 | # Diese Lizenz lässt die Urheberpersönlichkeitsrechte unberührt. |
||
34 | # |
||
35 | # Weitere Details zur Lizenzbestimmung gibt es hier: |
||
36 | # Kurzform: http://creativecommons.org/licenses/by-nc-sa/3.0/de/ |
||
37 | # Komplett: http://creativecommons.org/licenses/by-nc-sa/3.0/de/legalcode |
||
38 | # |
||
39 | ############################################################################### |
||
40 | # |
||
41 | # 20090317 0.0.1 rw created |
||
42 | # 20090401 0.1.0 rw RC1 |
||
43 | # 20091215 0.1.1 rw Move cfg to "logging"-section |
||
44 | # |
||
45 | ############################################################################### |
||
46 | |||
47 | $Version{'geserver.pl'} = "0.1.1 - 2009-12-15"; |
||
48 | |||
49 | # |
||
50 | # Parameter |
||
51 | # |
||
52 | |||
53 | $port_listen = $Cfg->{'logging'}->{'HttpPort'} || 8080; |
||
54 | |||
55 | |||
56 | use Socket; |
||
57 | use IO::Select; |
||
58 | |||
59 | use threads; |
||
60 | use threads::shared; |
||
61 | |||
62 | $| = 1; |
||
63 | |||
64 | # "Lon, Lat, Alt" |
||
65 | share (@GeCoords); |
||
66 | |||
67 | sub GeServer() |
||
68 | { |
||
69 | local *S; |
||
70 | |||
71 | socket (S, PF_INET , SOCK_STREAM , getprotobyname('tcp')) or die "couldn't open socket: $!"; |
||
72 | setsockopt (S, SOL_SOCKET, SO_REUSEADDR, 1); |
||
73 | bind (S, sockaddr_in($port_listen, INADDR_ANY)); |
||
74 | listen (S, 5) or die "don't hear anything: $!"; |
||
75 | |||
76 | my $ss = IO::Select->new(); |
||
77 | $ss -> add (*S); |
||
78 | |||
79 | while(1) |
||
80 | { |
||
81 | my @connections_pending = $ss->can_read(); |
||
82 | foreach (@connections_pending) |
||
83 | { |
||
84 | my $fh; |
||
85 | my $remote = accept($fh, $_); |
||
86 | |||
87 | my($port,$iaddr) = sockaddr_in($remote); |
||
88 | my $peeraddress = inet_ntoa($iaddr); |
||
89 | |||
90 | # memory-leak in threads!!! Process only one request in parallel |
||
91 | # my $t = threads->create(\&new_connection, $fh); |
||
92 | &new_connection ($fh); |
||
93 | } |
||
94 | } |
||
95 | } |
||
96 | |||
97 | |||
98 | sub new_connection |
||
99 | { |
||
100 | my $fh = shift; |
||
101 | |||
102 | binmode $fh; |
||
103 | |||
104 | my %req; |
||
105 | |||
106 | $req{HEADER}={}; |
||
107 | |||
108 | my $request_line = <$fh>; |
||
109 | my $first_line = ""; |
||
110 | |||
111 | while ($request_line ne "\r\n") |
||
112 | { |
||
113 | unless ($request_line) |
||
114 | { |
||
115 | close $fh; |
||
116 | } |
||
117 | |||
118 | chomp $request_line; |
||
119 | |||
120 | unless ($first_line) |
||
121 | { |
||
122 | $first_line = $request_line; |
||
123 | |||
124 | my @parts = split(" ", $first_line); |
||
125 | if (@parts != 3) |
||
126 | { |
||
127 | close $fh; |
||
128 | } |
||
129 | |||
130 | $req{METHOD} = $parts[0]; |
||
131 | $req{OBJECT} = $parts[1]; |
||
132 | } |
||
133 | else |
||
134 | { |
||
135 | my ($name, $value) = split(": ", $request_line); |
||
136 | $name = lc $name; |
||
137 | $req{HEADER}{$name} = $value; |
||
138 | } |
||
139 | |||
140 | $request_line = <$fh>; |
||
141 | } |
||
142 | |||
143 | &http_request_handler($fh, \%req); |
||
144 | |||
145 | close $fh; |
||
146 | } |
||
147 | |||
148 | |||
149 | sub http_request_handler |
||
150 | { |
||
151 | my $fh = shift; |
||
152 | my $req_ = shift; |
||
153 | |||
154 | my %req = %$req_; |
||
155 | |||
156 | my %header = %{$req{HEADER}}; |
||
157 | |||
158 | print $fh "HTTP/1.0 200 OK\n"; |
||
159 | print $fh "Content-Type: application/vnd.google-earth.kml+xml; charset=iso-8859-1\n"; |
||
160 | print $fh "Connection: close\n\n"; |
||
161 | |||
162 | # KML Header |
||
163 | print $fh <<EOF; |
||
164 | <?xml version="1.0" encoding="UTF-8"?> |
||
165 | <kml xmlns="http://earth.google.com/kml/2.2"> |
||
166 | <Document> |
||
167 | <name>Mikrokopter GPS logging</name> |
||
168 | <Style id="MK_gps-style"> |
||
169 | <LineStyle> |
||
170 | <color>ff0000ff</color> |
||
171 | <width>2</width> |
||
172 | </LineStyle> |
||
173 | </Style> |
||
174 | <Placemark> |
||
175 | <name>Flight live</name> |
||
176 | <styleUrl>MK_gps-style</styleUrl> |
||
177 | <LineString> |
||
178 | <tessellate>1</tessellate> |
||
179 | <altitudeMode>relativeToGround</altitudeMode> |
||
180 | <coordinates> |
||
181 | EOF |
||
182 | |||
183 | # send all KML Coords for each request |
||
184 | for $i (0 .. $#GeCoords) |
||
185 | { |
||
186 | print $fh "$GeCoords[$i]\n"; |
||
187 | } |
||
188 | |||
189 | # KML Trailler |
||
190 | print $fh <<EOF; |
||
191 | </coordinates> |
||
192 | </LineString> |
||
193 | </Placemark> |
||
194 | </Document> |
||
195 | </kml> |
||
196 | EOF |
||
197 | |||
198 | # Debug: |
||
199 | # print "Method: $req{METHOD}\n"; |
||
200 | # print "Object: $req{OBJECT}\n>"; |
||
201 | # foreach my $r (keys %header) |
||
202 | # { |
||
203 | # print $r, " = ", $header{$r} , "\n"; |
||
204 | # } |
||
205 | } |
||
206 | |||
207 | 1; |
||
208 | |||
209 | __END__ |