Hi,
--On Donnerstag, 19. Juni 2003 16:56 Uhr -0400 Ken Murchison
[EMAIL PROTECTED] wrote:
Has anyone found or written a tool to load test an IMAP server (Cyrus in
particular) which simulates client (reader) traffic?
sorry for the late reply, but I don't remember any other answers, so I
thought you might still be interested. A colleague and I have written a
very, very rough Perl script that's supposed to do exactly that. I'm not
sure how good a job of it it does ... anyway, I'm attaching it.
Cheers, Sebastian Hagedorn
--
Sebastian Hagedorn M.A. - RZKR-R1 (Gebäude 52), Zimmer 18
Zentrum für angewandte Informatik - Universitätsweiter Service RRZK
Universität zu Köln / Cologne University - Tel. +49-221-478-5587#!/usr/bin/perl
package imap;
use strict;
use warnings;
use Getopt::Long;
use Term::ReadKey;
use Cyrus::IMAP::Admin;
my ($client, $user, $host, $mech) = (undef, 'cyrus', 'cyrus.rrz.uni-koeln.de',
'DIGEST-MD5');
my ($file, $rc, $newuser) = ('usernames', undef, undef);
my $quota = 0;
my $pwd = undef;
my @connections = ();
my @connusers = ();
my $commandcount = 0;
my $key;
my $value;
my @userlist;
my $nc;
my $max=10;
my $result;
my $resulttext;
my $debug=0;
GetOptions('host=s' = \$host,
'user=s' = \$user,
'mechanism=s' = \$mech,
'max=i' = \$max,
'file=s' = \$file,
'debug' = \$debug,
'quota=i' = \$quota);
$max--;
ReadMode 2; # Echo off
print Password for Cyrus: ;
chop($pwd = STDIN);
print \n;
ReadMode 0;
# $client = imapconnection-new;
# printf State: %d\n, $client-getstate;
# print imapconnection::state $imapconnection::state\n;
open (IN, $file) or die $!;
@userlist = IN;
$quota = scalar @userlist;
# exit 0;
while (1) {
$nc = scalar (@connections);
if ($nc = $max) {
if (($nc == 0) or (int(rand(1000)) 80)) {
AGAIN: $rc = int(rand $quota)+1;
$newuser = $userlist[$rc];
chop $newuser;
print User: $newuser, now:, $nc+1, , # of commands:
$commandcount\n;
$result = openconn();
if (!$result) {
print STDERR Retrying ...\n;
redo AGAIN;
}
}
}
$rc = int(rand scalar(@connections));
$result = docommand ($rc);
if (!$result) {
splice (@connections, $rc, 1);
splice (@connusers, $rc, 1);
}
}
sub debugcomment {
return unless $debug;
my $comment = shift;
my $number = shift;
chomp $comment;
if ($number -1) {
print $comment, $connusers[$number]\n;
return;
}
print $comment\n;
}
sub docommand {
my $cnum = shift;
$commandcount++;
# print Connection number $cnum\n;
my $rand = int(rand(1000));
if ($rand 950) {
debugcomment (Vor FETCH BODY, $cnum);
($result,$resulttext) = $connections[$cnum]-send('', '', 'FETCH 1:1
(BODY[1])');
if (!$result) {
print Result: $result, Text: $resulttext\n;
return 0;
}
return 1;
}
debugcomment (Vor LOGOUT, $cnum);
$connections[$cnum]-send('', '', 'LOGOUT');
return 0;
}
sub openconn {
push @connections, Cyrus::IMAP::Admin-new($host);
push @connusers, $newuser;
debugcomment (Vor authenticate, -1);
$connections[$#connections]-authenticate('-mechanism' = $mech,
'-user' = 'cyrus',
'-authz' = $newuser,
'-password' = $pwd
) or die Authentication failed!: $!;
if ($connections[$#connections]-error) {
print STDERR Error: , $connections[$#connections],\n;
pop @connections;
pop @connusers;
return 0;
}
debugcomment (Vor SELECT, $#connections);
($result,$resulttext) = $connections[$#connections]-send('', '', 'SELECT
INBOX');
if (!$result) {
print Result: $result, Text: $resulttext\n;
return 0;
}
debugcomment (Vor SEARCH, $#connections);
($result,$resulttext) = $connections[$#connections]-send('', '', 'UID SEARCH
UNSEEN UNDELETED');
if (!$result) {
print Result: $result, Text: $resulttext\n;
return 0;
}
debugcomment (Vor THREAD, $#connections);
($result,$resulttext) = $connections[$#connections]-send('', '', 'THREAD
REFERENCES us-ascii ALL');
if (!$result) {
print Result: $result, Text: $resulttext\n;
return 0;
}
debugcomment (Vor FETCH FLAGS,
