#!/usr/bin/perl -w
# CONFIGURATION [0] : Set correct path of Perl in your system (above line)
# $Id: .regist.cgi,v 2.1 2005/09/06 09:17:12 alex Exp alex $

# CONFIGURATION [1] : Name of EDB server
	$ldap_ac_host = "cms-ldap.db.tokushima-u.ac.jp.";
		# specified in FQDN
		# Generary, you shouldn't rewrite it.
# CONFIGURATION [2] : Do you accept any user who are registered in EDB.
	$accept_ldap_user = 1;
		# 0: not accept
		# 1: accept
# CONFIGURATION [3] : Password expire time
	$maxage = 2*60*60;
		# in second
# CONFIGURATION [4] : Path of password file
	$pwfile = "/WWW/passwd/ldap-otp-passwd";
		# Password file MUST be read/write-accessible by executor of .regist.cgi

		# Invalid password string.
		# This passwd must be tried by Apache MD5 encryption, but always mismatch.
		# (in order to forbid plain-text-matching. e.g. WIN32, NETWARE)
	$invalidpasswd = '$apr1$abcdefgh$**********************';

		# content-type header is printed?
	$content_type_responsed = 0;

		# Move current directory.
		# Usually, httpd server move to current directory before execution.
		# This is for execution from cron.
	$cwd = $0;
	$cwd =~ s|(.*)/(.*?)$|$1|;	# dirname $cwd
	chdir($cwd) or print_and_exit(101, "can't change directory!$!");

		# Get IP-address of $ldap_ac_host.
	($a, $b, $c, $d) = unpack('C4',gethostbyname($ldap_ac_host));
	$ldap_ac_addr = "$a.$b.$c.$d";

		# Get parameters from HTTP
	my $remote_user = ""; my $query = ""; my $remote_addr = "";
	while (($key, $val) = each %ENV) {
		# print "$key = $val\n";
		if($key eq "REMOTE_USER") { $remote_user = $val; }
		if($key eq "QUERY_STRING") { $query = $val; }
		if($key eq "REMOTE_ADDR") { $remote_addr = $val; }
	}

		# Is this access is authorized (from EDB, or not).
	$authorized = 0;
	if($remote_addr eq $ldap_ac_addr) { $authorized = 1; }

		# Evaluate GET QUERY
	$uid = "";	# User-ID
	$cpwd = "";	# crypted password
	$loc = "";	# location (use for Location: $loc)
	$id = "";	# identifier (presently, not use)
	@pairs = split(/&/, $query);
	foreach $pair (@pairs) {
		($name, $value) = split(/=/, $pair, 2);
		$name =~ tr/A-Z/a-z/;
		if( $name eq "u" ) {$uid = $value;}
		elsif( $name eq "p" ) {$cpwd = $value;}
		elsif( $name eq "l" ) {$loc = $value;}
		elsif( $name eq "i" ) {$id = $value;}
	}

		# If the UID is valid and access is authorized,
		# try to register this account.
		# Otherwise, remove the registered account.
	if(($uid ne "") and $authorized) {
		response('Password Registration CGI: Revision $Revision: 2.1 $');
		response("AUTHORIZED ACCESS from $remote_addr");
		if($line=regist($uid, $cpwd)) {
			response("$line");
			my $et = localtime(time+$maxage);
			response("This password will be EXPIRED at '$et'");
			print_and_exit(200, "SUCCESS");
		} else {
			print_and_exit(100, "REFUSED");
		}
	} else {
		if($loc) {print "Location: $loc\n";}
		regist($remote_user, $invalidpasswd);
	}

		# Normal status code
	print_and_exit(200, "NORMAL");

# --- end of main

# manipulate password file
sub regist {
	my $change = 0;
	my $registered = "";
	my %pwd = ();
	my $u = $_[0];	# User-ID
	my $p = $_[1];	# crypted password
	my $t =time;	# current time
	my $line = "";
	my $name = "";
	my $pw = "";
	my $lifename = "";
	my $time = "";
	open(PWF, "+<$pwfile") or print_and_exit(101, "can't open password file");
	flock(PWF, 2) or print_and_exit(101, "can't lock password file.");
	if($authorized and $accept_ldap_user and $u) {
		$line = "$u:$p:$lifename:$t";
		$registered = $line;
		$change = 1;
		$pwd{$u} = $line;
	}
	while($line = <PWF>) {
		chomp($line);
		$name = $pw = $lifename = $time = "";
		($name, $pw, $lifename, $time) = split(/:/, $line);
		if($time) {
			if($name eq $u) {
				$line = "$u:$p:$lifename:$t";
				$registered = $line;
				$change = 1;
			} elsif(($t-$time>$maxage) and ($pw ne $invalidpasswd)) {
				$line = "$name:$invalidpasswd:$lifename:$t";
				$change = 1;
			}
		}
		$pwd{$name} = $line;
	}
	if($change) {
		seek PWF, 0, 0;
		response("Password file have been CHANGED!");
		while (($key, $val) = each %pwd) {	print PWF "$val\n"; }
		$pos = tell(PWF);
		truncate PWF, $pos;
	}
	flock(PWF, 8);
	close(PWF);
	return $registered;
}

# responser to access originator
sub response {
	$content_type_responsed or print "Content-type: text/plain\n\n";
	$content_type_responsed = 1;
	print "$_[0]\n";
}

# print STATUS and exit
sub print_and_exit {
	response("STATUS: $_[0] $_[1]");
	exit;
}