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

Comparing deliantra/server/ext/http.ext (file contents):
Revision 1.3 by root, Tue Oct 30 17:43:16 2012 UTC vs.
Revision 1.9 by root, Wed Oct 31 19:41:32 2012 UTC

1#! perl # mandatory 1#! perl # mandatory
2 2
3# http server on base port 3# http server on base port
4 4
5use Coro::AnyEvent; 5use Coro::AnyEvent;
6
7our @WEBSOCKETS_FORWARDER = qw(slashflash.pl 13327);
6 8
7sub send { 9sub send {
8 my $self = $_[0]; 10 my $self = $_[0];
9 11
10 $self->{wbuf} .= $_[1]; 12 $self->{wbuf} .= $_[1];
… …
23 $self->send ("HTTP/1.1 500 internal error\015\012"); 25 $self->send ("HTTP/1.1 500 internal error\015\012");
24 delete $self->{rw}; 26 delete $self->{rw};
25} 27}
26 28
27sub respond { 29sub respond {
28 $_[0]->send ("HTTP/1.1 $_[1]\015\012Content-Length: " . (0 + length $_[2]) . "\015\012$_[3]\015\012$_[2]"); 30 $_[0]->send ("HTTP/1.1 $_[1]\015\012content-length: " . (0 + length $_[2]) . "\015\012$_[3]\015\012$_[2]");
31}
32
33my $cache_headers = "cache-control: max-age=8640000\015\012"
34 . "etag: \"0\"\015\012";
35
36sub content_type {
37 return "content-type: image/png\015\012" if $_[0] =~ /^\x89PNG/;
38 return "content-type: image/jpeg\015\012" if $_[0] =~ /^......JFIF/s;
39 return "content-type: audio/wav\015\012" if $_[0] =~ /^RIFF/;
40 return "content-type: audio/x-ogg\015\012" if $_[0] =~ /^OggS/;
41
42 "content-type: text/plain\015\012"
43}
44
45sub copy {
46 my ($a, $b, $buf) = @_;
47
48 # ultra-lame
49 Coro::async {
50 while () {
51 while (length $buf) {
52 my $len = syswrite $b, $buf
53 or $! == Errno::EINTR
54 or return;
55
56 substr $buf, 0, $len, "";
57
58 Coro::AnyEvent::writable $b;
59 }
60
61 Coro::AnyEvent::readable $a;
62 sysread $a, $buf, 4096
63 or return;
64 }
65 };
29} 66}
30 67
31sub handle_req { 68sub handle_req {
32 my ($self) = @_; 69 my ($self) = @_;
33 70
34 $self->{rbuf} =~ s/^( ( [^\015]+ | . )+? )\015\012\015\012//xs 71 while ($self->{rbuf} =~ s/^( (?: [^\015]+ | . )+? )\015\012\015\012//xs) {
35 or return; 72 my $req = $1;
73 my $orig_req = $req;
36 74
37 my $req = $1; 75 # we ignore headers atm.
38 76
39 # we ignore headers atm. 77 $req =~ s%^GET (\S+) HTTP/[0-9.]+\015\012%%
78 or return $self->fatal;
40 79
41 $req =~ s%^GET (\S+) HTTP/[0-9.]+\015\012%% 80 my $uri = $1;
42 or return $self->fatal;
43 81
44 my $uri = $1; 82 $uri =~ s%^http://[^/]*%%i; # just in case
45 83
46 $uri =~ s%^http://[^/]*%%i; # just in case 84 cf::debug "HTTP GET: $self->{id} $uri";
47 85
48 cf::debug "HTTP GET: $self->{id} $uri"; 86 if ($uri =~ m%^/(M?)([0-9a-f]+)$%) { # faces
87 my $want_meta = $1;
88 my $idx = $cf::FACEHASH{pack "H*", $2};
49 89
50 if ($uri =~ m%^/([0-9a-f]+)$%) { # faces 90 $idx
51 my $idx = $cf::FACEHASH{pack "H*", $1}; 91 or do { $self->respond ("404 illegal face name"), next };
52 92
53 $idx 93 if ($req =~ /if-none-match/i) { # dirtiest hack evar
54 or return $self->respond ("404 illegal face name"); 94 $self->respond ("304 not modified", "", $cache_headers);
95 next;
96 }
55 97
56 my $type = cf::face::get_type $idx, 1; 98 my $type = cf::face::get_type $idx, 1;
99 my $data = cf::face::get_data $idx, 1;
57 100
101 (my $meta, $data) = unpack "(w/a*)*", $data
102 if $type & 1;
103
104 if ($want_meta) {
58 if ($type & 1) { 105 if ($type & 1) {
106 $self->respond ("200 OK", $meta, "content-type: text/plain\015\012" . $cache_headers);
107 } else {
59 $self->respond ("404 type $type not served yet"); 108 $self->respond ("404 type $type has no metadata");
109 }
110 } else {
111 $self->respond ("200 OK", $data, (content_type $data) . $cache_headers);
112 }
113
114 } elsif ($uri eq "/debug") { # for debugging
115 my $body = "<html><body>";
116
117 for my $type (6, 5, 4, 3, 2, 1, 0) {
118 $body .= "<h1>$type</h1>";
119
120 for (1 .. cf::face::faces_size - 1) {
121 next if $type != cf::face::get_type $_;
122 my $name = cf::face::get_name $_;
123 my $id = unpack "H*", cf::face::get_chksum $_, 1;
124 $body .= "$_ <a href='$id'>$name ($id)</a>";
125 $body .= " <a href='M$id'>(meta)</a>" if $type & 1;
126 $body .= "<br>";
127 }
128 }
129
130 $body .= "</body></html>";
131
132 $self->respond ("200 OK", $body, "Content-Type: text/html\015\012");
133 } elsif ($uri eq "/ws") {
134 my $fh = $self->{fh};
135 my $buf = $orig_req . "\015\012\015\012" . $self->{rbuf};
136
137 %$self = ();
138
139 &AnyEvent::Socket::tcp_connect (@WEBSOCKETS_FORWARDER, sub {
140 my ($fh2) = shift;
141
142 Coro::async {
143 if ($fh2) {
144 my $a = copy $fh, $fh2, $buf;
145 my $b = copy $fh2, $fh;
146
147 $a->join;
148 $b->join;
149
150 close $fh2;
151 }
152
153 close $fh;
154 };
155 });
156
60 } else { 157 } else {
61 if ($type == 0) { # faces 158 $self->respond ("404 not found");
62 $self->respond ("200 OK", (cf::face::get_data $idx, 1), "Content-Type: image/png\015\012Cache-Control: max-age=864000\015\012");
63 } else {
64 $self->respond ("404 type $type not served yet");
65 }
66 } 159 }
67 } elsif ($uri eq "/allimgs") { # for debugging
68 my $body = "<html><body>";
69
70 for (1 .. cf::face::faces_size - 1) {
71 next if cf::face::get_type $_;
72 my $name = cf::face::get_chksum $_, 1;
73 $body .= "<img src='" . (unpack "H*", $name) . "'><br>";
74 }
75
76 $body .= "</body></html>";
77
78 $self->respond ("200 OK", $body, "Content-Type: text/html\015\012");
79 } else {
80 $self->respond ("404 not found");
81 } 160 }
82} 161}
83 162
84# dirty hack: called directly from tcp.ext 163# dirty hack: called directly from tcp.ext
85sub server { 164sub server {

Diff Legend

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