| … | |
… | |
| 68 | sub handle_req { |
68 | sub handle_req { |
| 69 | my ($self) = @_; |
69 | my ($self) = @_; |
| 70 | |
70 | |
| 71 | while ($self->{rbuf} =~ s/^( (?: [^\015]+ | . )+? )\015\012\015\012//xs) { |
71 | while ($self->{rbuf} =~ s/^( (?: [^\015]+ | . )+? )\015\012\015\012//xs) { |
| 72 | my $req = $1; |
72 | my $req = $1; |
| 73 | my $orig_req = $req; |
|
|
| 74 | |
73 | |
| 75 | # we ignore headers atm. |
74 | # we ignore headers atm. |
| 76 | |
75 | |
| 77 | $req =~ s%^GET (\S+) HTTP/[0-9.]+\015\012%% |
76 | $req =~ m%^GET (\S+) HTTP/[0-9.]+\015\012% |
| 78 | or return $self->fatal; |
77 | or return $self->fatal; |
| 79 | |
78 | |
| 80 | my $uri = $1; |
79 | my $uri = $1; |
| 81 | |
80 | |
| 82 | $uri =~ s%^http://[^/]*%%i; # just in case |
81 | $uri =~ s%^http://[^/]*%%i; # just in case |
| … | |
… | |
| 130 | $body .= "</body></html>"; |
129 | $body .= "</body></html>"; |
| 131 | |
130 | |
| 132 | $self->respond ("200 OK", $body, "Content-Type: text/html\015\012"); |
131 | $self->respond ("200 OK", $body, "Content-Type: text/html\015\012"); |
| 133 | } elsif ($uri eq "/ws") { |
132 | } elsif ($uri eq "/ws") { |
| 134 | my $fh = $self->{fh}; |
133 | my $fh = $self->{fh}; |
| 135 | my $buf = $orig_req . "\015\012\015\012" . $self->{rbuf}; |
134 | my $buf = "$req\015\012\015\012$self->{rbuf}"; |
| 136 | |
135 | |
| 137 | %$self = (); |
136 | %$self = (); |
| 138 | |
137 | |
| 139 | &AnyEvent::Socket::tcp_connect (@WEBSOCKETS_FORWARDER, sub { |
138 | &AnyEvent::Socket::tcp_connect (@WEBSOCKETS_FORWARDER, sub { |
| 140 | my ($fh2) = shift; |
139 | my ($fh2) = shift; |
