X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FNet%2FPOP3.pm;h=8381c81815e7cd0af764a6d2172dc5d09eb02f0f;hb=89b2b9f7f6c8f99f7999c5b3fe437be2abac4340;hp=02c8bc63de7805dd285c7f81bb01226f0f39ce8c;hpb=7cf5cf7c1758b1eb1a7f98c7dcf213f949e5a5b4;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/lib/Net/POP3.pm b/lib/Net/POP3.pm
index 02c8bc6..8381c81 100644
--- a/lib/Net/POP3.pm
+++ b/lib/Net/POP3.pm
@@ -13,61 +13,63 @@ use Net::Cmd;
 use Carp;
 use Net::Config;
 
-$VERSION = "2.28_2";
+$VERSION = "2.29";
 
 @ISA = qw(Net::Cmd IO::Socket::INET);
 
-sub new
-{
- my $self = shift;
- my $type = ref($self) || $self;
- my ($host,%arg);
- if (@_ % 2) {
-   $host = shift ;
-   %arg  = @_;
- } else {
-   %arg = @_;
-   $host=delete $arg{Host};
- }
- my $hosts = defined $host ? [ $host ] : $NetConfig{pop3_hosts};
- my $obj;
- my @localport = exists $arg{ResvPort} ? ( LocalPort => $arg{ResvPort} ): ();
-
- my $h;
- foreach $h (@{$hosts})
-  {
-   $obj = $type->SUPER::new(PeerAddr => ($host = $h), 
-			    PeerPort => $arg{Port} || 'pop3(110)',
-			    Proto    => 'tcp',
-			    @localport,
-			    Timeout  => defined $arg{Timeout}
-						? $arg{Timeout}
-						: 120
-			   ) and last;
+
+sub new {
+  my $self = shift;
+  my $type = ref($self) || $self;
+  my ($host, %arg);
+  if (@_ % 2) {
+    $host = shift;
+    %arg  = @_;
+  }
+  else {
+    %arg  = @_;
+    $host = delete $arg{Host};
+  }
+  my $hosts = defined $host ? [$host] : $NetConfig{pop3_hosts};
+  my $obj;
+  my @localport = exists $arg{ResvPort} ? (LocalPort => $arg{ResvPort}) : ();
+
+  my $h;
+  foreach $h (@{$hosts}) {
+    $obj = $type->SUPER::new(
+      PeerAddr => ($host = $h),
+      PeerPort => $arg{Port} || 'pop3(110)',
+      Proto => 'tcp',
+      @localport,
+      Timeout => defined $arg{Timeout}
+      ? $arg{Timeout}
+      : 120
+      )
+      and last;
   }
 
- return undef
-	unless defined $obj;
+  return undef
+    unless defined $obj;
 
- ${*$obj}{'net_pop3_host'} = $host;
+  ${*$obj}{'net_pop3_host'} = $host;
 
- $obj->autoflush(1);
- $obj->debug(exists $arg{Debug} ? $arg{Debug} : undef);
+  $obj->autoflush(1);
+  $obj->debug(exists $arg{Debug} ? $arg{Debug} : undef);
 
- unless ($obj->response() == CMD_OK)
-  {
-   $obj->close();
-   return undef;
+  unless ($obj->response() == CMD_OK) {
+    $obj->close();
+    return undef;
   }
 
- ${*$obj}{'net_pop3_banner'} = $obj->message;
+  ${*$obj}{'net_pop3_banner'} = $obj->message;
 
- $obj;
+  $obj;
 }
 
+
 sub host {
- my $me = shift;
- ${*$me}{'net_pop3_host'};
+  my $me = shift;
+  ${*$me}{'net_pop3_host'};
 }
 
 ##
@@ -75,272 +77,272 @@ sub host {
 ## now do we :-)
 ##
 
+
 sub debug_text { $_[2] =~ /^(pass|rpop)/i ? "$1 ....\n" : $_[2]; }
 
-sub login
-{
- @_ >= 1 && @_ <= 3 or croak 'usage: $pop3->login( USER, PASS )';
- my($me,$user,$pass) = @_;
 
- if (@_ <= 2) {
-   ($user, $pass) = $me->_lookup_credentials($user);
- }
+sub login {
+  @_ >= 1 && @_ <= 3 or croak 'usage: $pop3->login( USER, PASS )';
+  my ($me, $user, $pass) = @_;
+
+  if (@_ <= 2) {
+    ($user, $pass) = $me->_lookup_credentials($user);
+  }
 
- $me->user($user) and
-    $me->pass($pass);
+  $me->user($user)
+    and $me->pass($pass);
 }
 
-sub apop
-{
- @_ >= 1 && @_ <= 3 or croak 'usage: $pop3->apop( USER, PASS )';
- my($me,$user,$pass) = @_;
- my $banner;
- my $md;
 
- if (eval { local $SIG{__DIE__}; require Digest::MD5 }) {
-   $md = Digest::MD5->new();
- } elsif (eval { local $SIG{__DIE__}; require MD5 }) {
-   $md = MD5->new();
- } else {
-   carp "You need to install Digest::MD5 or MD5 to use the APOP command";
-   return undef;
- }
+sub apop {
+  @_ >= 1 && @_ <= 3 or croak 'usage: $pop3->apop( USER, PASS )';
+  my ($me, $user, $pass) = @_;
+  my $banner;
+  my $md;
 
- return undef
-   unless ( $banner = (${*$me}{'net_pop3_banner'} =~ /(<.*>)/)[0] );
+  if (eval { local $SIG{__DIE__}; require Digest::MD5 }) {
+    $md = Digest::MD5->new();
+  }
+  elsif (eval { local $SIG{__DIE__}; require MD5 }) {
+    $md = MD5->new();
+  }
+  else {
+    carp "You need to install Digest::MD5 or MD5 to use the APOP command";
+    return undef;
+  }
+
+  return undef
+    unless ($banner = (${*$me}{'net_pop3_banner'} =~ /(<.*>)/)[0]);
 
- if (@_ <= 2) {
-   ($user, $pass) = $me->_lookup_credentials($user);
- }
+  if (@_ <= 2) {
+    ($user, $pass) = $me->_lookup_credentials($user);
+  }
 
- $md->add($banner,$pass);
+  $md->add($banner, $pass);
 
- return undef
-    unless($me->_APOP($user,$md->hexdigest));
+  return undef
+    unless ($me->_APOP($user, $md->hexdigest));
 
- $me->_get_mailbox_count();
+  $me->_get_mailbox_count();
 }
 
-sub user
-{
- @_ == 2 or croak 'usage: $pop3->user( USER )';
- $_[0]->_USER($_[1]) ? 1 : undef;
+
+sub user {
+  @_ == 2 or croak 'usage: $pop3->user( USER )';
+  $_[0]->_USER($_[1]) ? 1 : undef;
 }
 
-sub pass
-{
- @_ == 2 or croak 'usage: $pop3->pass( PASS )';
 
- my($me,$pass) = @_;
+sub pass {
+  @_ == 2 or croak 'usage: $pop3->pass( PASS )';
 
- return undef
-   unless($me->_PASS($pass));
+  my ($me, $pass) = @_;
 
- $me->_get_mailbox_count();
+  return undef
+    unless ($me->_PASS($pass));
+
+  $me->_get_mailbox_count();
 }
 
-sub reset
-{
- @_ == 1 or croak 'usage: $obj->reset()';
 
- my $me = shift;
+sub reset {
+  @_ == 1 or croak 'usage: $obj->reset()';
+
+  my $me = shift;
 
- return 0 
-   unless($me->_RSET);
+  return 0
+    unless ($me->_RSET);
 
- if(defined ${*$me}{'net_pop3_mail'})
-  {
-   local $_;
-   foreach (@{${*$me}{'net_pop3_mail'}})
-    {
-     delete $_->{'net_pop3_deleted'};
+  if (defined ${*$me}{'net_pop3_mail'}) {
+    local $_;
+    foreach (@{${*$me}{'net_pop3_mail'}}) {
+      delete $_->{'net_pop3_deleted'};
     }
   }
 }
 
-sub last
-{
- @_ == 1 or croak 'usage: $obj->last()';
 
- return undef
+sub last {
+  @_ == 1 or croak 'usage: $obj->last()';
+
+  return undef
     unless $_[0]->_LAST && $_[0]->message =~ /(\d+)/;
 
- return $1;
+  return $1;
 }
 
-sub top
-{
- @_ == 2 || @_ == 3 or croak 'usage: $pop3->top( MSGNUM [, NUMLINES ])';
- my $me = shift;
 
- return undef
+sub top {
+  @_ == 2 || @_ == 3 or croak 'usage: $pop3->top( MSGNUM [, NUMLINES ])';
+  my $me = shift;
+
+  return undef
     unless $me->_TOP($_[0], $_[1] || 0);
 
- $me->read_until_dot;
+  $me->read_until_dot;
 }
 
-sub popstat
-{
- @_ == 1 or croak 'usage: $pop3->popstat()';
- my $me = shift;
 
- return ()
+sub popstat {
+  @_ == 1 or croak 'usage: $pop3->popstat()';
+  my $me = shift;
+
+  return ()
     unless $me->_STAT && $me->message =~ /(\d+)\D+(\d+)/;
 
- ($1 || 0, $2 || 0);
+  ($1 || 0, $2 || 0);
 }
 
-sub list
-{
- @_ == 1 || @_ == 2 or croak 'usage: $pop3->list( [ MSGNUM ] )';
- my $me = shift;
 
- return undef
+sub list {
+  @_ == 1 || @_ == 2 or croak 'usage: $pop3->list( [ MSGNUM ] )';
+  my $me = shift;
+
+  return undef
     unless $me->_LIST(@_);
 
- if(@_)
-  {
-   $me->message =~ /\d+\D+(\d+)/;
-   return $1 || undef;
+  if (@_) {
+    $me->message =~ /\d+\D+(\d+)/;
+    return $1 || undef;
   }
 
- my $info = $me->read_until_dot
-	or return undef;
+  my $info = $me->read_until_dot
+    or return undef;
 
- my %hash = map { (/(\d+)\D+(\d+)/) } @$info;
+  my %hash = map { (/(\d+)\D+(\d+)/) } @$info;
 
- return \%hash;
+  return \%hash;
 }
 
-sub get
-{
- @_ == 2 or @_ == 3 or croak 'usage: $pop3->get( MSGNUM [, FH ])';
- my $me = shift;
 
- return undef
+sub get {
+  @_ == 2 or @_ == 3 or croak 'usage: $pop3->get( MSGNUM [, FH ])';
+  my $me = shift;
+
+  return undef
     unless $me->_RETR(shift);
 
- $me->read_until_dot(@_);
+  $me->read_until_dot(@_);
 }
 
-sub getfh
-{
- @_ == 2 or croak 'usage: $pop3->getfh( MSGNUM )';
- my $me = shift;
 
- return unless $me->_RETR(shift);
- return        $me->tied_fh;
-}
+sub getfh {
+  @_ == 2 or croak 'usage: $pop3->getfh( MSGNUM )';
+  my $me = shift;
 
+  return unless $me->_RETR(shift);
+  return $me->tied_fh;
+}
 
 
-sub delete
-{
- @_ == 2 or croak 'usage: $pop3->delete( MSGNUM )';
- my $me = shift;
- return  0 unless $me->_DELE(@_);
- ${*$me}{'net_pop3_deleted'} = 1;
+sub delete {
+  @_ == 2 or croak 'usage: $pop3->delete( MSGNUM )';
+  my $me = shift;
+  return 0 unless $me->_DELE(@_);
+  ${*$me}{'net_pop3_deleted'} = 1;
 }
 
-sub uidl
-{
- @_ == 1 || @_ == 2 or croak 'usage: $pop3->uidl( [ MSGNUM ] )';
- my $me = shift;
- my $uidl;
 
- $me->_UIDL(@_) or
-    return undef;
- if(@_)
-  {
-   $uidl = ($me->message =~ /\d+\s+([\041-\176]+)/)[0];
+sub uidl {
+  @_ == 1 || @_ == 2 or croak 'usage: $pop3->uidl( [ MSGNUM ] )';
+  my $me = shift;
+  my $uidl;
+
+  $me->_UIDL(@_)
+    or return undef;
+  if (@_) {
+    $uidl = ($me->message =~ /\d+\s+([\041-\176]+)/)[0];
   }
- else
-  {
-   my $ref = $me->read_until_dot
-	or return undef;
-   my $ln;
-   $uidl = {};
-   foreach $ln (@$ref) {
-     my($msg,$uid) = $ln =~ /^\s*(\d+)\s+([\041-\176]+)/;
-     $uidl->{$msg} = $uid;
-   }
+  else {
+    my $ref = $me->read_until_dot
+      or return undef;
+    my $ln;
+    $uidl = {};
+    foreach $ln (@$ref) {
+      my ($msg, $uid) = $ln =~ /^\s*(\d+)\s+([\041-\176]+)/;
+      $uidl->{$msg} = $uid;
+    }
   }
- return $uidl;
+  return $uidl;
 }
 
-sub ping
-{
- @_ == 2 or croak 'usage: $pop3->ping( USER )';
- my $me = shift;
 
- return () unless $me->_PING(@_) && $me->message =~ /(\d+)\D+(\d+)/;
+sub ping {
+  @_ == 2 or croak 'usage: $pop3->ping( USER )';
+  my $me = shift;
+
+  return () unless $me->_PING(@_) && $me->message =~ /(\d+)\D+(\d+)/;
 
- ($1 || 0, $2 || 0);
+  ($1 || 0, $2 || 0);
 }
 
-sub _lookup_credentials
-{
+
+sub _lookup_credentials {
   my ($me, $user) = @_;
 
   require Net::Netrc;
 
-  $user ||= eval { local $SIG{__DIE__}; (getpwuid($>))[0] } ||
-    $ENV{NAME} || $ENV{USER} || $ENV{LOGNAME};
+       $user ||= eval { local $SIG{__DIE__}; (getpwuid($>))[0] }
+    || $ENV{NAME}
+    || $ENV{USER}
+    || $ENV{LOGNAME};
 
-  my $m = Net::Netrc->lookup(${*$me}{'net_pop3_host'},$user);
+  my $m = Net::Netrc->lookup(${*$me}{'net_pop3_host'}, $user);
   $m ||= Net::Netrc->lookup(${*$me}{'net_pop3_host'});
 
-  my $pass = $m ? $m->password || ""
-                : "";
+  my $pass = $m
+    ? $m->password || ""
+    : "";
 
   ($user, $pass);
 }
 
-sub _get_mailbox_count
-{
+
+sub _get_mailbox_count {
   my ($me) = @_;
-  my $ret = ${*$me}{'net_pop3_count'} = ($me->message =~ /(\d+)\s+message/io)
-	  ? $1 : ($me->popstat)[0];
+  my $ret = ${*$me}{'net_pop3_count'} =
+    ($me->message =~ /(\d+)\s+message/io) ? $1 : ($me->popstat)[0];
 
   $ret ? $ret : "0E0";
 }
 
 
 sub _STAT { shift->command('STAT')->response() == CMD_OK }
-sub _LIST { shift->command('LIST',@_)->response() == CMD_OK }
-sub _RETR { shift->command('RETR',$_[0])->response() == CMD_OK }
-sub _DELE { shift->command('DELE',$_[0])->response() == CMD_OK }
+sub _LIST { shift->command('LIST', @_)->response() == CMD_OK }
+sub _RETR { shift->command('RETR', $_[0])->response() == CMD_OK }
+sub _DELE { shift->command('DELE', $_[0])->response() == CMD_OK }
 sub _NOOP { shift->command('NOOP')->response() == CMD_OK }
 sub _RSET { shift->command('RSET')->response() == CMD_OK }
 sub _QUIT { shift->command('QUIT')->response() == CMD_OK }
 sub _TOP  { shift->command('TOP', @_)->response() == CMD_OK }
-sub _UIDL { shift->command('UIDL',@_)->response() == CMD_OK }
-sub _USER { shift->command('USER',$_[0])->response() == CMD_OK }
-sub _PASS { shift->command('PASS',$_[0])->response() == CMD_OK }
-sub _APOP { shift->command('APOP',@_)->response() == CMD_OK }
-sub _PING { shift->command('PING',$_[0])->response() == CMD_OK }
+sub _UIDL { shift->command('UIDL', @_)->response() == CMD_OK }
+sub _USER { shift->command('USER', $_[0])->response() == CMD_OK }
+sub _PASS { shift->command('PASS', $_[0])->response() == CMD_OK }
+sub _APOP { shift->command('APOP', @_)->response() == CMD_OK }
+sub _PING { shift->command('PING', $_[0])->response() == CMD_OK }
 
-sub _RPOP { shift->command('RPOP',$_[0])->response() == CMD_OK }
+
+sub _RPOP { shift->command('RPOP', $_[0])->response() == CMD_OK }
 sub _LAST { shift->command('LAST')->response() == CMD_OK }
 
+
 sub _CAPA { shift->command('CAPA')->response() == CMD_OK }
 
-sub quit
-{
- my $me = shift;
 
- $me->_QUIT;
- $me->close;
+sub quit {
+  my $me = shift;
+
+  $me->_QUIT;
+  $me->close;
 }
 
-sub DESTROY
-{
- my $me = shift;
 
- if(defined fileno($me) and ${*$me}{'net_pop3_deleted'})
-  {
-   $me->reset;
-   $me->quit;
+sub DESTROY {
+  my $me = shift;
+
+  if (defined fileno($me) and ${*$me}{'net_pop3_deleted'}) {
+    $me->reset;
+    $me->quit;
   }
 }
 
@@ -348,6 +350,7 @@ sub DESTROY
 ## POP3 has weird responses, so we emulate them to look the same :-)
 ##
 
+
 sub response {
   my $cmd  = shift;
   my $str  = $cmd->getline() or return undef;
@@ -374,143 +377,151 @@ sub response {
 
 
 sub capa {
-    my $this = shift;
-    my ($capa, %capabilities);
+  my $this = shift;
+  my ($capa, %capabilities);
 
-    # Fake a capability here
-    $capabilities{APOP} = '' if ($this->banner() =~ /<.*>/);
+  # Fake a capability here
+  $capabilities{APOP} = '' if ($this->banner() =~ /<.*>/);
 
-    if ($this->_CAPA()) {
-      $capabilities{CAPA} = 1;
-      $capa = $this->read_until_dot();
-      %capabilities = (%capabilities, map { /^\s*(\S+)\s*(.*)/ } @$capa);
-    }
-    else {
-      # Check AUTH for SASL capabilities
-      if ( $this->command('AUTH')->response() == CMD_OK ) {
-          my $mechanism = $this->read_until_dot();
-          $capabilities{SASL} = join " ", map { m/([A-Z0-9_-]+)/ } @{ $mechanism };
-      }
+  if ($this->_CAPA()) {
+    $capabilities{CAPA} = 1;
+    $capa = $this->read_until_dot();
+    %capabilities = (%capabilities, map {/^\s*(\S+)\s*(.*)/} @$capa);
+  }
+  else {
+
+    # Check AUTH for SASL capabilities
+    if ($this->command('AUTH')->response() == CMD_OK) {
+      my $mechanism = $this->read_until_dot();
+      $capabilities{SASL} = join " ", map {m/([A-Z0-9_-]+)/} @{$mechanism};
     }
-    
-    return ${*$this}{'net_pop3e_capabilities'} = \%capabilities;
+  }
+
+  return ${*$this}{'net_pop3e_capabilities'} = \%capabilities;
 }
 
+
 sub capabilities {
-    my $this = shift;
+  my $this = shift;
 
-    ${*$this}{'net_pop3e_capabilities'} || $this->capa;
+  ${*$this}{'net_pop3e_capabilities'} || $this->capa;
 }
-    
-sub auth {
-    my ($self, $username, $password) = @_;
-
-    eval {
-	require MIME::Base64;
-	require Authen::SASL;
-    } or $self->set_status(500,["Need MIME::Base64 and Authen::SASL todo auth"]), return 0;
-
-    my $capa = $self->capa;
-    my $mechanisms = $capa->{SASL} || 'CRAM-MD5';
-
-    my $sasl;
-
-    if (ref($username) and UNIVERSAL::isa($username,'Authen::SASL')) {
-      $sasl = $username;
-      my $user_mech = $sasl->mechanism || '';
-      my @user_mech = split(/\s+/, $user_mech);
-      my %user_mech; @user_mech{@user_mech} = ();
-
-      my @server_mech = split(/\s+/,$mechanisms);
-      my @mech = @user_mech
-      				? grep { exists $user_mech{$_} } @server_mech
-      				: @server_mech;
-      unless (@mech) {
-        $self->set_status(500,
-                             [ 'Client SASL mechanisms (',
-                               join(', ', @user_mech),
-                               ') do not match the SASL mechnism the server announces (',
-                               join(', ', @server_mech), ')',
-                             ]);
-        return 0;
-      }
 
-      $sasl->mechanism(join(" ",@mech));
-    }
-    else {
-      die "auth(username, password)" if not length $username;
-      $sasl = Authen::SASL->new(mechanism=> $mechanisms,
-				callback => { user => $username,
-                                              pass => $password,
-					      authname => $username,
-                                            });
-    }
 
-    # We should probably allow the user to pass the host, but I don't
-    # currently know and SASL mechanisms that are used by smtp that need it
-    my ( $hostname ) = split /:/ , ${*$self}{'net_pop3_host'};
-    my $client = eval { $sasl->client_new('pop',$hostname,0) };
-    
-    unless ($client) {
-      my $mech = $sasl->mechanism;
-      $self->set_status(500, [
-         " Authen::SASL failure: $@",
-         '(please check if your local Authen::SASL installation',
-         "supports mechanism '$mech'"
-       ]);
+sub auth {
+  my ($self, $username, $password) = @_;
+
+  eval {
+    require MIME::Base64;
+    require Authen::SASL;
+  } or $self->set_status(500, ["Need MIME::Base64 and Authen::SASL todo auth"]), return 0;
+
+  my $capa       = $self->capa;
+  my $mechanisms = $capa->{SASL} || 'CRAM-MD5';
+
+  my $sasl;
+
+  if (ref($username) and UNIVERSAL::isa($username, 'Authen::SASL')) {
+    $sasl = $username;
+    my $user_mech = $sasl->mechanism || '';
+    my @user_mech = split(/\s+/, $user_mech);
+    my %user_mech;
+    @user_mech{@user_mech} = ();
+
+    my @server_mech = split(/\s+/, $mechanisms);
+    my @mech = @user_mech
+      ? grep { exists $user_mech{$_} } @server_mech
+      : @server_mech;
+    unless (@mech) {
+      $self->set_status(
+        500,
+        [ 'Client SASL mechanisms (',
+          join(', ', @user_mech),
+          ') do not match the SASL mechnism the server announces (',
+          join(', ', @server_mech), ')',
+        ]
+      );
       return 0;
     }
-    
-    my ($token) = $client->client_start
-      or do {
-        my $mech = $client->mechanism;
-        $self->set_status(500, [
-          ' Authen::SASL failure:  $client->client_start ',
-          "mechanism '$mech' hostname #$hostname#",
-          $client->error
-        ]);
-        return 0;
-      };
-
-    # We dont support sasl mechanisms that encrypt the socket traffic.
-    # todo that we would really need to change the ISA hierarchy
-    # so we dont inherit from IO::Socket, but instead hold it in an attribute
-
-    my @cmd = ("AUTH", $client->mechanism);
-    my $code;
-
-    push @cmd, MIME::Base64::encode_base64($token,'')
-      if defined $token and length $token;
-
-    while (($code = $self->command(@cmd)->response()) == CMD_MORE) {
-
-      my ( $token ) = $client->client_step(
-	MIME::Base64::decode_base64(
-	  ($self->message)[0]
-	)
-      ) or do {
-        $self->set_status(500, [
-          ' Authen::SASL failure:  $client->client_step ',
-          "mechanism '", $client->mechanism ," hostname #$hostname#, ",
+
+    $sasl->mechanism(join(" ", @mech));
+  }
+  else {
+    die "auth(username, password)" if not length $username;
+    $sasl = Authen::SASL->new(
+      mechanism => $mechanisms,
+      callback  => {
+        user     => $username,
+        pass     => $password,
+        authname => $username,
+      }
+    );
+  }
+
+  # We should probably allow the user to pass the host, but I don't
+  # currently know and SASL mechanisms that are used by smtp that need it
+  my ($hostname) = split /:/, ${*$self}{'net_pop3_host'};
+  my $client = eval { $sasl->client_new('pop', $hostname, 0) };
+
+  unless ($client) {
+    my $mech = $sasl->mechanism;
+    $self->set_status(
+      500,
+      [ " Authen::SASL failure: $@",
+        '(please check if your local Authen::SASL installation',
+        "supports mechanism '$mech'"
+      ]
+    );
+    return 0;
+  }
+
+  my ($token) = $client->client_start
+    or do {
+    my $mech = $client->mechanism;
+    $self->set_status(
+      500,
+      [ ' Authen::SASL failure:  $client->client_start ',
+        "mechanism '$mech' hostname #$hostname#",
+        $client->error
+      ]
+    );
+    return 0;
+    };
+
+  # We dont support sasl mechanisms that encrypt the socket traffic.
+  # todo that we would really need to change the ISA hierarchy
+  # so we dont inherit from IO::Socket, but instead hold it in an attribute
+
+  my @cmd = ("AUTH", $client->mechanism);
+  my $code;
+
+  push @cmd, MIME::Base64::encode_base64($token, '')
+    if defined $token and length $token;
+
+  while (($code = $self->command(@cmd)->response()) == CMD_MORE) {
+
+    my ($token) = $client->client_step(MIME::Base64::decode_base64(($self->message)[0])) or do {
+      $self->set_status(
+        500,
+        [ ' Authen::SASL failure:  $client->client_step ',
+          "mechanism '", $client->mechanism, " hostname #$hostname#, ",
           $client->error
-        ]);
-        return 0;
-      };
-
-      @cmd = (MIME::Base64::encode_base64(
-                  defined $token ?  $token : '',
-                  ''
-             )
+        ]
       );
-    }
+      return 0;
+    };
+
+    @cmd = (MIME::Base64::encode_base64(defined $token ? $token : '', ''));
+  }
 
-    $code == CMD_OK;
+  $code == CMD_OK;
 }
 
+
 sub banner {
-    my $this = shift;
+  my $this = shift;
 
-    return ${*$this}{'net_pop3_banner'};
+  return ${*$this}{'net_pop3_banner'};
 }
 
 1;