1 |
#!/opt/perl/bin/perl |
2 |
use strict; |
3 |
use utf8; |
4 |
use Event; |
5 |
use AnyEvent; |
6 |
use Net::XMPP2::Client; |
7 |
use Net::XMPP2::Util qw/simxml/; |
8 |
use Net::XMPP2::Ext::Disco; |
9 |
|
10 |
my $j = AnyEvent->condvar; |
11 |
my $cl = Net::XMPP2::Client->new; |
12 |
|
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 |
|
17 |
my $max_size = 100000; |
18 |
my $first_size = $max_size; |
19 |
my $last_nok_size = $max_size; |
20 |
my $last_ok_size = 0; |
21 |
my $delta = 2; |
22 |
|
23 |
$cl->reg_cb ( |
24 |
connected => sub { |
25 |
my ($cl, $acc) = @_; |
26 |
my $con = $acc->connection; |
27 |
if (($last_nok_size - $last_ok_size) < $delta) { |
28 |
print "Found limit in delta range: $last_ok_size for ".$acc->jid."\n"; |
29 |
$con->disconnect ("found limit"); |
30 |
return 0; |
31 |
} |
32 |
$con->send_iq (set => sub { |
33 |
my ($w) = @_; |
34 |
simxml ($w, |
35 |
defns => 'jabber:iq:private', |
36 |
node => { |
37 |
name => 'query', |
38 |
ns => 'jabber:iq:private', |
39 |
childs => [ |
40 |
{ name => "test", dns => "test:fe", childs => [ "A" x $first_size ] }, |
41 |
] |
42 |
} |
43 |
) |
44 |
}, sub { |
45 |
my ($n, $e) = @_; |
46 |
if ($e) { |
47 |
die "iq private error: " . $e->string . "\n"; |
48 |
} else { |
49 |
$con->send_iq (get => sub { |
50 |
my ($w) = @_; |
51 |
simxml ($w, |
52 |
defns => 'jabber:iq:private', |
53 |
node => { |
54 |
name => 'query', |
55 |
ns => 'jabber:iq:private', |
56 |
childs => [ { name => 'test', dns => 'test:fe' } ] |
57 |
} |
58 |
); |
59 |
}, sub { |
60 |
print "$first_size seems to be ok!\n"; |
61 |
$last_ok_size = $first_size; |
62 |
$first_size = $last_ok_size + ($last_nok_size - $last_ok_size) / 2; |
63 |
$first_size = int ($first_size); |
64 |
$con->disconnect ("retry"); |
65 |
}); |
66 |
} |
67 |
}, timeout => 1000000); |
68 |
|
69 |
1 |
70 |
}, |
71 |
stream_error => sub { |
72 |
my ($cl, $acc, $err) = @_; |
73 |
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 |
78 |
}, |
79 |
# debug_recv => sub { print "@_\n" }, |
80 |
disconnect => sub { |
81 |
my ($cl, $acc, $host, $port, $msg) = @_; |
82 |
if ($msg eq 'found limit') { $j->broadcast } |
83 |
print "Disconnect $msg\n"; |
84 |
$cl->update_connections; # reconnect ! |
85 |
1 |
86 |
}, |
87 |
message => sub { |
88 |
my ($cl, $acc, $msg) = @_; |
89 |
print "message from: " . $msg->from . ": " . $msg->any_body . "\n"; |
90 |
1 |
91 |
} |
92 |
); |
93 |
|
94 |
$cl->start; |
95 |
$j->wait; |
96 |
|