#!/usr/bin/perl  

# CsWebMAIL - Webmail Application for Perl
# -------------------------------------------
# Author:  Martin Boeck <m.boeck@comnex.net>
# Created: Vienna, 15. June 1998
# Last:    Vienna, 17. 04 2001
#
# -------------------------------------------
# ComneX - Commercial Internet Business
# http://www.comnex.net
# mailto:office@comnex.net
# -------------------------------------------

# The "USES" - dont want to invent the wheel
use CGI qw(:cgi :multidata);
use Net::POP3;
use Net::SMTP;
use MIME::Base64;
use MIME::QuotedPrint;
use Data::Dumper;
# ------------------ BEGIN of Configuration Area

# strict security (1 .. on, 0 .. off)
$|=1;
$strictsecure = 0;

# defaults
%DEFAULTuser = ( 'name' => 	'unknown', 
	'address'	=>	'unknown',
	'lang'		=>	'gr',
	'smtp'		=>	'!return "smtp." . ( split ( /\./, $currentInfo{BOX}, 2 ) ) [1]',
	'email'		=>	'!return $currentInfo{USER} . "@" . ( split ( /\./, $currentInfo{BOX}, 2 ) ) [1]'
	);

# allowed Mailhosts
$POPallow = "(.*)";

# default WebMail directory (no web access !)
$storedir = "/var/www/webmail";

# default WebMail Attachment directory (web access !)
$storeweb = "/var/www/webmail/webout";

# default CGI link for WebMail
$CGILink  = "http://webmail.comnex.net/webmail.pl";

# default ATTACHMENT link for Webmail
$ATTACHLink = "http://webmail.comnex.net/wmout/"; 

# local Webmail TEXT configuration for use in HTML pages
%localWebMail = ( 
	Company => 'ComneX - Commercial Internet Business',
	email   => 'mjb@comnex.net',
	version => '0.97',
	vdate   => '19. April 2001'
);

# Data for message reply :
$replySubject = "Re: ";
$replyQuote   = "> ";
$replyText    = "Answer to your message: \n";

# Time a Secure KEY is valid ( in seconds )
$timevalid = 1800;

# A list of short names for month (we only compare the first
# three letters) - Perhapes I forgot something
%monthlist =(
	jan     => '1',
	feb	=> '2',
	mar	=> '3',
	apr	=> '4',
	mai	=> '5',
	jun	=> '6',
	jul	=> '7',
	aug	=> '8',
	sep	=> '9',
	oct	=> '10',
	okt	=> '10',
	nov	=> '11',
	dec	=> '12',
	dez	=> '12',
);

# A Hash of all Configuration files in $storeweb/cfg[/lang]
%cfgfiles =(
	errors                  => 'errors.msg',		# Error Messages
	gen_err                 => 'gen_err.t',                 # General Error Template
	sec_err                 => 'sec_err.t',                 # Security Violation Template
	logon                   => 'logon.t',                   # Logon Template
	logon_err               => 'logon_err.t',               # Logon Error Template
	list_head               => 'listhead.t',                # Head of List
	list_foot               => 'listfoot.t',                # Foot of List
	list_entry              => 'listentry.t',               # One Entry of list
	msg_head                => 'msghead.t',                 # Message Head
	msg_foot                => 'msgfoot.t',                 # Message Foot
	msg_sus_start           => 'msgsusstart.t',             # Message Attachment Suspicious
	msg_sus_stop            => 'msgsusstop.t',              # Message Attachment Suspicious
	msg_print_start         => 'msgprintstart.t',   	# Message Print Start
	msg_print_stop          => 'msgprintstop.t',		# Message Print Stop
	msg_showpart_start      => 'msgshowstart.t',		# Message IMAGE show start
	msg_showpart_stop       => 'msgshowstop.t',             # Message IMAGE show stop
	msg_file_start          => 'msgfilestart.t',		# Message ATTACHMENT start
	msg_file_stop           => 'msgfilestop.t',             # Message ATTACHMENT stop
	ucfg                    => 'ucfg.t',                    # User Configuration
	ucfgproc                => 'ucfgproc.t',                # Process of User Configuration
	sendmail                => 'sendmail.t',                # Sendmail
	mailsent                => 'mailsent.t',                # Send a mail done
	mailsent_start                => 'mailsentstart.t',                # Send a mail done
	mailsent_stop                => 'mailsentstop.t',                # Send a mail done
	mailsent_err           => 'mailsenterr.t',                # Send a mail done
	logout                  => 'logout.t',                  # message after logging out
	logok                   => 'logok.msg',
	list_EN			=> 'listnew.t', 
);

# ------------------ END of Configuration Area

## ------------------ Error Messages
## 1    Security Key
## 2    SMTP host not good
## 3    SMTP not enough arguments
## 4    cannot get POP list or cannot save to disk
## 5    ucfg file not possible
## 6    not enough parameters
## 7    directory for UCFG error
## 8    BOX cannot be opened
## 9    Mailhost not allowed
## 10   datasend Error (SMTP)
## 11   cannot save head.cur
## 12   cannot open head.cur
## 13   a secure key exists !
## 14   logout error
## 15   error getting msg

## ------------------ Logfile Keys
## 1    User logs out
## 2    mail sent
## 3    configuration has been changed
## 4    delete multiple messages
## 5    delete one message
## 6    user logged on

# ------------------ BEGIN of MAIN Area

# Capture variables and initialize arrays and lists
&Do_CGI_Work;

# Handle Parameters from QUERY STRING
if (($CGIARG{'KEY'}) and ($CGIARG{'USER'}) and ($CGIARG{'BOX'})) {
		# is it a secure connection ?!
		if (&check_secure) {
				# get the Userdata from his directory
				if ((my $tmperrRead=&readUser) eq 0) {
					# lets see what the user wants
					$_ = $CGIARG{'ACTION'};
					GETSWITCH: {
						/^msg/          && do { &CGIGetMsg ( $CGIARG{'NUM'} );
									last GETSWITCH; };
						/^listmsg/      && do { &CGIListMsg;
									last GETSWITCH; };
						/^relistmsg/    && do { &CGIReListMsg;
									last GETSWITCH; };
						/^deletemsg/    && do { &CGIdelMsg ( $CGIARG{'NUM'} );
									last GETSWITCH; };
						/^usercfgp/     && do { &CGIUserCFGpr;
									last GETSWITCH; };
						/^usercfg/      && do { &CGIUserCFG;
									last GETSWITCH; };
						/^sendmail/     && do { &CGISendmail;
									last GETSWITCH; };
						/^dosend/       && do { &CGIDoSendmail;
									last GETSWITCH; };
						/^reply/        && do { &CGIReply ( $CGIARG{'NUM'} );
									last GETSWITCH; };
						/^deletemult/   && do { &CGIdelMult;
									last GETSWITCH; };
						/^logout/       && do { &CGILogout;
									last GETSWITCH; };
						# default case
						&CGILogon;
					}
				# user not defined, so he cannot go on without login
				} else {
					&doError ( $cfgfiles{'gen_err'}, $tmperrRead); # ERROR FROM "READUSER"
				}
		# Sorry, the user is using an invalid Security LINK
		} else {
			&doError ( $cfgfiles{'sec_err'}, 1 ); # ERROR / NO KEY GOOD
		}
# The QUERY String doesnt seem to be valid, lets try a POST case
} else {
	# lets see what the user wants
	$_ = $CGIDAT::action;
	POSTSWITCH: {
		/^logon/        && do { &CGILogonProc;
					last POSTSWITCH; };
		# default case
		&CGILogon;
	}
}

# Closing POP is needed to delete messages, and to please the POP server
&closePOP;
# not realy important, but do it !
exit 0;

# ------------------ END of MAIN Area

# ------------------ BEGIN of SUB - Area: CGI*

# SUB:          CGILogout
# PARAMETERS:   nothing
# GLOBALS:      %currentInfo
# INITWORK:     nothing
# DESC:         deletes the slink file and display accurate message
# ERRORS:       14
# RETURN:       nothing
# VERSION:      1
sub CGILogout {
	# if there is an slinkfile, and we can delete it
	&removePassword;	
	
	if ( &OSdelete( "$storedir/$CGIARG{'USER'}.$CGIARG{'BOX'}/slinks" ) ) {
        # do a log message, and display the logout message
		&logOutOk ( 1, "" );
		&htmlSubst($cfgfiles{'logout'}, \%currentInfo);
	} else {
        # else do an error log
       	&logOutError ( 14 );
       	# and display error message
		&doError ( $cfgfiles{'gen_err'}, 14 ); # ERROR / LOGOUT
	}
}

# SUB:          CGIReply
# PARAMETERS:   num to reply
# GLOBALS:      %currentInfo
# INITWORK:     nothing
# DESC:         print the sendmail screen with the current User Info,
#		including the old message
# ERRORS:       nothing
# RETURN:       nothing
# VERSION:      1
sub CGIReply {
	my $msgnum = shift;
	my %replydata = %currentInfo;

	# try to read the head of the messages
	if ((my $tmperr=&FileToHead) eq 0) {

		# whom to reply to ?
		if ($POPHead{$msgnum}{'RETURN-PATH'}) {
			$replydata{'TO'} = &emailAdress( $POPHead{$msgnum}{'RETURN-PATH'} );
		} else {
			$replydata{'TO'} = &emailAdress( $POPHead{$msgnum}{'FROM'} );
		}

		# What subject ?
		$replydata{'SUBJECT'} = &mydecode( $replySubject . $POPHead{$msgnum}{'SUBJECT'} );

		# do we have reply data left ?
		if ( open ( REPLY, "$currentInfo{'DIRECTORY'}/reply" ) ) {
			# ok. init message
			$replydata{'MESSAGE'} = "";
			while (<REPLY>) {
				$replydata{'MESSAGE'} .= $_;
			}
			close REPLY;
		} else {
			$replydata{'MESSAGE'} = $replyText;
		}
	} else {
		# Cannot find the correct head !
		$replydata{'TO'}      = "";
		$replydata{'SUBJECT'} = "";
		$replydata{'MESSAGE'} = "";
	}

	# now display the sendmail template using the data found
	&htmlSubst( $cfgfiles{'sendmail'}, \%replydata );
}

# SUB:          CGISendmail
# PARAMETERS:   nothing
# GLOBALS:      %currentInfo
# INITWORK:     nothing
# DESC:         print the sendmail screen with the current User Info
# ERRORS:       nothing
# RETURN:       nothing
# VERSION:      1
sub CGISendmail {
	&htmlSubst( $cfgfiles{'sendmail'}, \%currentInfo );
}

# SUB:          GIDoSendmail
# PARAMETERS:   nothing
# GLOBALS:      %currentInfo, $CGIDAT
# INITWORK:     nothing
# DESC:         sends a mail
# ERRORS:       1,2
# RETURN:       nothing
# VERSION:      1


sub CGIDoSendmail {
	# Can we send to someone at somewhere ?
	if (($CGIDAT::to) and ($currentInfo{'SMTP'}) and ($currentInfo{'EMAIL'})) {
		&htmlSubst($cfgfiles{'mailsent_start'}, \%currentInfo );
	
		$CGIDAT::to=~s/^\s*//; $CGIDAT::to=~s/\s*$//; $CGIDAT::to=~s/\s+/ /;
		$CGIDAT::cc=~s/^\s*//; $CGIDAT::cc=~s/\s*$//; $CGIDAT::cc=~s/\s+/ /;
		$CGIDAT::bcc=~s/^\s*//; $CGIDAT::bcc=~s/\s*$//; $CGIDAT::bcc=~s/\s+/ /m;
		
		if ($CGIDAT::to=~/[,;\s]/) {
			my @alladdr=split /[,;\s]+/, $CGIDAT::to;
			foreach (@alladdr) {
				my $tonow=&emailAdress($_);
				&DoOneSend ($tonow);
			}
		} else {
			my $tonow=emailAdress($CGIDAT::to);
			&DoOneSend($tonow);
		}
							
		if ( $CGIDAT::bcc ) { 
			if ($CGIDAT::bcc=~/[,;\s]/) {
				my @alladdr=split /[,;\s]+/, $CGIDAT::bcc;
				foreach (@alladdr) {
					my $tonow=&emailAdress($_);
					&DoOneSend ($tonow);
				}
			} else {
				my $tonow=emailAdress($CGIDAT::bcc);
				&DoOneSend($tonow);
			}
		}
		if ( $CGIDAT::cc ) { 
			if ($CGIDAT::cc=~/[,;\s]/) {print "YEP";
				my @alladdr=split /[,;\s]+/, $CGIDAT::cc;
				foreach (@alladdr) {
					my $tonow=&emailAdress($_);
					&DoOneSend ($tonow);
				}
			} else {
				my $tonow=emailAdress($CGIDAT::cc);
				&DoOneSend($tonow);
			}
		}

		
		&htmlSubst($cfgfiles{'mailsent_stop'}, \%currentInfo );

	} else {
	    &logOutError ( 3 );
	    &doError($cfgfiles{'gen_err'}, 3);
	}
}

sub DoOneSend {
	my $tmpto = &emailAdress( shift );
	my ($tsubject,$tmessage)=($CGIDAT::subject,$CGIDAT::message);	
	
	# Try to create SMTP session
	my $smtp = Net::SMTP->new( $currentInfo{'SMTP'} );
	# Session open
	if ($smtp) {
		# do some safty work
		$currentInfo{'EMAIL'} = &emailAdress( $currentInfo{'EMAIL'} );
            	$tsubject = &encodeLine ( $tsubject );

		# Tell the server whom to send to
		$smtp->mail( $currentInfo{'EMAIL'} );
		$smtp->to($tmpto);
		# send header Data
		$smtp->data();
		$smtp->datasend("From: $currentInfo{'EMAIL'}\n");	
		$smtp->datasend("To: $CGIDAT::to\n");
		if ( $CGIDAT::cc ) {
			$smtp->datasend("Cc: $CGIDAT::cc\n");
		}
		if ( $CGIDAT::bcc ) {
			$smtp->datasend("Bcc: $CGIDAT::bcc\n");
		}
		$smtp->datasend("Subject: $tsubject\n");
		# some fun
		my $bound="xxmartinlovesdanilaandhisbabies";

		# do we have an attachment
		if ($CGIDAT::attach) {
			# we need an content-Type
			$smtp->datasend("MIME-Version: 1.0\n");
			$smtp->datasend("Content-Type: multipart/mixed; boundary=$bound");
			$smtp->datasend("\n");
			$smtp->datasend("Mail created by cWebmail need a browser, which supports MIME Version 1.0\n");
			$smtp->datasend("\n");
			$smtp->datasend("--$bound\n");
			# assume text/plain for normal message
			$smtp->datasend("Content-Type: text/plain\n");
		}
		# check if it is a special character code
		unless ($tmessage =~ /([\x00-\x20] | [\x7F-\xFF])/) {
			$smtp->datasend("\n");
		} else {
			$smtp->datasend("MIME-Version: 1.0\n");
			$smtp->datasend("Content-Transfer-Encoding: quoted-printable\n");
			$smtp->datasend("Content-Type: text/plain\n");
			$smtp->datasend("\n");
			# Encode it using QP
			$tmessage = encode_qp ($tmessage);
		}
		$smtp->datasend("\n"); # for safty;
		# now the normal message
		$smtp->datasend("$tmessage\n");

		# now an attachment
		if ($CGIDAT::attach) {
			my $attachdata = $CGIDAT::attach;
			my $atfile = $cgih->param('attach');
			my @tmpfilename = split(/[\\\\\/]/, $atfile);
			$tmpfilename[$#tmpfilename] =~ s/[ \t]/_/g;
			my $cttmp = &findMIME($tmpfilename[$#tmpfilename]);	
			$tmpfilename[$#tmpfilename] = &encodeLine ( $tmpfilename[$#tmpfilename] );
			unless ($cttmp) {	
				$cttmp  = $cgih->uploadInfo($atfile)->{'Content-Type'};
			}	

			$smtp->datasend("--$bound\n");
			$smtp->datasend("Content-Transfer-Encoding: base64\n");
			$smtp->datasend("Content-Type: $cttmp; name=\"$tmpfilename[$#tmpfilename]\"\n");
			$smtp->datasend("Content-Disposition: attachment; filename=\"$tmpfilename[$#tmpfilename]\"\n");
			$smtp->datasend("\n");
			my $MIMEfiletmp = "";

			while (<$atfile>) {
				$MIMEfiletmp .= $_;
			}

			# encode it
			$MIMEfiletmp = encode_base64($MIMEfiletmp);
			$smtp->datasend("$MIMEfiletmp\n");

			# close $atfile;
			seek $atfile,0,0;

			$smtp->datasend("\n");
			$smtp->datasend("--$bound--\n");
		}
		
		# end session

		unless ($smtp->dataend()) {
			$smtp->quit;
		    	&logOutError ( 10 );
	    		my %htmlout = %currentInfo;
	    		$htmlout{TO} = $tmpto;
	    		&htmlSubst($cfgfiles{'mailsent_err'}, \%htmlout );
		} else {

		$smtp->quit;
		
		&logOutOk ( 2, "$tmpto" );
		
		my %htmlout = %currentInfo;
		$htmlout{TO} = $tmpto;
		&htmlSubst($cfgfiles{'mailsent'}, \%htmlout );
		}
	} else {
	    &logOutError ( 2 );
	    my %htmlout = %currentInfo;
	    $htmlout{TO} = $tmpto;
	    &htmlSubst($cfgfiles{'mailsent_err'}, \%htmlout );
	}
}

# SUB:          CGIUserCFG
# PARAMETERS:   nothing
# GLOBALS:      %currentInfo
# INITWORK:     nothing
# DESC:         let the User configure his account
# ERRORS:       nothing
# RETURN:       nothing
# VERSION:      1
sub CGIUserCFG {
	&htmlSubst($cfgfiles{'ucfg'}, \%currentInfo);
}

# SUB:          CGIUserCFGpr
# PARAMETERS:   nothing
# GLOBALS:      %currentInfo, %CGIDAT
# INITWORK:     nothing
# DESC:         let the User configure his account
# ERRORS:       from saveconfig
# RETURN:       nothing
# VERSION:      1
sub CGIUserCFGpr {
	# Get It !
	$currentInfo{'REALNAME'} = $CGIDAT::RealName;
	$currentInfo{'EMAIL'}    = $CGIDAT::email;
	$currentInfo{'ADRESS'}   = $CGIDAT::Adress;
	$currentInfo{'LANG'}     = $CGIDAT::lang;
	$currentInfo{'SMTP'}     = $CGIDAT::SMTP;

	# Save IT!
	if ((my $tmperrorSave = &saveConfig) eq 0) {
	        &logOutOk ( 3, "" );
		&htmlSubst ($cfgfiles{'ucfgproc'}, \%currentInfo);
	} else {
	        &logOutError ( $tmperrorSave );
		&doError($cfgfiles{'gen_err'}, $tmperrorSave);
	}
}

# SUB:          CGIdelMult
# PARAMETERS:   msgnum
# GLOBALS:      %currentInfo, $pop
# INITWORK:     nothing
# DESC:         deletes mult message
# ERRORS:       cannot log in
# RETURN:       nothing
# VERSION:      1
sub CGIdelMult {
	# We have to relogon
	my $msgident;
	if ((my $tmpErrorLog=&LoginUser( $currentInfo{'USER'}, $currentInfo{'BOX'}, $currentInfo{'PASS'})) eq 0) {
		foreach $msgident (@{$CGIARG{'MULT'}}) {
			$pop->delete( $msgident );
		}
		$pop->quit;
		&logOutOk ( 4, "" );
		&CGIReListMsg;
	} else {
	        &logOutError ( $tmpErrorLog );
		&doError($cfgfiles{'gen_err'}, $tmpErrorLog);
	}
}

# SUB:          CGIdelMsg
# PARAMETERS:   msgnum
# GLOBALS:      %currentInfo, $pop
# INITWORK:     nothing
# DESC:         deletes a message
# ERRORS:       cannot log in
# RETURN:       nothing
# VERSION:      1
sub CGIdelMsg {
	my $msgident = shift;
	# We have to relogon
	if ((my $tmpErrorLog=&LoginUser( $currentInfo{'USER'}, $currentInfo{'BOX'}, $currentInfo{'PASS'})) eq 0) {
		$pop->delete( $msgident );
		$pop->quit;
		&logOutOk ( 5, "" );
		&CGIReListMsg;
	} else {                    
	        &logOutError ( $tmpErrorLog );
		&doError($cfgfiles{'gen_err'}, $tmpErrorLog);
	}
}

# SUB:          CGILogon
# PARAMETERS:   nothing
# GLOBALS:      nothing
# INITWORK:     nothing
# DESC:         print the logon screen, no massiv work
# ERRORS:       nothing
# RETURN:       nothing
# VERSION:      1
sub CGILogon {
	# we just need to display the logon screen, no other work to be done
	&htmlSubst($cfgfiles{'logon'}, \%localWebMail);
}

# SUB:          CGILogonProc
# PARAMETERS:   nothing
# GLOBALS:      %CGIDAT
# INITWORK:     %currentInfo, $pop, %POPHead
# DESC:         Does the first login work and displays the list of POP
#               or print the logon Error
# ERRORS:       3, from logon
# RETURN:       nothing
# VERSION:      1
sub CGILogonProc {
	# lets see if the user can be logged on
	if ((my $returnstat = &LoginUser( $CGIDAT::user, $CGIDAT::box, $CGIDAT::pass )) eq 0) {
		# YES !, get his messages, and save it
		if ((&getPOPlist eq 0) && (&HeadToFile eq 0)) {
			&addPassword;

			# and display all messages !
		        &logOutOk ( 6, "$CGIDAT::user - $CGIDAT::box" );
			&CGIListMsg;
		} else {
			&logOutError ( 4 );
			&doError($cfgfiles{'logon_err'}, 4);
		}
	# Sorry, the user cant be logged on !
	} else {
		# Print error using the message number of the Login Result !
                &logOutError ( $returnstat );
		&doError($cfgfiles{'logon_err'}, $returnstat);
	}
}

# SUB:          CGIReListMsg
# PARAMETERS:   nothing
# GLOBALS:      %currentInfo
# INITWORK:     $pop, %POPHead
# DESC:         Reloads the list of Messages from the POP account
# ERRORS:       3, from logon
# RETURN:       nothing
# VERSION:      1
sub CGIReListMsg {
	# Logon the user and see, whats happening
	if ((my $tmpErrorLog=&LoginUser( $currentInfo{'USER'}, $currentInfo{'BOX'}, $currentInfo{'PASS'})) eq 0) {
		# YES !, get his messages, and save it
		if ((&getPOPlist eq 0) && (&HeadToFile eq 0)) {
			# and display all messages !
			&CGIListMsg;
		} else {
			&doError($cfgfiles{'logon_err'}, 4);
		}
	} else {
		# Print error using the message number of the Login Result !
		&doError($cfgfiles{'logon_err'}, $tmpErrorLog);
	}
}


# SUB:          CGIListMsg
# PARAMETERS:   nothing
# GLOBALS:      %currentInfo
# INITWORK:     %POPHead
# DESC:         Reloads the list of Messages from the POP account
# ERRORS:       from filetohead
# RETURN:       nothing
# VERSION:      1
sub CGIListMsg {
	my $headmsg;
	# Read the POP messages from the file
	if ((my $tmpErrorfile=&FileToHead) eq 0) {

		# turn sort direction
		if ($CGIARG{'SORTDIR'}) {
			if ($CGIARG{'SORTDIR'} eq 1) {
				$currentInfo{'NEWSORT'} = 2;
			} else {
				$currentInfo{'NEWSORT'} = 1;
			}
		} else {
			$currentInfo{'NEWSORT'} = 1;
		}

		# print the Header with User Information
		htmlSubst($cfgfiles{'list_head'}, \%currentInfo);

		# print each POP Header line with the Header Data
		foreach $headmsg ( sort sortList keys %POPHead ) {
			if ((not ($POPHead{$headmsg}{"STATUS"})) or (not $POPHead{$headmsg}{"STATUS"} =~ /r/i)) {
				htmlSubst($cfgfiles{'list_EN'}, $POPHead{$headmsg});
			} else {	
				htmlSubst($cfgfiles{'list_entry'}, $POPHead{$headmsg});
			}			
		}

		# print the footer with the local configuration Hash
		htmlSubst( $cfgfiles{'list_foot'}, \%localWebMail);

	# Cant get Header
	} else {
		&doError($cfgfiles{'gen_err'}, $tmpErrorfile);
	}
}

# SUB:          CGIGetMsg
# PARAMETERS:   [message ID]
# GLOBALS:      %currentInfo
# INITWORK:     %POPHead, %POPmsg
# DESC:         display the message selected
# ERRORS:       from LoginUser, or FileToHead
# RETURN:       nothing
# VERSION:      1
sub CGIGetMsg {
	# Check if its a number passed
	my $msgident = shift;
	# We have to relogon
	if ((my $tmpErrorlog=&LoginUser( $currentInfo{'USER'}, $currentInfo{'BOX'}, $currentInfo{'PASS'})) eq 0) {
		# check if we can get the header
		if ((my $tmpErrorFile=&FileToHead) eq 0) {

	                # get the list from our POP
	                if (@POPmsg = @{ $pop->get( $msgident ) }) {;

	                        # first, display the msg - head
	                        &htmlSubst($cfgfiles{'msg_head'}, $POPHead{$msgident} );

	                        &workmsg ( @POPmsg );

	                        &htmlSubst($cfgfiles{'msg_foot'}, $POPHead{$msgident} );
   				$POPHead{$msgident}{"STATUS"}="RO";
				&HeadToFile;	 
                        } else {
                                &doError( $cfgfiles{'gen_err'}, 15 );
		        }
		# Sorry, header problem
		} else {
			&doError($cfgfiles{'gen_err'}, $tmpErrorFile);
		}
	# no logon possible !
	} else {
		&doError($cfgfiles{'gen_err'}, $tmpErrorlog);
	}
}

# ------------------ END of SUB - Area: CGI*

# ------------------ BEGIN of SUB - Area: helping routinges

sub findMIME {
	my $filename = shift;
	my $mimefound = "";

	if (open (MIMECONF, "$storedir/cfg/mime.conf")) {
		while (($_ = <MIMECONF>) and (not $mimefound)) {
			chomp($_);	
			@mimemap = split(/[\ \t]+/, $_);
			if ($filename =~ /$mimemap[0]/) {
				$mimefound = $mimemap[1];
			}
		}
		close MIMECONF;
	}
	return $mimefound;
}				

# SUB:          sortList
# PARAMETERS:   -
# GLOBALS:      %CGIARG, %POPHead
# INITWORK:     -
# DESC:         sorting routine
# ERRORS:       -
# RETURN:       nothing
# VERSION:      1
sub sortList {
	if (($CGIARG{'SORT'}) and ($CGIARG{'SORTDIR'})) {
	  if ($CGIARG{'SORTNUM'} eq "1") {
		if ($CGIARG{'SORTDIR'} eq "1") {
			lc($POPHead{$a}{uc($CGIARG{'SORT'})}) <=> lc($POPHead{$b}{uc($CGIARG{'SORT'})});
		} else {
			lc($POPHead{$b}{uc($CGIARG{'SORT'})}) <=> lc($POPHead{$a}{uc($CGIARG{'SORT'})});
		}
	  } else {
		if ($CGIARG{'SORTDIR'} eq "1") {
			lc($POPHead{$a}{uc($CGIARG{'SORT'})}) cmp lc($POPHead{$b}{uc($CGIARG{'SORT'})});
		} else {
			lc($POPHead{$b}{uc($CGIARG{'SORT'})}) cmp lc($POPHead{$a}{uc($CGIARG{'SORT'})});
		}
	  }
	} else {
		$b <=> $a;
	}
}

# SUB:          prepareHTML
# PARAMETERS:   one line
# GLOBALS:      -
# INITWORK:     -
# DESC:         substitutes the html "bad" tags
# ERRORS:       -
# RETURN:       clean line
# VERSION:      1
sub text2htmlprep {
	my $workstring = shift;
	$workstring =~ s/\>/\&gt\;/g;
	$workstring =~ s/\</\&lt\;/g;
	return $workstring;
}

# SUB:          closePOP
# PARAMETERS:   -
# GLOBALS:      $pop
# INITWORK:     -
# DESC:         closes POP
# ERRORS:       -
# RETURN:       -
# VERSION:      1
sub closePOP {
	if ($pop) {             # only if initialized
		$pop->quit;
	}
}

# SUB:          logOutOK
# PARAMETERS:   num, text
# GLOBALS:      -
# INITWORK:     -
# DESC:         logs out OK
# ERRORS:       -
# RETURN:       -
# VERSION:      1
sub logOutOk {
        my $id      = shift;
        my $logtext = shift;

        my $gettext = &getOneLine ( $cfgfiles {'logok'}, $id );
        if (open (LOGOK, ">>$currentInfo{'DIRECTORY'}/log")) {
                my $gtime = gmtime ( time );
                print LOGOK "+ $gtime: $gettext $logtext\n";
                close LOGOK;
        }
}

# SUB:          logOutError
# PARAMETERS:   num
# GLOBALS:      -
# INITWORK:     -
# DESC:         logs out Error
# ERRORS:       -
# RETURN:       -
# VERSION:      1
sub logOutError {
        my $id      = shift;

        my $gettext = &getOneLine ( $cfgfiles {'errors'}, $id );
        if (open (LOGER, ">>$currentInfo{'DIRECTORY'}/log")) {
                my $gtime = gmtime ( time );
                print LOGER "- $gtime: $gettext\n";
                close LOGER;
        }
}

# SUB:          getOneLine
# PARAMETERS:   [File], [Num]
# GLOBALS:      $currentInfo ( if possible )
# INITWORK:     nothing
# DESC:         Reads line x from file
# ERRORS:       nothing
# RETURN:       The specific line
# VERSION:      1
sub getOneLine {
        my $msgfile = shift;
        my $msgnum  = shift;
        my $tmpline = "not defined\n";
        my $i;

	if (open ( MSGFILE, "$storedir/cfg/$currentInfo{'LANG'}/$msgfile") or open (MSGFILE, "$storedir/cfg/$msgfile")) {
		for ($i=1; $i <= $msgnum; $i++) {
			$tmpline = <MSGFILE>;
		}
		close MSGFILE;
	# cant open one of the errorfiles
	} else {
		$tmpline="Cannot open messagebase ! PANIC !\n";
	}

	# prepare for html output !
	chomp($tmpline);
	return($tmpline);
}

# SUB:          doError
# PARAMETERS:   [Errortemplate], [Errornumber]
# GLOBALS:      $currentInfo ( if possible )
# INITWORK:     nothing
# DESC:         what to have an Error
# ERRORS:       nothing
# RETURN:       nothing
# VERSION:      1
sub doError {
	my $errorfile = shift;
	my $errno     = shift;

	# try to open first the language specific errorfile, then try to open the
	# general errorfile
        my $tmpline = &getOneLine ( "$cfgfiles{'errors'}", $errno );

        # prepare hash for output
	my %tmperr = (
		ERROR => "$tmpline",
	);

	# display it !
	&htmlSubst($errorfile, \%tmperr);
	# sorry, but after an error, we dont want to produce more CPU overhead
	exit 0;
}

# SUB:          htmlSubst
# PARAMETERS:   [htmltemplate], [parameterhash]
# GLOBALS:      $currentInfo ( if possible - for secure links )
# INITWORK:     nothing
# DESC:         displays the html give by template and substitutes
# ERRORS:       selfproducing
# VERION:       1
sub nohtml {
	my $inhash=shift;

}

sub htmlSubst {
	my $file        = shift;
	my %substhash   = %{ shift() };
	my $correct	=	shift || 1;

	if ($correct) {	
		foreach my $substpart ( keys %substhash ) {
			$substhash{$substpart}=~s/\&/\&amp;/g;
			$substhash{$substpart}=~s/\</\&lt;/g;
			$substhash{$substpart}=~s/\>/\&gt;/g;
		}
	}	

	# Get the Session Key for the user
	my $tmplink     = $currentInfo{'SESSIONKEY'};
	my $partone     = "";
	my $parttwo     = "";
	my $tmphash     = "";

	if ((open (TEMPLATE, "$storedir/cfg/$currentInfo{'LANG'}/$file")) or (open (TEMPLATE, "$storedir/cfg/$file"))) {
		# read each line
		while (<TEMPLATE>) {
			# check for occurences of []
			while (/\[.*\]/) {
				($partone, $parttwo) = split(/\[/, $_, 2);
				print "$partone";
				($partone, $parttwo) = split(/\]/, $parttwo, 2);
				my $origpartone=$partone; $partone = uc ( $partone );
				# first deal with specials then deal with hash entries
				if ($partone eq "!LINK!") {
					$tmphash = $tmplink;
				} elsif ($partone eq "!ELINK!") {
					$tmphash = $CGILink;
				} elsif ($partone eq "!SORT!") {
					if (($CGIARG{'SORT'}) and ($CGIARG{'SORTDIR'})) {
					    if ($CGIARG{'SORTNUM'}) {
							$tmphash = "&sort=$CGIARG{'SORT'}&sortdir=$CGIARG{'SORTDIR'}&sortnum=$CGIARG{'SORTNUM'}";
						} else {
							$tmphash = "&sort=$CGIARG{'SORT'}&sortdir=$CGIARG{'SORTDIR'}";
						}
					} else {
						$tmphash = "";
					}
				} elsif ($partone =~ /[\[\]]/) {
					$tmphash = $origpartone;
				} else {
					$tmphash = $substhash{$partone};
				}
				# print it
				print "$tmphash";
				# lets go on with the rest of the line
				$_ = $parttwo;
			}
			# print the line without special fields
			print "$_";
		}
	} else {
		# no template available, so we have definit a panic case
		print << "EOF";
Content-Type:   text/html\n\n

<html><head>
<title>PANIC !</title>
</head><body>
Sorry, cannot get template for you. You have to contact the administrator ! PANIC !
</body></html>
EOF
	}
}

# SUB:          OSdelete
# PARAMETERS:   file or path to delete
# GLOBALS:      nothing
# INITWORK:     nothing
# DESC:         deletes a file or path
# ERRORS:       nothing
# VERION:       1
sub OSdelete {
	my $what = shift;

	`rm -rf $what`;
	return (1);
}

# SUB:          encodeLine
# PARAMETERS:   [line to be cleand]
# GLOBALS:      nothing
# INITWORK:     nothing
# DESC:         makes a clean line using QP
# ERRORS:       -
# VERSION:      1
sub encodeLine {
	my $inline = shift;

	# do we have "not normal character" included ?
	unless ($inline =~ /([\x00-\x20] | [\x7F-\xFF])/) {
		return ($inline);
	} else {
                # yes. encode it with qp.
		my $tmpline = encode_qp($inline);
                # !! could we have problems with iso-8859-1 ??
		$inline = "=?iso-8859-1?Q?$tmpline?=";
		return ($inline);
	}
}

sub removePassword {
	if ($currentInfo{'DIRECTORY'}) {
		if (open ( UCFG, ">$currentInfo{'DIRECTORY'}/box.cfg" ) ) {
			print UCFG "-notset-\n$currentInfo{'REALNAME'}\n$currentInfo{'ADRESS'}\n$currentInfo{'EMAIL'}\n$currentInfo{'LANG'}\n$currentInfo{'SMTP'}";
			close UCFG;
		}
	}
}

sub addPassword {
	if ($currentInfo{'DIRECTORY'}) {	
		if (open( UCFG, ">$currentInfo{'DIRECTORY'}/box.cfg")) {

			print UCFG "$CGIDAT::pass\n$currentInfo{'REALNAME'}\n$currentInfo{'ADRESS'}\n$currentInfo{'EMAIL'}\n$currentInfo{'LANG'}\n$currentInfo{'SMTP'}";
			close UCFG;
		}
	}
}

# SUB:          readUser
# PARAMETERS:   nothing
# GLOBALS:      $in
# INITWORK:     $currentInfo
# DESC:         reads users data from file
# ERRORS:       5,6
# VERSION:      1
sub readUser {
	$currentInfo{'USER'}            = $CGIARG{'USER'};
	$currentInfo{'BOX'}             = $CGIARG{'BOX'};
	$currentInfo{'DIRECTORY'}       = "$storedir/$currentInfo{'USER'}.$currentInfo{'BOX'}";

	if (($currentInfo{'USER'}) and ($currentInfo{'BOX'})) {
		# we try to get a valid key, ( if user is new, we get back nothing )
		$currentInfo{'SESSIONKEY'} = &get_secure_link;
		# lets try to open his directory
		if (open ( UCFG, "$currentInfo{'DIRECTORY'}/box.cfg" ) ) {
			# assign each value of the user
			($currentInfo{'PASS'}, $currentInfo{'REALNAME'}, $currentInfo{'ADRESS'}, $currentInfo{'EMAIL'}, $currentInfo{'LANG'}, $currentInfo{'SMTP'}) = <UCFG>;
			# we dont need the \n s
			chomp($currentInfo{'PASS'}, $currentInfo{'REALNAME'}, $currentInfo{'ADRESS'}, $currentInfo{'EMAIL'}, $currentInfo{'LANG'}, $currentInfo{'SMTP'});
			close UCFG;
			
			if ($CGIDAT::lang || $CGIARG{'LANG'}) {
				$currentInfo{'LANG'} = $CGIDAT::lang if ($CGIDAT::lang);
				$currentInfo{'LANG'} = $CGIARG{'LANG'} unless ($CGIDAT::lang);
			}
			
			# cool, everything seems to be ok
			return 0;
		# sorry, file is impossible to be opened
		} else {
			return 5;
		}
	# sorry, can I have correct parameters ?
	} else {
		return 6;
	}
}

# SUB:          completeUser
# PARAMETERS:   nothing
# GLOBALS:      $in
# INITWORK:     $currentInfo
# DESC:         extends the readUser to handle new users
# ERRORS:       from readuser
# VERSION:      1
sub getdefault {
	my $whattoget = shift;
	my $res = $DEFAULTuser{$whattoget};

	if ($res =~ /^!/) {
		$res=~s/^!//;
		return eval $res;
	} else {
		return $res;
	}
}
 
sub completeUser {
	my $tmpstatus;

	# try to read users configuration
	unless (($tmpstatus = &readUser) eq 0)  {

		# generate a new one
		$currentInfo{'REALNAME'} = getdefault ( 'name' );
		$currentInfo{'ADRESS'}   = getdefault ( 'address' );
		$currentInfo{'EMAIL'}  = getdefault ( 'email' );
		$currentInfo{'LANG'}     = getdefault ( 'lang' );
		$currentInfo{'SMTP'}     = getdefault ( 'smtp' );

		# save new configuration
		if (($tmpstatus = &saveConfig) eq 0) {
			$currentInfo{'SESSIONKEY'}      = &get_secure_link;
		}
	}
	return ($tmpstatus);
}

# SUB:          saveConfig
# PARAMETERS:   nothing
# GLOBALS:      $currentInfo
# INITWORK:     nothing
# DESC:         saves configuration even if new one
# ERRORS:       7,5
# VERSION:      1
sub saveConfig {
	# check, if directory exits
	if (( -d "$currentInfo{'DIRECTORY'}") or (mkdir ( "$currentInfo{'DIRECTORY'}", 0777 ))) {

		# try to open box
		if (open( UCFG, ">$currentInfo{'DIRECTORY'}/box.cfg")) {

			print UCFG "$currentInfo{'PASS'}\n$currentInfo{'REALNAME'}\n$currentInfo{'ADRESS'}\n$currentInfo{'EMAIL'}\n$currentInfo{'LANG'}\n$currentInfo{'SMTP'}";
			close UCFG;
			return(0);
		# cannot open box
		} else {
			return(5);
		}
	# cannot make or open directory
	} else {
		return(7);
	}
}

# SUB:          LoginUser
# PARAMETERS:   [user],[box],[pass]
# GLOBALS:      nothing
# INITWORK:     $currentInfo, $pop
# DESC:         runs the login
# ERRORS:       6,8,9
# VERSION:      1
sub LoginUser  {
	# get parameters
	$currentInfo{'USER'} = shift;
	$currentInfo{'BOX'}  = shift;
	$currentInfo{'PASS'} = shift;

	if ($currentInfo{'BOX'} =~ /$POPallow/i) {
		if ($pop = Net::POP3->new($currentInfo{'BOX'})) {;
			if ($pop->login($currentInfo{'USER'}, $currentInfo{'PASS'}) ne undef) {
				if ((my $retstat = &completeUser) eq 0) {
					&cleanUpWeb;
					return 0;
				} else {
					return $retstat; # completuser Problem
				}
			} else {
				return 6; # SECURITY Problem
			}
		} else {
			return 8; # BOX Problem
		}
	} else {
		return 9;
	}
}

# SUB:          HeadToFile
# PARAMETERS:   nothing
# GLOBALS:      $currentInfo, %POPHead
# INITWORK:     [FILE]
# DESC:         saves the head to the users file
# ERRORS:       11
# VERSION:      1
sub HeadToFile {
	my $headmsg;

	# try to write Head
	if (open HEAD, ">$currentInfo{'DIRECTORY'}/head.cur") {
		# now we write it !
		foreach $headmsg ( sort keys %POPHead ) {
			print HEAD "----->$headmsg<-----\n";
			foreach $headpart ( sort keys %{ $POPHead{$headmsg} }  ) {
				if ($headpart) {
					print HEAD "::$headpart\n$POPHead{$headmsg}{$headpart}\n";
				}
			}
		}
		close HEAD;
		return 0;
	} else {
		return 11;
	}

}

# SUB:          FileToHead
# PARAMETERS:   nothing
# GLOBALS:      $currentInfo
# INITWORK:     %POPHead
# DESC:         reads the Head from disk
# ERRORS:       12
# VERSION:      1
sub FileToHead {

	if (open HEAD, "$currentInfo{'DIRECTORY'}/head.cur") {
		# initialize DATA
		$POPHead = {};
		my $MsgNum  = 0;
		my $actKey      = "";

		# read each line
		while (<HEAD>) {
			# its a normal line
			unless (/-----\>.*\<-----/) {
				if ($MsgNum) {
					# lets see, if we have a field
					if (($actKey) and not (/^\:\:/)) {
						$POPHead{$MsgNum}{$actKey} .= $_;
					} elsif (/^\:\:/) {
					# is it a key
						chop ($POPHead{$MsgNum}{$actKey}) if ($actKey);
						s/^\:\://g;
						chop;
						$actKey = $_;
					}
				}
			}
			# is it a new message ?
			if (/-----\>.*\<-----/) {
				chop ($POPHead{$MsgNum}{$actKey}) if (($actKey) and ($MsgNum));
				s/[-\>\<\n]//g;
				$MsgNum = $_;
				$POPHead{$MsgNum} = {};
				$actKey = "";
			}
		}
		chop ($POPHead{$MsgNum}{$actKey}) if (($actKey) and ($MsgNum));
		close HEAD;
		return (0);
	} else {
		return (12);
	}
}

# SUB:          ArrayToLine
# PARAMETERS:   [the array]
# GLOBALS:      nothing
# INITWORK:     nothing
# DESC:         returns the array as a line
# ERRORS:       nothing
# VERSION:      1
sub ArrayToLine {

	my @anyarray;
	my $anyline;

	@anyarray = @_;
	$anyline  = "";

	foreach $arrayline ( @anyarray ) {
		$anyline .= $arrayline;
	}

	return($anyline);
}

# SUB:          stuffHead
# PARAMETERS:   head
# GLOBALS:      nothing
# INITWORK:     nothing
# DESC:         works on the head to find out the corresponding lines
# ERRORS:       nothing
# VERSION:      1
sub stuffHead {

	my @head;
	my $headline;

	@head = @_;
	$headline = -1;

	for ($headcount = 0; $headcount < $#head; $headcount++) {
		if (($head[$headcount] =~ /^[\t ]+/) and ($headcount > 0)) {
			$head[$headcount] =~ s/^[\t ]+| +$//;
			$head[$headline] =~ s/[\n]//;
			$head[$headline] .= " " . $head[$headcount];
			$head[$headcount] = "";
		} else {
			$headline = $headcount;
		}
	}
	return(@head);
}

# SUB:          dateconvert
# PARAMETERS:   a date
# GLOBALS:      nothing
# INITWORK:     nothing
# DESC:         tries to uniform a date
# ERRORS:       nothing
# VERSION:      1
sub dateconvert {
	my $indate = shift;
	my $hour;
	my $min;
	my $sec;
	my $mon;
	my $year;
	my $day;
	my $zone;

	if ($indate =~ /([0-9]{1,2}):([0-9]{1,2}):([0-9]{1,2})/) {
		$hour = $1;
		$min  = $2;
		$sec  = $3;
	}

	if ($indate =~ /([0-9]{1,2})[ .-]+([A-Za-z]{3,8})[ .-]+([0-9]{2,4})/) {
		$day  = $1;
		unless (length($day) eq 2) {
			$day = "0" . $day;
		}
		$mon  = $monthlist{ substr( lc( $2 ), 0, 3) };
		$year = $3;
		if (($year => 50) and ($year < 100)) {
			$year = $year + 1900;
		} elsif ($year < 50) {
			$year = $year + 2000;
		}
	}

	if ($indate =~ /([+-])([0-9]{2})([0-9]{2})/) {
		$zone = "$1$2$3";
	}

	$indate = "$year-$mon-$day $hour:$min:$sec $zone";


	return ($indate);
}

# SUB:          emailAdress
# PARAMETERS:   a Adress
# GLOBALS:      nothing
# INITWORK:     nothing
# DESC:         gets the email out of it
# ERRORS:       nothing
# VERSION:      1
sub emailAdress {
	my $inaddr = shift;	
	
	if ($inaddr =~ /(.*)\<\s*([A-Za-z_\-\.\@\!0-9]+)(.*)\>(.*)/) {
		return ( $2 );
	} elsif ($inaddr =~ /([A-Za-z_\-\.\@\!0-9]+)[ ]{0,1}\((.*)\)/) {
                return ( $1 );
    } else {
                return ( $inaddr );
    }
}

# SUB:          realAdress
# PARAMETERS:   a Adress
# GLOBALS:      nothing
# INITWORK:     nothing
# DESC:         gets the real out of it
# ERRORS:       nothing
# VERSION:      1
sub realAdress {
	my $inaddr = shift;	

	if ($inaddr =~ /(.*)\<([A-Za-z_\-\.\@\!0-9]+)(.*)\>(.*)/) {
		return ( $1 );
	} elsif ($inaddr =~ /([A-Za-z_\-\.\@\!0-9]+)[ ]{0,1}\((.*)\)/) {
                return ( $2 );
        } else {
                return ( "" );
        }
}

# SUB:          getPOPlist
# PARAMETERS:   nothing
# GLOBALS:      $pop
# INITWORK:     %POPHead
# DESC:         Puts the head in a hash
# ERRORS:       nothing
# VERSION:      1
sub getPOPlist {
	my $msg_pop;
	my $popline;
	my $actKey;
	my $actData;

	if (my $maillist = $pop->list()) {
		$POPHead = {};

		# work throug every line
		foreach $msg_pop (sort keys %{$maillist}) {
			# get message head
			if (@topmsg =@{$pop->top($msg_pop)}) {
				$POPHead{$msg_pop} = {};
				$POPHead{$msg_pop}{'MSGNUM'} = $msg_pop;
				my $tmpsize = $pop->list($msg_pop) / 1024;
				my @tmpsizeA = split (/\./, $tmpsize, 2);
				$tmpsize    = $tmpsizeA[0] . "." . substr($tmpsizeA[1], 0, 2);
				$POPHead{$msg_pop}{'SIZE'} = $tmpsize;
				@topmsg = stuffHead(@topmsg);
				foreach $popline ( @topmsg ) {
					($actKey, $actData) = split(/:/, $popline, 2);

					$actData =~ s/\n|^[ \t]*//g;
					$actKey  =~ s/[\t\n ]//g;
					if ($actKey) {
						$actKey = uc( $actKey );
						$POPHead{$msg_pop}{$actKey} = &mydecode ( $actData );
					}
				}

				if ($POPHead{$msg_pop}{'DATE'}) {
					$POPHead{$msg_pop}{'DATE'} = &dateconvert($POPHead{$msg_pop}{'DATE'});
				}

				if ($POPHead{$msg_pop}{'FROM'}) {
				        $POPHead{$msg_pop}{'REAL'} = &realAdress ( $POPHead{$msg_pop}{'FROM'} );
				        $POPHead{$msg_pop}{'FROM'} = &emailAdress ( $POPHead{$msg_pop}{'FROM'} );
				}
			}
		}
		return 0;
	}
}

# SUB:          mydecode
# PARAMETERS:   in line
# GLOBALS:      nothing
# INITWORK:     nothing
# DESC:         decodes qp and mime in one line
# ERRORS:       nothing
# VERSION:      1
sub mydecode {
	$wstring = shift;

	my @workarr = split (/\=\?/, $wstring, 2 );
	unless ($workarr[1]) {
		return ( $wstring );
	} else {
		my @workmime = split (/\?/, $workarr[1], 3);
		if ($workmime[2]) {
		my @work2arr = split (/\?\=/, $workmime[2],2);
		unless (($workmime[0] =~ /iso-/i) and (($workmime[1] =~ /q/i) or ($workmime[1] =~ /b/i))) {
			return ($wstring);
		} else {
			my $tmpmime = "";
			if ($workmime[1] =~ /q/i) {
				$tmpmime = decode_qp( $work2arr[0] );
			} else {
				$tmpmime = decode_base64 ( "$work2arr[0]\n" );
			}
			return (&mydecode ("$workarr[0]$tmpmime$work2arr[1]") );
		}
		} else {
			return ($wstring);
		}
	}
}

# SUB:          cleanUpWeb
# PARAMETERS:   nothing
# GLOBALS:      nothing
# INITWORK:     nothing
# DESC:         deletes the out files
# ERRORS:       nothing
# VERSION:      1
sub cleanUpWeb {
	if (($currentInfo{'USER'}) and ($currentInfo{'BOX'})) {
		&OSdelete ( "$storeweb/$currentInfo{'USER'}.$currentInfo{'BOX'}" );
		&OSdelete ( "$currentInfo{'DIRECTORY'}/reply" );
	}
}

# SUB:          dispMIME
# PARAMETERS:   [MIMEmain], [MIMEsub], [MIMEbound], [MIMEchar], [MIMEname], [MIMEencode]
# GLOBALS:      $pop, %currentInfo, $POPmsg
# INITWORK:     nothing
# DESC:         displays the message
# ERRORS:       nothing
# VERSION:      1
sub dispMIME {

	( my $MIMEmain, my $MIMEsub, my $MIMEchar, my $MIMEname, my $MIMEencode) = @_;
	my @POPinmsg  = @POPdisplay;
	my $printable = 0;
	my $showable  = 0;
	my $mimeok    = 0;
	my $tmpname;

	unless ($MIMEname) {
		$tmpname    = time . @POPinmsg;
	} else {
		$tmpname    = $MIMEname;
	}

	my $nextlinecr = "";
	my $notpos         = 0;
	my $filedone   = 0;
	my $substLink  = 0;
	my $ishtml         = 0;

	if ($MIMEmain =~ /text/i) {

		$_ = $MIMEsub;
		MIMEsubmsg: {
		/plain/i && do {
			$nextlinecr = "<br>";
			$printable  = 1;
			$substLink  = 1;
			last MIMEsubmsg; };
		/html/i  && do {
			$nextlinecr = "";
			# ++ 16/08
			$ishtml = 1;
			# -- 16/08
			$printable  = 1;
			last MIMEsubmsg; };
		}
		$mimeok = 1;

	} elsif ($MIMEmain =~ /image/i) {

		$_ = $MIMEsub;
		MIMEsubmsgimg: {
		/bmp/i  && do {
			$showable = 1;
			last MIMEsubmsgimg; };
		/gif/i  && do {
			$showable = 1;
			last MIMEsubmsgimg; };
		/jpg/i  && do {
			$showable = 1;
			last MIMEsubmsgimg; };
		/jpeg/i  && do {
			$showable = 1;
			last MIMEsubmsgimg; };
		}
		$mimeok = 1;

	} elsif ($MIMEmain =~ /application/i) {
		$mimeok = 1;
	} elsif ($MIMEmain =~ /audio/i) {
		$mimeok = 1;
	} elsif ($MIMEmain =~ /video/i) {
		$mimeok = 1;
        }

	# all other MIME parts should not be printed or showed immediate

	if ($mimeok) { # only if its a correct MIME type
		my $base64en = ($MIMEencode =~ /base64/i);
		my $qpen = ($MIMEencode =~ /quoted\-printable/i);
		
		if (($base64en || $qpen) && ($printable!=1)) {
			if (( -d "$storeweb/$currentInfo{'USER'}.$currentInfo{'BOX'}" ) or (mkdir ("$storeweb/$currentInfo{'USER'}.$currentInfo{'BOX'}", 0777)) ) {
				if (open( TMPBASE64, ">$storeweb/$currentInfo{'USER'}.$currentInfo{'BOX'}/$tmpname" )) {

					while (($POPinmsg[0] =~ /^[ \t\n]/) and (@POPinmsg))  {
						shift @POPinmsg;
					}
					my $MIMEdata = "";

					while (@POPinmsg) {
						if ($base64en) {
							$MIMEdata .= decode_base64( $POPinmsg[0] );
						} else {	
							$MIMEdata .= decode_qp( $POPinmsg[0] );
						}
						shift @POPinmsg;
					}
					print TMPBASE64 "$MIMEdata";
					close TMPBASE64;
					$filedone = 1;
				} else {
					$notpos = 1;
				}
			} else {
				$notpos = 1;
			}
		} elsif ($MIMEencode) {
			$notpos = 1;
		}

		if ($filedone) {
			if ($showable) {
				&htmlSubst( $cfgfiles{'msg_showpart_start'}, $POPHead{$msgnum} );
				print "<center><img src=$ATTACHLink$currentInfo{'USER'}.$currentInfo{'BOX'}/$tmpname alt=$MIMEname></center>";

				&htmlSubst( $cfgfiles{'msg_showpart_stop'}, $POPHead{$msgnum} );
			} else {
				&htmlSubst( $cfgfiles{'msg_file_start'}, $POPHead{$msgnum} );
				print "<center><a href=$ATTACHLink$currentInfo{'USER'}.$currentInfo{'BOX'}/$tmpname>$MIMEname ($MIMEmain/$MIMEsub)</a></center>";
				&htmlSubst( $cfgfiles{'msg_file_stop'}, $POPHead{$msgnum} );
			}
		} else {
			&htmlSubst( $cfgfiles{'msg_print_start'}, $POPHead{$msgnum} );
			if ($printable) {
				if ( open ( REPLY, ">>$currentInfo{'DIRECTORY'}/reply" ) ) {
					$replyok = 1;
				} else {
					$replyok = 0;
				}
				while (@POPinmsg) {
					if ($MIMEencode =~ /quoted-printable/i) {
						$POPinmsg[0] = decode_qp($POPinmsg[0]);
					} elsif ($MIMEencode =~ /base64/i) {
						$POPinmsg[0] = decode_base64($POPinmsg[0]);
					
						}
					if (($replyok) and (not $ishtml)) {
						print REPLY "> $POPinmsg[0]";
					}

					# ++ 16/08 --
					unless ($ishtml) {
						$POPinmsg[0] = &text2htmlprep( $POPinmsg[0] );
					}
					# -- 16/08
					if ($substLink) {
						$POPinmsg[0] =~ s/((ftp|http|https)\:\/\/[^\s]+)/\<a href\=\"\1\"\ target\=\"_new\">\1\<\/a\>/i;
						$POPinmsg[0] =~ s/((mailto|news)\:[^\s]+)/\<a href\=\"\1\"\>\1\<\/a\>/i;
					}
					print "$startchr$POPinmsg[0]$startchr$nextlinecr";
					shift @POPinmsg;
				}
				if ($replyok) {
					close REPLY;
				}
			} else {
				print "<br><b>???</b></br>";
				while (@POPinmsg) {
					shift @POPinmsg;
				}
			}
			&htmlSubst( $cfgfiles{'msg_print_stop'}, $POPHead{$msgnum} );
		}
	} else {
		&htmlSubst( $cfgfiles{'msg_sus_start'}, $POPHead{$msgnum} );
		print "<br><b>???</b></br>";
		while (@POPinmsg) {
			shift @POPinmsg;
		}
		&htmlSubst( $cfgfiles{'msg_sus_stop'}, $POPHead{$msgnum} );
	}
}

# SUB:          workmsg
# PARAMETERS:   a part of the message
# GLOBALS:      nothing
# INITWORK:     nothing
# DESC:         prepares a message
# ERRORS:       nothing
# VERSION:      1
sub workmsg {
	local @POPinmsg = @_;

	my $MIMEencode  = "";
	my @MIMEtype;
	my @MIMEspec;
	my $MIMEname    = "";
	my $MIMEchar    = "";
	my $MIMEbound   = "";


	# now begin to skip throug the message
	while (@POPinmsg) {
		$_ = $POPinmsg[0];
		POPMSG: {
		/Content-transfer-encoding:/i && do {
			$POPinmsg[0] =~ s/\n$//;
			(my $dummy, $MIMEencode) = split ( /:/, $POPinmsg[0], 2 );
			$MIMEencode =~ s/(^[\n \t]+|[\n \t]+$)//g;
				shift (@POPinmsg);
				last POPMSG; };
		/Content-Type:/i && do {
				# if there is a \n at the end of the POP message, so cut it
				$POPinmsg[0] =~ s/\n$//;

				my $workContent = $POPinmsg[0];
				# if the next line seems to be an append, work on it also !
				while ($POPinmsg[1] =~ /^[\t ]/) {
					$POPinmsg[1] =~ s/^[\t ]+|\n$//;
					$workContent .= $POPinmsg[1];
					shift @POPinmsg;
				}

				# now drop away the Content-Type and the leading spaces and tab
				$workContent =~ s/Content-Type://i;
				$workContent =~ s/^[ \t]//;

				# now analyze the Content-Type
				@MIMEtype = split (/\//, $workContent, 2);
				($MIMEtype[1], $MIMEspec[0]) = split (/;/, $MIMEtype[1], 2);

				# lets look at the specials
				@MIMEspec = split (/;/, $MIMEspec[0]);

				foreach my $MIMEspecpart ( @MIMEspec ) {
					my @MIMEworking = split ( /=/, $MIMEspecpart, 2 );
					# prepare the fields
					$MIMEworking[0] =~ s/^[ \t]//;
					$MIMEworking[1] =~ s/(^[ \t]|\"|\n)//g;

					$_ = $MIMEworking[0];
					MIMEWORK: {
						/boundary/i     &&      do      {       $MIMEbound = $MIMEworking[1];
												last MIMEWORK; };
						/charset/i  && do       {       $MIMEchar = $MIMEworking[1];
												last MIMEWORK; };
						/name/i     && do       {       $MIMEname = &mydecode ( $MIMEworking[1] );
												$MIMEname =~ s/[ \t]/_/g;
												last MIMEWORK; };

					}

				}
				# want to have the next line !
				shift @POPinmsg;
				last POPMSG; };
		/^\n/   && do {
				# is it multipart, and do we know how to find the bound ?
				if (($MIMEtype[0] =~ /multipart/i) and ($MIMEbound)) {
						# shift away all preamble
						while ((@POPinmsg) and (not ($POPinmsg[0] =~ /$MIMEbound\n$/))) {
							shift @POPinmsg;
						}
						# shift away the boundary
						shift @POPinmsg;
						# eventually find the begin of the message
						while ((@POPinmsg) and ($POPinmsg[0] =~ /^[\n]/)) {
							shift @POPinmsg;
						}

						while (@POPinmsg) {

							my @POPoutmsg;
							while (@POPinmsg and (not ($POPinmsg[0] =~ /$MIMEbound/i))) {
								push @POPoutmsg, $POPinmsg[0];
								shift @POPinmsg;
							}

							&workmsg ( @POPoutmsg );
							shift @POPinmsg;

						}

				} else {

						# now try to display the stuff ( or put it on the link )
						unless ($MIMEtype[0]) {
							$MIMEtype[0] = "text";
						}
						unless ($MIMEtype[1]) {
							$MIMEtype[1] = "plain";
						}
						if ($MIMEtype[0] =~ /message/i) {
							while ((@POPinmsg) and ($POPinmsg[0] =~ /^\n/)) {
								shift (@POPinmsg);
							}
							&workmsg( @POPinmsg );
						} else {

							while ((@POPinmsg) and ($POPinmsg[0] =~ /^\n/)) {
								shift (@POPinmsg);
							}

							@POPdisplay = @POPinmsg;

							&dispMIME( $MIMEtype[0], $MIMEtype[1], $MIMEchar, $MIMEname, $MIMEencode );
						}
						@POPinmsg = [];
				}
				last POPMSG; };
		# The shift occures, if nothing above is found
		shift @POPinmsg; }
	} # WHILE
}

# SUB:          compute_secure_link
# PARAMETERS:   nothing
# GLOBALS:      $currentInfo
# INITWORK:     nothing
# DESC:         litte sub to return a secure id
# ERRORS:       nothing
# VERSION:      1
sub compute_secure_link {
	# just take the ord of the first value of user and multipy it with a rand
	my $tmplnk = ord ($currentInfo{'USER'} ) *rand();
	$tmplnk =~ s/\.//g;

	return ( $tmplnk );
}

# SUB:          check_secure
# PARAMETERS:   nothing
# GLOBALS:      $currentInfo
# INITWORK:     nothing
# DESC:         litte sub to check a secure ID
# ERRORS:       1
# VERSION:      1
sub check_secure {
  if ($strictsecure) {
	my $tmpret;
	my $tmpinkey = $CGIARG{'KEY'};
	my $tmpuser  = $CGIARG{'USER'};
	my $tmpbox   = $CGIARG{'BOX'};

	if ( open ( SLINK, "$storedir/$tmpuser.$tmpbox/slinks" ) ) {

		# ok, i can open it !!
		(my $tmpkey, my $tmpvalid) = <SLINK>;
		chomp ($tmpkey);
		chomp ($tmpvalid);

		close SLINK;

		# kill everything !
		if (open SLINK, ">$storedir/$tmpuser.$tmpbox/slinks") {
			print SLINK "--\n";
			close SLINK;
			$tmpret = 1;
		} else {
			$tmpret = 0;
		}

		# ++ 17/07 -- fixed problems with valid time
		my $testtime = time - $tmpvalid;
		if (( $testtime > $timevalid ) or ($tmpinkey ne $tmpkey) or ($tmpret eq 0)) {
			$tmpret = 0;
		} else {
			$tmpret = 1;
		}
		# -- 17/07

	} else {
		$tmpret = 0;
	}

	unless ($tmpret) {
		&removePassword;
	}

	return ($tmpret);
  } else {
  	return (1);
  }
}

# SUB:          get_secure_link
# PARAMETERS:   nothing
# GLOBALS:      $currentInfo
# INITWORK:     nothing
# DESC:         litte sub to write and return a secure id
# ERRORS:       ""
# VERSION:      1
sub get_secure_link {

	if ($currentInfo{'DIRECTORY'}) {
		if ( ($CGIDAT::action =~ /logon/i) and (not ($CGIDAT::force eq "ON")) and ( open ( SLINK, "$currentInfo{'DIRECTORY'}/slinks" ) ) ) {
			# ok, i can open it !!
			(my $tmpkey, my $tmpvalid) = <SLINK>;
			close SLINK;
			chomp ($tmpvalid);
			my $testtime = time - $tmpvalid;
			if ( $testtime < $timevalid )  {
				&doError($cfgfiles{'logon_err'}, 13);
				exit 0;
			}
		}

		if (open ( SLINK_OUT, ">$currentInfo{'DIRECTORY'}/slinks" )) {

			my $tmpvalid = time;
			my $tmpkey   = &compute_secure_link;

			my $tmpwrite = "$tmpkey\n$tmpvalid\n";
			print SLINK_OUT $tmpwrite;

			$tmpkey = $CGILink . "?user=" . $currentInfo{'USER'} . "&box=" . $currentInfo{'BOX'} . "&key=" . $tmpkey;
			if ($CGIDAT::lang) {
				$tmpkey .= "&lang=" . $CGIDAT::lang;
			} else {
			if ($CGIARGS{'LANG'}) {
				$tmpkey .= "&lang=" . $CGIARGS{'LANG'};
			}
			}

			close SLINK_OUT;
			return ($tmpkey);
		} else {
			return ("");
		}
	} else {
		return ("");
	}
}

# SUB:          Do_CGI_Work
# PARAMETERS:   nothing
# GLOBALS:      nothing
# INITWORK:     %CGIARG, $cgih, CGIDAT
# DESC:         inits the CGI parameters past to script
# ERRORS:       nothing possible
# RETURN:       nothing
# VERSION:      1
sub Do_CGI_Work {
	$cgih = new CGI;
	$cgih->import_names('CGIDAT');

	$CGIARG{'KEY'}    = $cgih->url_param('key');
	$CGIARG{'USER'}   = $cgih->url_param('user');
	$CGIARG{'USER'}   = $CGIDAT::user unless $CGIARG{'USER'};
	$CGIARG{'BOX'}    = $cgih->url_param('box');
	$CGIARG{'BOX'}    = $CGIDAT::box unless $CGIARG{'BOX'};
	$CGIARG{'ACTION'} = $cgih->url_param('action');
	$CGIARG{'NUM'}    = $cgih->url_param('num');
	$CGIARG{'SORT'}   = $cgih->url_param('sort');
	$CGIARG{'SORTDIR'}= $cgih->url_param('sortdir');
	$CGIARG{'SORTNUM'}= $cgih->url_param('sortnum');
	$CGIARG{'LANG'}=$cgih->url_param('lang');


	my $multcount = 1;
	foreach $multname (sort keys %CGIDAT::) {
		if ($multname =~ /mult/) {
			$multname =~ s/mult//;
			$CGIARG{'MULT'}[$multcount] = $multname;
			$multcount = $multcount + 1;
		}
	}

	if ($CGIDAT::lang || $CGIARG{'LANG'}) {
		$currentInfo{'LANG'} = $CGIDAT::lang if ($CGIDAT::lang);
		$currentInfo{'LANG'} = $CGIARG{'LANG'} unless ($CGIDAT::lang);
	}
}