Initial revision
[poe:poe-loop-tk.git] / poe / samples / forkbomb.perl
1 #!perl -w -I../lib
2 # Copyright 1998 Rocco Caputo <troc@netrus.net>.  All rights reserved.
3 # This is a pre-release version.  Redistribution and modification are
4 # prohibited.
5
6 package main;
7 use strict;
8 use POE::Kernel;
9 use POE::Session;
10
11 open STDERR, '>&STDOUT';
12
13 my $kernel = new POE::Kernel();
14 my $forkbomber = 0;
15
16 sub forkbomb {
17   my $kernel = shift;
18
19   new POE::Session
20     (
21      $kernel,
22      '_start' => sub
23      {
24        my ($k, $me, $from) = @_;
25        $me->{'id'} = ++$forkbomber;
26        print $me->{'id'}, ": starting...\n";
27        $k->post_state($me, 'fork');
28      },
29      '_stop' => sub
30      {
31        my ($k, $me, $from) = @_;
32        print $me->{'id'}, ": stopping...\n";
33      },
34      '_child' => sub
35      {
36        my ($k, $me, $child_session) = @_;
37        print $me->{'id'}, ": child $child_session stopped...\n";
38      },
39      '_parent' => sub
40      {
41        my ($k, $me, $new_parent) = @_;
42        print $me->{'id'}, ": parent now is $new_parent ...\n";
43      },
44      'fork' => sub
45      {
46        my ($k, $me, $from) = @_;
47        print $me->{'id'}, ": starting new child...\n";
48        if ($forkbomber < 1000) {
49          &forkbomb($k);
50          if (($forkbomber < 500) || (rand() < 0.5)) {
51            $k->post_state($me, 'fork');
52          }
53          else {
54            print $me->{'id'}, ": preparing to stop...\n";
55          }
56        }
57        else {
58          print $me->{'id'}, ": forkbomber limit reached, b'bye!\n";
59        }
60      },
61     );
62 }
63
64 #------------------------------------------------------------------------------
65
66 &forkbomb($kernel);
67
68 $kernel->run();