#!C:/perl/bin/perl
use strict;
use warnings;
use warnings FATAL => qw(uninitialized);
use Apache::Htpasswd;
### Configuration
my $self_url = 'htpasswd.cgi';
my $htpasswd_filename = '/path/to/.htpasswd';
### End of configuration
package EncodeHTML;
use strict;
use warnings;
use warnings FATAL => qw(uninitialized);
use Carp;
sub TIEHASH
{
my ($self, $quot) = @_;
$quot = '' if !defined($quot);
return bless \$quot, $self;
}
sub FETCH
{
my ($self, $s) = @_;
my $quot = $$self;
if (defined($s)) {
$s =~ s/&/&/g;
$s =~ s//>/g;
$s =~ s/"/"/g if $quot eq '"';
$s =~ s/'/'/g if $quot eq "'";
}
return $s;
}
sub STORE
{
croak 'EncodeHTML-tied hash is read-only';
}
sub DELETE
{
croak 'EncodeHTML-tied hash is read-only';
}
sub CLEAR
{
croak 'EncodeHTML-tied hash is read-only';
}
sub EXISTS
{
my ($self, $s) = @_;
return 1;
}
sub FIRSTKEY
{
croak 'EncodeHTML-tied hash cannot be enumerated';
}
sub NEXTKEY
{
croak 'EncodeHTML-tied hash cannot be enumerated';
}
sub SCALAR
{
my ($self) = @_;
return 'EncodeHTML-tied hash';
}
package main;
use vars qw(%HTML %HTML_q);
tie %HTML, 'EncodeHTML';
tie %HTML_q, 'EncodeHTML', '"';
sub nz
{
while (1) {
return '' if !@_;
return $_[0] if defined($_[0]);
shift @_;
}
}
my $method = $ENV{'REQUEST_METHOD'};
if ($method eq 'GET' || $method eq 'HEAD') {
print <<"EOS";
Content-Type: text/html;charset=ISO-8859-1
Change password
EOS
exit;
}
elsif ($method eq 'POST') {
my $in;
read STDIN, $in, $ENV{'CONTENT_LENGTH'};
my %in;
foreach my $param (split(/[&;]/, $in)) {
if ($param =~ /^([^=]+)=(.*)$/) {
my $name = $1;
my $value = $2;
$name =~ tr/+/ /;
$name =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
$value =~ tr/+/ /;
$value =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
$in{$name} = $value;
}
}
my $user = nz($in{'user'});
my $old = nz($in{'old'});
my $new = nz($in{'new'});
my $new2 = nz($in{'new2'});
if ($new ne $new2) {
print <<"EOS";
Content-Type: text/html;charset=ISO-8859-1
Passwords do not match
Two new passwords do not match. Please try again.
EOS
exit;
}
if ($new eq '') {
print <<"EOS";
Content-Type: text/html;charset=ISO-8859-1
Weak password
New password is too weak. Please try again.
EOS
exit;
}
my $htpasswd = new Apache::Htpasswd($htpasswd_filename);
if (!$htpasswd->htpasswd($user, $new, $old)) {
print <<"EOS";
Content-Type: text/html;charset=ISO-8859-1
Username or password is incorrect
Username or password is incorrect. Please try again.
EOS
exit;
}
print <<"EOS";
Content-Type: text/html;charset=ISO-8859-1
Password is successfully changed
Password is successfully changed.
EOS
}
else {
print <<"EOS";
Status: 405 Method not allowed
Allow: GET, HEAD, POST
Content-Type: text/html;charset=ISO-8859-1
405 Method not allowed
405 Method not allowed
EOS
}