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

Diff Legend

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