#! perl # mandatory

# http server on base port

use Coro::AnyEvent;

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\012Content-Length: " . (0 + length $_[2]) . "\015\012$_[3]\015\012$_[2]");
}

sub handle_req {
   my ($self) = @_;

   $self->{rbuf} =~ s/^( ( [^\015]+ | . )+? )\015\012\015\012//xs
      or return;

   my $req = $1;

   # we ignore headers atm.

   $req =~ s%^GET (\S+) HTTP/[0-9.]+\015\012%%
      or return $self->fatal;

   my $uri = $1;

   if ($uri =~ m%^/([0-9a-f]+)$%) { # faces
      my $idx = $cf::FACEHASH{pack "H*", $1};

      $idx
         or return $self->respond ("404 illegal face name");

      my $type = cf::face::get_type $idx, 1;

      if ($type & 1) {
         $self->respond ("404 type $type not served yet");
      } else {
         if ($type == 0) { # faces
            $self->respond ("200 OK", (cf::face::get_data $idx, 1), "Content-Type: image/png\015\012");
         } else {
            $self->respond ("404 type $type not served yet");
         }
      }
   } else {
      $self->respond ("404 not found");
   }
}

# dirty hack: called directly from tcp.ext
sub server {
   my $self = bless {
      fh   => $_[0],
      rbuf => $_[1],
      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) = @_;

   "/"
};