#!/usr/ncsa/bin/perl5
#
# $Id: projectsfilter,v 1.1 94/12/16 12:52:14 pjdev Exp $
#
# The CoCoBoard - A Collaborative CorkBoard for the WWW
# Version 1.1
#
# Ben Johnson - NCSA Consulting/UIUC Dept of Computer Science
# Paul Walker - NCSA Relativity Group/NCSA Consulting/UIUC Dept of Physics
#

$installdir = "/afs/ncsa/projects/genrel/web/Server/ProjectsPages/pjdev";
$hthome = "/www/Util/pjdev";




open(CONF,"< $installdir/Projects.conf");

while (<CONF>) {
    next if (/^$/||/^\#/);
    m/^(\S+) (.*)$/;
    $variable = $1;
    $value = $2;
    eval "\$$variable = \"$value\"";
}


# Subroutine Libraries
require "$installdir/mime2html";
require "$installdir/responses";
require "$installdir/imagesubs";
require "$installdir/pjutils";
require "$installdir/commands";
require "$installdir/contenttypes";
require "$installdir/defaultprojects";
require 'getopts.pl';



# -p project
# -a  to turn off authorization
&Getopts("p:a");

# Build the AuthUsers list and the projects list.  Do this by making
# an associative array %projects{pjname} which contains the description
# and many arrays with the name @pjname which contain the authorized
# users.  Finally, make an associative array %authusers{'email'} which
# by its very existance (eg, being set to 1) indicates a user is an
# authorized user, and that way we have a single list of authorized
# users.
open(LISTFILE,"<$userlistfile") || &cleandie ("Cannot open $userlistfile\n");
while (<LISTFILE>) {
    if (/\&\&/) {
	($currproj,$at,$bo,$pj) = split('&&');
	
	($authtype{$currproj}, $bouncit{$currproj}, 
	 $projects{$currproj}) = ($at,$bo,$pj);
    } elsif (/^\#.*$/) {
	# Ignore as a comment
    } else {
	@thisline=split(" ");
	foreach $USER (@thisline) { 
	    $astring = <<"EVALSTREND";
	    if (\@x$currproj) { 
		\@x$currproj = (\@x$currproj, \"$USER\"); 
	    } else {
		\@x$currproj = (\"$USER\");
	    }
EVALSTREND
	    eval $astring;
	}
    }
}


# Put the original text into $ORIG.  Scan it.  If suitable, send it off
# to ben for htmeratization, otherwise, nuke it ...
open(ORIG,">$hthome/$$.txt");

# Scan the headers ... thanks Ben!
$contenttype = "";
$name = $header = $rest = $var = $val = "";
$lineno = 0;
while (<STDIN>) {
    print ORIG;
    chop; 
    if (($lineno == 0) && (!m/^(\S*):\s*/ )) {
	$FirstMailLine = $_;
	$lineno++;
	next;
    }
    $lineno++;
    last if  m/^$/ ;
    if ( m/^(\S*):\s*/ ) {
	$MainHeader{"\L$header\E"} = $rest if $header && "$rest"  !~ m/^\s*$/;
	$header = $1;
	$rest = $';  #'
    } else {
	$rest .= $_ ;
    }
}
$MainHeader{"\L$header\E"} = $rest;
$MainHeader{'firstline'} = $FirstMailLine;
$MainHeader{'firstline'} =~ m/ (\S*@\S*) /;
$MainHeader{'topemail'} = $1;

# Strip out the project or command and finish the dump
$theproject = "No Project Specified";

# It is important to do from based before to based, since a user wants to
# be able to use aliases even if they have a default project!

# Default From based projects
foreach $USER (keys %fromdefaults) {
    ($user,$domain) = split ('@',$USER);
    if (($MainHeader{"from"} =~ /$user/i) && 
	($MainHeader{"from"} =~ /$domain/i)) {
        $theproject = $fromdefaults{$USER};
    } 
}

# Default TO based projects
foreach $RECIP (keys %todefaults) {
    if (($MainHeader{"to"} =~ /$RECIP/i) ||
	($MainHeader{"cc"} =~ /$RECIP/i) ||
	($MainHeader{"apparently-to"} =~ /$RECIP/i)) {
        $theproject = $todefaults{$RECIP};
    } 
}



# Command line
if ($opt_p ) { $theproject = "\U$opt_p\E" ; }

# Check the headers for piority

# Check with eudora headers
if ($MainHeader{'x-priority'} == 1) {
    $thepriority=4;
} elsif ($MainHeader{'x-priority'} == 2) {
    $thepriority=3;
} elsif ($MainHeader{'x-priority'} == 4) {
    $thepriority=2;
}

# Check with ZMail headers
if ($MainHeader{'x-zm-priority'} =~ /[HA]/){
    $thepriority=4;
} elsif ($MainHeader{'x-zm-priority'} =~ /[MB]/){
    $thepriority=3;
} elsif ($MainHeader{'x-zm-priority'} =~ /[LC]/){
    $thepriority=2;
}

# Now parse the text!
while (<STDIN>) {
    $thisl = $_;
    $thisl =~ tr/[a-z]/[A-Z]/;
    if ($thisl =~ m/^[\s\>]*PROJEC[TS]+\s+(\w+)\s+$/) {
	$theproject = $1;
    } else {
	if ($thisl =~ m/^\s*COMMAND\s+(\w+)\s+$/) {
	    $thecommand = $1;
	    print ORIG;
	} else {
	    if ($thisl =~ m/^\s*PRIORITY\s+(\d+)\s+$/) {
		$thepriority = $1;
		$thepriority=4 if ($thepriority > 4);
	    } else {
		print ORIG;
	    }
	}
    }
}
close ORIG;

$isaproject = 0;

foreach $VALIDPROJ (keys %projects) {
    $isaproject = 1 if ($theproject =~ /\b$VALIDPROJ\b/);
}

# Dont let anyone inadvertently post to project command or strongcommand
$isaproject = 0 if ($theproject =~ /COMMAND/);


# Check that the person is the authorized user if its a valid project.  
# In the process, make the email and name fields.
$MainHeader{'email'} = $MainHeader{'from'};
if ($MainHeader{'email'} =~ m/(\S+@\S+)/) {
	$MainHeader{'email'} = $1 ;
	}
elsif ($MainHeader{'email'} =~ m/(\<\S+\>)/ ) {
	$MainHeader{'email'} = $1 ;
	}
$MainHeader{'email'} =~ s/[\<\>]//g;
$MainHeader{'matchthis'} = $MainHeader{'email'};
$MainHeader{'matchthis'} =~ tr/[A-Z]/[a-z]/;
if ($MainHeader{'matchthis'} =~ m/$defaultdomain/) {
    $MainHeader{'matchthis'} =~ s/(\S+)\@\S*$defaultdomain/$1/;
}

$MainHeader{'name'} = $MainHeader{'from'};
$MainHeader{'name'} =~ s/</&lt\;/g;
$MainHeader{'name'} =~ s/>/&gt\;/g;
$MainHeader{'name'} =~ s/Masso/Mass\&oacute\;/g;
$MainHeader{'name'} =~ s/[\(\)\"]//g; # "
$MainHeader{'name'} =~ s/\S+\@\S+\s*//g;
$MainHeader{'name'} =~ s/^\s+//g;

$MainHeader{'date'} =~ s/</&lt\;/g;
$MainHeader{'date'} =~ s/>/&gt\;/g;
$MainHeader{'date'} =~ s/(.*199[0-9])(.*)/\1/;


if ($MainHeader{'matchthis'} =~ /$mailer_daemon/) {
    &bouncedmail;
    &gohome;
}

# Preprogrammed bounces
if (
    $MainHeader{'from'} =~ /Postmaster/i ||
    $MainHeader{'from'} =~ /UUCP/i ||
    $MainHeader{'from'} =~ /MAILER/i ||
    $MainHeader{'from'} =~ /MAILER-DAEMON/i
    ) {
    &bouncedmail;
    &gohome;

}

if ( $opt_a ) { $authuser = 1; }
if ($isaproject) {
    if ($authtype{$theproject} == 1) {
	$authuser = 0;
	# Check users agains 'matchthis'  Users contain and @ and . or neither,
	# but may not contain only a .
	# no . s
	$evstr = "foreach \$USER (\@x$theproject) {next if ((\$USER =~ /\\./) && (!(\$USER =~ /\\@/)));\$authuser = 1 if (\$USER =~ m/$MainHeader{'matchthis'}/);}";
	eval $evstr;		

	# Check domains agains 'email'.  Domains contain a . and no @
	$evstr = "foreach \$USER (\@x$theproject) {next if ((\$USER =~ /\\@/) || (!(\$USER=~/\\./)));  \$authuser = 1 if (\$MainHeader{'email'} =~ m/\$USER/);}";
	eval $evstr;		
    } else {
	# Allow any user
	$authuser = 1;
    }
}

# Dump Log Information.  The Lock is not perfect.
$tries = 0;
while (!link("$logfile","$logfile.lock") && $tries < 10) {
    sleep(1);
    $tries++;
}
if ($tries >= 9) {
    die "Cannot lock $logfile";
}

open(LOGFILE,">>$logfile") || 
    &cleandie("Cannot open log.  Please report this error to $maintainer");
# 
print LOGFILE "\n";
$date = `date`;
print LOGFILE "$date";
print LOGFILE "*** UNAUTHORIZED ACCESS ATTEMPT $from ***\n" 
    if ((!$authuser)&&($isaproject));
print LOGFILE "FROM   : $MainHeader{'from'}\n";
print LOGFILE "TO     : $MainHeader{'to'}\n";
print LOGFILE "PROJECT: $theproject \n";
print LOGFILE "COMMAND: $thecommand\n" if ($thecommand);
print LOGFILE "SUBJECT: $MainHeader{'subject'}\n";
close LOGFILE;

unlink("$logfile.lock");

$testhelp = $MainHeader{'subject'};
$testhelp =~ tr/[a-z]/[A-Z]/;


if ($testhelp =~ m/^\s*HELP\s*$/) {
    &HelpMail;
    &gohome;
}

if ($thecommand) {
    $thecommand =~ tr/[A-Z]/[a-z]/;
    eval "\&$thecommand";
    &gohome;
}

if (!$isaproject) {
    &InvalidProject;
    &gohome;
}

if (!$authuser) {
    &NotAuthMail;
    &gohome;
}


# Make the appropriate subdirectory into $themessfolder
$themessfolder = "00001";
while (-d "$hthome/$theproject/$themessfolder/") {
    $themessfolder++;
}
system ("mkdir $hthome/$theproject/$themessfolder; chmod 755 $hthome/$theproject/$themessfolder");

# Well, alright then ... pass it off to ben
&mime2html("$hthome/$$.txt","$hthome/$theproject/$themessfolder/index.html");

# Add the user to the index list
#
# Handle priority
$priopen = "";
$priclose = "";

$j = 2;
$priimage = "";
while ($j <= $thepriority) {
    $j++;
    $priimage = "$priimage<img src=\"$htserverhome/Icons/primark.gif\">";
}

if ($thepriority == 2) {
    $priopen = "<i>$priimage"; $priclose = "</i><!-- EOS -->";
} elsif ($thepriority == 3) {
    $priopen = "<b>$priimage"; $priclose = "</b><!-- EOS -->";
} elsif ($thepriority == 4) {
    $priopen = "<b><i>$priimage"; 
    $priclose = "</i></b><!-- EOS -->";
}

open (IND, "< $hthome/$theproject/index.html" ) 
    || die "no index $hthome/$theproject/index.html";

open (NEWIN, "> $hthome/tmp.new" ) || die "no output";

# Threading goes here 
#
if ($MainHeader{subject} =~ /^Re[\: ](.*)/i) {
    # Scan the entire file dumping to newin looking for the subject
    # If we find it, stick the guy in a <ul> underneath, otherwise 
    # keep on going.  If we do it, set $threaded to 1.
    $matchingsubj = $1;
    while (<IND>) {
	print NEWIN;
	if (/<li>/ && !$threaded) {
	    /<a href=\"\d+\/\index.html\">(.*)<\/a>/; 
	    $thissubj = $1;
	    $thissubj =~ s/^Re[: ]//i;
            $thissubj =~ s:([\:\?\(\)\\\*\.]):\\\1:g;
	    if ($matchingsubj =~ /$thissubj/) {
		print "Got a match!\n";
		$threaded = 1;
		$nextline = <IND>;
		if ($nextline =~ /<ul>/) {
		    # We already have threading under this message 
		    print NEWIN "$nextline";
		    while (<IND>) {
			last if /<\/ul>/;
			print NEWIN;
		    }
		    print NEWIN "<li>$priopen<a href=\"$themessfolder\/index.html\">";
		    print NEWIN "$MainHeader{'subject'}</a>";
		    print NEWIN "$priclose: $MainHeader{'name'} ($MainHeader{'date'})\n";
		    print NEWIN "</ul>\n";

		} else {
		    print NEWIN "<ul>\n";
		    print NEWIN "<li>$priopen<a href=\"$themessfolder\/index.html\">";
		    print NEWIN "$MainHeader{'subject'}</a>";
		    print NEWIN "$priclose: $MainHeader{'name'} ($MainHeader{'date'})\n";
		    print NEWIN "</ul>\n";
		    print NEWIN "$nextline";
		}
	    } else {
		print "$matchingsubj didn't match $thissubj\n";
	    }
	}
    }
    close NEWIN;
}

if (!$threaded) {
    # Rewind <IND>
    seek(IND,0,0);
    
    # unlink and repon NEWIN
    open (NEWIN, "> $hthome/tmp.new" ) || die "no output";

    # Do the old style insertion
    while (<IND>) {
	if ($_ =~ m/<ul>/ ) {
	    print NEWIN $_;
	    if ( !( $subject =  $MainHeader{'subject'} ) ) {
		$subject = "no subject";
	    }
	    print NEWIN "<li>$priopen<a href=\"$themessfolder\/index.html\">$subject</a>";
	    print NEWIN "$priclose: $MainHeader{'name'} ($MainHeader{'date'})\n";
	    print NEWIN <IND>;
	} else {
	    print NEWIN $_ ;
	}		
    }
    close IND;
    close NEWIN;
}

# Update the index file
system "ls $hthome/tmp.new";

system("/bin/mv $hthome/tmp.new $hthome/$theproject/index.html");
if (!-e "$hthome/$theproject/index.html") {
    die ("COMPLETELY FUCKED\n");
}
unlink ("$hthome/tmp.new");
unlink ("$hthome/$$.txt");
system("chmod 644 $hthome/$theproject/$themessfolder/* $hthome/$theproject/index.html");

# OK, so now we have the inmail in place ... Lets send it out to the
# rest of the members of our project and we are done.  Only send if
# bouncit tells us to
exit(0) if ($bouncit{$theproject} == 0);

# Get the outgoing address
$outaddr = $originator;
if ($projecttofrom{$theproject}) {
    $outaddr = $projecttofrom{$theproject};
}

$MainHeader{'name'} =~ s/\&oacute\;/o/g;
$outusers = " ";
# Be sure to skip just domain names
$evalstr = <<"EVALSTREND";
foreach \$USER (\@x$theproject) {
	next if ((\$USER =~ /\\./) && (!(\$USER =~ /\@/)));
	if (!(\$USER =~ /\@/)) {
		\$outusers .= \" \$USER\@\$defaultdomain \";
	} else {
		\$outusers .= \" \$USER \";
	}
}
EVALSTREND
eval $evalstr;

$outviasm = "| $sendmail $outusers";


$outusers =~ s/\b\s+\b/, /g;
open(SENDMAIL,$outviasm);
# Priority Header
if ($thepriority == 4) {
    print SENDMAIL "X-Priority: 1\n";
    print SENDMAIL "X-Zm-Priority: High\n";
} elsif ($thepriority == 3) {
    print SENDMAIL "X-Priority: 2\n";
    print SENDMAIL "X-Zm-Priority: Medium\n";
} elsif ($thepriority == 2) {
    print SENDMAIL "X-Priority: 3\n";
    print SENDMAIL "X-Zm-Priority: Low\n";
}

print SENDMAIL "X-Mailer: The CoCoBoard [Ver 1.1 Beta Final a]\n";
print SENDMAIL "Precedence: bulk\n";
print SENDMAIL "To: $outusers\n";
print SENDMAIL "From: $outaddr \(Project $theproject/$MainHeader{'name'}\)\n";
print SENDMAIL "Subject: $MainHeader{'subject'}\n";
print SENDMAIL "\n";
open(SCANIN,"<$hthome/$theproject/$themessfolder/index.html");

while (<SCANIN>) {
    last if (/<hr>/);
}

# Dump with Lynx if they have it ;-)
if ($uselynx) {
    open (LYNXT,"> $hthome/$$.lynx.html");
    while (<SCANIN>) {
	last if (/^<\!-- END OF BODY -->/);
	print LYNXT;
    }
    close LYNXT;
    open (LYNXO, "$lynx -dump $hthome/$$.lynx.html |");
    while (<LYNXO>) {
	print SENDMAIL;
    } 
    close LYNXO;
    unlink "$hthome/$$.lynx.html";
} else {
    while (<SCANIN>) {
	last if (/<\!-- END OF BODY -->/);
	s/\<[lL][iI]\>/\+/g;
	s/\<[^\>]*href[^\>]*\>/\-\-\>/g;  
	s/\<[^\>]*\>//g;	       
	print SENDMAIL;
    }
    print SENDMAIL "     _________________________________________________________________\n";
}


close SCANIN;
print SENDMAIL <<EOM;

                           CoCoBoard Information

This item was originated by $MainHeader{'name'} ($MainHeader{'email'})
And the processed by the $organization CoCoBoard.

The HTML version is available, with attachments, at
    $htserverhome/$theproject/$themessfolder/

EOM

if ($outaddr eq $originator)  {

print <<EOM;
Please include this information or the following line in any reply
project $theproject

EOM
}

close SENDMAIL;
exit(0);



