poppass-cgi 3-6 / usr / lib / cgi-bin / poppass

#!/usr/bin/perl

# PopPass - a CGI script in Perl to allow users to changes their password
# using a WWW interface. PopPass uses poppassd version 1.2 (available at
# ftp://ftp.qualcomm.com/eudora/servers/unix/password/ to actually make 
# the password change. It can therefore run as an unprivilaged user on any 
# server (not necessarly the server where the password file exists). The 
# Perl 5 modules IO::Socket and CGI are also required (available from your 
# favorite CPAN site).
# A version of poppassd for Linux systems using shadow passwords can be
# found at ftp://ftp.ceti.com.pl/pub/linux/poppassd-1.8-ceti.tar.gz
# ==========================================================================
# Created: 2 Feb 96 by Jerry Workman (jerry@mtnsoft.com)
# Last Revised: 19 January 2000
# ==========================================================================
use strict;
use CGI qw(:all);	# CGI forms etc
use CGI::Carp qw(fatalsToBrowser set_message);
BEGIN {
  sub handle_errors {
    my $msg = shift;
    print "<h2>Error:</H2><i>$msg</i>";
  }
  set_message(\&handle_errors);
}
$SIG{ALRM} = \&error_exit;
alarm(60);
open(STDERR,">&STDOUT") || die "Can't dup stdout: $!\n";
select(STDERR); $| = 1; # Make unbuffered.
select(STDOUT); $| = 1; # Make unbuffered.
# --------------------------------------------------------------------------
my $DEBUG		= 0;
my $DEFAULTHOST	= 'localhost';	# host name if different from web server
my $TITLE		= 'Change Your Password';
my $AUTHOR		= 'Jerry Workman';
my $COPYRIGHT	= "Copyright 1996-2000 $AUTHOR";
my $HOME		= hr. a({href=>"/"}, "Home"); # Very Basic Home link
my $MESSAGE	= <<EOM;
Enter your username, current password, and new password (twice for
verification) then click on Change Password. Passwords must be
at least 6 characters and can be mixed case.
EOM
# ** End of Configurable Parameters (unless you're a Perl hacker) **
# --------------------------------------------------------------------------
my $host 		= param('host') || $DEFAULTHOST;
my $username 	= param('username');
my $password 	= param('password');
my $newpassword1 	= param('newpassword1');
my $newpassword2 	= param('newpassword2');
my $msg;
# --------------------------------------------------------------------------
print header, 
      start_html(-title=>$TITLE,
                 -author=>$AUTHOR,
                 -base=>'true',
                 -meta=>{'copyright'=>$COPYRIGHT});
print CGI::Dump() if $DEBUG;
if(!param()) {
  showform();
} else {
  error_exit("You must supply a Username") 
    if (!$username);
  error_exit("New Passwords do not match") 
    if ($newpassword1 ne $newpassword2);
  error_exit("The New Password can not be blank") 
    if length($newpassword1) == 0;
  my $newpassword = $newpassword1;
  error_exit("New Password can not contain spaces") 
    if $newpassword =~ / /;
  error_exit ("Password must be six or more characters")
    if length($newpassword) < 6;
  if(poppass($host, $username, $password, $newpassword)) {
    print p, center(h2("Password Changed Successfully")), "\n";
  } else {
    error_exit($msg);
  }
  print hr, "<I>Be sure to change your password in both your dialer" .
            " and E-mail programs</I>";
}
print $HOME, end_html;
# --------------------------------------------------------------------------
# Subroutines
# --------------------------------------------------------------------------
sub showform {
  my @p;
  if (remote_user) {
    @p = (hidden('username', remote_user), remote_user);
  } else {
    @p = (textfield('username', '', 25));
  }
  print p, blockquote(center(h2('Change Password')), hr, 
    $MESSAGE, hr, pre(start_form(),
    "<b>           Username: </b>", @p, "\n",
    "<b>       Old Password: </b>", password_field('password','', 25), "\n",
    "<b>       New Password: </b>", password_field('newpassword1','',25),"\n",
    "<b>Verify New Password: </b>", password_field('newpassword2','',25),"\n\n",
    submit('action','Change Password'),
    end_form)), "\n";
}
# --------------------------------------------------------------------------
sub error_exit {
  my($msg) = @_;
  print h1("Error:"), h2($msg), hr,
       "Return to the previous page and make the necessary corrections",
       $HOME, end_html;
  exit;
}
# --------------------------------------------------------------------------
# Change the password using service poppassd at port 106
#
sub poppass
{
  my($host, $username, $password, $newpassword) = @_;
  my ($status, $socket) = 0;
  eval {
	sub popout {
		my $str = shift;
		print $socket "$str\n";
		print "$str <br>\n" if $DEBUG;
	}
	use IO::Socket::INET;
	$socket = IO::Socket::INET->new(
		PeerAddr => $host,
		PeerPort => 106, 
		Proto    => 'tcp',
		Type	 => SOCK_STREAM) or
		( $msg = "No Response from poppass server:$@\n", return $status = 0 );

        my $seq = 0;
	while ($_ = <$socket>) {
		s/\n//g;
		s/\r//g;
		print "$_ <br>\n" if $DEBUG;
		/^500/ && ( s/^500//, $msg = $_, $status = undef, last );
		! /^200/ && ( $msg = "No Response from server", $status = 0, last );
                ++$seq;
                $seq == 1 && (popout("USER $username"), next );
                $seq == 2 && (popout("PASS $password"), next );
                $seq == 3 && (popout("NEWPASS $newpassword"), next );
                $seq == 4 && ($msg = "Password successfully changed",
			      $status = 1, popout("QUIT"), last );
	}
    close($socket);
  }; #eval
	if ($@) {
		($msg) = split(/:/, $@);
		$msg =~ /[Tt]imeout/ && ($msg = "poppassd server not responding, try again later.");
		$status = 0;
	}
	return $status;
}