Coro/myhttpd/tbf.pl

package tbf;

# kind of token-bucket-filter

my $max_per_client = $::TBF_MAX_PER_CLIENT || 24000;

sub new {
   my $class = shift;
   my %arg = @_;
   my $self = bless \%arg, $class;

   $self->{maxbucket} ||= $self->{rate} * 3; # max 3s bucket
   $self->{minbucket} ||= $self->{rate}; # minimum bucket to share
   $self->{interval}  ||= $::BUFSIZE / $max_per_client; # good default interval

   if ($self->{rate}) {
      $self->{w} = Event->timer(hard => 1, after => 0, interval => $self->{interval}, repeat => 1, cb => sub {
         $self->inject($self->{rate} * $self->{interval});
      });
   } else {
      die "chaining not yet implemented\n";
   }

   $self;
}

sub DESTROY {
   my $self = shift;

   $self->{w}->cancel;
}

sub inject {
   my ($self, $bytes) = @_;

   $self->{bucket} += $bytes;

   while ($self->{bucket} >= $self->{minbucket}) {
      if ($self->{waitw}) {
         my $rate = $self->{bucket} / $self->{waitw};

         for my $v (values %{$self->{waitq}}) {
            $self->{bucket} -= $rate * $v->[0];
            $v->[1]         += $rate * $v->[0];

            if ($v->[1] >= $v->[2]) {
               $self->{bucket} += $v->[1] - $v->[2];
               $v->[3]->();
            }
         }

      }
      last;
   }

   if ($self->{maxbucket} < $self->{bucket}) {
      ::unused_bandwidth ($self->{bucket} - $self->{maxbucket});
      $self->{bucket} = $self->{maxbucket};
   }
}

my $_tbf_id;

sub request {
   my ($self, $bytes, $weight) = @_;

   $weight ||= 1;

   my $coro = $Coro::current;
   my $id   = $_tbf_id++;

   $self->{waitw} += $weight;
   $self->{waitq}{$id} = [$weight, 0, $bytes, sub {
      delete $self->{waitq}{$id};
      $self->{waitw} -= $weight;
      $coro->ready;
   }];

   Coro::schedule;
}

1;
Revision:	1.5
Committed:	Thu Nov 21 09:52:34 2002 UTC (23 years, 11 months ago) by root
Content type:	text/plain
Branch:	MAIN
CVS Tags:	rel-2_5, rel-4_22, rel-4_21, rel-4_0, rel-4_3, rel-3_41, rel-4_13, rel-4_11, rel-3_55, rel-3_51, rel-4_01, rel-4_03, rel-4_02, rel-2_0, rel-2_1, rel-1_1, rel-1_0, rel-1_9, rel-1_2, rel-3_6, rel-3_62, rel-3_63, rel-3_61, rel-1_5, rel-1_4, rel-1_7, rel-1_6, rel-3_4, rel-3_1, rel-3_5, rel-3_3, rel-3_2, rel-3_0, rel-3_01, rel-3_11, rel-1_31, rel-4_1, rel-4_2, stack_sharing, rel-3_501, rel-4_31
Changes since 1.4:	+1 -1 lines
Log Message:	config.pl.dist
#	Content
1	package tbf;
2
3	# kind of token-bucket-filter
4
5	my $max_per_client = $::TBF_MAX_PER_CLIENT \|\| 24000;
6
7	sub new {
8	my $class = shift;
9	my %arg = @_;
10	my $self = bless \%arg, $class;
11
12	$self->{maxbucket} \|\|= $self->{rate} * 3; # max 3s bucket
13	$self->{minbucket} \|\|= $self->{rate}; # minimum bucket to share
14	$self->{interval} \|\|= $::BUFSIZE / $max_per_client; # good default interval
15
16	if ($self->{rate}) {
17	$self->{w} = Event->timer(hard => 1, after => 0, interval => $self->{interval}, repeat => 1, cb => sub {
18	$self->inject($self->{rate} * $self->{interval});
19	});
20	} else {
21	die "chaining not yet implemented\n";
22	}
23
24	$self;
25	}
26
27	sub DESTROY {
28	my $self = shift;
29
30	$self->{w}->cancel;
31	}
32
33	sub inject {
34	my ($self, $bytes) = @_;
35
36	$self->{bucket} += $bytes;
37
38	while ($self->{bucket} >= $self->{minbucket}) {
39	if ($self->{waitw}) {
40	my $rate = $self->{bucket} / $self->{waitw};
41
42	for my $v (values %{$self->{waitq}}) {
43	$self->{bucket} -= $rate * $v->[0];
44	$v->[1] += $rate * $v->[0];
45
46	if ($v->[1] >= $v->[2]) {
47	$self->{bucket} += $v->[1] - $v->[2];
48	$v->[3]->();
49	}
50	}
51
52	}
53	last;
54	}
55
56	if ($self->{maxbucket} < $self->{bucket}) {
57	::unused_bandwidth ($self->{bucket} - $self->{maxbucket});
58	$self->{bucket} = $self->{maxbucket};
59	}
60	}
61
62	my $_tbf_id;
63
64	sub request {
65	my ($self, $bytes, $weight) = @_;
66
67	$weight \|\|= 1;
68
69	my $coro = $Coro::current;
70	my $id = $_tbf_id++;
71
72	$self->{waitw} += $weight;
73	$self->{waitq}{$id} = [$weight, 0, $bytes, sub {
74	delete $self->{waitq}{$id};
75	$self->{waitw} -= $weight;
76	$coro->ready;
77	}];
78
79	Coro::schedule;
80	}
81
82	1;