From 66b0682010cf24a4d2e92465dd57bcd795d21970 Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Mon, 27 Jul 2015 22:02:17 +0200 Subject: No longer try to guess whether a mailbox was deleted or renamed. This was too error-prone. Instead, abort if a naming conflict occurs, and provide explicit commands --delete and --rename to delete or rename a mailbox. --- lib/Net/IMAP/Sync.pm | 19 ++++++++++++++++++- 1 file changed, 18 insertions(+), 1 deletion(-) (limited to 'lib/Net/IMAP/Sync.pm') diff --git a/lib/Net/IMAP/Sync.pm b/lib/Net/IMAP/Sync.pm index 3216483..c1bccbf 100644 --- a/lib/Net/IMAP/Sync.pm +++ b/lib/Net/IMAP/Sync.pm @@ -520,11 +520,13 @@ sub create($$) { my ($self, $mailbox) = @_; $self->fail("Server is read-only.") if $self->{'read-only'}; $self->_send("CREATE ".quote($mailbox)); + $self->log("Created mailbox ".$mailbox) unless $self->{quiet}; } sub delete($$) { my ($self, $mailbox) = @_; $self->fail("Server is read-only.") if $self->{'read-only'}; - #$self->_send("DELETE ".quote($mailbox)); + $self->_send("DELETE ".quote($mailbox)); + $self->log("Deleted mailbox ".$mailbox) unless $self->{quiet}; delete $self->{_CACHE}->{$mailbox}; delete $self->{_PCACHE}->{$mailbox}; } @@ -533,12 +535,24 @@ sub delete($$) { # $self->rename($oldname, $newname) # RENAME the mailbox $oldname to $newname. Requires the 'read-only' # flag to be unset. +# /!\ Requires a LIST command to be issued to determine the hierarchy +# delimiter for the original name. sub rename($$$) { my ($self, $from, $to) = @_; + my $delim = $self->{_CACHE}->{$from}->{DELIMITER} if defined $self->{_CACHE}->{$from}; $self->fail("Server is read-only.") if $self->{'read-only'}; $self->_send("RENAME ".quote($from).' '.quote($to)); + $self->log("Renamed mailbox ".$from.' to '.$to) unless $self->{quiet}; $self->{_CACHE}->{$to} = delete $self->{_CACHE}->{$from} if exists $self->{_CACHE}->{$from}; $self->{_PCACHE}->{$to} = delete $self->{_PCACHE}->{$from} if exists $self->{_PCACHE}->{$from}; + if (defined $delim) { + # on non-flat mailboxes, move children as well (cf 3501) + foreach my $c1 (grep /\A\Q$from$delim\E/, keys %{$self->{_CACHE}}) { + my $c2 = $c1 =~ s/\A\Q$from$delim\E/$to$delim/r; + $self->{_CACHE}->{$c2} = delete $self->{_CACHE}->{$c1} if exists $self->{_CACHE}->{$c1}; + $self->{_PCACHE}->{$c2} = delete $self->{_PCACHE}->{$c1} if exists $self->{_PCACHE}->{$c1}; + } + } } @@ -550,11 +564,13 @@ sub subscribe($$) { my ($self, $mailbox) = @_; $self->fail("Server is read-only.") if $self->{'read-only'}; $self->_send("SUBSCRIBE ".quote($mailbox)); + $self->log("Subscribed to mailbox ".$mailbox) unless $self->{quiet}; } sub unsubscribe($$) { my ($self, $mailbox) = @_; $self->fail("Server is read-only.") if $self->{'read-only'}; $self->_send("UNSUBSCRIBE ".quote($mailbox)); + $self->log("Unsubscribed to mailbox ".$mailbox) unless $self->{quiet}; } @@ -1456,6 +1472,7 @@ sub _resp($$;$$$) { $mailbox = 'INBOX' if uc $mailbox eq 'INBOX'; # INBOX is case-insensitive undef $delim if uc $delim eq 'NIL'; $delim =~ s/\A"(.*)"\Z/$1/ if defined $delim; + $self->_update_cache_for($mailbox, DELIMITER => $delim); $callback->($mailbox, $delim, @flags) if defined $callback and $cmd eq 'LIST'; } elsif (s/\ASTATUS //) { -- cgit v1.2.3 From 2a3287ab0b04341adcb8187b75cf35ac3f07d24f Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Mon, 27 Jul 2015 22:49:07 +0200 Subject: bugfix: Don't exist with the children's exist status upon error. --- lib/Net/IMAP/Sync.pm | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) (limited to 'lib/Net/IMAP/Sync.pm') diff --git a/lib/Net/IMAP/Sync.pm b/lib/Net/IMAP/Sync.pm index c1bccbf..677f991 100644 --- a/lib/Net/IMAP/Sync.pm +++ b/lib/Net/IMAP/Sync.pm @@ -386,9 +386,8 @@ sub new($%) { # Log out when the Net::IMAP::Sync object is destroyed. sub DESTROY($) { my $self = shift; - if (defined $self->{STDIN} and $self->{STDIN}->opened() and - defined $self->{STDOUT} and $self->{STDOUT}->opened()) { - $self->logout(); + foreach (qw/STDIN STDOUT/) { + $self->{$_}->close() if defined $self->{$_} and $self->{$_}->opened(); } } -- cgit v1.2.3 From 67b2781d691d107f92409ac6fd9aeef97593ffa1 Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Mon, 27 Jul 2015 22:52:21 +0200 Subject: Drop the 'read-only' option. It didn't really work since STORE commands are answered with a tagged OK response for instance. --- lib/Net/IMAP/Sync.pm | 35 ++++++++--------------------------- 1 file changed, 8 insertions(+), 27 deletions(-) (limited to 'lib/Net/IMAP/Sync.pm') diff --git a/lib/Net/IMAP/Sync.pm b/lib/Net/IMAP/Sync.pm index 677f991..3faab63 100644 --- a/lib/Net/IMAP/Sync.pm +++ b/lib/Net/IMAP/Sync.pm @@ -47,7 +47,6 @@ my %OPTIONS = ( password => qr/\A([\x01-\x7F]+)\z/, auth => qr/\A($RE_ATOM_CHAR+(?: $RE_ATOM_CHAR+)*)\z/, command => qr/\A(\/\P{Control}+)\z/, - 'read-only' => qr/\A(YES|NO)\z/i, SSL_fingerprint => qr/\A([A-Za-z0-9]+\$\p{AHex}+)\z/, SSL_cipher_list => qr/\A(\P{Control}+)\z/, SSL_verify_trusted_peer => qr/\A(YES|NO)\z/i, @@ -210,10 +209,6 @@ our $IMAP_text; # # - 'name': An optional instance name to include in log messages. # -# - 'read-only': Use only commands that don't modify the server state. -# In particular, use EXAMINE in place of SELECT for mailbox -# selection. -# # - 'extra-attrs': An attribute or list of extra attributes to FETCH # when getting new mails, in addition to (MODSEQ FLAGS INTERNALDATE # BODY.PEEK[]). @@ -225,9 +220,6 @@ sub new($%) { my $self = { @_ }; bless $self, $class; - # whether we're allowed to to use read-write command - $self->{'read-only'} = uc ($self->{'read-only'} // 'NO') ne 'YES' ? 0 : 1; - # the IMAP state: one of 'UNAUTH', 'AUTH', 'SELECTED' or 'LOGOUT' # (cf RFC 3501 section 3) $self->{_STATE} = ''; @@ -479,14 +471,12 @@ sub search($$) { # $self->select($mailbox) # $self->examine($mailbox) -# Issue a SELECT or EXAMINE command for the $mailbox. (Always use -# EXAMINE if the 'read-only' flag is set.) Upon success, change the -# state to SELECTED, otherwise go back to AUTH. +# Issue a SELECT or EXAMINE command for the $mailbox. Upon success, +# change the state to SELECTED, otherwise go back to AUTH. sub select($$) { my $self = shift; my $mailbox = shift; - my $cmd = $self->{'read-only'} ? 'EXAMINE' : 'SELECT'; - $self->_select_or_examine($cmd, $mailbox); + $self->_select_or_examine('SELECT', $mailbox); } sub examine($$) { my $self = shift; @@ -514,16 +504,14 @@ sub noop($) { # $self->create($mailbox) # $self->delete($mailbox) -# CREATE or DELETE $mailbox. Requires the 'read-only' flag to be unset. +# CREATE or DELETE $mailbox. sub create($$) { my ($self, $mailbox) = @_; - $self->fail("Server is read-only.") if $self->{'read-only'}; $self->_send("CREATE ".quote($mailbox)); $self->log("Created mailbox ".$mailbox) unless $self->{quiet}; } sub delete($$) { my ($self, $mailbox) = @_; - $self->fail("Server is read-only.") if $self->{'read-only'}; $self->_send("DELETE ".quote($mailbox)); $self->log("Deleted mailbox ".$mailbox) unless $self->{quiet}; delete $self->{_CACHE}->{$mailbox}; @@ -532,14 +520,12 @@ sub delete($$) { # $self->rename($oldname, $newname) -# RENAME the mailbox $oldname to $newname. Requires the 'read-only' -# flag to be unset. +# RENAME the mailbox $oldname to $newname. # /!\ Requires a LIST command to be issued to determine the hierarchy # delimiter for the original name. sub rename($$$) { my ($self, $from, $to) = @_; my $delim = $self->{_CACHE}->{$from}->{DELIMITER} if defined $self->{_CACHE}->{$from}; - $self->fail("Server is read-only.") if $self->{'read-only'}; $self->_send("RENAME ".quote($from).' '.quote($to)); $self->log("Renamed mailbox ".$from.' to '.$to) unless $self->{quiet}; $self->{_CACHE}->{$to} = delete $self->{_CACHE}->{$from} if exists $self->{_CACHE}->{$from}; @@ -557,17 +543,14 @@ sub rename($$$) { # $self->subscribe($mailbox) # $self->unsubscribe($mailbox) -# SUBSCRIBE or UNSUBSCRIBE $mailbox. Requires the 'read-only' flag to -# be unset. +# SUBSCRIBE or UNSUBSCRIBE $mailbox. sub subscribe($$) { my ($self, $mailbox) = @_; - $self->fail("Server is read-only.") if $self->{'read-only'}; $self->_send("SUBSCRIBE ".quote($mailbox)); $self->log("Subscribed to mailbox ".$mailbox) unless $self->{quiet}; } sub unsubscribe($$) { my ($self, $mailbox) = @_; - $self->fail("Server is read-only.") if $self->{'read-only'}; $self->_send("UNSUBSCRIBE ".quote($mailbox)); $self->log("Unsubscribed to mailbox ".$mailbox) unless $self->{quiet}; } @@ -639,7 +622,6 @@ sub append($$@) { my $self = shift; my $mailbox = shift; return unless @_; - $self->fail("Server is read-only.") if $self->{'read-only'}; $self->fail("Server did not advertise UIDPLUS (RFC 4315) capability.") if $self->incapable('UIDPLUS'); @@ -1234,9 +1216,8 @@ sub _open_mailbox($$) { # $self->_select_or_examine($command, $mailbox) -# Issue a SELECT or EXAMINE command for the $mailbox. (Always use -# EXAMINE if the 'read-only' flag is set.) Upon success, change the -# state to SELECTED, otherwise go back to AUTH. +# Issue a SELECT or EXAMINE command for the $mailbox. Upon success, +# change the state to SELECTED, otherwise go back to AUTH. sub _select_or_examine($$$) { my $self = shift; my $command = shift; -- cgit v1.2.3 From 36b7d017145bac2f883cca12289e66b6b369a5e3 Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Mon, 27 Jul 2015 23:45:09 +0200 Subject: Enable fine-grained control on the mailboxes to consider. Add 3 options: - list-mailbox - list-select-opts - ignore-mailbox The first two control the initial LIST command, while the last one is a regular expression to filter out mailboxes to exclude from the LIST response. --- lib/Net/IMAP/Sync.pm | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) (limited to 'lib/Net/IMAP/Sync.pm') diff --git a/lib/Net/IMAP/Sync.pm b/lib/Net/IMAP/Sync.pm index 3faab63..48f61c1 100644 --- a/lib/Net/IMAP/Sync.pm +++ b/lib/Net/IMAP/Sync.pm @@ -78,10 +78,11 @@ sub read_config($$%) { foreach my $section (@$sections) { my $conf = defined $h->{_} ? { %{$h->{_}} } : {}; # default section $configs{$section} = $conf; - next unless defined $section and $section ne '_'; - die "No such section $section\n" unless defined $h->{$section}; - $conf->{$_} = $h->{$section}->{$_} foreach keys %{$h->{$section}}; + if ($section ne '_') { + die "No such section $section\n" unless defined $h->{$section}; + $conf->{$_} = $h->{$section}->{$_} foreach keys %{$h->{$section}}; + } # default values $conf->{type} //= 'imaps'; -- cgit v1.2.3 From a76acfe7af03ea9087c3c063c315b52109c41f10 Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Thu, 30 Jul 2015 01:16:51 +0200 Subject: Add a $try parameter to create, delete, rename, etc. And no longer crash when trying to create a mailbox that already exists. This could happen for instance if list-select-opts contains 'SUBSCRIBE' and the mailbox is not subscribed on one side. --- lib/Net/IMAP/Sync.pm | 90 +++++++++++++++++++++++++++++++++++++--------------- 1 file changed, 64 insertions(+), 26 deletions(-) (limited to 'lib/Net/IMAP/Sync.pm') diff --git a/lib/Net/IMAP/Sync.pm b/lib/Net/IMAP/Sync.pm index 48f61c1..509ad5b 100644 --- a/lib/Net/IMAP/Sync.pm +++ b/lib/Net/IMAP/Sync.pm @@ -503,32 +503,47 @@ sub noop($) { } -# $self->create($mailbox) -# $self->delete($mailbox) +# $self->create($mailbox, [$try]) +# $self->delete($mailbox, [$try]) # CREATE or DELETE $mailbox. -sub create($$) { - my ($self, $mailbox) = @_; - $self->_send("CREATE ".quote($mailbox)); - $self->log("Created mailbox ".$mailbox) unless $self->{quiet}; +# If try is set, print a warning but don't crash if the command fails. +sub create($$;$) { + my ($self, $mailbox, $try) = @_; + my $r = $self->_send("CREATE ".quote($mailbox)); + if ($IMAP_cond eq 'OK') { + $self->log("Created mailbox ".$mailbox) unless $self->{quiet}; + } + else { + my $msg = "Couldn't create mailbox ".$mailbox.': '.$IMAP_text; + $try ? $self->warn($msg) : $self->fail($msg); + } + return $r; } -sub delete($$) { - my ($self, $mailbox) = @_; - $self->_send("DELETE ".quote($mailbox)); - $self->log("Deleted mailbox ".$mailbox) unless $self->{quiet}; +sub delete($$;$) { + my ($self, $mailbox, $try) = @_; + my $r = $self->_send("DELETE ".quote($mailbox)); delete $self->{_CACHE}->{$mailbox}; delete $self->{_PCACHE}->{$mailbox}; + if ($IMAP_cond eq 'OK') { + $self->log("Deleted mailbox ".$mailbox) unless $self->{quiet}; + } + else { + my $msg = "Couldn't delete mailbox ".$mailbox.': '.$IMAP_text; + $try ? $self->warn($msg) : $self->fail($msg); + } + return $r; } -# $self->rename($oldname, $newname) +# $self->rename($oldname, $newname, [$try]) # RENAME the mailbox $oldname to $newname. +# If $try is set, print a warning but don't crash if the command fails. # /!\ Requires a LIST command to be issued to determine the hierarchy # delimiter for the original name. -sub rename($$$) { - my ($self, $from, $to) = @_; +sub rename($$$;$) { + my ($self, $from, $to, $try) = @_; my $delim = $self->{_CACHE}->{$from}->{DELIMITER} if defined $self->{_CACHE}->{$from}; - $self->_send("RENAME ".quote($from).' '.quote($to)); - $self->log("Renamed mailbox ".$from.' to '.$to) unless $self->{quiet}; + my $r = $self->_send("RENAME ".quote($from).' '.quote($to)); $self->{_CACHE}->{$to} = delete $self->{_CACHE}->{$from} if exists $self->{_CACHE}->{$from}; $self->{_PCACHE}->{$to} = delete $self->{_PCACHE}->{$from} if exists $self->{_PCACHE}->{$from}; if (defined $delim) { @@ -539,21 +554,44 @@ sub rename($$$) { $self->{_PCACHE}->{$c2} = delete $self->{_PCACHE}->{$c1} if exists $self->{_PCACHE}->{$c1}; } } + if ($IMAP_cond eq 'OK') { + $self->log("Renamed mailbox ".$from.' to '.$to) unless $self->{quiet}; + } + else { + my $msg = "Couldn't rename mailbox ".$from.': '.$IMAP_text; + $try ? $self->warn($msg) : $self->fail($msg); + } + return $r; } -# $self->subscribe($mailbox) -# $self->unsubscribe($mailbox) +# $self->subscribe($mailbox, [$try]) +# $self->unsubscribe($mailbox, [$try]) # SUBSCRIBE or UNSUBSCRIBE $mailbox. -sub subscribe($$) { - my ($self, $mailbox) = @_; - $self->_send("SUBSCRIBE ".quote($mailbox)); - $self->log("Subscribed to mailbox ".$mailbox) unless $self->{quiet}; +# If $try is set, print a warning but don't crash if the command fails. +sub subscribe($$;$) { + my ($self, $mailbox, $try) = @_; + my $r = $self->_send("SUBSCRIBE ".quote($mailbox)); + if ($IMAP_cond eq 'OK') { + $self->log("Subscribe to ".$mailbox) unless $self->{quiet}; + } + else { + my $msg = "Couldn't subscribe to ".$mailbox.': '.$IMAP_text; + $try ? $self->warn($msg) : $self->fail($msg); + } + return $r; } -sub unsubscribe($$) { - my ($self, $mailbox) = @_; - $self->_send("UNSUBSCRIBE ".quote($mailbox)); - $self->log("Unsubscribed to mailbox ".$mailbox) unless $self->{quiet}; +sub unsubscribe($$;$) { + my ($self, $mailbox, $try) = @_; + my $r = $self->_send("UNSUBSCRIBE ".quote($mailbox)); + if ($IMAP_cond eq 'OK') { + $self->log("Unsubscribe to ".$mailbox) unless $self->{quiet}; + } + else { + my $msg = "Couldn't unsubscribe to ".$mailbox.': '.$IMAP_text; + $try ? $self->warn($msg) : $self->fail($msg); + } + return $r; } @@ -1149,7 +1187,7 @@ sub _send($$;&) { $IMAP_cond = $1; $IMAP_text = $1.' '.$x; $self->_resp_text($x); - $self->fail($IMAP_text, "\n") unless defined wantarray or $IMAP_cond eq 'OK'; + $self->fail($IMAP_text) unless defined wantarray or $IMAP_cond eq 'OK'; $r = $1; last; } -- cgit v1.2.3 From 7f7a29ef79915a86d3f5bd3533e3a49ac6f36cb6 Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Thu, 30 Jul 2015 01:26:16 +0200 Subject: Don't try to rename children of mailboxes with \NoInferiors or \HasNoChildren attribute. --- lib/Net/IMAP/Sync.pm | 17 +++++++++++------ 1 file changed, 11 insertions(+), 6 deletions(-) (limited to 'lib/Net/IMAP/Sync.pm') diff --git a/lib/Net/IMAP/Sync.pm b/lib/Net/IMAP/Sync.pm index 509ad5b..2a25720 100644 --- a/lib/Net/IMAP/Sync.pm +++ b/lib/Net/IMAP/Sync.pm @@ -539,14 +539,18 @@ sub delete($$;$) { # RENAME the mailbox $oldname to $newname. # If $try is set, print a warning but don't crash if the command fails. # /!\ Requires a LIST command to be issued to determine the hierarchy -# delimiter for the original name. +# delimiter and the mailbox attributes for the original name. sub rename($$$;$) { my ($self, $from, $to, $try) = @_; - my $delim = $self->{_CACHE}->{$from}->{DELIMITER} if defined $self->{_CACHE}->{$from}; + my ($delim, @attrs); + if ($self->{_CACHE}->{$from}) { + $delim = $self->{_CACHE}->{$from}->{DELIMITER}; + @attrs = @{$self->{_CACHE}->{$from}->{LIST_ATTRIBUTES} // []}; + } my $r = $self->_send("RENAME ".quote($from).' '.quote($to)); $self->{_CACHE}->{$to} = delete $self->{_CACHE}->{$from} if exists $self->{_CACHE}->{$from}; $self->{_PCACHE}->{$to} = delete $self->{_PCACHE}->{$from} if exists $self->{_PCACHE}->{$from}; - if (defined $delim) { + if (defined $delim and !grep {lc $_ eq lc '\NoInferiors' or lc $_ eq lc '\HasNoChildren'} @attrs) { # on non-flat mailboxes, move children as well (cf 3501) foreach my $c1 (grep /\A\Q$from$delim\E/, keys %{$self->{_CACHE}}) { my $c2 = $c1 =~ s/\A\Q$from$delim\E/$to$delim/r; @@ -1484,15 +1488,16 @@ sub _resp($$;$$$) { $callback->(split(/ /, ($1 =~ s/^ //r))) if defined $callback and $cmd eq 'SEARCH'; } elsif (s/\ALIST \((\\?$RE_ATOM_CHAR+(?: \\?$RE_ATOM_CHAR+)*)?\) ("(?:\\[\x22\x5C]|[\x01-\x09\x0B\x0C\x0E-\x21\x23-\x5B\x5D-\x7F])"|NIL) //) { - my ($delim, $flags) = ($2, $1); - my @flags = defined $flags ? split(/ /, $flags) : (); + my ($delim, $attrs) = ($2, $1); + my @attrs = defined $attrs ? split(/ /, $attrs) : (); my $mailbox = $self->_astring(\$_); $self->panic($_) unless $_ eq ''; $mailbox = 'INBOX' if uc $mailbox eq 'INBOX'; # INBOX is case-insensitive undef $delim if uc $delim eq 'NIL'; $delim =~ s/\A"(.*)"\Z/$1/ if defined $delim; $self->_update_cache_for($mailbox, DELIMITER => $delim); - $callback->($mailbox, $delim, @flags) if defined $callback and $cmd eq 'LIST'; + $self->_update_cache_for($mailbox, LIST_ATTRIBUTES => \@attrs); + $callback->($mailbox, $delim, @attrs) if defined $callback and $cmd eq 'LIST'; } elsif (s/\ASTATUS //) { my $mailbox = $self->_astring(\$_); -- cgit v1.2.3 From 7a5ef2ffc002e7976fae34d08f296ace993211c8 Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Thu, 30 Jul 2015 01:39:30 +0200 Subject: Log out before exiting. --- lib/Net/IMAP/Sync.pm | 23 +++++++++++++---------- 1 file changed, 13 insertions(+), 10 deletions(-) (limited to 'lib/Net/IMAP/Sync.pm') diff --git a/lib/Net/IMAP/Sync.pm b/lib/Net/IMAP/Sync.pm index 2a25720..47c6258 100644 --- a/lib/Net/IMAP/Sync.pm +++ b/lib/Net/IMAP/Sync.pm @@ -380,7 +380,7 @@ sub new($%) { sub DESTROY($) { my $self = shift; foreach (qw/STDIN STDOUT/) { - $self->{$_}->close() if defined $self->{$_} and $self->{$_}->opened(); + $self->{$_}->close() if defined $self->{$_} and $self->{$_}->opened(); } } @@ -490,7 +490,8 @@ sub examine($$) { # Issue a LOGOUT command. Change the state to LOGOUT. sub logout($) { my $self = shift; - $self->_send('LOGOUT'); + # don't bother if the connection is already closed + $self->_send('LOGOUT') if $self->{STDIN}->opened(); $self->{_STATE} = 'LOGOUT'; undef $self; } @@ -1100,10 +1101,15 @@ sub _getline($;$) { my $self = shift; my $msg = shift // ''; - my $x = $self->{STDOUT}->getline() // $self->panic("Can't read: $!"); - $x =~ s/\r\n\z// or $self->panic($x); - $self->logger("S: $msg", $x) if $self->{debug}; - return $x; + if ($self->{STDOUT}->opened()) { + my $x = $self->{STDOUT}->getline() // $self->panic("Can't read: $!"); + $x =~ s/\r\n\z// or $self->panic($x); + $self->logger("S: $msg", $x) if $self->{debug}; + return $x; + } + else { + undef $self; + } } @@ -1452,10 +1458,7 @@ sub _resp($$;$$$) { if (s/\A\* //) { if (s/\ABYE //) { - foreach (qw/STDIN STDOUT/) { - $self->{$_}->close() if defined $self->{$_} and $self->{$_}->opened(); - } - exit 0; + undef $self; } elsif (s/\A(?:OK|NO|BAD) //) { $self->_resp_text($_); -- cgit v1.2.3