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 |
|
15 |
my $max_size = 100000; |
16 |
my $first_size = $max_size; |
17 |
my $last_nok_size = $max_size; |
18 |
my $last_ok_size = 0; |
19 |
my $delta = 10; |
20 |
|
21 |
$cl->reg_cb ( |
22 |
connected => sub { |
23 |
my ($cl, $acc) = @_; |
24 |
my $con = $acc->connection; |
25 |
|
26 |
$con->{max_write_length} = 4096; |
27 |
|
28 |
if (($last_nok_size - $last_ok_size) < $delta) { |
29 |
print "Found limit in delta range: $last_ok_size for ".$acc->jid."\n"; |
30 |
$con->disconnect ("found limit"); |
31 |
return 0; |
32 |
} |
33 |
|
34 |
$con->send_iq (set => sub { |
35 |
my ($w) = @_; |
36 |
simxml ($w, |
37 |
defns => 'jabber:iq:private', |
38 |
node => { |
39 |
name => 'query', |
40 |
ns => 'jabber:iq:private', |
41 |
childs => [ |
42 |
{ name => "test", dns => "test:fe", childs => [ "A" x $first_size ] }, |
43 |
] |
44 |
} |
45 |
); |
46 |
print "Trying $first_size...\n"; |
47 |
}, sub { |
48 |
my ($n, $e) = @_; |
49 |
if ($e) { |
50 |
die "iq private error: " . $e->string . "\n"; |
51 |
} else { |
52 |
$con->send_iq (get => sub { |
53 |
my ($w) = @_; |
54 |
simxml ($w, |
55 |
defns => 'jabber:iq:private', |
56 |
node => { |
57 |
name => 'query', |
58 |
ns => 'jabber:iq:private', |
59 |
childs => [ { name => 'test', dns => 'test:fe' } ] |
60 |
} |
61 |
); |
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) { |
71 |
print "$len seems to be ok!\n"; |
72 |
$last_ok_size = $first_size; |
73 |
$first_size = $last_ok_size + ($last_nok_size - $last_ok_size) / 2; |
74 |
$first_size = int ($first_size); |
75 |
$con->disconnect ("retry"); |
76 |
} else { |
77 |
$con->disconnect ("too short iq reply"); |
78 |
} |
79 |
} |
80 |
}); |
81 |
} |
82 |
}, timeout => 1000000); |
83 |
|
84 |
1 |
85 |
}, |
86 |
stream_error => sub { |
87 |
my ($cl, $acc, $err) = @_; |
88 |
print "STREAM ERROR: [" . $err->string . "] at $first_size, retry...\n"; |
89 |
1 |
90 |
}, |
91 |
connect_error => sub { |
92 |
my ($cl, $acc, $err) = @_; |
93 |
print "Connect error ".$acc->jid.": $err\n"; |
94 |
1 |
95 |
}, |
96 |
disconnect => sub { |
97 |
my ($cl, $acc, $host, $port, $msg) = @_; |
98 |
if ($msg eq 'found limit') { $j->broadcast } |
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 |
} |
105 |
$cl->update_connections; # reconnect ! |
106 |
1 |
107 |
}, |
108 |
message => sub { |
109 |
my ($cl, $acc, $msg) = @_; |
110 |
print "message from: " . $msg->from . ": " . $msg->any_body . "\n"; |
111 |
1 |
112 |
} |
113 |
); |
114 |
|
115 |
$cl->start; |
116 |
$j->wait; |
117 |
|