#! perl # mandatory # http server on base port use Coro::AnyEvent; our @WEBSOCKETS_FORWARDER = qw(slashflash.pl 13327); sub send { my $self = $_[0]; $self->{wbuf} .= $_[1]; $self->{ww} ||= AE::io $self->{fh}, 1, sub { my $len = syswrite $self->{fh}, $self->{wbuf}; substr $self->{wbuf}, 0, $len, ""; delete $self->{ww} unless length $self->{wbuf}; }; } sub fatal { my ($self) = @_; $self->send ("HTTP/1.1 500 internal error\015\012"); delete $self->{rw}; } sub respond { $_[0]->send ("HTTP/1.1 $_[1]\015\012" . "content-length: " . (0 + length $_[2]) . "\015\012" . "access-control-allow-origin: *\015\012" . "$_[3]\015\012$_[2]"); } my $cache_headers = "cache-control: max-age=8640000\015\012" . "etag: \"0\"\015\012"; sub content_type { return "content-type: image/png\015\012" if $_[0] =~ /^\x89PNG/; return "content-type: image/jpeg\015\012" if $_[0] =~ /^......JFIF/s; return "content-type: audio/wav\015\012" if $_[0] =~ /^RIFF/; return "content-type: audio/ogg\015\012" if $_[0] =~ /^OggS/; "content-type: text/plain\015\012" } sub copy { my ($a, $b, $buf) = @_; # ultra-lame Coro::async { while () { while (length $buf) { my $len = syswrite $b, $buf or $! == Errno::EINTR or return; substr $buf, 0, $len, ""; Coro::AnyEvent::writable $b; } Coro::AnyEvent::readable $a; sysread $a, $buf, 4096 or return; } }; } sub handle_req { my ($self) = @_; while ($self->{rbuf} =~ s/^( (?: [^\015]+ | . )+? )\015\012\015\012//xs) { my $req = $1; # we ignore headers atm. $req =~ m%^GET (\S+) HTTP/[0-9.]+\015\012% or return $self->fatal; my $uri = $1; $uri =~ s%^http://[^/]*%%i; # just in case cf::debug "HTTP GET: $self->{id} $uri"; if ($uri =~ m%^/(M?)([0-9a-f]+)$%) { # faces my $want_meta = $1; my $idx = $cf::FACEHASH{pack "H*", $2}; $idx or do { $self->respond ("404 illegal face name"), next }; if ($req =~ /if-none-match/i) { # dirtiest hack evar $self->respond ("304 not modified", "", $cache_headers); next; } my $type = cf::face::get_type $idx, 1; my $data = cf::face::get_data $idx, 1; (my $meta, $data) = unpack "(w/a*)*", $data if $type & 1; if ($want_meta) { if ($type & 1) { $self->respond ("200 OK", $meta, "content-type: text/plain\015\012" . $cache_headers); } else { $self->respond ("404 type $type has no metadata"); } } else { $self->respond ("200 OK", $data, (content_type $data) . $cache_headers); } } elsif ($uri eq "/debug") { # for debugging my $body = "
"; for my $type (6, 5, 4, 3, 2, 1, 0) { $body .= "