ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/cvsroot/Net-XMPP2/samples/limit_searcher
(Generate patch)

Comparing cvsroot/Net-XMPP2/samples/limit_searcher (file contents):
Revision 1.1 by elmex, Fri Jul 6 09:43:41 2007 UTC vs.
Revision 1.2 by elmex, Fri Jul 6 15:19:52 2007 UTC

… …
8use Net::XMPP2::Ext::Disco; 8use Net::XMPP2::Ext::Disco;
9 9
10my $j = AnyEvent->condvar; 10my $j = AnyEvent->condvar;
11my $cl = Net::XMPP2::Client->new; 11my $cl = Net::XMPP2::Client->new;
12 12
13#$cl->add_account ('net_xmpp2@jabber.org', 'test'); 13$cl->add_account ('net_xmpp2@jabber.org', 'test');
14#$cl->add_account ('elmex@localhost', 'xxxxxxxx');
15$cl->add_account ('elmex@igniterealtime.org', 'xxxxxxx');
16 14
17my $max_size = 100000; 15my $max_size = 100000;
18my $first_size = $max_size; 16my $first_size = $max_size;
19my $last_nok_size = $max_size; 17my $last_nok_size = $max_size;
20my $last_ok_size = 0; 18my $last_ok_size = 0;
21my $delta = 2; 19my $delta = 10;
22 20
23$cl->reg_cb ( 21$cl->reg_cb (
24 connected => sub { 22 connected => sub {
25 my ($cl, $acc) = @_; 23 my ($cl, $acc) = @_;
26 my $con = $acc->connection; 24 my $con = $acc->connection;
25
26 $con->{max_write_length} = 4096;
27
27 if (($last_nok_size - $last_ok_size) < $delta) { 28 if (($last_nok_size - $last_ok_size) < $delta) {
28 print "Found limit in delta range: $last_ok_size for ".$acc->jid."\n"; 29 print "Found limit in delta range: $last_ok_size for ".$acc->jid."\n";
29 $con->disconnect ("found limit"); 30 $con->disconnect ("found limit");
30 return 0; 31 return 0;
31 } 32 }
33
32 $con->send_iq (set => sub { 34 $con->send_iq (set => sub {
33 my ($w) = @_; 35 my ($w) = @_;
34 simxml ($w, 36 simxml ($w,
35 defns => 'jabber:iq:private', 37 defns => 'jabber:iq:private',
36 node => { 38 node => {
… …
38 ns => 'jabber:iq:private', 40 ns => 'jabber:iq:private',
39 childs => [ 41 childs => [
40 { name => "test", dns => "test:fe", childs => [ "A" x $first_size ] }, 42 { name => "test", dns => "test:fe", childs => [ "A" x $first_size ] },
41 ] 43 ]
42 } 44 }
43 ) 45 );
46 print "Trying $first_size...\n";
44 }, sub { 47 }, sub {
45 my ($n, $e) = @_; 48 my ($n, $e) = @_;
46 if ($e) { 49 if ($e) {
47 die "iq private error: " . $e->string . "\n"; 50 die "iq private error: " . $e->string . "\n";
48 } else { 51 } else {
… …
55 ns => 'jabber:iq:private', 58 ns => 'jabber:iq:private',
56 childs => [ { name => 'test', dns => 'test:fe' } ] 59 childs => [ { name => 'test', dns => 'test:fe' } ]
57 } 60 }
58 ); 61 );
59 }, sub { 62 }, sub {
63 my ($n, $e) = @_;
64 if ($e) {
65 $con->disconnect ("bad iq reply");
66 } else {
67 my ($q) = $n->find_all ([qw/jabber:iq:private query/],
68 [qw/test:fe test/]);
69 my $len = length $q->text;
70 if ($len == $first_size) {
60 print "$first_size seems to be ok!\n"; 71 print "$len seems to be ok!\n";
61 $last_ok_size = $first_size; 72 $last_ok_size = $first_size;
62 $first_size = $last_ok_size + ($last_nok_size - $last_ok_size) / 2; 73 $first_size = $last_ok_size + ($last_nok_size - $last_ok_size) / 2;
63 $first_size = int ($first_size); 74 $first_size = int ($first_size);
64 $con->disconnect ("retry"); 75 $con->disconnect ("retry");
76 } else {
77 $con->disconnect ("too short iq reply");
78 }
79 }
65 }); 80 });
66 } 81 }
67 }, timeout => 1000000); 82 }, timeout => 1000000);
68 83
69 1 84 1
70 }, 85 },
71 stream_error => sub { 86 stream_error => sub {
72 my ($cl, $acc, $err) = @_; 87 my ($cl, $acc, $err) = @_;
73 print "STREAM ERROR: [" . $err->string . "] at $first_size, retry...\n"; 88 print "STREAM ERROR: [" . $err->string . "] at $first_size, retry...\n";
74 $last_nok_size = $first_size;
75 $first_size = $last_ok_size + ($last_nok_size - $last_ok_size) / 2;
76 $first_size = int ($first_size);
77 1 89 1
78 }, 90 },
79 # debug_recv => sub { print "@_\n" }, 91 connect_error => sub {
92 my ($cl, $acc, $err) = @_;
93 print "Connect error ".$acc->jid.": $err\n";
94 1
95 },
80 disconnect => sub { 96 disconnect => sub {
81 my ($cl, $acc, $host, $port, $msg) = @_; 97 my ($cl, $acc, $host, $port, $msg) = @_;
82 if ($msg eq 'found limit') { $j->broadcast } 98 if ($msg eq 'found limit') { $j->broadcast }
83 print "Disconnect $msg\n"; 99 elsif ($msg ne 'retry') {
100 $last_nok_size = $first_size;
101 $first_size = $last_ok_size + ($last_nok_size - $last_ok_size) / 2;
102 $first_size = int ($first_size);
103 print "disconnect got ($msg), retry with $first_size\n";
104 }
84 $cl->update_connections; # reconnect ! 105 $cl->update_connections; # reconnect !
85 1 106 1
86 }, 107 },
87 message => sub { 108 message => sub {
88 my ($cl, $acc, $msg) = @_; 109 my ($cl, $acc, $msg) = @_;

Diff Legend

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