… | |
… | |
55 | our $httpevent = new Coro::Signal; |
55 | our $httpevent = new Coro::Signal; |
56 | |
56 | |
57 | our $queue_file = new transferqueue $MAX_TRANSFERS; |
57 | our $queue_file = new transferqueue $MAX_TRANSFERS; |
58 | our $queue_index = new transferqueue 10; |
58 | our $queue_index = new transferqueue 10; |
59 | |
59 | |
60 | our $tbf_top = new tbf rate => 200000; |
60 | our $tbf_top = new tbf rate => $TBF_RATE || 100000; |
|
|
61 | |
|
|
62 | my $unused_bytes = 0; |
|
|
63 | my $unused_last = time; |
|
|
64 | |
|
|
65 | sub unused_bandwidth { |
|
|
66 | $unused_bytes += $_[0]; |
|
|
67 | if ($unused_last < $NOW - 30 && $unused_bytes / ($NOW - $unused_last) > 50000) { |
|
|
68 | $unused_last = $NOW; |
|
|
69 | $unused_bytes = 0; |
|
|
70 | $queue_file->force_wake_next; |
|
|
71 | slog 1, "forced filetransfer due to unused bandwidth"; |
|
|
72 | } |
|
|
73 | } |
61 | |
74 | |
62 | my @newcons; |
75 | my @newcons; |
63 | my @pool; |
76 | my @pool; |
64 | |
77 | |
65 | # one "execution thread" |
78 | # one "execution thread" |
… | |
… | |
97 | if (@pool) { |
110 | if (@pool) { |
98 | (pop @pool)->ready; |
111 | (pop @pool)->ready; |
99 | } else { |
112 | } else { |
100 | async \&handler; |
113 | async \&handler; |
101 | } |
114 | } |
102 | |
|
|
103 | } |
115 | } |
104 | }; |
116 | }; |
105 | } |
117 | } |
106 | |
118 | |
107 | my $http_port = new Coro::Socket |
119 | my $http_port = new Coro::Socket |
… | |
… | |
219 | $hdr->{"Content-Length"} = length $content; |
231 | $hdr->{"Content-Length"} = length $content; |
220 | $GZ = sprintf "GZ%02d", 100 - 100*((length $content) / $orig); |
232 | $GZ = sprintf "GZ%02d", 100 - 100*((length $content) / $orig); |
221 | } |
233 | } |
222 | |
234 | |
223 | $res .= "Date: $HTTP_NOW\015\012"; |
235 | $res .= "Date: $HTTP_NOW\015\012"; |
|
|
236 | $res .= "Server: $::NAME\015\012"; |
224 | |
237 | |
225 | while (my ($h, $v) = each %$hdr) { |
238 | while (my ($h, $v) = each %$hdr) { |
226 | $res .= "$h: $v\015\012" |
239 | $res .= "$h: $v\015\012" |
227 | } |
240 | } |
228 | $res .= "\015\012"; |
241 | $res .= "\015\012"; |
… | |
… | |
555 | |
568 | |
556 | $self->response(@code, $hdr, ""); |
569 | $self->response(@code, $hdr, ""); |
557 | |
570 | |
558 | if ($self->{method} eq "GET") { |
571 | if ($self->{method} eq "GET") { |
559 | $self->{time} = $::NOW; |
572 | $self->{time} = $::NOW; |
|
|
573 | $self->{written} = 0; |
560 | |
574 | |
561 | my $current = $Coro::current; |
575 | my $current = $Coro::current; |
562 | |
576 | |
563 | my ($fh, $buf, $r); |
577 | my ($fh, $buf, $r); |
564 | |
578 | |
… | |
… | |
580 | while ($h > 0) { |
594 | while ($h > 0) { |
581 | unless ($locked) { |
595 | unless ($locked) { |
582 | if ($locked ||= $transfer->try($::WAIT_INTERVAL)) { |
596 | if ($locked ||= $transfer->try($::WAIT_INTERVAL)) { |
583 | $bufsize = $::BUFSIZE; |
597 | $bufsize = $::BUFSIZE; |
584 | $self->{time} = $::NOW; |
598 | $self->{time} = $::NOW; |
|
|
599 | $self->{written} = 0; |
585 | } |
600 | } |
586 | } |
601 | } |
587 | |
602 | |
588 | if ($blocked{$self->{remote_id}}) { |
603 | if ($blocked{$self->{remote_id}}) { |
589 | $self->{h}{connection} = "close"; |
604 | $self->{h}{connection} = "close"; |