Mail::PopPwd - Perl 5 module to talk to a poppasswd daemon

  use Mail::PopPwd;

  my $poppwd = Mail::PopPwd->new(
                        HOST   => "localhost",
                        USER   => "hdias",
                        OLDPWD => "********",
                        NEWPWD => "********");
  my $error = $poppwd->change();

  # set hash values

  $poppwd->{HOST} = "localhost";
  $poppwd->{USER} = "hdias";
  $poppwd->{OLDPWD} = "********";
  $poppwd->{NEWPWD} = "********";

   Mail::POP3Client->new(
                HOST    => "local",
                PORT    => 106,
                USER    => "",
                OLDPWD  => "",
                NEWPWD  => "",
                TIMEOUT => 0,
   );

#
# PopPwd.pm
# Last Modification: Fri Oct 10 18:31:17 WEST 2003
#
# Copyright (c) 2002 Henrique Dias <hdias@aesbuc.pt>. All rights reserved.
# This module is free software; you can redistribute it and/or modify
# it under the same terms as Perl itself.
#

package Mail::PopPwd;
use strict;
require Exporter;
use vars qw($VERSION @ISA @EXPORT);
@ISA = qw(Exporter AutoLoader);
$VERSION = 0.03;
@ISA = qw(Exporter);
require 5;
use IO::Socket;
use Crypt::Cracklib;

sub new {
        my $proto = shift;
        my $class = ref($proto) || $proto;
        my $self  = {
		HOST      => "localhost",
		PORT      => 106,
		TIMEOUT   => 0,
		USER      => "",
		NAME      => "",
		STOREDPWD => "",
		OLDPWD    => "",
		NEWPWD    => "",
		CONFPWD   => "",
		NMIN      => 6,
		NMAX      => 12,
		NDIFCHARS => 4,
		NSEQWORD  => 4,
		CRACKLIB  => "",
		@_,
	};
	bless ($self, $class);
	return($self);
}

sub count_chars {
	my $string = shift;

	my %seen;
	my @chars = split(//, $string);
	@seen{@chars} = ();
	return(scalar(keys(%seen)));
}

sub checkpwd {
	my $self = shift;

	$self->{USER} or return(551);
	$self->{OLDPWD} or return(551);
	$self->{NEWPWD} or return(553);
	$self->{CONFPWD} or return(554);
	return(555) if(length($self->{NEWPWD}) < $self->{NMIN});
	return(556) if(length($self->{NEWPWD}) > $self->{NMAX});
	return(557) if($self->{NEWPWD} ne $self->{CONFPWD});
	return(558) if($self->{STOREDPWD} && ($self->{OLDPWD} ne $self->{STOREDPWD}));
	return(559) if(&count_chars($self->{NEWPWD}) < $self->{NDIFCHARS});

	my $pwdrev = reverse($self->{NEWPWD});
	return(560) if(&check_dif($self->{NEWPWD},$self->{OLDPWD},$self->{NSEQWORD}) || &check_dif($pwdrev,$self->{OLDPWD},$self->{NSEQWORD}));
	return(561) if(&check_dif($self->{NEWPWD},$self->{USER},$self->{NSEQWORD}) || &check_dif($pwdrev,$self->{USER},$self->{NSEQWORD}));
	return(562) if($self->{NAME} &&
			(&check_dif($self->{NEWPWD}, $self->{NAME},$self->{NSEQWORD}) ||
				&check_dif($pwdrev, $self->{NAME}, $self->{NSEQWORD})));

	if($self->{CRACKLIB}) {
		my $reason = fascist_check($self->{NEWPWD}, $self->{CRACKLIB});
		chomp($reason);
		($reason eq "ok") or return(563);
	}
	return();
}

sub change {
	my $self = shift;

	my $socket = IO::Socket::INET->new(
			PeerAddr => $self->{HOST},
			PeerPort => $self->{PORT},
			Proto    => "tcp",
			Type     => SOCK_STREAM,
			Timeout  => $self->{TIMEOUT}		
	) or return(join("", "Couldn't connect to ", $self->{HOST}, ":", $self->{PORT}, " $@\n"));

	my $EOL = "\015\012";
	my $error = "";
	TEST: {
		print $socket join(" ", "user", $self->{USER}), $EOL;
		last TEST if($error = &get_answer($socket));
		print $socket join(" ", "pass", $self->{OLDPWD}), $EOL;
		last TEST if($error = &get_answer($socket));
		print $socket join(" ", "newpass", $self->{NEWPWD}), $EOL;
		last TEST if($error = &get_answer($socket));
		print $socket "quit$EOL";
		last TEST if($error = &get_answer($socket));
	}
	close($socket);
	return($error);
}

sub get_answer {
	my $answer = shift;
	my $line = <$answer>;
	my $v = substr($line,0,3);
	return(($v eq "200") ? "" : $line);
}

sub check_dif($$$) {
	my($str1, $str2, $n) = @_;

	($str1, $str2) = ($str2, $str1) if(length($str2) < length($str1));
	my @parts = $str1 =~ /(?=(.{$n}))/g;
	for(@parts) { return($_) if($str2 =~ /\Q$_\E/ig); }
	return();
}

1;

__END__

# POD Documentation (perldoc PopPwd or pod2html this_file)