#!/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$errormsg!\n\n"; print "\n"; print "
\n

\n\n"; print "\n$errormsg\n\n"; print "

\n"; print "If you are recieving this Error Message and are using Internet Explorer \n"; print "4.x and above, your password will automatically be activated in approximately 15 minutes.\n"; if ($DEBUG) { print "\n"; } print ""; exit; } sub new_signup { if (($contents{'username'} eq "") || ($contents{'username'} eq " ")) { &error("Invalid User Name"); } if (($contents{'password'} eq "") || ($contents{'password'} eq " ")) { &error("Invalid Password"); } if ($refering_url !~ /secure.rightconnect.com/) { &error("Bad Refering URL - $refering_url"); } &salt_password; &add_to_file; &good_add; } sub salt_password { srand($$|time); @saltchars=('a..z','A..Z','0..9','.','/'); $salt=$saltchars[int(rand($#saltchars+1))]; $salt.=$saltchars[int(rand($#saltchars+1))]; $cpw = crypt($contents{'password'},$salt); } sub add_to_file { if (-e "$pass_dir/$pass_file") { open(HTPASSWD, ">>$pass_dir/$pass_file") || &error("Can't write to $pass_dir/$pass_file ($!)"); } else { open(HTPASSWD, ">$pass_dir/$pass_file") || &error("Can't write to $pass_dir/$pass_file ($!)"); } flock(HTPASSWD, $LOCK_EX); print HTPASSWD "$contents{'username'}:$cpw\n"; flock(HTPASSWD, $LOCK_UN); close(HTPASSWD); } sub good_add { print "Connection: close\n"; print "Content-Type: text/html\n\n"; print "\n"; print "\n"; print "\nComplete\n\n"; print "\n"; print "\n"; print "
\n

\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 () { chomp; print MOVE "$_\n"; } close(TMP); close(MOVE); chmod (0666, "$pass_dir/$pass_file.tmp"); unlink ("$pass_dir/$pass_file.tmp"); print "Connection: close\n"; print "Content-Type: text/plain\n\n"; print "\n"; print "OK\n"; print "\n"; if ($DEBUG) { print "\n"; } exit; }