aboutsummaryrefslogtreecommitdiffstats
path: root/lib/Net/IMAP/Sync.pm
diff options
context:
space:
mode:
authorGuilhem Moulin <guilhem@fripost.org>2015-07-26 01:14:39 +0200
committerGuilhem Moulin <guilhem@fripost.org>2015-07-26 01:16:06 +0200
commit71cddb9e85ae0ea2468c64687319677e6bc9746a (patch)
tree67a5045089470d7c8c55e90de7ae7c977aa344e8 /lib/Net/IMAP/Sync.pm
parentebdf2537dc0eb1b54e4420c2bdd673110ced30d3 (diff)
Clean how we're sending commands to the server.
Diffstat (limited to 'lib/Net/IMAP/Sync.pm')
-rw-r--r--lib/Net/IMAP/Sync.pm55
1 files changed, 27 insertions, 28 deletions
diff --git a/lib/Net/IMAP/Sync.pm b/lib/Net/IMAP/Sync.pm
index cea647f..6c4b8a3 100644
--- a/lib/Net/IMAP/Sync.pm
+++ b/lib/Net/IMAP/Sync.pm
@@ -1043,7 +1043,7 @@ sub _getline($;$) {
my $self = shift;
my $msg = shift // '';
- my $x = $self->{STDOUT}->getline() // return; # non-blocking IO
+ my $x = $self->{STDOUT}->getline() // $self->panic("Can't read: $!");
$x =~ s/\r\n\z// or $self->panic($x);
$self->log("S: $msg", $x) if $self->{debug};
return $x;
@@ -1099,42 +1099,47 @@ sub _send($$;&) {
# literals, mark literals as such and then the whole command in one
# go, otherwise send literals one at a time
my $tag = sprintf '%06d', $self->{_TAG}++;
- my $prefix = $tag.' ';
+ my $litplus;
+ my @command = ("$tag ");
+ my $dbg_cmd = "C: $command[0]";
while ($command =~ s/\A(.*?)\{([0-9]+)\}\r\n//) {
my ($str, $len) = ($1, $2);
my $lit = substr $command, 0, $len, ''; # consume the literal
- if ($self->_capable('LITERAL+')) { # RFC 2088 LITERAL+
- $self->log('C: ', ($prefix ne '' ? $prefix : '[...]'), $str, "{$len+}") if $self->{debug};
- $self->{STDIN}->print($prefix, $str, "{$len+}\r\n");
- }
- else {
- $self->log('C: ', ($prefix ne '' ? $prefix : '[...]'), $str, "{$len}") if $self->{debug};
- $self->{STDIN}->print($prefix, $str, "{$len}\r\n");
+ $litplus //= $self->_capable('LITERAL+') ? '+' : '';
+ push @command, $str, "{$len$litplus}", "\r\n";
+ $self->log($dbg_cmd, $str, "{$len$litplus}") if $self->{debug};
+ $dbg_cmd = 'C: [...]';
+
+ unless ($litplus) {
+ $self->{STDIN}->write(join('',@command)) // $self->panic("Can't write: $!");
$self->{STDIN}->flush();
my $x = $self->_getline();
$x =~ /\A\+ / or $self->panic($x);
+ @command = ();
}
- $self->{STDIN}->print($lit);
- $prefix = '';
+ push @command, $lit;
}
- $self->log('C: ', ($prefix ne '' ? $prefix : '[...]'), $command) if $self->{debug};
- $self->{STDIN}->print($prefix, $command, "\r\n");
+ push @command, $command, "\r\n";
+ $self->log($dbg_cmd, $command) if $self->{debug};
+ $self->{STDIN}->write(join('',@command)) // $self->panic("Can't write: $!");
$self->{STDIN}->flush();
+
my $r;
# wait for the answer
- while (defined($_ = $self->_getline())) {
- if (s/\A\Q$tag\E (OK|NO|BAD) //) {
+ while (1) {
+ my $x = $self->_getline();
+ if ($x =~ s/\A\Q$tag\E (OK|NO|BAD) //) {
$IMAP_cond = $1;
- $IMAP_text = $1.' '.$_;
- $self->_resp_text($_);
+ $IMAP_text = $1.' '.$x;
+ $self->_resp_text($x);
$self->fail($IMAP_text, "\n") unless defined wantarray or $IMAP_cond eq 'OK';
$r = $1;
last;
}
else {
- $self->_resp($_, $cmd, $set, $callback);
+ $self->_resp($x, $cmd, $set, $callback);
}
}
@@ -1312,16 +1317,10 @@ sub _string($$) {
}
elsif ($$stream =~ s/\A\{([0-9]+)\}\z//) {
# literal
- my $count = $1;
- my @acc;
- my $buf;
- while ($count > 0) {
- my $n = $self->{STDOUT}->read($buf, $count);
- push @acc, $buf;
- $count -= $n;
- }
+ $self->{STDOUT}->read(my $lit, $1) // $self->panic("Can't read: $!");
+ # read a the rest of the response
$$stream = $self->_getline('[...]');
- return join ('', @acc);
+ return $lit;
}
else {
$self->panic($$stream);
@@ -1523,7 +1522,7 @@ sub _resp($$;$$$) {
if (defined $callback and $cmd eq 'AUTHENTICATE') {
my $x = $callback->($_);
print STDERR "C: ", $x, "\n" if $self->{debug};
- $self->{STDIN}->print($x, "\r\n");
+ $self->{STDIN}->write($x."\r\n") // $self->panic("Can't write: $!");
$self->{STDIN}->flush();
}
}