#!/usr/bin/perl require 5; #$DEBUG =1; $version = "4.0"; ################################################### # PASS.CGI v4.0 # Copyright 2001 Right Connection, Inc. # For use by their customers only for integrating IPPS # Password Management to their website # # Please be sure and set all of the variables below. If they are # not properly set ....... the Password Management will not work # ################################################### # What is the directory where your encrypted password file is located ? $pass_dir = "/path/to/.htpasswd/directory"; # What is the name of your encrypte password file ? (Should be .htpasswd). $pass_file = ".htpasswd"; # What is the URL the NEW customer should be taken to when they sign-up? $members_url = "http://www.yourwebsite.com/members/"; # The BODY tag variables for the script $bgcolor = "FFFFFF"; $text = "000000"; $link = "FF0000"; $vlink = "FF00FF"; $alink = "FFFF00"; ################################################### # NO CHANGES ARE NEEDED BEYOND THIS POINT ################################################### &read_parse; $refering_url = $ENV{'HTTP_REFERER'}; $LOCK_EX = 2; $LOCK_UN = 8; if ($contents{'mode'} eq "" || $contents{'mode'} eq "add") { &new_signup; } if ($contents{'mode'} eq "stat") { &stat; } if ($contents{'mode'} eq "update") { &update(@user_pairs); } &error("No Commands were received"); exit; sub read_parse { local (*contents) = @_; local ( $request_method, $query_string, @key_value_pairs, $key_value, $key, $value, $data); $data_string = ""; $request_method = $ENV{'REQUEST_METHOD'}; if ($request_method eq "GET") { $query_string = $ENV{'QUERY_STRING'}; } elsif ($request_method eq "POST") { read (STDIN, $query_string, $ENV{'CONTENT_LENGTH'}); } @key_value_pairs = split (/&/, $query_string); foreach $key_value (@key_value_pairs) { ($key, $value) = split (/=/, $key_value); $value =~ tr/+/ /; $value =~ s/\r/\n/g; $value =~ s/%([\dA-Fa-f][\dA-Fa-f])/pack ("C", hex ($1))/eg; if (defined($FORM_DATA{$key})) { $contents{$key} = join ("\0", $contents{$key}, $value); } else { $contents{$key} = $value; } $data_string .= "$key - $value\n"; if ($contents{'userpair'} ne "") { push(@user_pairs,$contents{'userpair'}); } } if (@user_pairs) { $data_string .= "userpairs\n@user_pairs\n"; } } sub error { local($errormsg) = @_; print "Content-Type: text/html\n\n"; print "\n"; print "\n"; print "
\n\n\n"; print "\n$errormsg\n\n"; print "
\n\n"; print "Your Membership sign-up is complete.
You may now enter the \n";
print "MEMBERS AREA using your User ID of \n";
print "$contents{'username'} and Password of $contents{'password'}
\n";
if ($DEBUG) {
print "\n";
}
print "\n";
print "";
exit;
}
sub stat {
open(FILE, "$pass_dir/$pass_file") || &error("Can't stat file $pass_dir/$pass_file ($!)");
$filesize = -s FILE;
close(FILE);
&good_stat;
}
sub good_stat {
print "Connection: close\n";
print "Content-Type: text/plain\n\n";
print "\n";
print "$filesize\n";
print "\n";
if ($DEBUG) {
print "\n";
}
exit;
}
sub update {
my(@users) = @_;
open(TMP, ">$pass_dir/$pass_file.tmp") || &error("Can't write to $pass_dir/$pass_file.tmp ($!)");
flock(TMP, $LOCK_EX);
foreach $user (@users) {
print TMP "$user\n";
if ($DEBUG) { $data_string .= "pair - $user\n"; }
}
flock(TMP, $LOCK_UN);
close(TMP);
open(FILE, "$pass_dir/$pass_file.tmp") || &error("Can't get filesize $pass_dir/$pass_file.tmp ($!)");
$tmp_filesize = -s FILE;
close(FILE);
if ($contents{'filesize'} != $tmp_filesize) {
open(TMP, ">$pass_dir/$pass_file.tmp") || &error("Can't write to $pass_dir/$pass_file.tmp ($!)");
flock(TMP, $LOCK_EX);
foreach $pair (@user_pairs) {
print TMP "$pair\n";
}
flock(TMP, $LOCK_UN);
close(TMP);
open(FILE, "$pass_dir/$pass_file.tmp") || &error("Can't get filesize $pass_dir/$pass_file.tmp ($!)");
$tmp_filesize2 = -s FILE;
close(FILE);
if ($contents{'filesize'} != $tmp_filesize2) {
&error("File Size Checksum Failure - sent $contents{'filesize'} - got1 $tmp_filesize - got2 $tmp_filesize2");
}
}
open(MOVE, ">$pass_dir/$pass_file");
open(TMP, "$pass_dir/$pass_file.tmp");
while (