On Sat Sep 04 10:06:27 2010, grebneke wrote:
Show quoted text> I tried renaming the MIGMSG labels to MSG. Now the code runs but seems
> to end up in an endless loop where nothing happens. stracing shows
forever:
Show quoted text>
> read(3, 0x8569328, 1) = -1 EAGAIN (Resource temporarily unavailable)
> where filehandle 3 is the source_imap object.
Correction: fh 3 is the target imap object.
Anyway: I found the comment around line 830, which explains a lot:
#???? this code is very clumsy, and currently probably broken.
I fiddled around a bit and eventually got it all working. Please see the
attached patch. (Some of the changes are just variable-names that
happened when I was trying to sort stuff out.)
But it's not very fast. Using the default buffer size of 4096 it's
actually damn slow. With a buffer around 4096 * 32 it worked better, but
still couldn't beat using Mail::Mbox::MessageParser to read the source
mailbox and then feed it to IMAPClient, append()ing to the target
mailbox. So I guess I'll stick to that solution even though it felt
neater to use a dedicated migrate()-function.
Take care,
/Johan
--- /root/.cpan/build/Mail-IMAPClient-3.25/blib/lib/Mail/IMAPClient.pm Fri May 28 06:06:35 2010
+++ /usr/lib/perl5/site_perl/5.8.8/Mail/IMAPClient.pm Sun Sep 5 01:00:52 2010
@@ -978,12 +979,12 @@
if ( $code ne 'OK' ) {
$self->_debug("Error writing to target host: $@");
- next MIGMSG;
+ next MSG;
}
# Here is where we start sticking in UID if that parameter
# is turned on:
- my $string = ( $self->Uid ? "UID " : "" ) . "FETCH $mid $cmd";
+ my $fetchCmd = ( $self->Uid ? "UID " : "" ) . "FETCH $mid $cmd";
# Clean up history buffer if necessary:
$self->Clear($clear)
@@ -993,16 +994,16 @@
# next IMAP FETCH should start (1st time start at offset zero):
my $position = 0;
my $chunkCount = 0;
- my $readSoFar = 0;
while ( $leftSoFar > 0 ) {
+ my $readSoFar = 0;
my $take = min $leftSoFar, $bufferSize;
- my $newstring = "$trans $string<$position.$take>";
+ my $newFetchCmd = "$trans $fetchCmd<$position.$take>";
- $self->_record( $trans, [ 0, "INPUT", $newstring ] );
- $self->_debug("Issuing migration command: $newstring");
+ $self->_record( $trans, [ 0, "INPUT", $newFetchCmd ] );
+ $self->_debug("Issuing migration command: $newFetchCmd");
- unless ( $self->_send_line($newstring) ) {
- $self->LastError( "Error sending '$newstring' to source IMAP: "
+ unless ( $self->_send_line($newFetchCmd) ) {
+ $self->LastError( "Error sending '$newFetchCmd' to source IMAP: "
. $self->LastError );
return undef;
}
@@ -1016,14 +1018,15 @@
$self->_record( $trans, [ 0, "OUTPUT", $fromBuffer ] );
+# TODO: We should make sure $toSock is available (interrupt any ongoing APPEND reads etc) before trying the next message
if ( $fromBuffer =~ /^$trans\s+(?:NO|BAD)/ ) {
$self->LastError($fromBuffer);
- next MIGMSG;
+ next MSG;
}
elsif ( $fromBuffer =~ /^$trans\s+OK/ ) {
$self->LastError( "Unexpected good return code "
. "from source host: $fromBuffer" );
- next MIGMSG;
+ next MSG;
}
}
@@ -1035,6 +1038,14 @@
|| 0;
}
+
+ # Finish up reading the server fetch response from the source system:
+ # look for "<trans> (OK|BAD|NO)"
+ $self->_debug("Reading from source: expecting 'OK' response");
+ $code = $self->_get_response($trans) or return undef;
+ return undef unless $code eq 'OK';
+
+ # We have read a chunk, now comes the writing
my $wroteSoFar = 0;
my $temperrs = 0;
my $waittime = .02;
@@ -1074,24 +1085,15 @@
$self->State(Unconnected)
if ( $! == EPIPE or $! == ECONNRESET );
- $self->LastError("Write failed '$!'");
- return; # no luck
}
$peer->_debug(
"Chunk $chunkCount: wrote $wroteSoFar (of $chunk)");
}
- }
-
$position += $readSoFar;
$leftSoFar -= $readSoFar;
- my $fromBuffer = "";
+ }
- # Finish up reading the server fetch response from the source system:
- # look for "<trans> (OK|BAD|NO)"
- $self->_debug("Reading from source: expecting 'OK' response");
- $code = $self->_get_response($trans) or return undef;
- return undef unless $code eq 'OK';
# Now let's send a CRLF to the peer to signal end of APPEND cmd:
unless ( $peer->_send_bytes( \$CRLF ) ) {
