Details | Last modification | View Log | RSS feed
Rev | Author | Line No. | Line |
---|---|---|---|
365 | 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 | # |
||
44 | ############################################################################### |
||
45 | |||
46 | $Version{'geserver.pl'} = "0.1.0 - 2009-04-01"; |
||
47 | |||
48 | # |
||
49 | # Parameter |
||
50 | # |
||
51 | |||
52 | $port_listen = $Cfg->{'geserver'}->{'HttpPort'}; |
||
53 | |||
54 | |||
55 | use Socket; |
||
56 | use IO::Select; |
||
57 | |||
58 | use threads; |
||
59 | use threads::shared; |
||
60 | |||
61 | $| = 1; |
||
62 | |||
63 | # "Lon, Lat, Alt" |
||
64 | share (@GeCoords); |
||
65 | |||
66 | sub GeServer() |
||
67 | { |
||
68 | local *S; |
||
69 | |||
70 | socket (S, PF_INET , SOCK_STREAM , getprotobyname('tcp')) or die "couldn't open socket: $!"; |
||
71 | setsockopt (S, SOL_SOCKET, SO_REUSEADDR, 1); |
||
72 | bind (S, sockaddr_in($port_listen, INADDR_ANY)); |
||
73 | listen (S, 5) or die "don't hear anything: $!"; |
||
74 | |||
75 | my $ss = IO::Select->new(); |
||
76 | $ss -> add (*S); |
||
77 | |||
78 | while(1) |
||
79 | { |
||
80 | my @connections_pending = $ss->can_read(); |
||
81 | foreach (@connections_pending) |
||
82 | { |
||
83 | my $fh; |
||
84 | my $remote = accept($fh, $_); |
||
85 | |||
86 | my($port,$iaddr) = sockaddr_in($remote); |
||
87 | my $peeraddress = inet_ntoa($iaddr); |
||
88 | |||
89 | # memory-leak in threads!!! Process only one request in parallel |
||
90 | # my $t = threads->create(\&new_connection, $fh); |
||
91 | &new_connection ($fh); |
||
92 | } |
||
93 | } |
||
94 | } |
||
95 | |||
96 | |||
97 | sub new_connection |
||
98 | { |
||
99 | my $fh = shift; |
||
100 | |||
101 | binmode $fh; |
||
102 | |||
103 | my %req; |
||
104 | |||
105 | $req{HEADER}={}; |
||
106 | |||
107 | my $request_line = <$fh>; |
||
108 | my $first_line = ""; |
||
109 | |||
110 | while ($request_line ne "\r\n") |
||
111 | { |
||
112 | unless ($request_line) |
||
113 | { |
||
114 | close $fh; |
||
115 | } |
||
116 | |||
117 | chomp $request_line; |
||
118 | |||
119 | unless ($first_line) |
||
120 | { |
||
121 | $first_line = $request_line; |
||
122 | |||
123 | my @parts = split(" ", $first_line); |
||
124 | if (@parts != 3) |
||
125 | { |
||
126 | close $fh; |
||
127 | } |
||
128 | |||
129 | $req{METHOD} = $parts[0]; |
||
130 | $req{OBJECT} = $parts[1]; |
||
131 | } |
||
132 | else |
||
133 | { |
||
134 | my ($name, $value) = split(": ", $request_line); |
||
135 | $name = lc $name; |
||
136 | $req{HEADER}{$name} = $value; |
||
137 | } |
||
138 | |||
139 | $request_line = <$fh>; |
||
140 | } |
||
141 | |||
142 | &http_request_handler($fh, \%req); |
||
143 | |||
144 | close $fh; |
||
145 | } |
||
146 | |||
147 | |||
148 | sub http_request_handler |
||
149 | { |
||
150 | my $fh = shift; |
||
151 | my $req_ = shift; |
||
152 | |||
153 | my %req = %$req_; |
||
154 | |||
155 | my %header = %{$req{HEADER}}; |
||
156 | |||
157 | print $fh "HTTP/1.0 200 OK\n"; |
||
158 | print $fh "Content-Type: application/vnd.google-earth.kml+xml; charset=iso-8859-1\n"; |
||
159 | print $fh "Connection: close\n\n"; |
||
160 | |||
161 | # KML Header |
||
162 | print $fh <<EOF; |
||
163 | <?xml version="1.0" encoding="UTF-8"?> |
||
164 | <kml xmlns="http://earth.google.com/kml/2.2"> |
||
165 | <Document> |
||
166 | <name>Mikrokopter GPS logging</name> |
||
167 | <Style id="MK_gps-style"> |
||
168 | <LineStyle> |
||
169 | <color>ff0000ff</color> |
||
170 | <width>2</width> |
||
171 | </LineStyle> |
||
172 | </Style> |
||
173 | <Placemark> |
||
174 | <name>Flight live</name> |
||
175 | <styleUrl>MK_gps-style</styleUrl> |
||
176 | <LineString> |
||
177 | <tessellate>1</tessellate> |
||
178 | <altitudeMode>relativeToGround</altitudeMode> |
||
179 | <coordinates> |
||
180 | EOF |
||
181 | |||
182 | # send all KML Coords for each request |
||
183 | for $i (0 .. $#GeCoords) |
||
184 | { |
||
185 | print $fh "$GeCoords[$i]\n"; |
||
186 | } |
||
187 | |||
188 | # KML Trailler |
||
189 | print $fh <<EOF; |
||
190 | </coordinates> |
||
191 | </LineString> |
||
192 | </Placemark> |
||
193 | </Document> |
||
194 | </kml> |
||
195 | EOF |
||
196 | |||
197 | # Debug: |
||
198 | # print "Method: $req{METHOD}\n"; |
||
199 | # print "Object: $req{OBJECT}\n>"; |
||
200 | # foreach my $r (keys %header) |
||
201 | # { |
||
202 | # print $r, " = ", $header{$r} , "\n"; |
||
203 | # } |
||
204 | } |
||
205 | |||
206 | 1; |
||
207 | |||
208 | __END__ |