resources/tinyamf.cgi

   1 #!/usr/bin/perl -w
   2
   3         # ----------------------
   4         # Tiny AMF read-only API
   5         # Richard Fairhurst 2010
   6         # richard@systemeD.net
   7
   8         # This is the simplest possible server for Halcyon (Flash vector map
   9         # renderer) to read from an OpenStreetMap database - populated by
  10         # Osmosis, for example. It has no dependencies other than DBI. It
  11         # expects to run on Apache or another server that populates the
  12         # CONTENT_LENGTH environment variable.
  13         #
  14         # The database should have the current_ tables populated, and be
  15         # consistent with a changeset and user table containing at least one
  16         # entry each. Edit the DBI->connect line to contain the connection
  17         # details for your database.
  18         #
  19         # Configure Halcyon's connection like this:
  20         #   fo.addVariable("api","tinyamf.cgi?");
  21         #   fo.addVariable("connection","AMF");
  22         #
  23         # Note the question mark at the end of tinyamf.cgi.
  24         #
  25         # Questions? Patches? Please subscribe to the potlatch-dev mailing
  26         # list at lists.openstreetmap.org and ask there.
  27
  28         # With thanks to Musicman (AMF) and Tom Hughes (quadtiles) from whose
  29         # PHP and Ruby code some of this is adapted.
  30
  31         # The following globals are maintained throughout the program:
  32         #       $d               - input file
  33         #       $offset  - position in input file
  34         #       $result  - response file
  35         #       $results - number of responses
  36         #       $dbh     - database handle
  37         #       $ppc     - PowerPC or Intel byte-order
  38
  39         use DBI;
  40         $dbh=DBI->connect('DBI:mysql:openstreetmap','openstreetmap','openstreetmap', { RaiseError =>1 } );
  41         $"=',';
  42
  43         # ----- Get data
  44
  45         $l=$ENV{'CONTENT_LENGTH'};
  46         read (STDIN, $d, $l);
  47
  48         $tmp=pack("d", 1); $ppc=0;
  49         if        ($tmp eq "\0\0\0\0\0\0\360\77") { $ppc=0; }
  50         elsif ($tmp eq "\77\360\0\0\0\0\0\0") { $ppc=1; }
  51         else { die "Unknown byte order\n"; }
  52
  53         # ----- Read headers
  54
  55         %headers=();
  56         $offset=3;
  57         $hc=ord(substr($d,$offset++,1));
  58         while (--$hc>=0) {
  59                 $key=getstr($d, $offset);
  60                 $offset++;
  61                 $lo=getlength($d, $offset);     # not used
  62                 $ch=ord(substr($d,$offset++,1));
  63                 $val=parseitem($ch, $offset);
  64                 $headers{$key}=$val;
  65         }
  66
  67         # ----- Read calls
  68
  69         $result=''; $results=0;
  70         $offset+=2;
  71         while ($offset<$l) {
  72
  73                 # -     Get call name
  74                 $fn=getstr($d, $offset);
  75
  76                 # -     Get number in sequence
  77                 $seq=substr(getstr($d, $offset),1);
  78                 $lo=getlength($d, $offset);     # length of all params? not used
  79
  80                 # -     Get all parameters (sent as an array, hence the '10')
  81                 @params=();
  82                 $ch=ord(substr($d,$offset++,1)); if ($ch!=10) { print "Error - expecting array"; }
  83                 $lo=getlength($d, $offset);
  84                 for ($ni=0; $ni<$lo; $ni++) {
  85                         $ch=ord(substr($d,$offset++,1));
  86                         $p=parseitem($ch, $offset);
  87                         push (@params,$p);
  88                 }
  89
  90                 if ($fn eq 'whichways') { addresult($seq,whichways(@params)); }
  91                 elsif ($fn eq 'getway') { addresult($seq,getway(@params)); }
  92                 elsif ($fn eq 'getrelation') { addresult($seq,getrelation(@params)); }
  93
  94         }
  95
  96         # ----- Write response
  97
  98         $dbh->disconnect();
  99
 100         print "Content-type: application/x-amf\n\n";
 101         print "\0\0\0\0";
 102         print pack("n",$results);
 103         print $result;
 104
 105
 106         # ====================================================================================
 107         # whichways
 108
 109         sub whichways {
 110                 my ($query,$query2,$sql,$id,$lat,$lon,$v,$k,$vv);
 111                 my ($xmin,$ymin,$xmax,$ymax)=@_;
 112                 my $enlarge = ($xmax-$xmin)/8; if ($enlarge<0.01) { $enlarge=0.01; }
 113                 $xmin -= $enlarge; $ymin -= $enlarge;
 114                 $xmax += $enlarge; $ymax += $enlarge;
 115                 my $sqlarea=sql_for_area($ymin,$xmin,$ymax,$xmax,'current_nodes.');
 116
 117                 # -     Ways in area
 118
 119                 $sql=<<EOF;
 120     SELECT DISTINCT current_ways.id AS wayid,current_ways.version AS version
 121                FROM current_way_nodes
 122          INNER JOIN current_nodes ON current_nodes.id=current_way_nodes.node_id
 123          INNER JOIN current_ways  ON current_ways.id =current_way_nodes.id
 124               WHERE current_nodes.visible=TRUE
 125                 AND current_ways.visible=TRUE
 126                 AND $sqlarea
 127 EOF
 128                 $query=$dbh->prepare($sql); $query->execute();
 129                 my $ways=(); my @wayids=();
 130                 while (($id,$v)=$query->fetchrow_array()) { push (@ways,[$id,$v]); push (@wayids,$id); }
 131                 $query->finish();
 132
 133                 # - POIs in area
 134
 135                 $sql=<<EOF;
 136           SELECT current_nodes.id,current_nodes.latitude*0.0000001 AS lat,current_nodes.longitude*0.0000001 AS lon,current_nodes.version
 137             FROM current_nodes
 138  LEFT OUTER JOIN current_way_nodes cwn ON cwn.node_id=current_nodes.id
 139            WHERE current_nodes.visible=TRUE
 140              AND cwn.id IS NULL
 141              AND $sqlarea
 142 EOF
 143                 $query=$dbh->prepare($sql); $query->execute();
 144                 my @pois=();
 145                 while (($id,$lat,$lon,$v)=$query->fetchrow_array()) {
 146                         my %tags=();
 147                         $query2=$dbh->prepare("SELECT k,v FROM current_node_tags WHERE id=?");
 148                         $query2->execute($id); while (($k,$vv)=$query2->fetchrow_array()) { $tags{$k}=$vv; }
 149                         $query2->finish();
 150                         push (@pois,[$id,$lon,$lat,{%tags},$v]);
 151                 }
 152                 $query->finish();
 153
 154                 # - Relations in area
 155
 156                 $sql=<<EOF;
 157 SELECT DISTINCT cr.id AS relid,cr.version AS version
 158            FROM current_relations cr
 159      INNER JOIN current_relation_members crm ON crm.id=cr.id
 160      INNER JOIN current_nodes ON crm.member_id=current_nodes.id AND crm.member_type='Node'
 161           WHERE $sqlarea
 162 EOF
 163                 unless ($#wayids) {
 164                         $sql.=<<EOF;
 165           UNION
 166 SELECT DISTINCT cr.id AS relid,cr.version AS version
 167            FROM current_relations cr
 168      INNER JOIN current_relation_members crm ON crm.id=cr.id
 169           WHERE crm.member_type='Way'
 170             AND crm.member_id IN (@wayids)
 171 EOF
 172                 }
 173                 $query=$dbh->prepare($sql); $query->execute();
 174                 my @rels=();
 175                 while (($id,$v)=$query->fetchrow_array()) { push (@rels,[$id,$v]); }
 176                 $query->finish();
 177
 178                 return [0,'',[@ways],[@pois],[@rels]];
 179         }
 180
 181         # ====================================================================================
 182         # getway
 183
 184         sub getway {
 185                 my $wayid=$_[0];
 186                 my ($sql,$query,$lat,$lon,$id,$v,$k,$vv,$uid,%tags);
 187                 $sql=<<EOF;
 188    SELECT latitude*0.0000001 AS lat,longitude*0.0000001 AS lon,current_nodes.id,current_nodes.version
 189      FROM current_way_nodes,current_nodes
 190     WHERE current_way_nodes.id=?
 191       AND current_way_nodes.node_id=current_nodes.id
 192       AND current_nodes.visible=TRUE
 193  ORDER BY sequence_id
 194 EOF
 195                 $query=$dbh->prepare($sql); $query->execute($wayid);
 196                 my @points=();
 197                 while (($lat,$lon,$id,$v)=$query->fetchrow_array()) {
 198                         %tags=();
 199                         $query2=$dbh->prepare("SELECT k,v FROM current_node_tags WHERE id=?");
 200                         $query2->execute($id); while (($k,$vv)=$query2->fetchrow_array()) { $tags{$k}=$vv; }
 201                         $query2->finish();
 202                         push (@points,[$lon,$lat,$id,{%tags},$v]);
 203                 }
 204                 $query->finish();
 205
 206                 $query=$dbh->prepare("SELECT k,v FROM current_way_tags WHERE id=?"); $query->execute($wayid);
 207                 %tags=();
 208                 while (($k,$vv)=$query->fetchrow_array()) { $tags{$k}=$vv; }
 209                 $query->finish();
 210
 211                 $query=$dbh->prepare("SELECT version FROM current_ways WHERE id=?"); $query->execute($wayid);
 212                 $v=$query->fetchrow_array();
 213                 $query->finish();
 214
 215                 $query=$dbh->prepare("SELECT user_id FROM current_ways,changesets WHERE current_ways.id=? AND current_ways.changeset_id=changesets.id"); $query->execute($wayid);
 216                 $uid=$query->fetchrow_array();
 217                 $query->finish();
 218
 219                 return [0, '', $wayid, [@points], {%tags}, $v, $uid];
 220         }
 221
 222         # ====================================================================================
 223         # getrelation
 224
 225         sub getrelation {
 226                 my $relid=$_[0];
 227                 my ($sql,$query,$v,$k,$vv,$type,$id,$role);
 228
 229                 $query=$dbh->prepare("SELECT member_type,member_id,member_role FROM current_relation_members,current_relations WHERE current_relations.id=? AND current_relation_members.id=current_relations.id ORDER BY sequence_id");
 230                 $query->execute($relid);
 231                 my @members=();
 232                 while (($type,$id,$role)=$query->fetchrow_array()) { push(@members,[ucfirst $type,$id,$role]); }
 233                 $query->finish();
 234
 235                 $query=$dbh->prepare("SELECT k,v FROM current_relation_tags WHERE id=?"); $query->execute($relid);
 236                 my %tags=();
 237                 while (($k,$vv)=$query->fetchrow_array()) { $tags{$k}=$vv; }
 238                 $query->finish();
 239
 240                 $query=$dbh->prepare("SELECT version FROM current_relations WHERE id=?"); $query->execute($relid);
 241                 $v=$query->fetchrow_array();
 242                 $query->finish();
 243
 244                 return [0, '', $relid, {%tags}, [@members], $v];
 245         }
 246
 247
 248         # ====================================================================================
 249         # AMF decoding routines
 250
 251         # returns object of unknown type
 252         sub parseitem {
 253                 my $ch=$_[0];
 254
 255                 if    ($ch==0) { return getnumber(); }                                  # number
 256                 elsif ($ch==1) { return ord(subtr($d,$offset++,1)); }   # boolean
 257                 elsif ($ch==2) { return getstr(); }                                             # string
 258                 elsif ($ch==3) { return getobj(); }                                             # object
 259                 elsif ($ch==5) { return undef; }                                                # null
 260                 elsif ($ch==6) { return undef; }                                                # undefined
 261                 elsif ($ch==8) { return getmixed(); }                                   # mixedArray
 262                 elsif ($ch==10){ return getarray(); }                                   # array
 263
 264                 print "Didn't recognise type $ch\n";
 265         }
 266
 267         sub getstr {
 268                 my $hi=ord(substr($d,$offset++,1));
 269                 my $lo=ord(substr($d,$offset++,1))+256*$hi;
 270                 my $val=substr($d,$offset,$lo);
 271                 $offset+=$lo;
 272                 return $val;
 273         }
 274
 275
 276         sub getnumber {
 277                 my $ibf='';
 278                 if ($ppc) { $ibf=substr($d,$offset,8); }
 279                      else { for (my $nc=7; $nc>=0; $nc--) { $ibf.=substr($d,$offset+$nc,1); } }
 280                 $offset+=8;
 281                 return unpack("d", $ibf);
 282         }
 283
 284         sub getobj {
 285                 my %ret=();
 286                 my ($key,$ch);
 287                 while($key=getstr()) {
 288                         $ch=ord(substr($d,$offset++,1));
 289                         $ret{$key}=parseitem($ch);
 290                 }
 291                 $ch=ord(substr($d,$offset++,1));
 292                 if ($ch!=9) { print "Unexpected object end: $ch"; }
 293                 return $ret;
 294         }
 295
 296         sub getmixed {
 297                 my $lo=getlength();
 298                 return getobj();
 299         }
 300
 301         sub getarray {
 302                 my @ret=();
 303                 my $lo=getlength();
 304                 for (my $ni=0; $ni<$lo; $ni++) {
 305                         my $ch=ord(substr($d,$offset++,1));
 306                         push (@ret,parseitem($ch));
 307                 }
 308                 return $ret;
 309         }
 310
 311
 312         # ====================================================================================
 313         # AMF encoding routines
 314
 315         # $data is object of unknown type
 316         sub addresult {
 317                 my $seq=$_[0]; my $data=$_[1];
 318                 $results++;
 319                 $result.=sendstr("/$seq/onResult").sendstr("null").pack("N",-1).sendobj($data);
 320         }
 321
 322         # $ref is a reference to an object of unknown type
 323         sub sendobj {
 324                 my $ref=$_[0];
 325                 my $type=ref $ref;
 326                 my ($key,$first,$n);
 327
 328                 if ($type eq 'ARRAY') {
 329                         # Send as array (code 10)
 330                         my @arr=@{$ref};
 331                         my $ret="\12".pack("N",$#arr+1);
 332                         for ($n=0; $n<=$#arr; $n++) { $ret.=sendobj($arr[$n]); }
 333                         return $ret;
 334
 335                 } elsif ($type eq 'HASH') {
 336                         # Send as object (code 3)
 337                         my %hash=%{$ref};
 338                         my $ret="\3";
 339                         foreach $key (keys %hash) { $ret.=sendstr($key).sendobj($hash{$key}); }
 340                         return $ret.sendstr('')."\11";
 341
 342                 } elsif ($ref=~/^[+\-]?[\d\.]+$/) {
 343                         # Send as number (code 0)
 344                         return "\0" . sendnum($ref);
 345
 346                 } elsif ($ref) {
 347                         # Send as string (code 2)
 348                         return "\2" . sendstr($ref);
 349
 350                 } else {
 351                         # Send as undefined
 352                         return "\6";
 353                 }
 354
 355         }
 356
 357         sub sendstr {
 358                 my $b=$_[0];
 359                 return pack("n", length($b)).$b;
 360         }
 361
 362         sub sendnum {
 363                 my $b=pack("d", $_[0]);
 364                 if ($ppc) { return $b; }
 365                 my $r=''; for (my $n=7; $n>=0; $n--) { $r.=substr($b,$n,1); }
 366                 return $r;
 367         }
 368
 369         sub getlength {
 370                 my $b=0;
 371                 for (my $c=0; $c<4; $c++) {
 372                         $b*=256;
 373                         $b+=ord(substr($d,$offset++,1));
 374                 }
 375                 return $b;
 376         }
 377
 378         # ================================================================
 379         # OSM quadtile routines
 380         # based on original Ruby code by Tom Hughes
 381
 382         sub tile_for_point {
 383                 my $lat=$_[0]; my $lon=$_[1];
 384                 return tile_for_xy(round(($lon+180)*65535/360),round(($lat+90)*65535/180));
 385         }
 386
 387         sub round {
 388                 return int($_[0] + .5 * ($_[0] <=> 0));
 389         }
 390
 391         sub tiles_for_area {
 392                 my $minlat=$_[0]; my $minlon=$_[1];
 393                 my $maxlat=$_[2]; my $maxlon=$_[3];
 394
 395                 $minx=round(($minlon + 180) * 65535 / 360);
 396                 $maxx=round(($maxlon + 180) * 65535 / 360);
 397                 $miny=round(($minlat + 90 ) * 65535 / 180);
 398                 $maxy=round(($maxlat + 90 ) * 65535 / 180);
 399                 @tiles=();
 400
 401                 for ($x=$minx; $x<=$maxx; $x++) {
 402                         for ($y=$miny; $y<=$maxy; $y++) {
 403                                 push(@tiles,tile_for_xy($x,$y));
 404                         }
 405                 }
 406                 return @tiles;
 407         }
 408
 409         sub tile_for_xy {
 410                 my $x=$_[0];
 411                 my $y=$_[1];
 412                 my $t=0;
 413                 my $i;
 414
 415                 for ($i=0; $i<16; $i++) {
 416                         $t=$t<<1;
 417                         unless (($x & 0x8000)==0) { $t=$t | 1; }
 418                         $x<<=1;
 419
 420                         $t=$t<< 1;
 421                         unless (($y & 0x8000)==0) { $t=$t | 1; }
 422                         $y<<=1;
 423                 }
 424                 return $t;
 425         }
 426
 427         sub sql_for_area {
 428                 my $minlat=$_[0]; my $minlon=$_[1];
 429                 my $maxlat=$_[2]; my $maxlon=$_[3];
 430                 my $prefix=$_[4];
 431                 my @tiles=tiles_for_area($minlat,$minlon,$maxlat,$maxlon);
 432
 433                 my @singles=();
 434                 my $sql='';
 435                 my $tile;
 436                 my $last=-2;
 437                 my @run=();
 438                 my $rl;
 439
 440                 foreach $tile (sort @tiles) {
 441                         if ($tile==$last+1) {
 442                                 # part of a run, so keep going
 443                                 push (@run,$tile);
 444                         } else {
 445                                 # end of a run
 446                                 $rl=@run;
 447                                 if ($rl<3) { push (@singles,@run); }
 448                                           else { $sql.="${prefix}tile BETWEEN ".$run[0].' AND '.$run[$rl-1]." OR "; }
 449                                 @run=();
 450                                 push (@run,$tile);
 451                         }
 452                         $last=$tile;
 453                 }
 454                 $rl=@run;
 455                 if ($rl<3) { push (@singles,@run); }
 456                           else { $sql.="${prefix}tile BETWEEN ".$run[0].' AND '.$run[$rl-1]." OR "; }
 457                 if ($#singles>-1) { $sql.="${prefix}tile IN (".join(',',@singles).') '; }
 458                 $sql=~s/ OR $//;
 459                 return $sql;
 460         }