ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/cvsroot/Coro/myhttpd/httpd.pl
(Generate patch)

Comparing cvsroot/Coro/myhttpd/httpd.pl (file contents):
Revision 1.89 by root, Sun Jan 24 20:44:34 2010 UTC vs.
Revision 1.92 by root, Tue Mar 9 16:46:23 2010 UTC

1use Coro; 1use Coro;
2use Coro::Semaphore; 2use Coro::Semaphore;
3use Coro::SemaphoreSet;
3use Coro::EV; 4use Coro::EV;
4use Coro::Socket; 5use Coro::Socket;
5use Coro::Signal; 6use Coro::Signal;
6use Coro::AIO (); 7use Coro::AIO ();
7 8
9use Fcntl;
8use HTTP::Date; 10use HTTP::Date;
9use POSIX (); 11use POSIX ();
10 12
11use Compress::Zlib (); 13use Compress::Zlib ();
12 14
13no utf8; 15use common::sense;
14use bytes;
15 16
16# at least on my machine, this thingy serves files 17# at least on my machine, this thingy serves files
17# quite a bit faster than apache, ;) 18# quite a bit faster than apache, ;)
18# and quite a bit slower than thttpd :( 19# and quite a bit slower than thttpd :(
19 20
20$SIG{PIPE} = 'IGNORE'; 21$SIG{PIPE} = 'IGNORE';
21 22
22our $accesslog; 23our $accesslog;
23our $errorlog; 24our $errorlog;
25our @listen_sockets;
24 26
25our $NOW; 27our $NOW;
26our $HTTP_NOW; 28our $HTTP_NOW;
27 29
28our $ERROR_LOG; 30our $ERROR_LOG;
29our $ACCESS_LOG; 31our $ACCESS_LOG;
32our $TRANSFER_LOCK = new Coro::SemaphoreSet; # lock to be acquired per ip
30 33
31our $update_time = EV::periodic 0, 1, undef, sub { 34our $update_time = EV::periodic 0, 1, undef, sub {
32 $NOW = time; 35 $NOW = time;
33 $HTTP_NOW = time2str $NOW; 36 $HTTP_NOW = time2str $NOW;
34}; 37};
… …
49} 52}
50 53
51sub slog { 54sub slog {
52 my $level = shift; 55 my $level = shift;
53 my $format = shift; 56 my $format = shift;
57
58 $format = sprintf $format, @_ if @_;
59
54 my $NOW = (POSIX::strftime "%Y-%m-%d %H:%M:%S", gmtime $::NOW); 60 my $NOW = (POSIX::strftime "%Y-%m-%d %H:%M:%S", gmtime $::NOW);
55 printf "$NOW: $format\n", @_; 61 print "$NOW: $format\n";
56 printf $errorlog "$NOW: $format\n", @_ if $errorlog; 62 printf $errorlog "$NOW: $format\n", @_ if $errorlog;
57} 63}
58 64
59our $connections = new Coro::Semaphore $MAX_CONNECTS || 250; 65our $connections = new Coro::Semaphore $::MAX_CONNECTS || 250;
60our $httpevent = new Coro::Signal; 66our $httpevent = new Coro::Signal;
61 67
62our $queue_file = new transferqueue $MAX_TRANSFERS; 68our $queue_file = new transferqueue $::MAX_TRANSFERS;
63our $queue_index = new transferqueue 10; 69our $queue_index = new transferqueue 10;
64 70
65our $tbf_top = new tbf rate => $TBF_RATE || 100000; 71our $tbf_top = new tbf rate => $::TBF_RATE || 100000;
66 72
67my $unused_bytes = 0; 73my $unused_bytes = 0;
68my $unused_last = time; 74my $unused_last = time;
69 75
70sub unused_bandwidth { 76sub unused_bandwidth {
71 $unused_bytes += $_[0]; 77 $unused_bytes += $_[0];
72 if ($unused_last < $NOW - 30 && $unused_bytes / ($NOW - $unused_last) > 50000) { 78 if ($unused_last < $NOW - 30 && $unused_bytes / ($NOW - $unused_last) > 50000) {
73 $unused_last = $NOW; 79 $unused_last = $NOW;
74 $unused_bytes = 0; 80 $unused_bytes = 0;
75 $queue_file->force_wake_next; 81 $queue_file->force_wake_next
76 slog 1, "forced filetransfer due to unused bandwidth"; 82 and slog 1, "forced filetransfer due to unused bandwidth";
77 } 83 }
78} 84}
79 85
80sub listen_on { 86sub listen_on {
81 my $listen = $_[0]; 87 my $listen = $_[0];
… …
103 } 109 }
104 }; 110 };
105} 111}
106 112
107my $http_port = new Coro::Socket 113my $http_port = new Coro::Socket
108 LocalAddr => $SERVER_HOST, 114 LocalAddr => $::SERVER_HOST,
109 LocalPort => $SERVER_PORT, 115 LocalPort => $::SERVER_PORT,
110 ReuseAddr => 1, 116 ReuseAddr => 1,
111 Listen => 50, 117 Listen => 50,
112 or die "unable to start server"; 118 or die "unable to start server";
113 119
114listen_on $http_port; 120listen_on $http_port;
115 121
116if ($SERVER_PORT2) { 122if ($::SERVER_PORT2) {
117 my $http_port = new Coro::Socket 123 my $http_port = new Coro::Socket
118 LocalAddr => $SERVER_HOST, 124 LocalAddr => $::SERVER_HOST,
119 LocalPort => $SERVER_PORT2, 125 LocalPort => $::SERVER_PORT2,
120 ReuseAddr => 1, 126 ReuseAddr => 1,
121 Listen => 50, 127 Listen => 50,
122 or die "unable to start server"; 128 or die "unable to start server";
123 129
124 listen_on $http_port; 130 listen_on $http_port;
125} 131}
126 132
127package conn; 133package conn;
128 134
129use strict; 135use common::sense;
130use bytes;
131 136
132use Socket; 137use Socket;
133use HTTP::Date; 138use HTTP::Date;
134use Convert::Scalar 'weaken'; 139use Convert::Scalar 'weaken';
135use IO::AIO; 140use IO::AIO;
… …
587 592
588 if ($self->{method} eq "GET") { 593 if ($self->{method} eq "GET") {
589 $self->{time} = $::NOW; 594 $self->{time} = $::NOW;
590 $self->{written} = 0; 595 $self->{written} = 0;
591 596
592 open my $fh, "<", $self->{path} 597 my $fh = Coro::AIO::aio_open $self->{path}, Fcntl::O_RDONLY, 0
593 or die "$self->{path}: late open failure ($!)"; 598 or die "$self->{path}: late open failure ($!)";
594 599
595 $h -= $l - 1; 600 $h -= $l - 1;
596 601
597 my $transfer = $queue->start_transfer ($h); 602 my $transfer = $queue->start_transfer ($h);
598 my $locked; 603 my $locked;
599 my $bufsize = $::WAIT_BUFSIZE; # initial buffer size 604 my $bufsize = $::WAIT_BUFSIZE; # initial buffer size
600 605
601 while ($h > 0) { 606 while ($h > 0) {
607 Coro::cede;
608 my $transfer_lock = $TRANSFER_LOCK->guard ($self->{remote_id});
609
602 unless ($locked) { 610 unless ($locked) {
603 if ($locked ||= $transfer->try ($::WAIT_INTERVAL)) { 611 if ($locked ||= $transfer->try ($::WAIT_INTERVAL)) {
604 $bufsize = $::BUFSIZE; 612 $bufsize = $::BUFSIZE;
605 $self->{time} = $::NOW; 613 $self->{time} = $::NOW;
606 $self->{written} = 0; 614 $self->{written} = 0;

Diff Legend

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