gistfile1.pl

use Text::MicroTemplate::File;
use AnyEvent::DBI;

my $dbh = AnyEvent::DBI->new("DBI:SQLite:dbname=users.db","","");
my $tmt = Text::MicroTemplate::File->new(
  include_path => "/home/leedo/alice-manager/templates"
);

package HTTPProxyHandler;
use base qw(Tatsumaki::Handler);
__PACKAGE__->asynchronous(1);

use Tatsumaki::HTTPClient;
use AnyEvent::HTTP;
use Try::Tiny;
use Digest::SHA1 qw/sha1_hex/;
use MIME::Base64 qw/decode_base64/;
use Encode;

sub get {
  my $self = shift;
  my $host = $self->request->uri->host;
  my ($user) = ($host =~ /^([^\.]+)/);
  my $headers = $self->request->headers;
  my $pass;
  if ($user and my $auth = $headers->header('Authorization')) {
    $auth =~ s/Basic //;
    $auth = decode_base64($auth);
    $pass = (split /:/, $auth)[1];
    $pass = sha1_hex("$pass-alicesalt");
  }
  $dbh->exec("SELECT port,password FROM users WHERE username=?", $user, sub {
    my ($dbh, $rows, $rv) = @_;
    if (!@$rows) {
      $self->response->redirect("http://www.usealice.org:5000/join",301);
      $self->finish;
      return;
    }
    elsif ($rows->[0][1] ne $pass) {
      $self->response->status(401);
      $self->response->headers->header("WWW-Authenticate" => 'Basic realm="Alice"');
      $self->finish;
      return;
    }
    else {
      my $port = $rows->[0][0];
      my $host = "http://localhost:$port";
      my $url = $host.$self->request->request_uri;
      if ($self->request->request_uri =~ /^\/stream/) {
        http_request(GET => $url,
          want_body_handle => 1,
          sub {
            my ($handle, $headers) = @_;
            $handle->on_eof(sub {
             $self->finish;
             $handle->destroy
            });
            $handle->on_read(sub {
              my $data = delete $_[0]{rbuf};
              try {
                $self->write(
                  decode_utf8($data)
                );
                $self->flush(0);
              } catch {
                $self->finish;
                $handle->destroy;
              };
            });
          }
        );        
        return;
      }
      elsif ($self->request->request_uri =~ /^\/get\/(.+)/) {
        $url = $1;
      }
      elsif ($self->request->request_uri eq "/") {
        $url = $host."/view";
      }
      Tatsumaki::HTTPClient->new->get($url, $self->async_cb(sub {
        my $res = shift;
        $self->write($res->content);
        $self->finish;
      }));
    }
  });
}

package Register;
use base qw(Tatsumaki::Handler);
__PACKAGE__->asynchronous(1);

use AnyEvent::Socket;
use AnyEvent::Handle;
use Digest::SHA1 qw/sha1_hex/;

sub get {
  my $self = shift;

  my $host = $self->request->uri->host;
  my ($subdomain) = ($host =~ /^([^\.]+)/);
  $self->response->redirect("/") unless $subdomain eq "www";

  my $params = $self->request->parameters;
  $user = $params->{user};
  if ($user and $user !~ /^[a-z1-9]{1,16}$/) {
    my $html = $tmt->render_file('register.html', $params, "invalid username");
    $self->write($html->as_string);
    $self->finish;
    return;
  }

  $dbh->exec("SELECT * FROM users WHERE username=?",$user, sub {
    my ($dbh, $rows, $rv) = @_;
    if (@$rows) {
      my $html = $tmt->render_file('register.html', $params, 'username taken');
      $self->write($html->as_string);
      $self->finish;
    }
    else {
      for (qw/user email password/) {
        if (!$params->{$_}) {
          my $html = $tmt->render_file('register.html', $params, "$_ missing");
          $self->write($html->as_string);
          $self->finish;
          return;
        }
      }
      tcp_connect 'localhost', 8888, sub {
        my $fh = shift;
        my $handle;
        $handle = AnyEvent::Handle->new(
          fh => $fh, on_eof => sub{$handle->destroy});
        $handle->push_write("$user\015\012");
        $handle->push_read(line => sub {
          my (undef, $port) = @_;
          undef $handle;
          if ($port) {
            $pass = sha1_hex("$params->{password}-alicesalt");
            $dbh->exec("INSERT INTO users (username,port,password,email) VALUES(?,?,?,?)",
              $user, $port, $pass, $params->{email}, sub {
                $self->response->redirect("http://$user.usealice.org:5000",301);
                $self->finish;
              }
            );
          }
          else {
            $self->write("didn't get a port...");
          }
        });
      };
    }
  });
}

package Join;
use base qw(Tatsumaki::Handler);

use Tatsumaki::Application;

sub get {
  my $self = shift;

  my $host = $self->request->uri->host;
  my ($subdomain) = ($host =~ /^([^\.]+)/);
  $self->response->redirect("/") unless $subdomain eq "www";

  my $html = $tmt->render_file('register.html', $self->request->parameters);
  $self->write($html->as_string);
}

package main;
my $app = Tatsumaki::Application->new(
  [
    '/join' => 'Join',
    '/register' => 'Register',
    '/' => 'HTTPProxyHandler',
  ]
);