#!/usr/bin/perl
use CGI::Carp qw(fatalsToBrowser);

# Nutzungsbedingungen:  
#	Lizenz:
#		Stand: 7.09.2001
#
# Durch den Kauf und Einsatz der Software erklären Sie sich mit diesen Lizenzabkommen einverstanden.
#
# Diese Lizenz erlaubt es Ihnen, Newsletter Pro auf einer oder mehrere Webseiten zu benutzen. 
# Für jede installierte Instanz dieses Programms benötigen Sie jeweils nur eine gesamte Lizenz. 
# Jedoch muss die Webseite, auf dem das Script angeboten wird auf ihrem Namen sein.
#
# Als Nutzer des Newsletter Pro können Sie auf eigene Gefahr die Software verändern und/oder auf Ihre 
# Bedürfnisse anpassen. Sie können auch Dritte mit der Anpassung/Veränderung beauftragen. Aus rechtlichen 
# Gründen, ist es nicht gestattet den Link zur Abmeldung zu entfernen, der beim Newsletter zu finden ist.
#
# Die Original-Software oder die angepasste/veränderte Software und Teile derer dürfen nicht weitergegeben 
# oder verkauft oder wiederverkauft werden.
#
# Alle Copyright- und Versions-Hinweise, die im Newsletter Pro oder deren HTML-Seiten verwendet, erstellt 
# und/oder gezeigt werden, dürfen nicht entfernt werden. Diese müssen für Benutzer sichtbar sein und in ungeänderter 
# Form dargestellt werden. Diese Klausel gilt nicht für das Copyright im unteren Bereich in jeder Seite ,ansonsten 
# gilt diese Klausel für alle Copyright- und Versions-Hinweise!
#
# Dieses Lizenzabkommen beruht auf der aktuellen internationalen Gesetzeslage.
#
# Bei einem Verstoß gegen diesen Lizenzvertrag kann durch die Firma Coder-World oder deren Beauftragten die 
# erworbene Lizenz jederzeit zurückgezogen und für nichtig erklärt werden, es werden keinerlei geleisteten 
# Zahlungen für erworbene Lizenzen erstattet.
#
# Newsletter Pro und die dazugehörenden Dateien werden ohne Funktionsgarantie für die im Umfeld verwendete 
# Hardware oder Software verkauft.
#
# Coder-World oder deren Beauftragten sind in keiner Form für Inhalte oder Verfasser verantwortlich, die durch 
# diese Software erstellt wurden.
#
# Das Risiko der Benutzung von Newsletter Pro obliegt dem Lizenznehmer, jegliche Erstattungen im Rechtsfall 
# erstrecken sich maximal auf den Kaufpreis der Lizenz. 
# Eine Lizenz ist zeitlich unbegrenzt nutzbar, im Preis ist grundsätzlich der Zugriff auf alle neuen Versionen 
# für den Zeitraum von mindestens 365 Tagen ab Zahlungseingang enthalten.
#
# Hinweis: Es existieren keine Reseller-, Wiederverkaufs- oder Schüler-/Studenten - Versionen. Nach den 
# Lizenzbedingungen muß der Website-Besitzer die Lizenz selbst kaufen.
#
#
# Autor: Stefan Gipper (Stefanos)
# Webseite: http://www.coder-world.de
# E-Mail: support@coder-world.de
#
$version = "1.02";

if($OS=~/vms/i){
	$CRLF = "\n";
}elsif($OS=~/^MacOS$/i){
	$CRLF = "\n\r";
}else{
	$CRLF = "\015\012";
}

binmode STDIN;
read(STDIN, $Daten, $ENV{'CONTENT_LENGTH'});

if($ENV{'CONTENT_TYPE'} =~ /^(.+)boundary=(.+)$/){
	$boundary = '--'.$2;
	@parts = split(/$boundary/, $Daten);
}else{
	@parts = split(/&/, $Daten);
}
foreach $part (@parts){
	if($boundary){
		($header,$content) = split(/$CRLF$CRLF/, $part, 2);
		($name) = ($header =~ / name="([^"]*?)"/s);
	}else{
		($name,$content) = split(/=/, $part);
	}
	if($content){
		if($header =~ /filename/s && $boundary ne "" && $name =~ /^file-upload-[\d]+$/i){
			($filename) = ($header =~ /; filename="([^"]*?)"/s);
			while ($filename =~ /\\/) { $filename =~ s/^.*\\//; }
			($mimetype) = ($header =~ /Content-Type: (.*)/s);
			$mimetype =~ s/($CRLF.*)//s;

			if($filename){
				$content =~ s/^$CRLF//gs;
				$content =~ s/$CRLF$//gs;
				$FORM{$name} = $content;
				$FILE{$name} = $filename;
				$MIME{$name} = $mimetype;
			}
		}else{
			$name =~ tr/+/ /;
			$name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
			if($name ne "emails"){
				$content =~ tr/+/ /;
			}
			$content =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;

			$content =~ s/$CRLF/\n/g;

			if($FORM{$name}){
				chomp($content);
				$FORM{$name} .= ",$content";
			}else{
				chomp($content);
				$FORM{$name} = $content;
			}
		}
	}
}
foreach $pair (split(/&/, $ENV{QUERY_STRING})){
	($name,$value) = split(/=/, $pair);
	$name =~ tr/+/ /;
	$name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
	$value =~ tr/+/ /;
	$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
	$value =~ s/<!--(.|\n)*-->//g;
	if($INFO{$name}){
		$INFO{$name} .= ",$value";
	}else{
		$INFO{$name} = $value;
	}
}
$action = $INFO{'action'} || $FORM{'action'};
$cgi = "newsletter.cgi\?";

foreach ("/bin/sendmail","/sbin/sendmail","/usr/lib/sendmail","/usr/bin/sendmail","/usr/share/sendmail","/usr/sbin/sendmail","/usr/bin/sendmail.restart","/etc/sendmail.cf","/etc/sendmail.cw","/usr/man/man8/sendmail.8","/var/qmail/bin/qmail-inject"){
	if(-e $_ && -X _){
		$mailprog = $_;
		last;
	}
}
require "templates/standard.org";

if($action eq "subscribe") {&eintragen;}
elsif($action eq "unsubscribe") {&austragen;}
elsif($action =~ /aktiv|archiv/) {&$action;}
elsif($action =~ /admin/) {require "admin.cgi";&$action;}
elsif($action =~ /newsletter/) {&$action;}
&newsletter;

sub newsletter {
	# html-formular (eingabe)
	open(T,"<templates/newsletter.html");
	flock(T,2) if($use_flock);
	$i = join("",<T>);
	flock(T,8) if($use_flock);
	close(T);
	$i =~ s/<_cgi>/$cgi/g;
	$i =~ s/<_url>/$url/g;

	&ausgabe($i);
}

sub eintragen {
	$email = $FORM{'submitemail'};
	if($email =~ /^([a-zA-Z_0-9-\.]+)(\@)([a-zA-Z_0-9-\.]+)(\.)(\w+)$/ && $email ne ""){
		open(F, "<templates/standard.dat");
		flock(F,2) if($use_flock);
		@file = <F>;
		flock(F,8) if($use_flock);
		close(F);

		foreach my $line (@file){
			$line =~ s/[\n\r]//g;
			if(lc($line) eq lc($email)){
				&error("Diese Emailadresse wurde schon eingetragen.");
			}
		}

		open(F, "<templates/standard.not");
		flock(F,2) if($use_flock);
		@not = <F>;
		flock(F,8) if($use_flock);
		close(F);

		foreach my $i (@not){
			$i =~ s/[\n\r]//g;
			if($i =~ /^\*/){
				$stern = 1;
				($vor,$maili) = split(/\@/ , $i);
			}else{
				$stern = 0;
			}

			if(lc($i) eq lc($email)){
				&error("Diese E-Mailadresse wurde gesperrt.");
			}elsif(lc($email) =~ /\@$maili$/i && $stern == 1){
				&error("Diese E-Mailadresse wurde gesperrt.");
			}
		}

		$key = crypt("$email","$cryptkey"); # Key generieren
		$key =~ s/^$cryptkey//isg;

		open(T,"<templates/aktiv.txt");
		flock(T,2) if($use_flock);
		$i = join("",<T>);
		flock(T,8) if($use_flock);
		close(T);
		$i =~ s/<_cgi>/$cgi/g;
		$i =~ s/<_to>/$email/g;
		$i =~ s/<_from>/$webmasteremail/g;
		$i =~ s/<_aktiv>/$url\/newsletter.cgi?email=$email\&key=$key\&action=aktiv/g;

		if($path == 1){
			open (M,"| $mailprog -f $webmasteremail -t");
		}else{
			open (M,"| $mailprog -t");
		}
		print M $i;
		close(M);

		open(T,"<templates/aktiv.html");
		flock(T,2) if($use_flock);
		$line = join("",<T>);
		flock(T,8) if($use_flock);
		close(T);
		$line =~ s/<_email>/$email/g;

		&ausgabe($line);
	}else{
		&error("E-Mailadresse hatte kein \"\@\" oder \".\" enthalten. Normale Emailadressen sehen aus wie name\@domain.de! Tippfehler k&ouml;nnen passieren.");
	}
}

sub aktiv {
	$email = $INFO{'email'};
	$key = $INFO{'key'};

	open(F,"<templates/standard.dat");
	flock(F,2) if($use_flock);
	@file = <F>;
	flock(F,8) if($use_flock);
	close(F);

	foreach my $line (@file){
		$line =~ s/[\n\r]//g;
		if(lc($line) eq lc($email)){
			&error("Diese Emailadresse wurde schon eingetragen.");
		}
	}

	open(F,"<templates/standard.not");
	flock(F,2) if($use_flock);
	@not = <F>;
	flock(F,8) if($use_flock);
	close(F);

	foreach my $i (@not){
		$i =~ s/[\n\r]//g;
		if($i =~ /^\*/){
			$stern = 1;
			($vor,$maili) = split(/\@/ , $i);
		}else{
			$stern = 0;
		}

		if(lc($i) eq lc($email)){
			&error("Diese E-Mailadresse wurde gesperrt.");
		}elsif(lc($email) =~ /\@$maili$/i && $stern == 1){
			&error("Diese E-Mailadresse wurde gesperrt.");
		}
	}

	$keyG = crypt("$email", "$cryptkey");
	$keyG =~ s/^$cryptkey//isg;
	if($keyG ne $key){&error("Key stimmt nicht.");}

	open(F, "+<templates/standard.dat");
	flock(F,2) if($use_flock);
	@file = <F>;
	flock(F,8) if($use_flock);
	seek(F,0,0);
	truncate(F,0);
	print F "$email\n";
	print F @file;
	flock(F,8) if($use_flock);
	close(F);

	if($new == 1){
		open(T,"<templates/admin.txt");
		flock(T,2) if($use_flock);
		$i = join("",<T>);
		flock(T,8) if($use_flock);
		close(T);
		$i =~ s/<_cgi>/$url\/$cgi/g;
		$i =~ s/<_email>/$email/g;

		if($path == 1){
			open (M,"| $mailprog -f $webmasteremail -t");
		}else{
			open (M,"| $mailprog -t");
		}
		print M "To: $webmasteremail\n";
		print M "From: $webmasteremail\n";
		print M "Reply-To: $webmasteremail\n";
		print M $i;
		close(M);
	}

	open(T,"<templates/eintragen.txt");
	flock(T,2) if($use_flock);
	$i = join("",<T>);
	flock(T,8) if($use_flock);
	close(T);
	$i =~ s/<_cgi>/$url\/$cgi/g;
	$i =~ s/<_email>/$email/g;

	if($path == 1){
		open (M,"| $mailprog -f $webmasteremail -t");
	}else{
		open (M,"| $mailprog -t");
	}
	print M "To: $email\n";
	print M "From: $webmasteremail\n";
	print M "Reply-To: $webmasteremail\n";
	print M $i;
	close(M);

	open(F,"+<templates/standard.ip");
	flock(F,2) if($use_flock);
	@ip = <F>;
	seek(F,0,0);
	truncate(F,0);

	($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime;

	$mon_num = $mon+1;
	$hour = "0$hour" if($hour < 10);
	$min = "0$min" if($min < 10);
	$sec = "0$sec" if($sec < 10);
	$year += 1900;
	
	$mon_num = "0$mon_num" if($mon_num < 10);
	$mday = "0$mday" if($mday < 10);

	$thishour = (0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,0) [(localtime)[2]];
	$thismonth = (Januar,Februar,Maerz,April,Mai,Juni,Juli,August,September,Oktober,November,Dezember)[(localtime)[4]];
	$thisday = (Sonntag,Montag,Dienstag,Mittwoch,Donnerstag,Freitag,Samstag)[(localtime)[6]];

	print F "$email\|Angemeldet\|$mday.$mon_num.$year , $hour:$min\|$ENV{'REMOTE_ADDR'}\|\n";
	print F @ip;
	flock(F,8) if($use_flock);
	close(F);

	open(T,"<templates/eintragen2.html");
	flock(T,2) if($use_flock);
	$i = join("",<T>);
	flock(T,8) if($use_flock);
	close(T);
	$i =~ s/<_email>/$email/g;
	&ausgabe($i);
}

sub aktiv2 {
	open(F,"<templates/standard.old");
	flock(F,2) if($use_flock);
	@daten = <F>;
	flock(F,8) if($use_flock);
	close(F);

	open(T,"<templates/archiv2.html");
	flock(T,2) if($use_flock);
	$split = join("",<T>);
	flock(T,8) if($use_flock);
	close(T);

	$daten[0] =~ s/[\n\r]//g;
	($FORM{'empfang'},$html,$FORM{'subject'},$boundary) = split(/\|/,shift(@daten));

	if($html == 1){
		$FORM{'emails'} = join("",@daten);
	}else{
		$FORM{'emails'} = join("",@daten);
		$FORM{'emails'} =~ s/\r//g;
		$FORM{'emails'} =~ s/\n/<br>/g;
	}
	$split =~ s/<_titel>/$FORM{'subject'}/g;
	$split =~ s/<_datum>//g;
	$split =~ s/<_text>/$FORM{'emails'}/g;
	$split =~ s/<_webseite>/$url2/g;

	&ausgabe("$split");
}

sub archiv {
	&error("Falsches Passwort") if($passwort ne $INFO{'pass'} && $INFO{'pass'} ne "");

	open(F,"<templates/standard.archiv");
	flock(F,2) if($use_flock);
	@daten = <F>;
	flock(F,8) if($use_flock);
	close(F);

	open(T,"<templates/archiv.html");
	flock(T,2) if($use_flock);
	($split,$split2,$split3) = split(/<!-- SPLIT -->/,join("",<T>));
	flock(T,8) if($use_flock);
	close(T);

	for($i=0;$i<@daten;$i++){
		$daten[$i] =~ s/[\n\r]//g;
		$plus = $split2;
		($html,$subject,$text,$datum) = split(/\|/,$daten[$i]);
		if($subject){
			$plus =~ s/<_titel>/$subject/g;
		}else{
			$plus =~ s/<_titel>/Kein Titel/g;
		}
		$plus =~ s/<_datum>/$datum/g;
		$plus =~ s/<_i>/$i/g;
		$rest .= $plus;
	}
	$split .= $rest . $split3;
	$split =~ s/<_webseite>/$url2/g;
	$split =~ s/<_pass>/$INFO{'pass'}/g;
	if($INFO{'pass'} eq $passwort){
		$split =~ s/<!--S(.+?)S-->/$1/sg;
	}else{
		$split =~ s/<!--S(.+?)S-->//sg;
	}

	&ausgabe("$split");
}

sub archiv2 {
	&error("Newsletter im Archiv nicht gefunden.") if($INFO{'x'} eq "");
	open(F,"<templates/standard.archiv");
	flock(F,2) if($use_flock);
	@daten = <F>;
	flock(F,8) if($use_flock);
	close(F);

	open(T,"<templates/archiv2.html");
	flock(T,2) if($use_flock);
	$split = join("",<T>);
	flock(T,8) if($use_flock);
	close(T);

	$daten[$INFO{'x'}] =~ s/[\n\r]//g;
	($html,$subject,$text,$datum) = split(/\|/,$daten[$INFO{'x'}]);

	if($html == 1){
		$text =~ s/\[br\]/\n/g;
	}else{
		$text =~ s/\[br\]/<br>/g;
	}
	$split =~ s/<_titel>/$subject/g;
	$split =~ s/<_datum>/$datum/g;
	$split =~ s/<_text>/$text/g;
	$split =~ s/<_webseite>/$url2/g;

	&ausgabe("$split");
}

sub austragen {
	$email = $FORM{'submitemail'} || $INFO{'submitemail'};
	open(F,"<templates/standard.dat");
	flock(F,2) if($use_flock);
	@file = <F>;
	flock(F,8) if($use_flock);
	close(F);

	foreach $line (@file){
		$line =~ s/[\n\r]//g;
		if(lc($line) eq lc($email)){
			$nein = 1;
		}
	}

	if($nein != 1){
		&error("Diese E-Mailadresse ist nicht vorhanden.");
	}

	open(F, ">templates/standard.dat");
	flock(F,2) if($use_flock);
	foreach my $i (@file){
		$i =~ s/[\n\r]//g;
		if(lc($i) ne lc($email)){
			print F "$i\n";
		}
	}
	flock(F,8) if($use_flock);
	close(F);

	open(T,"<templates/austragen.html");
	flock(T,2) if($use_flock);
	$i = join("",<T>);
	flock(T,8) if($use_flock);
	close(T);
	$i =~ s/<_email>/$email/g;

	open(T,"<templates/austragen.txt");
	flock(T,2) if($use_flock);
	$i2 = join("",<T>);
	flock(T,8) if($use_flock);
	close(T);
	$i2 =~ s/<_cgi>/$url\/$cgi/g;
	$i2 =~ s/<_email>/$email/g;

	if($path == 1){
		open (M,"| $mailprog -f $webmasteremail -t");
	}else{
		open (M,"| $mailprog -t");
	}
	print M "To: $email\n";
	print M "From: $webmasteremail\n";
	print M "Reply-To: $webmasteremail\n";
	print M $i2;
	close(M);

	if($newx == 1){
		open(T,"<templates/admin2.txt");
		flock(T,2) if($use_flock);
		$x = join("",<T>);
		flock(T,8) if($use_flock);
		close(T);
		$x =~ s/<_cgi>/$url\/$cgi/g;
		$x =~ s/<_email>/$email/g;

		if($path == 1){
			open (M,"| $mailprog -f $webmasteremail -t");
		}else{
			open (M,"| $mailprog -t");
		}
		print M "To: $webmasteremail\n";
		print M "From: $webmasteremail\n";
		print M "Reply-To: $webmasteremail\n";
		print M $x;
		close(M);
	}

	open(F,"<templates/standard.ip");
	flock(F,2) if($use_flock);
	@ip = <F>;
	flock(F,8) if($use_flock);
	close(F);

	($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime;

	$mon_num = $mon+1;
	$hour = "0$hour" if($hour < 10);
	$min = "0$min" if($min < 10);
	$sec = "0$sec" if($sec < 10);
	$year += 1900;
	
	$mon_num = "0$mon_num" if($mon_num < 10);
	$mday = "0$mday" if($mday < 10);

	$thishour = (0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,0) [(localtime)[2]];
	$thismonth = (Januar,Februar,Maerz,April,Mai,Juni,Juli,August,September,Oktober,November,Dezember)[(localtime)[4]];
	$thisday = (Sonntag,Montag,Dienstag,Mittwoch,Donnerstag,Freitag,Samstag)[(localtime)[6]];

	open(F,">templates/standard.ip");
	flock(F,2) if($use_flock);
	print F "$email\|Abgemeldet\|$mday.$mon_num.$year , $hour:$min\|$ENV{'REMOTE_ADDR'}\|\n";
	print F @ip;
	flock(F,8) if($use_flock);
	close(F);

	&ausgabe($i);
}


#
# Errorseite
#
sub error {
	local($e) = @_;

	open(T,"<templates/error.html");
	flock(T,2) if($use_flock);
	$line = join("",<T>);
	flock(T,8) if($use_flock);
	close(T);
	$line =~ s/<_e>/$e/g;

	&ausgabe($line);
}

sub generate_boundary() {
    my $unique_id = crypt(time(), $webmasteremail) . crypt(time(), $multiemail);
    return "----_=_$unique_id";
}

sub get_mime_type {
    my $filename = shift;

    my %types = (
	'dat' => 'application/octet-stream',
    );
    chomp(my $typ = [split(/\./, $filename)]->[-1]);
    return ( $types{$typ} or 'application/octet-stream');
}

sub base64enc {

    my $mailpipe = shift;
    my $filename = shift;
    
    open(F, "< $filename") or die "Fehler: Konnte $filename nicht oeffnen!";
    my @b64str = ("A".."Z","a".."z","0".."9","+","/");
    my($buflen,$num,$len,$dat,@dat,$a,$b,$c,$d,$e,$f,$g);
    $buflen=300*3;
    $num=0;
    { local $^W = 0;
      while (!eof(F)) {
          $len=read(F, $dat, $buflen);
          @dat=unpack('C*', $dat);
          while (@dat) {
              $a=shift(@dat);
              $b=shift(@dat);
              $c=shift(@dat);
              if ($b eq "") {
                  ($d,$e)=($a>>2, ($a<<4)&0x3f);
                  print $mailpipe "$b64str[$d]$b64str[$e]==";
              } elsif ($c eq "") {
                  ($d,$e,$f)=(($a>>2),
                  ((($a<<4)&0x3f) | $b>>4), ($b<<2)&0x3f);
                  print $mailpipe "$b64str[$d]$b64str[$e]$b64str[$f]=";
              } else {
                  ($d,$e,$f,$g)=
                      ($a>>2,
                       (($a<<4)&0x3f) | $b>>4,
                       ($b<<2)&0x3f | $c>>6,
                       $c&0x3f);
                  print $mailpipe
                    "$b64str[$d]$b64str[$e]$b64str[$f]$b64str[$g]";
              }
              if (++$num==15) {print $mailpipe "\n"; $num=0;}
          }
      }
    }
    print $mailpipe "\n" unless ($num==0);
}

sub ausgabe {
	local($mitte) = @_;
	$mitte =~ s/<_cgi>/$cgi/g;

	BEGIN {
		eval { $died_in_eval = 1; require Compress::Zlib; };
		if ($@) {
			$zlib = 0;
		}else{
			$zlib = 1;
			import Compress::Zlib;
		}
	}

	if($ENV{'HTTP_ACCEPT_ENCODING'} =~ /x-gzip/ && $gzip == 1 && $ENV{'SERVER_PROTOCOL'} eq "HTTP/1.1"){
		print "Content-Encoding: x-gzip\n";
		print "Content-Type: text/html\n\n";
		binmode STDOUT;
		if($zlib){
			my $out = gzopen(\*STDOUT, "wb");
			$out->gzwrite($mitte);
			print $out;
			$out->gzclose;
		}else{
			open(G, "|gzip -c|");
			print G $mitte;
			select(STDOUT);

			print <G>;
			close(G);
		}
	}elsif($ENV{'HTTP_ACCEPT_ENCODING'} =~ /gzip/ && $gzip == 1 && $ENV{'SERVER_PROTOCOL'} eq "HTTP/1.1"){
		print "Content-Encoding: gzip\n";
		print "Content-Type: text/html\n\n";
		binmode STDOUT;
		if($zlib){
			my $out = gzopen(\*STDOUT, "wb");
			$out->gzwrite($mitte);
			print $out;
			$out->gzclose;
		}else{
			open(G, "|gzip -c|");
			print G $mitte;
			select(STDOUT);

			print <G>;
			close(G);
		}
	}else{
		print "Content-Type: text/html\n\n";
		print $mitte;
	}
	exit(0);
}