ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/server/ext/tcp_http.ext
(Generate patch)

Comparing deliantra/server/ext/tcp_http.ext (file contents):
Revision 1.1 by root, Tue Nov 6 01:25:48 2012 UTC vs.
Revision 1.8 by root, Fri Nov 9 00:11:49 2012 UTC

1#! perl # optional depends=tcp 1#! perl # optional depends=tcp
2 2
3# http server on base port 3# http server
4
5use Coro::AnyEvent;
6 4
7sub send { 5sub send {
8 my $self = $_[0]; 6 my $self = $_[0];
9 7
10 $self->{wbuf} .= $_[1]; 8 $self->{wbuf} .= $_[1];
… …
26 24
27sub respond { 25sub respond {
28 $_[0]->send ("HTTP/1.1 $_[1]\015\012" 26 $_[0]->send ("HTTP/1.1 $_[1]\015\012"
29 . "content-length: " . (0 + length $_[2]) . "\015\012" 27 . "content-length: " . (0 + length $_[2]) . "\015\012"
30 . "access-control-allow-origin: *\015\012" 28 . "access-control-allow-origin: *\015\012"
29 . $_[0]{ohdr}
31 . "$_[3]\015\012$_[2]"); 30 . "$_[3]\015\012$_[2]");
32} 31}
33 32
34my $cache_headers = "cache-control: max-age=8640000\015\012" 33my $cache_headers = "cache-control: max-age=8640000\015\012"
35 . "etag: \"0\"\015\012"; 34 . "etag: \"0\"\015\012";
… …
37sub content_type { 36sub content_type {
38 return "content-type: image/png\015\012" if $_[0] =~ /^\x89PNG/; 37 return "content-type: image/png\015\012" if $_[0] =~ /^\x89PNG/;
39 return "content-type: image/jpeg\015\012" if $_[0] =~ /^......JFIF/s; 38 return "content-type: image/jpeg\015\012" if $_[0] =~ /^......JFIF/s;
40 return "content-type: audio/wav\015\012" if $_[0] =~ /^RIFF/; 39 return "content-type: audio/wav\015\012" if $_[0] =~ /^RIFF/;
41 return "content-type: audio/ogg\015\012" if $_[0] =~ /^OggS/; 40 return "content-type: audio/ogg\015\012" if $_[0] =~ /^OggS/;
41 return "content-type: text/html\015\012" if $_[0] =~ /^</;
42 42
43 "content-type: text/plain\015\012" 43 "content-type: text/plain\015\012"
44} 44}
45 45
46sub handle_req { 46sub handle_req {
… …
49 while ($self->{rbuf} =~ s/^( (?: [^\015]+ | . )+? )\015\012\015\012//xs) { 49 while ($self->{rbuf} =~ s/^( (?: [^\015]+ | . )+? )\015\012\015\012//xs) {
50 my $req = $1; 50 my $req = $1;
51 51
52 # we ignore headers atm. 52 # we ignore headers atm.
53 53
54 $req =~ m%^GET (\S+) HTTP/[0-9.]+\015\012%i 54 $req =~ m%^GET (\S+) HTTP/([0-9.]+)\015\012%i
55 or return $self->fatal; 55 or return $self->fatal;
56 56
57 my $uri = $1; 57 my $uri = $1;
58 my $http = $2;
59
60 if ($http == 1.0) {
61 if ($req =~ /^connection\s*:\s*keep-alive/mi) {
62 $self->{ohdr} = "connection: keep-alive\015\012";
63 } else {
64 $self->{ohdr} = "connection: close\015\012";
65 delete $self->{rw};
66 }
67 }
58 68
59 $uri =~ s%^http://[^/]*%%i; # just in case 69 $uri =~ s%^http://[^/]*%%i; # just in case
60 70
61 cf::debug "HTTP GET: $self->{id} $uri"; 71 cf::debug "HTTP GET: $self->{id} $uri";
62 72
63 if ($uri =~ m%^/(M?)([0-9a-f]+)$%) { # faces 73 if ($uri =~ m%^/([0-9a-f]+)(M?)$%) { # faces
64 my $want_meta = $1; 74 my $want_meta = $2;
65 my $idx = $cf::FACEHASH{pack "H*", $2}; 75 my $idx = $cf::FACEHASH{pack "H*", $1};
66 76
67 $idx 77 $idx
68 or do { $self->respond ("404 illegal face name"), next }; 78 or do { $self->respond ("404 illegal face name"), next };
69 79
70 if ($req =~ /if-none-match/i) { # dirtiest hack evar 80 if ($req =~ /if-none-match/i) { # dirtiest hack evar
… …
86 } 96 }
87 } else { 97 } else {
88 $self->respond ("200 OK", $data, (content_type $data) . $cache_headers); 98 $self->respond ("200 OK", $data, (content_type $data) . $cache_headers);
89 } 99 }
90 100
101 } elsif (my $idx = (cf::face::find "res/http$uri") || (cf::face::find "res/http${uri}index.html")) {
102 # TODO: temp redirect to face itself, for caching, or use etag (shudder)
103 my $data = cf::face::get_data $idx, 1;
104 $self->respond ("200 OK", $data, (content_type $data) . $cache_headers);
105
106 } elsif (cf::face::find "res/http$uri/index.html") {
107 $self->respond ("302 dirslash", "", "location: $uri/\015\012");
108
91 } elsif ($uri eq "/debug") { # for debugging 109 } elsif ($uri eq "/debug") { # for debugging
92 my $body = "<html><body>"; 110 my @body = "<html><body>";
93 111
94 for my $type (6, 5, 4, 3, 2, 1, 0) { 112 for my $type (6, 5, 4, 3, 2, 1, 0) {
95 $body .= "<h1>$type</h1>"; 113 push @body, "<h1>$type</h1>";
96 114
97 for (1 .. cf::face::faces_size - 1) { 115 for (1 .. cf::face::faces_size - 1) {
98 next if $type != cf::face::get_type $_; 116 next if $type != cf::face::get_type $_;
99 my $name = cf::face::get_name $_; 117 my $name = cf::face::get_name $_;
100 my $id = unpack "H*", cf::face::get_chksum $_, 1; 118 my $id = unpack "H*", cf::face::get_chksum $_, 1;
101 $body .= "$_ <a href='$id'>$name ($id)</a>"; 119 push @body, "$_ <a href='$id'>$name ($id)</a>";
102 $body .= " <a href='M$id'>(meta)</a>" if $type & 1; 120 push @body, " <a href='${id}M'>(meta)</a>" if $type & 1;
103 $body .= "<br>"; 121 push @body, "<br>";
104 } 122 }
105 } 123 }
106 124
107 $body .= "</body></html>"; 125 push @body, "</body></html>";
108 126
109 $self->respond ("200 OK", $body, "Content-Type: text/html\015\012"); 127 $self->respond ("200 OK", (join "", @body), "content-type: text/html\015\012");
110 } elsif ($uri eq "/ws" && defined &ext::ws::server) { 128 } elsif ($uri eq "/ws" && defined &ext::ws::server) {
111 &ext::ws::server ($self->{id}, $self->{fh}, "$req\015\012\015\012$self->{rbuf}"); 129 &ext::ws::server ($self->{id}, $self->{fh}, "$req\015\012\015\012$self->{rbuf}");
112 130
113 %$self = (); 131 %$self = ();
114 132
… …
118 } 136 }
119} 137}
120 138
121our $DETECTOR = ext::tcp::register http => 64, sub { 139our $DETECTOR = ext::tcp::register http => 64, sub {
122 # regex avoids conflict with websockets, which use /ws 140 # regex avoids conflict with websockets, which use /ws
123 m{^(?:(?i)GET|HEAD|OPTIONS) \ (?: [^/] | /[^w] | /w[^s] /ws[^\ ] ) }x 141 m{^(?i:GET|HEAD|OPTIONS) \ (?! (?i:http://[^/]+)? /ws \ ) }x
124}, sub { 142}, sub {
125 my $self = bless { 143 my $self = bless {
126 id => $_[0], 144 id => $_[0],
127 fh => $_[1], 145 fh => $_[1],
128 rbuf => $_[2], 146 rbuf => $_[2],

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines