| 1 | #! perl # mandatory |
1 | #! perl # mandatory |
| 2 | |
2 | |
| 3 | # http server on base port |
3 | # http server on base port |
| 4 | |
4 | |
| 5 | use Coro::AnyEvent; |
5 | use Coro::AnyEvent; |
|
|
6 | |
|
|
7 | our @WEBSOCKETS_FORWARDER = qw(slashflash.pl 13327); |
| 6 | |
8 | |
| 7 | sub send { |
9 | sub send { |
| 8 | my $self = $_[0]; |
10 | my $self = $_[0]; |
| 9 | |
11 | |
| 10 | $self->{wbuf} .= $_[1]; |
12 | $self->{wbuf} .= $_[1]; |
| … | |
… | |
| 38 | return "content-type: audio/x-ogg\015\012" if $_[0] =~ /^OggS/; |
40 | return "content-type: audio/x-ogg\015\012" if $_[0] =~ /^OggS/; |
| 39 | |
41 | |
| 40 | "content-type: text/plain\015\012" |
42 | "content-type: text/plain\015\012" |
| 41 | } |
43 | } |
| 42 | |
44 | |
|
|
45 | sub 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 | }; |
|
|
66 | } |
|
|
67 | |
| 43 | sub handle_req { |
68 | sub handle_req { |
| 44 | my ($self) = @_; |
69 | my ($self) = @_; |
| 45 | |
70 | |
| 46 | while ($self->{rbuf} =~ s/^( ( [^\015]+ | . )+? )\015\012\015\012//xs) { |
71 | while ($self->{rbuf} =~ s/^( (?: [^\015]+ | . )+? )\015\012\015\012//xs) { |
| 47 | my $req = $1; |
72 | my $req = $1; |
|
|
73 | my $orig_req = $req; |
| 48 | |
74 | |
| 49 | # we ignore headers atm. |
75 | # we ignore headers atm. |
| 50 | |
76 | |
| 51 | $req =~ s%^GET (\S+) HTTP/[0-9.]+\015\012%% |
77 | $req =~ s%^GET (\S+) HTTP/[0-9.]+\015\012%% |
| 52 | or return $self->fatal; |
78 | or return $self->fatal; |
| … | |
… | |
| 93 | |
119 | |
| 94 | for (1 .. cf::face::faces_size - 1) { |
120 | for (1 .. cf::face::faces_size - 1) { |
| 95 | next if $type != cf::face::get_type $_; |
121 | next if $type != cf::face::get_type $_; |
| 96 | my $name = cf::face::get_name $_; |
122 | my $name = cf::face::get_name $_; |
| 97 | my $id = unpack "H*", cf::face::get_chksum $_, 1; |
123 | my $id = unpack "H*", cf::face::get_chksum $_, 1; |
| 98 | $body .= "<a href='$id'>$name ($id)</a>"; |
124 | $body .= "$_ <a href='$id'>$name ($id)</a>"; |
| 99 | $body .= " <a href='M$id'>(meta)</a>" if $type & 1; |
125 | $body .= " <a href='M$id'>(meta)</a>" if $type & 1; |
| 100 | $body .= "<br>"; |
126 | $body .= "<br>"; |
| 101 | } |
127 | } |
| 102 | } |
128 | } |
| 103 | |
129 | |
| 104 | $body .= "</body></html>"; |
130 | $body .= "</body></html>"; |
| 105 | |
131 | |
| 106 | $self->respond ("200 OK", $body, "Content-Type: text/html\015\012"); |
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 | |
| 107 | } else { |
157 | } else { |
| 108 | $self->respond ("404 not found"); |
158 | $self->respond ("404 not found"); |
| 109 | } |
159 | } |
| 110 | } |
160 | } |
| 111 | } |
161 | } |
