… | |
… | |
24 | |
24 | |
25 | sub respond { |
25 | sub respond { |
26 | $_[0]->send ("HTTP/1.1 $_[1]\015\012" |
26 | $_[0]->send ("HTTP/1.1 $_[1]\015\012" |
27 | . "content-length: " . (0 + length $_[2]) . "\015\012" |
27 | . "content-length: " . (0 + length $_[2]) . "\015\012" |
28 | . "access-control-allow-origin: *\015\012" |
28 | . "access-control-allow-origin: *\015\012" |
|
|
29 | . $_[0]{ohdr} |
29 | . "$_[3]\015\012$_[2]"); |
30 | . "$_[3]\015\012$_[2]"); |
30 | } |
31 | } |
31 | |
32 | |
32 | my $cache_headers = "cache-control: max-age=8640000\015\012" |
33 | my $cache_headers = "cache-control: max-age=8640000\015\012" |
33 | . "etag: \"0\"\015\012"; |
34 | . "etag: \"0\"\015\012"; |
… | |
… | |
47 | while ($self->{rbuf} =~ s/^( (?: [^\015]+ | . )+? )\015\012\015\012//xs) { |
48 | while ($self->{rbuf} =~ s/^( (?: [^\015]+ | . )+? )\015\012\015\012//xs) { |
48 | my $req = $1; |
49 | my $req = $1; |
49 | |
50 | |
50 | # we ignore headers atm. |
51 | # we ignore headers atm. |
51 | |
52 | |
52 | $req =~ m%^GET (\S+) HTTP/[0-9.]+\015\012%i |
53 | $req =~ m%^GET (\S+) HTTP/([0-9.]+)\015\012%i |
53 | or return $self->fatal; |
54 | or return $self->fatal; |
54 | |
55 | |
55 | my $uri = $1; |
56 | my $uri = $1; |
|
|
57 | my $http = $2; |
|
|
58 | |
|
|
59 | if ($http == 1.0) { |
|
|
60 | if ($req =~ /^connection\s*:\s*keep-alive/mi) { |
|
|
61 | $self->{ohdr} = "connection: keep-alive\015\012"; |
|
|
62 | } else { |
|
|
63 | $self->{ohdr} = "connection: close\015\012"; |
|
|
64 | delete $self->{rw}; |
|
|
65 | } |
|
|
66 | } |
56 | |
67 | |
57 | $uri =~ s%^http://[^/]*%%i; # just in case |
68 | $uri =~ s%^http://[^/]*%%i; # just in case |
58 | |
69 | |
59 | cf::debug "HTTP GET: $self->{id} $uri"; |
70 | cf::debug "HTTP GET: $self->{id} $uri"; |
60 | |
71 | |