#!/usr/bin/perl -w
#
# $Id: error-report.pl,v 1.3 1997/06/23 09:12:35 webadm Exp $
#
#
# DESCRIPTION: error-report.pl - reads input from error-report-page.pl and
#    quick-report-page.pl, checks on plausibility and sends it to gnats
#
# URL: none yet
#
# AUTHOR: Jens Kurlanda
#	  Theresa Konstantinov
#	  Claus Langhans (Langhans@rz.uni-frankfurt.de)
#         Cord Beermann (cord@Wunder-Nett.org)
#
# Thanks to: Ralf Begemann (begemann@cc.fh-lippe.de)
#            Gerold Meerkoetter (gerold@noc.fh-lippe.de)
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
#
#
# A Perl script is "correct" if it gets the job done before your boss fires
# you.
# ('Programming Perl Second Edition' by Larry Wall, Tom Christiansen
#   & Randal. L. Schwartz)
#
# Bugs and shortcomings
# none yet
#
### Configuration ###
#
# where is the gnats-homedir?
$gnatshome="/var/infosystems/gnats";
#
# where is the current-file?
$current=$gnatshome."/gnats-db/gnats-adm/current";
#
# where is the gnats-queue?
$queuedir=$gnatshome."/gnats-db/gnats-queue/";
#
# who is responsible for this?
$webmaster='gnats@thalassa.cc.fh-lippe.de';
#
# where do we put errors?
$errorfile="/tmp/errors";
#
### End of Configuration ###

# include perl-modules
use CGI::Carp;
use CGI qw(:standard);
use CGI qw(:shortcuts);

# initialize the CGI-Module and load the form-input
$query = new CGI;
$query->autoEscape(undef);

if ($query->referer eq '') {
    $referer = '/cgi-bin/error-report-page.pl';
} else {
    $referer = $query->referer;
}

# print HTTP and HTML-Header and so on.
print $query->header;

# comment goto out for debugging
goto SKIP;
print "Sie bekommen Nachricht von uns per Mail.<p>\n";
print "SERVER_SOFTWARE $ENV{'SERVER_SOFTWARE'}<br>\n";
print "SERVER_NAME $ENV{'SERVER_NAME'}<br>\n";
print "GATEWAY_INTERFACE $ENV{'GATEWAY_INTERFACE'}<br>\n";
print "SERVER_PROTOCOL $ENV{'SERVER_PROTOCOL'}<br>\n";
print "SERVER_PORT $ENV{'SERVER_PORT'}<br>\n";
print "REQUEST_METHOD $ENV{'REQUEST_METHOD'}<br>\n";
print "HTTP_ACCEPT = $ENV{'HTTP_ACCEPT'}<br>\n";
print "PATH_INFO $ENV{'PATH_INFO'}<br>\n";
print "PATH_TRANSLATED $ENV{'PATH_TRANSLATED'}<br>\n";
print "SCRIPT_NAME $ENV{'SCRIPT_NAME'}<br>\n";
print "QUERY_STRING $ENV{'QUERY_STRING'}<br>\n";
print "REMOTE_HOST $ENV{'REMOTE_HOST'}<br>\n";
print "REMOTE_ADDR $ENV{'REMOTE_ADDR'}<br>\n";
print "REMOTE_USER $ENV{'REMOTE_USER'}<br>\n";
print "AUTH_TYPE $ENV{'AUTH_TYPE'}<br>\n";
print "CONTENT_TYPE $ENV{'CONTENT_TYPE'}<br>\n";
print "CONTENT_LENGTH $ENV{'CONTENT_LENGTH'}<br>\n";
SKIP:

# send a receipt to the report-sender

#$ClassCount=0;

# loop over each variable we got and check if all is correct
foreach $var ($query->param) {
    $VARS{$var}=&all2ascii($query->param($var));
    $var=~/(MUST_)(.*)/;
    if ($1 eq "MUST_" ) {
	if(!(defined($Must{$2})) && ($VARS{$var} eq '')) {
	    $errmessage.="<li>Sie haben das Feld <strong>$2</strong> nicht ausgef&uuml;llt!\n";
	};
	$value=$2;
	$value =~ tr/+/ /;
	$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
	$value =~ s/~!/dont do that ~!/g; # no subshells
	$Must{$value}="$value";
    } 
    $var=~/(OPTION_)(.*)/;

    if ($1 eq "OPTION_" ) {
	$value=$2;
	$value =~ tr/+/ /;
	$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
	$value =~ s/~!/dont do that ~!/g; # no subshells
	$Option{$value}="$value";
    }
}

# get the realname of report-sender
($login,$gcos) = (getpwnam($VARS{'MUST_Login'}))[0,6];

if (($VARS{'MUST_Login'} ne '') && ($login eq '') &&
    ($VARS{'OPTION_Mailadresse'} eq '')) {
    $errmessage.="<li>Sie haben einen <strong>Login</strong>-Namen
	angegeben, der auf den DVZ-Rechnern unbekannt ist,\n";
    $errmessage.="bitte f&uuml;llen Sie die <strong>Mailadresse</strong>
	aus, sonst k&ouml;nnen wir Sie nicht erreichen!\n";
}

if (($VARS{'MUST_Login'} ne '') && ($login eq '') && ($VARS{'OPTION_Name'} eq '')) {
    $errmessage.="<li>Sie haben einen <strong>Login</strong>-Namen
	angegeben, der auf den DVZ-Rechnern unbekannt ist,\n";
    $errmessage.="bitte f&uuml;llen Sie Ihren <strong>Namen</strong> aus!\n";
}

if ($login eq '') {
    $mailadr=$VARS{'OPTION_Mailadresse'};
} else {
    $mailadr=$login."\@cc.fh-lippe.de";
    $VARS{'OPTION_Name'}=$gcos;
}

if (($VARS{'MUST_reproduzierbar'} eq 'Ja') &&
    ($VARS{'OPTION_wie_reproduzierbar'} eq '')) {
    $errmessage.="<li>Sie geben an, da&szlig; der Fehler
	<strong>reproduzierbar</strong> ist, aber nicht <strong>wie</strong>
	er reproduzierbar ist!\n";
}

if ($VARS{'MUST_Fehlerkategorie'} eq '') {
    $errmessage.="<li>Sie haben keine <strong>Fehlerkategorie</strong>
	ausgew&auml;hlt!\n";
};

if ($VARS{'MUST_pri'} eq "") {
    $errmessage.="<li>Sie haben keine <strong>Priorit&auml;t</strong>
	angegeben!\n";
};

# if an error occurs give an error
if(defined($errmessage)) {

#   call friendlyerror with these hidden field to go around M$
#	IE-back-delete-button
    &friendlyerror("<ul>\n$errmessage\n</ul>".

		   '<FORM METHOD="POST"
		    ACTION="'.$referer.'"
		    ENCTYPE="application/x-www-form-urlencoded"><INPUT
		    TYPE="HIDDEN" NAME="MUST_Login" VALUE="' .
		    $query->param('MUST_Login') . '">

		    <INPUT TYPE="HIDDEN" NAME="OPTION_Name" VALUE="' .
		    $query->param('OPTION_Name') . '">

		    <INPUT TYPE="HIDDEN" NAME="OPTION_Mailadresse" VALUE="' .
		    $query->param('OPTION_Mailadresse') . '">

		    <INPUT TYPE="HIDDEN" NAME="OPTION_Telefon" VALUE="' .
		    $query->param('OPTION_Telefon') . '">

		    <INPUT TYPE="HIDDEN" NAME="OPTION_betreff" VALUE="' .
		    $query->param('OPTION_betreff') . '">

		    <INPUT TYPE="HIDDEN" NAME="OPTION_Wann" VALUE="' .
		    $query->param('OPTION_Wann') . '">

		    <INPUT TYPE="HIDDEN" NAME="MUST_Host" VALUE="' .
		    $query->param('MUST_Host') . '">

		    <INPUT TYPE="HIDDEN" NAME="MUST_Fehlerbeschreibung"
		    VALUE="' .  $query->param('MUST_Fehlerbeschreibung') .
		    '">

		    <INPUT TYPE="HIDDEN" NAME="MUST_reproduzierbar" VALUE="' .
		    $query->param('MUST_reproduzierbar') . '">

		    <INPUT TYPE="HIDDEN" NAME="OPTION_wie_reproduzierbar"
		    VALUE="' .  $query->param('OPTION_wie_reproduzierbar') .
		    '">

		    <INPUT TYPE="HIDDEN" NAME="MUST_Fehlerkategorie" VALUE="' .
		    $query->param('MUST_Fehlerkategorie') . '">

		    <INPUT TYPE="HIDDEN" NAME="MUST_pri" VALUE="' .
		    $query->param('MUST_pri') . '">

		    Bitte w&auml;hlen Sie nun <INPUT TYPE="submit"
		    NAME="Zur&uuml;ck" VALUE="Zur&uuml;ck"> und korrigieren
		    Sie Ihre Angaben.</p>');

};

# give a message back to the user
&html_header('Fehlerbericht empfangen');

print "<!--#include virtual=\"/fhl/dvz/loesungen/.header\" -->\n";
print "\n<h1>Fehlerbericht empfangen</h1>\n";

if ($VARS{'MUST_Fehlerkategorie'} =~ /mail/ig ) {
    print <<EOT;

<p>Sie haben einen Fehlerbericht zum Mailsystem abgeschickt.  Da es sein
kann, da&szlig; Sie keine Mail empfangen k&ouml;nnen, k&ouml;nnen Sie auch
unsere Antworten nicht lesen.

<UL><LI>Wenn Sie Ihr Problem selber l&ouml;sen konnten, dann schicken Sie uns
bitte eine Antwort auf die Eingangsbest&auml;tigung Ihrer Anfrage, die Sie
per Mail bekommen werden.

</UL>

<H3>Hier Ihre ausgef&uuml;llten Felder:</h3>

EOT
}

#print "<STRONG>zwingende Felder:</STRONG><p>\n<ol>";

print "<ul>\n";

foreach $must (keys %Must) {
    print "<li><strong>$must:</strong> $VARS{'MUST_'.$must}\n";
}


#print "<STRONG>optionale Felder:</STRONG><p>\n<ol>";

foreach $option (keys %Option) {
    print "<li><strong>$option:</strong> $VARS{'OPTION_'.$option}<p>\n";
}
print "</ul>\n";

chop($hostname=`hostname`);
$hostname=~s/.cc.fh-lippe.de//;
$hostname.=".cc.fh-lippe.de";

($sec,$min,$hour,$mday,$mon,$year,$wday) = (localtime(time))[0,1,2,3,4,5,6];
$month=(Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec)[$mon];
$day=(Sun,Mon,Tue,Wed,Thu,Fri,Sat)[$wday];
if ($VARS{'OPTION_betreff'} eq '') {
    $subject=sprintf("Fehler vom %02d %s %02d %02d:%02d:%02d\n",
		     $mday,$month,$year,$hour,$min,$sec);
} else {
    $subject=$VARS{'OPTION_betreff'};
}

# print data in gnats fromat to sendmail
open (GNATS,"| /usr/lib/sendmail -oi -t 2> /dev/null > /dev/null")||
    die "can`t open sendmail!";
print GNATS "From: $mailadr\n";
print GNATS "Reply-To: $mailadr\n";
print GNATS "Sender: $mailadr\n";
print GNATS "To: bugs\@thalassa.cc.fh-lippe.de\n";
printf GNATS ("Date: %s, %02d %s %02d %02d:%02d:%02d\n",
	$day,$mday,$month,$year,$hour,$min,$sec);
print GNATS "Subject: $subject\n";
print GNATS "\n";
print GNATS ">Synopsis: $subject\n";
print GNATS ">Confidential: no\n";
print GNATS ">Originator: $mailadr\n";
print GNATS ">Organization: unknown\n";
print GNATS ">Release: unknown\n";
print GNATS ">Category: $VARS{'MUST_Fehlerkategorie'}\n";
print GNATS ">Environment: $VARS{'MUST_Host'}\n";
print GNATS ">Description: \n$VARS{'MUST_Fehlerbeschreibung'}\n";
print GNATS ">Severity: serious\n";
print GNATS ">Priority: $VARS{'MUST_pri'}\n";
print GNATS ">How-To-Repeat: \n$VARS{'OPTION_wie_reproduzierbar'}\n";
print GNATS ">Submitter-Id: www-form\n";
print GNATS ">Unformatted: \n";
print GNATS "X-Reply-To: $mailadr\n";
print GNATS "X-Telefon: $VARS{'OPTION_Telefon'}\n";
print GNATS "X-Name: $VARS{'OPTION_Name'}\n";
print GNATS "X-Time: $VARS{'OPTION_Wann'}\n";
print GNATS "X-REMOTE_HOST: $ENV{'REMOTE_HOST'}\n";
print GNATS "X-REMOTE_ADDR: $ENV{'REMOTE_ADDR'}\n";
print GNATS "X-HTTP_USER_AGENT: $ENV{'HTTP_USER_AGENT'}\n";
print GNATS "\n";
close (GNATS);

# guess PR-No.
$prnr=`cat $current`+2;
@files=<$queuedir/gnats*>;
$prnr+= $#files;

# print a nice message for the user
print "<p>Bitte schauen Sie demn&auml;chst in Ihre Mail. Das Subject hei&szlig;t:\n";
print "<p><strong>$VARS{'MUST_Fehlerkategorie'}/$prnr: $subject</strong>\n";
print "<p>Wir werden uns mit Ihnen in Verbindung setzen.\n";

print "<p>Wenn Sie nicht innerhalb einiger Minuten eine
Eingangsbest&auml;tigung mit obigem Subject bekommen, dann ist mit Ihrer
Fehlermeldung selber etwas schief gegangen.  Bitte wiederholen Sie diese
oder wenden Sie sich bitte direkt an die <A
HREF=\"/fhl/dvz/loesungen/ort.html\">Benutzerberatung</A>.\n";

print "<p>Falls Sie zu dem gemeldeten Fehler noch weitere Fragen oder
Informationen haben, machen Sie bitte ein reply auf die erste Mail die wir
Ihnen schicken. Benutzen Sie bitte <strong>nicht</strong> das Formular
f&uuml;r diesen Zweck. Es ist nur f&uuml;r neue Fehler gedacht.\n";

# print HTML-Trailer
&html_trailer;

#####################################################################

# comment out for debugging
goto SKIPMAIL;
# append data to $errorfile
open (ERRORFILE, ">> $errorfile") || &fatalerror("Couldn`t open file $errorfile:$!");
foreach $must (keys %Must) {
    print ERRORFILE "$must=$VARS{'MUST_'.$must}\n";
}
foreach $option (keys %Option) {
    print ERRORFILE "$option=$VARS{'OPTION_'.$option}\n";
}

# write all ErrorClasses
foreach $class (keys %Classes) {
    print ERRORFILE "Class=$class\n";
}

print ERRORFILE "RemoteHost=$ENV{'REMOTE_HOST'}\n";
if ($ENV{'REMOTE_USER'} ne '' ) {
    print ERRORFILE "RemoteUser=$ENV{'REMOTE_USER'}\n";
}
print ERRORFILE "\n";
close(ERRORFILE);

#################### 

open (ERRORFILE, "| Mail -s error-report gnats\@thalassa.cc.fh-lippe.de") ||
    &fatalerror("Couldn`t open file!");

print ERRORFILE "\n\nzwingend:\n\n";
foreach $must (keys %Must) {
    $must =~ tr/+/ /;
    $must =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
    $must =~ s/~!/dont do that ~!/g; # no subshells
    print ERRORFILE "$must=$VARS{'MUST_'.$must}\n";
}

print ERRORFILE "\n\noptional:\n\n";
foreach $option (keys %Option) {
    $option =~ tr/+/ /;
    $option =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
    $option =~ s/~!/dont do that ~!/g; # no subshells
    print ERRORFILE "$option=$VARS{'OPTION_'.$option}\n";
}

# write all ErrorClasses
print ERRORFILE "\n\nKategorie:\n\n";
foreach $class (keys %Classes) {
    print ERRORFILE "Class=$class\n";
}

print ERRORFILE "\nRemoteHost=$ENV{'REMOTE_HOST'}\n";
if ($ENV{'REMOTE_USER'} ne '' ) {
    print ERRORFILE "RemoteUser=$ENV{'REMOTE_USER'}\n";
}

print ERRORFILE "\n";
close(ERRORFILE);
SKIPMAIL:
1;

# Subroutinen for errors
sub fatalerror{
    local ($errortext) = @_;
    &html_header("Error executing script $0 (pid $$)");
    print "<h1>ERROR</h1><hr>";
    print "You got an error while executing the script <strong>$0 (pid $$)</strong> !<br>\n";
    print "Please notify $webmaster<br><br>\n";
    print "Description : <h1>$errortext</h1><br><hr>";
    &html_trailer;
    exit;
};	                

# output for a user error
sub friendlyerror{
    local ($errortext) = @_;
    &html_header("Benutzerfehler");
    print "<h1>Fehler</h1><hr>";
#    print "User error detected executing <strong>$0 (pid $$)</strong>!<br>\n";
    print "<br><br>\n";
    print "Sie haben folgendes falsch gemacht : $errortext<br><br>";
    &html_trailer;
    exit;
};

# Subroutine for putting together a HTML-msg
sub html_header {
    local($title) = @_;
    print qq|<html><head><title>$title</title></head>\n<BODY TEXT="#000000" bgcolor="#FFFFF7">\n|;
}

sub html_trailer {
    	print "<hr>\n";
	print 'Autoren: Jens Kurlanda, Theresa Konstantinov, ';
	print '<A HREF="http://www.rz.uni-frankfurt.de/personal/Claus_Langhans.html">Claus Langhans</A>';
	print '<br>&uuml;berarbeitet von <A HREF="http://Cord.de/">Cord Beermann</a>';
  	print "</body></html>\n";
}


# convert Umlauts to ISO and IBM-PC chars to 7-Bit ASCII
sub all2ascii {
	local($string)=@_;

	$string=~ s/\204/ae/g;
	$string=~ s/\201/ue/g;
	$string=~ s/\224/oe/g;
	$string=~ s/\216/Ae/g;
	$string=~ s/\231/Oe/g;
	$string=~ s/\232/Ue/g;
	$string=~ s/\341/ss/g;

	$string=~ s/\304/Ae/g;
	$string=~ s/\326/Oe/g;
	$string=~ s/\334/Ue/g;
	$string=~ s/\344/ae/g;
	$string=~ s/\366/oe/g;
	$string=~ s/\374/ue/g;
	$string=~ s/\337/ss/g;

	return $string;
}
	
