Skip to content

Instantly share code, notes, and snippets.

@tony-o
Created April 5, 2015 20:45
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
Star You must be signed in to star a gist
Save tony-o/ae5c68d1b61ce97db09e to your computer and use it in GitHub Desktop.

##script

class HTTP::Server::Threaded;

has Str $.host = '127.0.0.1';
has Int $.port = 8081;
has Int $.timeout = 5;

has Channel $.connection-channel .= new;
has Channel $.request-channel    .= new;
has Channel $.response-channel   .= new;

has IO::Socket::INET $!server;

has %.connections;

method listen(Bool $block? = True) {
  my Promise $promise .= new;
  
  $!server = IO::Socket::INET.new(localhost => $.host, localport => $.port, :listen, input-line-separator => "\r\n\r\n");
  self!setup;

  my $listen = sub {
    while my $conn = $!server.accept {
      $.connection-channel.send($conn);
    }
    $promise.keep;
    $.connection-channel.close;
    $.requeset-channel.close;
    $.response-channel.close;
  };

  start({ $listen(); }) if !$block;
  $listen() if $block;
    
  $promise; 
}


method !setup {
  self!connection-handler;
  self!request-handler;
}

method !connection-handler {
  start({
    my $id = 0;
    loop {
      my $conn = $.connection-channel.receive;
      my $local-id = $id++;
      %.connections{$local-id} = {
        connection => $conn,
        cache      => Buf.new,
      };
      $.request-channel.send($local-id);
    }
  });
}

method !request-handler {
  start({
    loop {
      my $id = $.request-channel.receive;
      "$id recv".say;
      %.connections{$id}<connection>.^methods.say;
      #%.connections{$id}<connection>.write("HTTP/1.0 200 OK\r\nContent-length: 16\r\nContent-type: text/html\r\n\r\n<html>Hi.</html>".encode('utf8'));
      #%.connections{$id}<connection>.close; next;
      while my $data = %.connections{$id}<connection>.recv(:bin) {
        %.connections{$id}<cache> ~= $data;
      }
      $data.perl.say;
      CATCH { .say; .resume; }
    }
  });
}

##one liner to start it

perl6 -Ilib -e 'use HTTP::Server::Threaded; my $s = HTTP::Server::Threaded.new(); $s.listen;'
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment