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.2 by root, Tue Nov 6 03:45:17 2012 UTC vs.
Revision 1.8 by root, Fri Nov 9 00:11:49 2012 UTC

24 24
25sub respond { 25sub 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
32my $cache_headers = "cache-control: max-age=8640000\015\012" 33my $cache_headers = "cache-control: max-age=8640000\015\012"
33 . "etag: \"0\"\015\012"; 34 . "etag: \"0\"\015\012";
35sub content_type { 36sub content_type {
36 return "content-type: image/png\015\012" if $_[0] =~ /^\x89PNG/; 37 return "content-type: image/png\015\012" if $_[0] =~ /^\x89PNG/;
37 return "content-type: image/jpeg\015\012" if $_[0] =~ /^......JFIF/s; 38 return "content-type: image/jpeg\015\012" if $_[0] =~ /^......JFIF/s;
38 return "content-type: audio/wav\015\012" if $_[0] =~ /^RIFF/; 39 return "content-type: audio/wav\015\012" if $_[0] =~ /^RIFF/;
39 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] =~ /^</;
40 42
41 "content-type: text/plain\015\012" 43 "content-type: text/plain\015\012"
42} 44}
43 45
44sub handle_req { 46sub handle_req {
47 while ($self->{rbuf} =~ s/^( (?: [^\015]+ | . )+? )\015\012\015\012//xs) { 49 while ($self->{rbuf} =~ s/^( (?: [^\015]+ | . )+? )\015\012\015\012//xs) {
48 my $req = $1; 50 my $req = $1;
49 51
50 # we ignore headers atm. 52 # we ignore headers atm.
51 53
52 $req =~ m%^GET (\S+) HTTP/[0-9.]+\015\012%i 54 $req =~ m%^GET (\S+) HTTP/([0-9.]+)\015\012%i
53 or return $self->fatal; 55 or return $self->fatal;
54 56
55 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 }
56 68
57 $uri =~ s%^http://[^/]*%%i; # just in case 69 $uri =~ s%^http://[^/]*%%i; # just in case
58 70
59 cf::debug "HTTP GET: $self->{id} $uri"; 71 cf::debug "HTTP GET: $self->{id} $uri";
60 72
61 if ($uri =~ m%^/(M?)([0-9a-f]+)$%) { # faces 73 if ($uri =~ m%^/([0-9a-f]+)(M?)$%) { # faces
62 my $want_meta = $1; 74 my $want_meta = $2;
63 my $idx = $cf::FACEHASH{pack "H*", $2}; 75 my $idx = $cf::FACEHASH{pack "H*", $1};
64 76
65 $idx 77 $idx
66 or do { $self->respond ("404 illegal face name"), next }; 78 or do { $self->respond ("404 illegal face name"), next };
67 79
68 if ($req =~ /if-none-match/i) { # dirtiest hack evar 80 if ($req =~ /if-none-match/i) { # dirtiest hack evar
84 } 96 }
85 } else { 97 } else {
86 $self->respond ("200 OK", $data, (content_type $data) . $cache_headers); 98 $self->respond ("200 OK", $data, (content_type $data) . $cache_headers);
87 } 99 }
88 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
89 } elsif ($uri eq "/debug") { # for debugging 109 } elsif ($uri eq "/debug") { # for debugging
90 my $body = "<html><body>"; 110 my @body = "<html><body>";
91 111
92 for my $type (6, 5, 4, 3, 2, 1, 0) { 112 for my $type (6, 5, 4, 3, 2, 1, 0) {
93 $body .= "<h1>$type</h1>"; 113 push @body, "<h1>$type</h1>";
94 114
95 for (1 .. cf::face::faces_size - 1) { 115 for (1 .. cf::face::faces_size - 1) {
96 next if $type != cf::face::get_type $_; 116 next if $type != cf::face::get_type $_;
97 my $name = cf::face::get_name $_; 117 my $name = cf::face::get_name $_;
98 my $id = unpack "H*", cf::face::get_chksum $_, 1; 118 my $id = unpack "H*", cf::face::get_chksum $_, 1;
99 $body .= "$_ <a href='$id'>$name ($id)</a>"; 119 push @body, "$_ <a href='$id'>$name ($id)</a>";
100 $body .= " <a href='M$id'>(meta)</a>" if $type & 1; 120 push @body, " <a href='${id}M'>(meta)</a>" if $type & 1;
101 $body .= "<br>"; 121 push @body, "<br>";
102 } 122 }
103 } 123 }
104 124
105 $body .= "</body></html>"; 125 push @body, "</body></html>";
106 126
107 $self->respond ("200 OK", $body, "Content-Type: text/html\015\012"); 127 $self->respond ("200 OK", (join "", @body), "content-type: text/html\015\012");
108 } elsif ($uri eq "/ws" && defined &ext::ws::server) { 128 } elsif ($uri eq "/ws" && defined &ext::ws::server) {
109 &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}");
110 130
111 %$self = (); 131 %$self = ();
112 132

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines