#!/usr/local/bin/perl
require "/home/todd/weblib.lib";
#use DB_File;
$VERSION="1.0";
$HOMEPAGE_SCRIPTNAME="/rdl/homepage";
$SCRIPTPATH="http://www.rocemabra.com/rdl";
$LINKSFILE="/home/roger/LINKS";
$USERSDB="/home/roger/users";
$LIBRARY="/home/roger/lib";
### Process PATH_INFO arguments
$PATHINFO=$ENV{PATH_INFO};
$edit=$PATHINFO =~ s#/edit/|/edit$#/#;
$random=$PATHINFO =~ s#/random/|/random$#/#;
$id=$PATHINFO =~ s#/id/|/id$#/#;
$showrestrict=$PATHINFO =~ s#/showrestrict/|/showrestrict$#/#;
$login=$PATHINFO =~ s#/login/|/login$#/#;
$logout=$PATHINFO =~ s#/logout/|/logout$#/#;
$changepw=$PATHINFO =~ s#/changepw/|/changepw$#/#;
while($PATHINFO =~ m#/$#){chop($PATHINFO)}
### Remaining PATHINFO identifies desired user/script
if($ENV{SCRIPT_NAME} eq "/cgi-bin/general"){
	$ENV{OLD_SCRIPT_NAME}="/cgi-bin/general";
	($ENV{SCRIPT_NAME}=$ENV{QUERY_STRING}) =~ s/:/\//;
	$ENV{SCRIPT_NAME}="/cgi-bin/$ENV{SCRIPT_NAME}";
	$ENV{OLD_QUERY_STRING}=$ENV{QUERY_STRING};
	$ENV{QUERY_STRING}="";
}
$SCRIPTNAME=$ENV{SCRIPT_NAME} eq $HOMEPAGE_SCRIPTNAME?$PATHINFO:$ENV{SCRIPT_NAME};
$URL=$weblib'URL;
$URL.=$SCRIPTNAME if $ENV{SCRIPT_NAME} eq $HOMEPAGE_SCRIPTNAME;
&htmlopen("$SCRIPTPATH/login?URL=$URL") if $login;
&htmlopen("$SCRIPTPATH/logout?URL=$URL") if $logout;
&htmlopen("$SCRIPTPATH/changepw?URL=$URL") if $changepw;
require "$LIBRARY/edit.pl" if $edit;
open(LINKS,$LINKSFILE);
dbmopen(%USERS,$USERSDB,0644);
foreach $key (keys %USERS){
	if(($group=$key) =~ s/GROUP$//){$GROUP{$group}=$USERS{$key}}
	elsif($key =~ /PASSWORD$/){next;}
	else {
		$USER{$key}=$USERS{$key};
	}
}
dbmclose(%USERS);
while(<LINKS>){
chop;
$first=$_ unless $first;
($match0)=split(/\s+/);
if("LINK$SCRIPTNAME" =~ /$match0/){$match=$_};
}
$match=$first unless $match;
($script,$linkfile)=split(/\s+/,$match); # comments may follow addl whitespace
$script=substr($script,4);
$PATHINFO =~ s/^$script//;
if($edit){
	$edit=0;&readscript;$edit=1;
	undef %HTML;
	undef %PICT;
	if($u=$LINKS{ADMIN}){
		($c,$u)=split(/:/,$u) if $u =~ /:/;
		@u=split(/,/,$u);
		foreach $u (@u){
			last if $edit=$HTTPUSER{$u};
		}
	}
	&editlinks($linkfile),exit if $edit;
}
### Process user script
&readscript;
######  Random links feature.  Experimental.
if($random){
	@urlhold=keys(%URL);
	foreach $url (@urlhold){
		($cat,$group,$url)=split(/:/,$url,3);
		next unless &groupmatch($group);
		push(@url,$url);
	}
	if($#url ne -1){
		$url=$url[(time%($#url+1))];
		&htmlopen($url);
	}
	else{
		&htmlopen("Sorry but...");
		print <<EOF;
There are no links that meet the authorization criteria that you carry
EOF
		&htmlclose;
		exit;
	}
}
######  End Random links feature.  Experimental.
$WWWLOGFILE=$LINKS{LOG} if $LINKS{LOG};
if($u=$LINKS{ADMIN}){
	$c="9admin";
	($c,$u)=split(/:/,$u) if $u =~ /:/;
	if(!$CAT{$c}){
		$CAT{$c}="$u:Administrator Functions";
	}
	$sn=$SCRIPTNAME;
	if($ENV{SCRIPT_NAME} eq $HOMEPAGE_SCRIPTNAME){$sn="$HOMEPAGE_SCRIPTNAME$sn"}
	$URL{"$c:$u:$sn/edit"}="Alter contents of this page";
	$URL{"$c:$u:$sn/logout"}="Logout as privileged user";
	$URL{"$c:$u:$sn/changepw"}="Change Administrator Password";
}
if($LINKS{MAIL}){
($localmail,$WWWMAIL)=split(/,/,$LINKS{MAIL});
&webmail($localmail,$LINKS{PAGENAME})
	if $localmail && !$HTTPUSER{$localmail};
}
if($ENV{HTTP_USER_AGENT} eq "braindead"){
	&htmlopen($LINKS{ALTHOME});
	exit;
}
$BODYENHANCE=$LINKS{BODYENHANCE};
&htmlopen("$LINKS{PAGENAME}|");
print "<!-- Generated by HomePage -->\n";
foreach $key (sort keys %TABLE){
	$value=$TABLE{$key};
	if(($newkey=$key) =~ s/%%ROW$//){
		next unless defined $TABLE{$newkey};
		foreach $user (keys %USER){
			$value =~ s/<$user>.*<\/$user>// unless $HTTPUSER{$user};
			$value =~ s/<!$user>.*<\/!$user>// if $HTTPUSER{$user};
			$value =~ s/<\/?!?$user>//g;
		}
		@row=split(/\\n/,$value);
		for($i=0;$i<$#row;$i+=2){
			$HTML{$newkey}.=&htmlrow($row[$i],$row[$i+1]);
		}
	}
	else{
		($groups,$value)=split(/:/,$value,2);
		delete $TABLE{$key},next unless &groupmatch($groups);
		($caption,$att)=split(/,/,$value);
		$HTML{$key}.=&htmltable($caption,$att);
	}
}
foreach $key (sort keys %TABLE){
	next if $key =~ /%%ROW$/;
	$HTML{$key}.=&htmltableend;
}
foreach $HTML (keys %HTML){
	foreach $key (keys %USER){
		$HTML{$HTML} =~ s/<$key>.*<\/$key>// unless $HTTPUSER{$key};
		$HTML{$HTML} =~ s/<!$key>.*<\/!$key>// if $HTTPUSER{$key};
		$HTML{$HTML} =~ s/<\/?!?$key>//g;
	}
	$HTML{$HTML} =~ s/\\n/\n/g;
}
######  Identification feature.
if($id&&defined %HTTPUSER){
	print "I recognize you as being in all of the following special groups:<dl>\n";
	foreach $key (keys %USER){print "<dd>$GROUP{$key}\n" if $HTTPUSER{$key}}
	print "</dl>\n";
}
######  End Identification feature.
### Check for subpage
if($PATHINFO){
	$PATHINFO =~ s#^/##;
	print $HTML{$PATHINFO};
	exit;
}
### Generate Heading
#print "<a name=top></a>\n";
foreach $key (grep(/^HEAD/,sort keys %PICT)){ &putpict; }
print "$HTML{HEAD}<hr>\n" if $HTML{HEAD};
### Generate Index
$LINKS{INDEX}="Index" unless $LINKS{INDEX};
if(defined(%CAT)){
print "<h2><a name=index href=#>$LINKS{INDEX}</a></h2>\n";
foreach $key (sort keys %CAT){
	($cat,$subcat)=split(/\//,$key);
	next if $subcat;
	$value=$CAT{$key};
	($groups,$value)=split(/:/,$value,2);
	($groups,$update)=split(/;/,$groups);
	if($value eq ""){$value=$groups;$groups="";}
	if($group=&groupmatch($groups)){
		$group="" if $group == 1;
		$group="" unless $showrestrict;
		$group=" ($group only)" if $group;
		next unless $value;
		print "<a href=#$key>$value</a>$group";
		print " ($update)" if $update;
		print "<br>\n";
	}
}
}
### Generate Main Page
foreach $key (sort keys %CAT){
	$level=2;
	($cat,$subcat)=split(/\//,$key);
	$level=3 if $subcat;
	$value=$CAT{$key};
	($groups,$value)=split(/:/,$value,2);
	($groups,$update)=split(/;/,$groups);
	if($value eq ""){$value=$groups;$groups="";}
	next unless $group=&groupmatch($groups);
	$group="" if $group == 1;
	$group="" unless $showrestrict;
	$group=" ($group only)" if $group;
	print "<hr>" if $level==2;
	&htmlhead($level,"<a href=#index name=$key>$value</a>$group");
	&putpict;
	print $HTML{$key};
	print "<ul>\n";
	undef %VALUE;
	foreach $key2 (grep(/^$key[\,:]|,$key[\,:]/,keys %URL)){
		($junk,$key3)=split(/:/,$key2,2);
		$value=$URL{$key2};
		$VALUE{$value}=$key3;
	}
	foreach $value (sort keys %VALUE){
		$url=$VALUE{$value};
		($groups,$url)=split(/:/,$url,2);
		next unless &groupmatch($groups);
		if($value =~ /[<>]/){
			($value1,$value2,$value3)=split(/[<>]/,$value,3);
			$value="<li>$value1<a href=$url>$value2</a>$value3";
		}
		else {$value="<li><a href=$url>$value</a>"}
		if($group=&groupmatch($groups)){
			$group="" if $group == 1;
			$group="" unless $showrestrict;
			$group=" ($group only)" if $group;
		}
		print "$value$group\n";
	}
	print "</ul>\n";
}
### Generate Tail items
print "<hr>\n";
foreach $key (grep(/^TAIL/,sort keys %PICT)){ &putpict; }
print  "$HTML{TAIL}\n";
print "$LINKS{AD}\n";
&htmlclose;
### Support subroutines
sub readscript{
open(LINKS,$linkfile);
while(<LINKS>){
	next if /^#/;
	last if /^EXIT/;
	chop;
	($key,$value)=split(/\s+/,$_,2);
	if($key =~ /^REQUIRE/){
		if($edit){$REQUIRE{$key}=$value;next}
		require $value;
		next;
	}
	if($key =~ s/^ENV//){ # ENV lines must appear before USER to be effective
		if($edit){$ENVEDIT{$key}=$value;next}
		($valueold,$valuenew)=split(/=/,$value);
		$ENV{$key}=$valuenew if $ENV{$key} eq $valueold;
		next;
	}
	if($key =~ s/^USER//){
		$USER{$key}=$value;
		next;
	}
	if($key =~ s/^HTML//){
		($key,$endline)=split(/:/,$key);
		if($edit){$HTMLENDLINE{$key}=$endline;$endline.="&editbr;"}
		else {$endline='\n' if $endline eq ""}
		if($value){$HTML{$key}.="$value$endline"}
		else{
			while(<LINKS>){
				last if /^HTMLEND/;
				chop;
				$HTML{$key}.="$_$endline";
			}
		}
		next;
	}
	if($key =~ s/^TABLE//){
		if($value !~ /:/){$value=":$value"}
		$TABLE{$key}=$value;
		next;
	}
	if($key =~ s/^TBROW//){
		#$value=":" unless $value;
		if($value){$TABLE{"$key%%ROW"}.="<$value>"}
		while(<LINKS>){
			last if /^TBROWEND/;
			chop;
			$TABLE{"$key%%ROW"}.="$_\\n";
		}
		if($value){
			chop($TABLE{"$key%%ROW"});
			chop($TABLE{"$key%%ROW"});
			$TABLE{"$key%%ROW"}.="</$value>\\n";
		}
	}
	if($key =~ s/^ARTICLE//){
		if($edit){
			$groups="";
			$artfile=$value;
			($groups,$artfile)=split(/:/,$artfile,2) if $artfile =~ /:/;
			if($artfile =~ m#^/#){$ARTICLE{$key}="$groups:$artfile"}
			else{$ARTICLE{$key}="$groups:$artfile:$PATH{ART}"}
			next;
		}
		$groups="";
		$artfile=$value;
		($groups,$artfile)=split(/:/,$artfile,2) if $artfile =~ /:/;
		$artfile="$PATH{ART}/$artfile";
		@stat=stat($artfile);
		($sec,$min,$hour,$day,$mon,$year)=localtime($stat[9]);
		$lm=sprintf("%s %d, %s",(Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec)[$mon],$day,$year+1900);
		($title,$html)=&getart3($artfile);
		if($title){$CAT{$key}="$groups;$lm:$title";}
		$HTML{$key}.=$html;
		next;
	}
	if($key =~ s/^PICT//){
		$value=";$value" if $PICT{$key};
		$PICT{$key}.=$value;
		next;
	}
	$PATH{$key}=$value,next if $key =~ s/^PATH//;
	$CAT{$key}=$value,next if $key =~ s/^CAT//;
	$GROUP{$key}=$value,next if $key =~ s/^GROUP//;
	if($key =~ s/^URL//){
		($cat,$group,$value)=split(/:/,$value,3);
		$URL{"$cat:$group:$key"}=$value;
		next;
	}
	$LINKS{$key}=$value;
}
foreach $value (values %USER){
		@user=split(/,/,$value);
		&defuser(@user);
}
}
sub groupmatch{
local($group,$groupok,$gr);
	return 1 if $_[0] eq "";
	$groupok=0;
	foreach $group (split(/,/,$_[0])){
		if(($gr=$group) =~ s/^!//){return "not $gr" unless $HTTPUSER{$gr}}
		else{$groupok=$group if $HTTPUSER{$group}}
	}
	return $groupok;
}
sub putpict{
	return unless $PICT{$key};
	@pict=split(/;/,$PICT{$key});
	$pict=$pict[(time%($#pict+1))];
	($groups,$pict)=split(/:/,$pict,2);
	if($pict eq ""){$pict=$groups;$groups="";}
	return unless &groupmatch($groups);
	($pict,$html,$tag)=split(/,/,$pict);
	$pict="$PATH{PICT}/$pict"
		if $PATH{PICT} && $pict && $pict !~ /^\/|^[A-Z]+:/i;
	print $tag if $tag =~ /^</;
	if($html =~ /^[A-Za-z0-9]+$/){
		print "<a href=$ENV{SCRIPT_NAME}$ENV{PATH_INFO}/$html>";
	}
	else {print "<a href=$html>" if $html}
	if($tag && $tag !~ /^</){$tag=" alt=$tag"}
	else {$tag=""}
	print "<img src=$pict$tag>" if $pict;
	print "</a>" if $html;
	print "\n";
}