httpd

#!/usr/bin/env perl6

my $port = 3333;
my $keepalive_timeout = 15;
my $keepalive_max = 100;

#use DateTime::Format::W3CDTF; # Doesn't compile 2016-01-08


class Header {
  has %!headers = ();

  method set(Str $key, Str $value) {
    %!headers{$key} = $value;
  }

  method send(IO::Socket $socket) {
    my $raw = "";
    for keys %!headers -> $key {
      say "SENT> $key: %!headers{$key}";
      $raw ~= "$key: %!headers{$key}\n";
    }
    #say "";
    $raw ~= "\n";
    #say $!content;
    $socket.write(:bin, $raw.encode('ISO-8859-1'));
  }
}

class Response {
  has $.status is rw = 500;
  has $.message is rw = 'Server Error';
  has $.header = Header.new();
  has $.content is rw = '';

  method send(IO::Socket $socket) {
    $!header.set( 'Content-Length', $!content.chars.Str );
    say "SENT> HTTP1/1 $.status $.message";
    $socket.write(:bin, "HTTP1/1 $.status $.message\n".encode('ISO-8859-1'));
    $!header.send($socket);
    $socket.write(:bin, $!content.encode('ISO-8859-1'));
  }
}


my $http_server = IO::Socket::INET.new(
  :listen,
  :localport($port),
  :reuse-address
);
say "listening on tcp/$port";


sub formatter (DateTime $dt) {
  say "Formatter called with $dt";
  return "huh?";
}

# TCP connect loop
loop {
  my $client = $http_server.accept;
  say "\nclient connected: ";

  # HTTP request loop
  loop {
    my %request = ( headers => {} );

    # Get current date/time
#    my $now = DateTime::Format::W3CDTF.new.format(DateTime.now());
    my @weekdays = < Mon Tue Wed Thu Fri Sat Sun >;
    my @months = < Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec >;
    my $now = DateTime.now( :formatter({ sprintf("%s, %02d %s %04d %02d:%02d:%02d %04d",
    @weekdays[.day-of-week -1], .day-of-month, @months[.month -1], .year, .hour, .minute, .second, .offset-in-hours*100) }) );

    # Get first line of request
    say "waiting for first line";
    my $first_line = $client.get();
    last unless $first_line;
    %request{<method uri protocol>} = $first_line.split(/\s/);
    say "\nmethod=%request{'method'}, uri=%request{'uri'}, protocol=%request{'protocol'}";

    # Get request headers
    say "receiving headers";
    while my $line = $client.get() {
      $line.chomp;
      last unless $line; # End of headers
      %request{'headers'}.push($line.split(/\:\s/, 2));
      say "RECV> " ~ $line;
    }
    say "end of headers";

    # Dump request hash for debugging
    say %request.perl;

    # Get request data (if any, check Content-Length header? FIXME)
    if (%request{'method'} ~~ /:i ^POST$/ && %request{'headers'}.{'Content-Length'}) {
      say "get request content";
      %request{'content'} = Buf.new;
      my $wanted = %request{'headers'}.{'Content-Length'};
      my $bufsiz = 4096;
      while $wanted {
        # Read $wanted bytes from client, limited to $bufsiz
        my $buffer = $client.read(:bin, $wanted > $bufsiz ?? $bufsiz !! $wanted);
        $wanted -= $buffer.elems;
        %request{'content'} ~= $buffer;
        die "Got excess data? (wanted=$wanted)" if $wanted < 0; # Should be impossible
      }
      say "received " ~ %request{'content'}.elems ~ " bytes of request content";
    }

    # Keep-alive requested?
    #%request{'keep-alive'} = %request{'headers'}.{'Connection'} ~~ /:i^keep\-alive$/;

    my $response = Response.new();

    $response.status = 200;
    $response.message = 'OK';

    $response.header.set('Server', 'Atlas/4.0.0alpha');
    $response.header.set('Content-Type','text/html; charset=UTF-8');
    $response.header.set('Cache-Control', 'no-cache');
    $response.header.set('Connection', ' keep-alive') if %request{'keep-alive'};
    $response.header.set('Date', $now.Str);

    $response.content = "<html><body><form method='post' enctype='multipart/form-data'><input type='file' name='file' value='file'><input type='submit' name='key1' value='value1'></form></body></html>\n";

    $response.send($client);

    # Keep-alive
    last unless %request{'keep-alive'};
  }

  say "closing connection";
  $client.close;
}



=finish

== Sample request

GET / HTTP/1.1
Host: localhost:3333
User-Agent: Mozilla/5.0 (X11; Ubuntu; Linux x86_64; rv:42.0) Gecko/20100101
Firefox/42.0
Accept: text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8
Accept-Language: en-US,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Cache-Control: max-age=0


== Sample response

HTTP1/1 200 OK
Content-Length: 176
Content-Type: text/html; charset=UTF-8
Server: Atlas/4.0.0alpha
Cache-Control: no-cache
Date: Sat, 09 Jan 2016 20:01:45 0100

<html><body><form method='post' enctype='multipart/form-data'><input type='file' name='file' value='file'><input type='submit' name='key1' value='value1'></form></body></html>