#! 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/x-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 .= "$type
";
for (1 .. cf::face::faces_size - 1) {
next if $type != cf::face::get_type $_;
my $name = cf::face::get_name $_;
my $id = unpack "H*", cf::face::get_chksum $_, 1;
$body .= "$_ $name ($id)";
$body .= " (meta)" if $type & 1;
$body .= "
";
}
}
$body .= "";
$self->respond ("200 OK", $body, "Content-Type: text/html\015\012");
} elsif ($uri eq "/ws") {
my $fh = $self->{fh};
my $buf = "$req\015\012\015\012$self->{rbuf}";
%$self = ();
&AnyEvent::Socket::tcp_connect (@WEBSOCKETS_FORWARDER, sub {
my ($fh2) = shift;
Coro::async {
if ($fh2) {
my $a = copy $fh, $fh2, $buf;
my $b = copy $fh2, $fh;
$a->join;
$b->join;
close $fh2;
}
close $fh;
};
});
} else {
$self->respond ("404 not found");
}
}
}
# dirty hack: called directly from tcp.ext
sub server {
my $self = bless {
id => $_[0],
fh => $_[1],
rbuf => $_[2],
wbuf => "",
};
$self->{rw} = AE::io $self->{fh}, 0, sub {
my $len = sysread $self->{fh}, $self->{rbuf}, 4096, length $self->{rbuf};
if ($len == 0) {
delete $self->{rw};
} else {
$self->handle_req;
delete $self->{rw} if length $self->{rbuf} > 8192; # headers too long
}
};
$self->handle_req; # in the unlikely case of the buffer already forming a valid request
}
cf::register_exticmd http_faceurl => sub {
my ($ns) = @_;
"/"
};