#!/usr/bin/perl -w
# ----------------------------------------------------------------
# Ein Web-Datei-Austausch
#
# Weitere Informationen siehe unter http://www.schaarwaechter.de/sp/projekte/dateiaustausch.html
#
# Wenn eigenes CSS benutzt wird, lohnt sich ein Blick in die von diesem Programm per Default
# erzeugten Webseiten. Einiges Tags sollten im eigenen CSS nachdefiniert werden.
#
# Ich uebernehme keine Verantwortung fuer Schaeden jedweder Art, die durch die
# direkte oder indirekte Nutzung dieses Programmes entstanden sein koennten.
#
# Dieses Programm wird als freie Software zur Verfuegung gestellt. Es darf
# beliebig veraendert und genutzt werden, ausgenommen ist allerdings die kommerzielle
# Nutzung und mein Name muss im Quelltext und in den html-Ausgaben erhalten bleiben.
# Ich freue mich ueber eine Nachricht an michael@schaarwaechter.de , wenn das Programm
# irgendwo dauerhaft verwendet wird.
#
# Achtung:
# Zugriff auf dieses Programm ohne Upload-Passwortschutz bedeutet, man kann hochladen. Daraus folgt:
# Zugriff auf das Formular muss Passwort-beschraenkt oder versteckt sein!
# Ansonsten gibts ruckzuck ne nette Filmesammlung auf der Platte ;-)
#
# Das Formular, mit dem Dateien hochgeladen werden, kann auch separat
# erzeugt und abgelegt werden. Vorlage: Siehe das von diesem Script
# erzeugte Formular.
#
# Programmhistorie: Siehe http://www.schaarwaechter.de/sp/projekte/dateiaustausch.html
#
use CGI;
use File::Basename;
use DB_File;
use Data::Dumper; # Nur zum Debuggen, kann in Produktion ausgeklammert werden
use Time::Local;
use Sys::Syslog; # Logging in das Syslog.
use Date::Calc qw(:all);
use Email::Valid; # Testet die Emailadresse bei TAN-Erzeugung
use Mail::Mailer; # Schickt die Mails bei TAN-Verwendung
use MIME::Types; # Definiert die Mimetypes beim Runterladen der Dateien
use HTML::Template; # Auslagern von HTML-Texten
&Language(Decode_Language("Deutsch"));
our $mimetypes=MIME::Types->new();
our $version="3.4, 3/2018";
########################---Konfiguration-Anfang---###############################
########################################################
# Hier: Die Konfigurationsoptionen. Alle Variablen aus dem folgenden Konfigurationsblock
# koennen dort neu gesetzt werden.
#
# !!! Die Einstellung in der Datei, sofern vorhanden, hat Vorrang,
# ueberschreibt also die aus dem Programm. !!!
#
# Diese Datei sollte aus Sicherheitsgruenden fuer den Webserverprozess nur Leserechte haben.
# Fehler beim Interpretieren dieser Datei werden in das Systemlog geschrieben.
our $configfile = '/pfad/exchange.conf.pl';
#
#######################################################
# Ab hier werden die Defaults festgelegt. In der Configdatei wird jede Var. erklaert.
# Diese Defaultwerte koennen und sollten bei Verwendung der Configdatei unveraendert bleiben!
our $languagedefault = "de";
our $languagefiles = '/pfad/lang';
our $bruteforceconnects = "50";
our $bruteforcetime = "1";
our $bruteforcetime2wait=15;
our $vscan = "";
our $faviconurl = "https://mein.server.de/favicon.ico";
our $cssurl = "";
our $filelocation = '/pfad/dateitransfer';
our $hashlocation = "$filelocation/files.hash";
our $tanlocation = "$filelocation/tans.hash";
our $statistlocation = "$filelocation/statist.hash";
our $filestatlocation = "$filelocation/filestat.hash";
our $bruteforcelocation ="$filelocation/bruteforce.hash";
our $tanenable = 1;
our $mailfrom = 'noreply@mein.server.de';
our $mailquestions = 'ich@mein.server.de';
our $allownotifyemail = 1;
our $tanlength = 5;
our $tancreatepasswordfile = "$filelocation/tanpassword.txt";
our $maxtanstocreate = 5;
our $tanlivetime = 60;
our $usedtanlivetime = 100;
our $uploadwithpassword = 1;
our $useradius = 1;
our $radiusname2show = "radiusDienst";
our $radiusdomain="mein.server.de";
our $radiusserver="mein.server.de:1812";
our $radiussecret="radiussecret";
our $radiuscommand="/usr/local/bin/radclient";
our @iprange = ("192.168.1","192.169.");
our $passwordfile = "$filelocation/password.txt";
our $passwordinform = "password";
our $nameinform = "putfile";
our $ownurl = "http://mein.server.de/cgi-bin/exchange.pl";
our $downloadurl = $ownurl."?g=";
our $uploadurl = "http://mein.server.de/cgi-bin/exchange.pl";
our $lifetime = 28;
our @lifetimes = (1,2,7,14,28,35,42);
our @dieafteraccesses = (1,2,3,4,5,6,7,8,9);
our $gracetime=0;
our $lifetimeforgottendownloads = 200;
our $statlifetime = 100;
our $maxsize = 309000000;
our $maxstoresize = 8000000000;
our $adminpassword = "langesundkomplexespasswort";
our $syslog = 2;
########################---Konfiguration-Ende---###############################
if ($configfile and -s $configfile) {
unless (my $return = do $configfile) {
&log("Parsing of $configfile failed: $@") if $@;
&log("do of $configfile failed: $!") unless defined $return;
&log("Could not execute $configfile") unless $return;
}
}
our $query = new CGI;
our $t="-#-"; # Achtung: Aendern nur wenn gleichzeitig store geloescht wird!!
our $maxsize2show=int($maxsize / 1024 / 1024);
our $marginleft=q# style="margin-left:3%;"#;
our $marginright=q# style="margin-right:3%;"#;
our $language = $query->param("lang") || $languagedefault ;
# -----------------------------------------------------
sub datum {
my @time;
if ($_[0]) {
@time=localtime($_[0]);
} else {
@time=localtime;
}
my $y=$time[5]+1900;
my $m=$time[4]+1;
my $d=$time[3];
my $hour=$time[2];
my $min=$time[1];
my $sec=$time[0];
$sec="0".$sec if (length($sec)==1);
$min="0".$min if (length($min)==1);
$hour="0".$hour if (length($hour)==1);
$d="0".$d if (length($d)==1);
$m="0".$m if (length($m)==1);
return $d.".".$m.".".$y." ".$hour.":".$min.":$sec";
}
# -----------------------------------
sub log {
my $message=shift;
if ($syslog) {
openlog($0, 'cons,pid', 'user');
syslog('info', $message);
closelog();
}
}
# -----------------------------------
sub starthtml {
print $query->header(-type => 'text/html');
my $template = HTML::Template->new(filename => "$languagefiles/$language/starthtml.tmpl");
$template->param("FAVICONURL" => $faviconurl);
$template->param("CSSURL" => qq##) if ($cssurl);
if ($query->param("help")) {
$template->param("HELPSTART" => "");
} else {
$template->param("HELPURL" => "$ownurl?help=1&lang=$language");
}
print $template->output;
}
# -----------------------------------
sub stophtml {
my $programname=&basename($0);
my $template = HTML::Template->new(filename => "$languagefiles/$language/stophtml.tmpl");
$template->param("VERSION" => "$programname, $version");
print $template->output;
}
# -----------------------------------
sub addfilestat {
my ($id)=@_;
my ($timestamp,$downloads,$timelocal,$filename,$deleteafter,$filetype,$date,$filesize,$remotehost,$useragent)=(" ",0,0," ",0," "," ",0," "," ");
($timelocal,$filename,$deleteafter,$filetype,$date,$filesize,$remotehost,$useragent)=split(/$t/,$filenames{$id}) if ($filenames{$id});
($timestamp,$downloads,$timelocal,$filename,$deleteafter,$filetype,$date,$filesize,$remotehost,$useragent)=
split(/$t/,$filestats{$id}) if ($filestats{$id});
$downloads++;
$filestats{$id}=join($t,&timelocal(localtime),$downloads,$timelocal,$filename,$deleteafter,$filetype,$date,$filesize,$remotehost,$useragent);
}
# -----------------------------------
sub remotehost {
my $erg=$query->remote_host();
if ($erg !~ m/^\d+\.\d+\.\d+\.\d+$/) {
open PIPE,"host $erg|";
my $z=;
chomp $z;
$z=(split(/ /,$z))[3];
$erg=$z if ($z);
close PIPE;
}
return $erg;
}
# -----------------------------------
sub getpassword {
my $passwordfile=shift || $passwordfile; # Wird mitgegeben oder aus der globalen Var genommen
my $password="";
if ($uploadwithpassword) {
if (-s $passwordfile and not -l $passwordfile) {
open (FH,$passwordfile);
$password=;
close FH;
chomp $password;
if (not $password) {
&starthtml;
print qq#Systemfehler: Passwortdatei fehlerhaft!#;
&stophtml;
&log("Password required but password from file is empty!");
exit;
}
} else {
&log("Could not open $passwordfile");
&starthtml;
print qq#Systemfehler: Passwortdatei fehlerhaft!#;
&stophtml;
exit;
}
}
return $password;
}
# -----------------------------------
sub getsizeofstore {
my $erg=0;
foreach $i(keys %filenames) {
my ($timelocal,$filename,$deleteafter,$filetype,$date,$filesize,$remotehost,$useragent) = split(/$t/,$filenames{$i});
$erg+=$filesize;
}
return $erg;
}
# -----------------------------------
sub cleanstore {
# Saeubern des Stores und %filestat von abgelaufenen Dateien
my @jetzt=localtime;
foreach $i(keys %filenames) {
if (-s "$filelocation/$i" and not -l "$filelocation/$i") { # Datei da und kein Link?
my ($timelocal,$filename,$deleteafter,$filetype,$date,$filesize,$remotehost,$useragent) = split(/$t/,$filenames{$i});
if ($deleteafter=~s/^d//) { # Soll die Datei nach x Tagen geloescht werden? Gleichzeitig dann das d raus.
my @eingang=localtime($timelocal);
if (&Delta_Days($eingang[5],$eingang[4]+1,$eingang[3],$jetzt[5],$jetzt[4]+1,$jetzt[3]) > $deleteafter) {
if ($filenames{$i}) { # Ist der Eintrag noch da? Hmm, das ist eigentlich zuviel des Guten.
if (unlink("$filelocation/$i")) { # Hat das Loeschen geklappt?
delete($filenames{$i}); # Eintrag aus Hash loeschen.
&log("$i deleted: Lifetime ended.");
}
}
}
} else { # Datei mit Downloadzaehler. Aber hier auf $lifetimeforgottendownloads und gracetime achten:
if ($deleteafter=~/-/) { # gracetime ist aktiv
my @gracetimedownloadtime=split("-",$deleteafter);
if ( (&timelocal(localtime) - $gracetimedownloadtime[1]) > int($gracetime*60) ) {
if (unlink("$filelocation/$i")) { # Hat das Loeschen geklappt?
delete($filenames{$i}); # Eintrag aus Hash loeschen.
&log("$i deleted: File with downloadcounter=max and gracetime spent $gracetimedownloadtime[1].");
}
}
}
my @eingang=localtime($timelocal);
if (&Delta_Days($eingang[5],$eingang[4]+1,$eingang[3],$jetzt[5],$jetzt[4]+1,$jetzt[3]) > $lifetimeforgottendownloads) {
if ($filenames{$i}) { # Ist der Eintrag noch da? Hmm, das ist eigentlich zuviel des Guten.
if (unlink("$filelocation/$i")) { # Hat das Loeschen geklappt?
delete($filenames{$i}); # Eintrag aus Hash loeschen.
&log("$i deleted: File with downloadcounter but lifetimeforgottendownloads ended.");
}
}
}
}
} else { # Dann ist die Datei weg oder besteht aus einem Link, dann lieber nicht anfassen.
delete($filenames{$i}); # Eintrag aus Hash loeschen.
&log($filenames{$i}. "File not found, therefor hashentry deleted for $i");
}
}
foreach $i(keys %filestats) {
my ($timestamp,$downloads,$timelocal,$filename,$deleteafter,$filetype,$date,$filesize,$remotehost,$useragent)=split(/$t/,$filestats{$i});
my @eingang=localtime($timestamp);
if (&Delta_Days($eingang[5],$eingang[4]+1,$eingang[3],$jetzt[5],$jetzt[4]+1,$jetzt[3]) > $statlifetime) {
delete($filestats{$i});
}
}
foreach $i(keys %tans) {
my ($creationdate,$time2live,$email,$used,$tantype) = split(/$t/,$tans{$i});
if ($used>1000000) { # Benutzte 1mal TAN
my @useddate=localtime($used);
if (&Delta_Days($useddate[5],$useddate[4]+1,$useddate[3],$jetzt[5],$jetzt[4]+1,$jetzt[3]) > $usedtanlivetime) {
delete($tans{$i});
&log("Used TAN ".$i." deleted");
}
} else { # Unbenutzt oder MehrfachTAN
my @eingang=localtime($creationdate);
if ($used >= 0 and $used < 1000000) { # Noch gueltig
if (&Delta_Days($eingang[5],$eingang[4]+1,$eingang[3],$jetzt[5],$jetzt[4]+1,$jetzt[3]) > $time2live) { # Abgelaufen, ungueltig machen
$tans{$i}=$creationdate.$t.$time2live.$t.$email.$t."-1".$t.$tantype;
&log("TAN ".$i." expired");
}
} else { # Bereits abgelaufen
if (&Delta_Days($eingang[5],$eingang[4]+1,$eingang[3],$jetzt[5],$jetzt[4]+1,$jetzt[3]) > $time2live+$usedtanlivetime) {
delete($tans{$i}); # Abgelaufen und maximale Lebenszeit erreicht: Tschuess.
&log("TAN ".$i." deleted.");
}
}
}
}
if ($bruteforceconnects > 0) {
tie our %bruteforce, "DB_File", $bruteforcelocation or die "Could not open $bruteforcelocation: $!";
foreach $i(keys %bruteforce) {
my ($y,$m,$d,$H,$M,$S,$count) = split(/$t/,$bruteforce{$i});
if (&Date_to_Time(&Today_and_Now) - &Date_to_Time($y,$m,$d,$H,$M,$S) > $bruteforcetime*60) {
delete($bruteforce{$i});
}
}
untie %bruteforce;
}
}
# -----------------------------------
sub getid {
my $length=shift || $tanlength;
my @z=("a".."h","k".."n","p".."z","2".."9");
my $p="";
for (my $x=1;$x<($length+1);$x++) {
$p.=$z[int(rand(scalar(@z)))];
}
return $p;
}
# -----------------------------------
sub tan_ok {
my $tan=shift;
my $erg=0;
if ($tans{$tan}) {
my ($creationdate,$time2live,$email,$used,$tantype,$deakt) = split(/$t/,$tans{$tan});
$erg=1 if ($used >=0 and $used<1000000);
$erg=0 if ($deakt);
}
return $erg;
}
# -----------------------------------
sub set_tan_used_and_get_email {
$tan=shift;
my ($creationdate,$time2live,$email,$used,$tantype) = split(/$t/,$tans{$tan});
if ($tantype eq "d") {
$used++
} else {
$used=time
}
$tans{$tan} = $creationdate . $t . $time2live . $t . $email . $t . $used . $t . $tantype;
return $email;
}
# -----------------------------------
sub radiusauthen {
my ($username,$password)=@_;
# use Authen::Radius;
# my $r = new Authen::Radius(Host => $radiusserver, Secret => $radiussecret);
# return 1 if ($r->check_pwd($username,$password));
$password = quotemeta($password);
$username = quotemeta($username);
open PIPE,qq{echo "User-Name=$username", "User-Password=$password" | $radiuscommand $radiusserver auth $radiussecret|};
while (my $z=) {
if ($z=~/code 2,/) {
close PIPE;
&log("Radiusauth successful at $radiusserver for $username");
return 1;
}
}
close PIPE;
&log("Radiusauth _not_ successful at $radiusserver for $username");
return 0;
}
# -----------------------------------
sub upload {
my $template;
if (&getsizeofstore > $maxstoresize) {
&starthtml;
my $template = HTML::Template->new(filename => "$languagefiles/$language/uploadfailure_store.tmpl");
print $template->output;
&stophtml;
&log("Upload failed: Max storesize reached");
exit; # Platte voll: Jetzt machen wir nix mehr...
}
my ($passwordupload,$radiusupload,$tanupload,$iprangeupload)=(0,0,0,0);
if ($uploadwithpassword) {
foreach my $i(@iprange) {
$iprangeupload=1 if(&remotehost=~m/^$i/);
}
$passwordupload=1 if (($query->param("$passwordinform")) and (uc($query->param("$passwordinform")) eq uc(&getpassword)));
$radiusupload=1 if (($useradius and $query->param("radiususer") and $query->param("radiuspassword"))
and ((&radiusauthen($query->param("radiususer"),$query->param("radiuspassword")))));
$tanupload=1 if ($tanenable and $query->param("$passwordinform") and &tan_ok(lc($query->param("$passwordinform"))));
if ( not $passwordupload and not $radiusupload and not $tanupload and not $iprangeupload ) {
&starthtml;
my $template = HTML::Template->new(filename => "$languagefiles/$language/uploadfailure_wrongpw.tmpl");
print $template->output;
&stophtml;
&log("Upload failed: Password needed but wrong password/tan given from ".$query->remote_host());
exit;
}
}
my $file = $query->param($nameinform);
my $fh=$file;
my $filename = $query->uploadInfo($file)->{'Content-Disposition'};
$filename =~ s/^.*?filename="(.*?)"/$1/;
$filename=&basename($filename); # Zur Sicherheit, falls ein Browser einen Pfad mitliefert
&fileparse_set_fstype("MSWin32");
$filename=&basename($filename); # und nochmal fuer Windozeclients
$filename =~ s/$t/__/g; # Unser Trennzeichen hat im Dateinamen nix zu suchen, sonst geht split nicht mehr
my $filetype = $query->uploadInfo($file)->{'Content-Type'};
my $datum=&datum;
my $md5=&getid(); # Es heisst md5, weil es mal ein md5-hash war. Der ist aber viel zu lang.
while ($filestats{$md5} or $filenames{$md5}) {
$md5=&getid();
}
my $fname = $filelocation."/".$md5;
open DAT,'>'.$fname or die 'Error processing file: ',$!;
binmode $fh;
binmode DAT;
my $data;
my $bytesread;
while(my $b=read($fh,$data,1024)) {
$bytesread+=$b;
print DAT $data;
last if ($bytesread > $maxsize);
}
close DAT;
if ($bytesread > $maxsize) {
unlink $filelocation."/".$md5 if ($bytesread > $maxsize);
&starthtml;
$template = HTML::Template->new(filename => "$languagefiles/$language/uploadfailure_toobig.tmpl");
$template->param(MARGINLEFT => $marginleft);
$template->param(MAXSIZE2SHOW => $maxsize2show);
print $template->output;
$statistics{"up-unsuccess"}++;
&log("Upload failed: File exceeds sizelimit per file");
} elsif (not $bytesread) {
&starthtml;
$template = HTML::Template->new(filename => "$languagefiles/$language/uploadfailure_null.tmpl");
$template->param(MARGINLEFT => $marginleft);
print $template->output;
$statistics{"up-unsuccess"}++;
&log("Upload failed: File has zero length");
} else {
if ($vscan) {
$vscan=~s/{}/$fname/g;
&log("Virusscan $vscan") if ($syslog>1);
system("$vscan > /dev/null");
if (not -e $fname) { # Virenscan hat Datei entfernt?!
&log("Upload canceled, virusscan removed file $fname!");
&starthtml;
$template = HTML::Template->new(filename => "$languagefiles/$language/uploadfailure_virus.tmpl");
$template->param(MARGINLEFT => $marginleft);
print $template->output;
&stophtml;
exit;
}
}
$statistics{"up-success"}++;
my $deleteafter=$query->param("deleteafter") || ("d".$lifetime);
$deleteafter=("d".$lifetime) if (not $deleteafter=~m/^(d|a)\d+/); # Wenn nicht d oder a am Anfang und Ziffern, defaultlifetime
# Jetzt pruefen wir, ob jemand das Formular geschummelt hat fuer eine laengere Lifetime. Wenn ja: Defaultlifetime.
$testlifetime=$deleteafter;
$testlifetime=~s/^(d|a)//;
my $found=0;
if ($1 eq "d") {
foreach $i(@lifetimes) {
$found=1 if ($i==$testlifetime);
}
$deleteafter=("d".$lifetime) if (not $found);
&log("Found faked lifetime of $testlifetime days, set to default. From ".$query->remote_host()) if (not $found);
} else {
foreach $i(@dieafteraccesses) {
$found=1 if ($i==$testlifetime);
}
$deleteafter=("d".$lifetime) if (not $found);
&log("Found faked downloadaccesses of $testlifetime downloads, set to default. From ".$query->remote_host()) if (not $found);
}
my $usedtan="";
if (&tan_ok(lc($query->param("$passwordinform")))) { # Es ist eine gueltige TAN
$usedtan=lc($query->param("$passwordinform"));
}
my $email="";
$email=&set_tan_used_and_get_email($usedtan) if ($usedtan);
$usedtan="Radiusauth" if ($radiusupload);
$email=$query->param("radiususer") if ($radiusupload);
$filenames{$md5}=&timelocal(localtime).$t
.$filename.$t
.$deleteafter.$t
.$filetype.$t
.$datum.$t
.$bytesread.$t
.$query->remote_host().$t.$query->user_agent().$t
.$usedtan.$t
.$email;
my $url= $downloadurl.$md5;
&log($md5. " uploaded from ".$query->remote_host());
$deleteafter=~s/(d|a)//;
my $anzeige="";
$anzeige="$deleteafter Tag(e)" if ($1 eq "d");
$anzeige="$deleteafter Download(s)" if ($1 eq "a");
&starthtml;
if ($email and ($usedtan ne "Radiusauth")) {
my $mail=Mail::Mailer->new("sendmail");
$mail->open(
{"From" => $mailfrom,
"To" => $email,
"Subject" => "TAN $usedtan wurde verwendet",
"Precedence" => 'bulk',
"X-Mailrobot" => "SENT BY $0, $version"
}
);
$template = HTML::Template->new(filename => "$languagefiles/$language/email_tanused.tmpl");
$template->param(USEDTAN => $usedtan);
$template->param(OWNURL => "$ownurl");
$template->param(FILENAME => $filename);
$template->param(BYTESREAD => $bytesread);
$template->param(ANZEIGE => $anzeige);
$template->param(URL => $url);
$template->param(MAILQUESTIONS => $mailquestions);
print $mail $template->output;
$mail->close;
&log("TAN-used-email for $md5 sent to $email");
}
my ($notifyemail,$notifyemailtext)=("","");
if ($allownotifyemail and $query->param("notifyemailto")) {
$notifyemail=$query->param("notifyemailto");
if ($notifyemail) {
$notifyemail = Email::Valid->address($notifyemail); # Erster Check erledigt behebbare Fehler
if (not Email::Valid->address(-address=>$notifyemail, -mxcheck=>1)) { # Zweiter Check negativ: Adresse Muell
$template = HTML::Template->new(filename => "$languagefiles/$language/upload_wrongemail.tmpl");
print $template->output;
&stophtml;
&log("Upload failed: Invalid emailaddress from ".$query->remote_host());
exit;
}
}
$notifyemailtext=$query->param("notifyemailtext") || "";
$notifyemailtext=~s/(/isg;
$notifyemailtext=~s/>/)/isg; # Kein html o ae erwuenscht hier
$mail=Mail::Mailer->new("sendmail");
$mail->open(
{"From" => $mailfrom,
"To" => $notifyemail,
"Subject" => "$filename wurde fuer Sie hochgeladen",
"Precedence" => 'bulk',
"X-Mailrobot" => "SENT BY $0, $version"
}
);
$template = HTML::Template->new(filename => "$languagefiles/$language/email_upload.tmpl");
$template->param(OWNURL => "$ownurl");
$template->param(FILENAME => $filename);
$template->param(BYTESREAD => $bytesread);
$template->param(ANZEIGE => $anzeige);
$template->param(URL => $url);
$template->param(MAILQUESTIONS => $mailquestions);
print $mail $template->output;
print $mail $notifyemailtext;
$mail->close;
&log("notify-email for $md5 sent to $notifyemail");
}
my $tmp;
my $notifyemailsent="";
if ($allownotifyemail and ($notifyemail)) {
$tmp=HTML::Template->new(filename => "$languagefiles/$language/upsuccess_emailsent.tmpl");
$tmp->param(NOTIFYEMAILTO => $notifyemail);
$tmp->param(MARGINLEFT => $marginleft);
$tmp->param(NOTIFYEMAILTEXT => $notifyemailtext);
$notifyemailsent=$tmp->output;
}
my $example=&getid;
$template = HTML::Template->new(filename => "$languagefiles/$language/upsuccess.tmpl");
$template->param(FILENAME => $filename);
$template->param(MARGINLEFT => $marginleft);
$template->param(BYTESREAD => $bytesread);
$template->param(ANZEIGE => $anzeige);
$template->param(URL => $url);
$template->param(MD5 => $md5);
$template->param(NOTIFYEMAILSENT => $notifyemailsent);
$template->param(OWNURL => "$ownurl?lang=$language");
print $template->output;
}
&stophtml;
}
# -----------------------------------
sub download {
my $md5=$query->param("g");
$md5=~s/ //g; # Leerzeichen sind doof.
if (($filenames{$md5})) {
my ($timelocal,$filename,$deleteafter,$filetype,$date,$filesize,$remotehost,$useragent,$email) = split(/$t/,$filenames{$md5});
my $mimetype=$mimetypes->mimeTypeOf($filename);
$mimetype="application/octet-stream" if (not $mimetype);
print $query->header(#-type=>$filetype,
#-type=>"application/octet-stream",
-type=>$mimetype,
-charset=>"ISO-8859-15",
-attachment=>$filename,
-"Content-length"=>$filesize,
-"Content-Description"=>$filename
);
open (my $fh,"$filelocation/$md5")
or die "Fehler beim oeffnen von $filelocation/$md5: $!"; # Sicher, weil dieser Name im Hash sein muss. Ansonsten wäre ../ usw möglich.
while(my $b=read($fh,$data,1024)) {
print $data;
}
close $fh;
$statistics{"dn-success"}++;
&log($md5." downloaded from ".$query->remote_host());
&addfilestat($md5);
if (not $deleteafter=~/:/) { # gracetime noch nicht in deleteafter enthalten
if ($deleteafter=~s/^a//) {
(undef,$downloads)= split(/$t/,$filestats{$md5},3);
if ($downloads >= $deleteafter) {
if ($gracetime) { # noch nicht loeschen sondern erst nach $gracetime
$deleteafter="a".$deleteafter."-".&timelocal(localtime); # ergibt zB a2-1427289680 = Zeitpkt letzter Download
$filenames{$md5}=join($t,$timelocal,$filename,$deleteafter,$filetype,$date,$filesize,$remotehost,$useragent,$email);
&log($md5." last download, gracetime of $gracetime from now on.");
} else { # Keine gracetime, sofort loeschen
if (unlink("$filelocation/$md5")) { # Hat das Loeschen geklappt?
delete($filenames{$md5}); # Eintrag aus Hash loeschen.
&log($md5." deleted: Downloadlimit reached.");
}
}
}
}
}
} else {
$statistics{"dn-unsuccess"}++;
my $temp=$query->param("g");
$temp=quotemeta($temp);
&starthtml;
&log("Download but file not found: $temp");
$template = HTML::Template->new(filename => "$languagefiles/$language/downgone.tmpl");
$template->param(TEMP => $temp);
$template->param(MARGINLEFT => $marginleft);
$template->param(LIFETIME => $lifetime);
print $template->output;
&stophtml;
}
}
# -----------------------------------
sub showalltans {
&starthtml;
print qq#
Liste aller TANs
#;
print qq#
TANs haben ein Ablaufdatum, welches wie folgt bestimmt wird:
Gültige TANs werden nach $tanlivetime Tagen nach ihrer Erzeugung ungültig.
Ungültige TANs (sei es, weil sie verwendet wurden oder weil sie abgelaufen sind) werden
nach $usedtanlivetime Tagen aus der Tabelle gelöscht.
TAN können je nach Typ nur einmal verwendet werden (Typ 1) oder beliebig oft bis zum Ablaufdatum (Typ d).
#;
print qq#
TAN
Typ
Erzeugt
Tage Gültigkeit
Ablaufdatum
EMailadresse
Status
Löschdatum
#;
foreach $tan(sort {(split(/$t/,$tans{$b}))[0] <=> (split(/$t/,$tans{$a}))[0]} keys %tans) {
my ($creationdate,$time2live,$email,$used,$tantype,$deakt) = split(/$t/,$tans{$tan});
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)=localtime($creationdate);
$hour="0".$hour if (length($hour)<2);
$min ="0".$min if (length($min )<2);
$creationdate= &Date_to_Text( $year+1900,$mon+1,$mday ).", $hour:$min";
my $ablaufdatum= &Date_to_Text( &Add_Delta_Days( $year+1900,$mon+1,$mday,$time2live ) );
my $loeschdatum;
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)=localtime($used) if ($used>1000);
$hour="0".$hour if (length($hour)<2);
$min ="0".$min if (length($min )<2);
if ($used<1000000) {
$loeschdatum= "spätest. ".&Date_to_Text( &Add_Delta_Days( $year+1900,$mon+1,$mday,$time2live+$usedtanlivetime ) );
} else {
$loeschdatum=&Date_to_Text( &Add_Delta_Days( $year+1900,$mon+1,$mday,$usedtanlivetime ) );
}
$email=$email || " "; # Die 0 will ich nicht sehen
$status=qq#Benutzt: #.&Date_to_Text($year+1900,$mon+1,$mday).", $hour:$min"."" if ($used > 1000000);
$status=qq#Gültig ($used x ben.)# if ($used >= 0 and $used < 1000000);
$status=qq#Abgelaufen # if ($used == -1);
$status=qq#Deaktiviert# if ($deakt);
$time2live="-" if ($used > 1000000);
my $deakttext="Deaktivieren";
$deakttext="Aktivieren" if ($deakt);
print qq#
#;
&stophtml;
}
# -----------------------------------
sub deakttan {
my $tan=shift; my $newdeakt;
if ($tans{$tan}) {
my ($creationdate,$time2live,$email,$used,$tantype,$deakt) = split(/$t/,$tans{$tan});
$newdeakt=1 if (not $deakt);
$newdeakt=0 if ($deakt);
$tans{$tan} = $creationdate .$t. # Erzeugungsdatum
$time2live .$t. # Lebenszeit in Tagen
$email .$t. # Emailadresse fuer Benachrichtigung bei Einloesung
$used .$t. # Einloesedatum oder 0, wenn noch gueltig oder -1, wenn abgelaufen
$tantype .$t. # 1 wenn nur einmal gueltig, d wenn bis Ablaufdatum gueltig
$newdeakt;
}
}
# -----------------------------------
sub admin {
&starthtml;
$statistics{"showlist"}++;
if ($query->param("delete")) {
my $md5=$query->param("delete");
if (($filenames{$md5})) {
if (unlink("$filelocation/$md5")) {
delete($filenames{$md5}); # Eintrag aus Hash loeschen.
print qq#
Löschvorgang von $filelocation/$md5 fehlgeschlagen!
#;
}
} else {
print qq#
ID $md5 ist nicht (mehr) vorhanden! Löschvorgang fehlgeschlagen!
#;
&log("Admin tried to delete $md5 but file not found.");
}
}
my $overallsize=(int((&getsizeofstore/1024/1024)*1000))/1000;
my $showmaxstoresize = (int(($maxstoresize/1024/1024)*1000))/1000;
my $showmaxstoresizeever = (int(($statistics{"maxstoresize"}/1024/1024)*1000))/1000;
my $showmaxsize = (int(($maxsize/1024/1024)*1000))/1000;
my $storeremain=$showmaxstoresize - $overallsize;
my $numberoffiles=scalar(keys %filenames);
my $numberoffilestats=scalar(keys %filestats);
my $numberoftans=scalar(keys %tans);
my $numberofusedtans=0;
my $numberofexpiredtans=0;
foreach $tan(keys %tans) {
my ($creationdate,$time2live,$email,$used) = split(/$t/,$tans{$tan});
$numberofusedtans++ if ($used>1000);
$numberofexpiredtans++ if ($used==-1);
}
my $numberofvalidtans=$numberoftans - ($numberofusedtans+$numberofexpiredtans);
my $uploadwithpasswordtext=qq#Ja: #.&getpassword."";
$uploadwithpasswordtext=qq#Nein# if (not $uploadwithpassword);
my $passwordfile2show="";
$passwordfile2show=qq#
Passwortdatei
$passwordfile
# if ($uploadwithpassword);
my $passwordinform2show="";
$passwordinform2show=qq#
Passwortvariable in Formular
$passwordinform
# if ($uploadwithpassword);
my $tansgeschaltet="nein";
$tansgeschaltet="ja, Länge $tanlength" if ($tanenable);
my $tanlocation2show="";
$tanlocation2show=qq#
Hash mit TANs
$tanlocation
# if ($tanenable);
my $tanpasswordfile2show = "";
$tanpasswordfile2show = qq#
Datei mit TAN-Erzeugungs-pwd
$tancreatepasswordfile
# if ($tanenable);
my $tancreatepassword2show = "";
$tancreatepassword2show = qq#
Tan-Erzeugungspasswort
#.&getpassword($tancreatepasswordfile).
qq#
# if ($tanenable);
my $tanlivetime2show = "";
$tanlivetime2show = qq#
Nicht erfolgr. Dateidownload (ID abgelaufen o.ä.) gesamt
$statistics{"dn-unsuccess"}
Erfolgreicher Dateiupload gesamt
$statistics{"up-success"}
Nicht erfolgr. Dateiupload (Datei zu groß o.ä.) gesamt
$statistics{"up-unsuccess"}
#;
print qq#
#;
my $inhaltopen="";
$inhaltopen="&inhalt=1" if ($query->param("inhalt"));
my $filestatopen="";
$filestatopen="&filestat=1" if ($query->param("filestat"));
my $showmoreinfo="";
$showmoreinfo="&moreinfo=1" if ($query->param("moreinfo"));
if ($query->param("filestat")) {
print qq#
Downloadstatistik der Dateien (auch schon gelöschte), sortiert nach Häufigkeit
#;
}
if ($query->param("inhalt")) {
my $moreinfo=0;
$moreinfo=1 if ($query->param("moreinfo"));
print qq#
Inhalt des Store, sortiert nach Alter
#;
print qq#Diese Tabelle ausblenden #;
print qq#Weniger Informationen # if ($moreinfo);
print qq#Mehr Informationen # if (not $moreinfo);
print qq#Das Löschen passiert sofort und ohne Rückfrage bei Klick auf Löschen!
Einträge mit markierten Resttagen bzw Downloads stehen kurz vor der automatischen Löschung. #;
print qq#
#;
}
&stophtml;
}
# -----------------------------------
sub maske {
my ($template,$tmp1,$tmp2);
my $defaultpw="";
&starthtml;
# Nur zum Debuggen:
#print "
";
$statistics{"menue"}++;
my $deleteafter=qq#\n";
my $radiustext="";
if ($useradius and $uploadwithpassword and (not $defaultpw)) {
$tmp=HTML::Template->new(filename => "$languagefiles/$language/main_radiusdecl.tmpl");
$tmp->param(RADIUSNAME2SHOW => $radiusname2show);
$radiustext=$tmp->output;
}
my $example=&getid;
my $notifyemail="";
if ($allownotifyemail) {
$tmp=HTML::Template->new(filename => "$languagefiles/$language/main_notifyemail.tmpl");
$notifyemail=$tmp->output;
}
$tmp=HTML::Template->new(filename => "$languagefiles/$language/main_pwdesc_1.tmpl") if ($uploadwithpassword);
if ($tanenable) {
$tmp=HTML::Template->new(filename => "$languagefiles/$language/main_pwdesc_2.tmpl");
$tmp->param(OWNURL => "$ownurl");
$tmp->param(LANGUAGE => "$language");
}
my $passworddesc=$tmp->output || "";
my $tanmailerklaerung="";
if ($tanenable) {
$tmp=HTML::Template->new(filename => "$languagefiles/$language/main_tandecl.tmpl");
$tanmailerklaerung=$tmp->output;
}
$template = HTML::Template->new(filename => "$languagefiles/$language/main.tmpl");
$template->param(MARGINLEFT => $marginleft);
$template->param(OWNURL => "$ownurl");
$template->param(PASSWORDDESC => $passworddesc);
$template->param(TANMAILERKLAERUNG => $tanmailerklaerung);
$template->param(PASSWORDTEXT => $passwordtext);
$template->param(NOTIFYEMAIL => $notifyemail);
$template->param(MAXSIZE2SHOW => $maxsize2show);
$template->param(UPLOADURL => $uploadurl);
$template->param(DELETEAFTER => $deleteafter);
$template->param(PASSWORD => $password);
$template->param(RADIUSTEXT => $radiustext);
$template->param(MAXSIZE => $maxsize);
$template->param(EXAMPLE => $example);
print $template->output;
&stophtml;
}
# -----------------------------------
sub tancreate {
my ($template, $tmp1);
&starthtml;
my ($tanpasswordcreate,$tanradiuscreate)=(0,0);
foreach my $i(@iprange) {
$tanpasswordcreate=1 if(&remotehost=~m/^$i/);
}
$tanpasswordcreate=1 if ( uc($query->param("password")) eq uc(&getpassword($tancreatepasswordfile)) );
$tanradiuscreate=1 if (($useradius and $query->param("radiususer") and $query->param("radiuspassword"))
and ((&radiusauthen($query->param("radiususer"),$query->param("radiuspassword")))));
if (not $tanpasswordcreate and not $tanradiuscreate) {
$template = HTML::Template->new(filename => "$languagefiles/$language/tan_wrongpw.tmpl");
print $template->output;
&stophtml;
&log("Tancreation failed: Wrong Password from ".$query->remote_host());
exit;
}
if (not $email) {
if ($query->param("radiususer")=~/\@/) {
$email=$query->param("radiususer") if ($tanradiuscreate);
} else {
$email=$query->param("radiususer")."\@$radiusdomain" if ($tanradiuscreate);
}
}
my $email=$query->param("email") || "";
if ($email) {
$email = Email::Valid->address($email); # Erster Check erledigt behebbare Fehler
if (not Email::Valid->address(-address=>$email, -mxcheck=>1)) { # Zweiter Check negativ: Adresse Muell
$template = HTML::Template->new(filename => "$languagefiles/$language/tan_wrongemail.tmpl");
print $template->output;
&stophtml;
&log("Tancreation failed: Invalid emailaddress from ".$query->remote_host());
exit;
}
}
my $tantype=$query->param("tantype") || "1";
$tantype="1" if ($tantype ne "1" and $tantype ne "d");
my $count=$query->param("count") || 1;
$count=$maxtanstocreate if ($count > $maxtanstocreate);
my $ende=&Date_to_Text_Long(&Add_Delta_Days(&Today,$tanlivetime));
my $jetzt=&Date_to_Text_Long(&Today);
$tmp1 = HTML::Template->new(filename => "$languagefiles/$language/tan_desc_more.tmpl") if ($tantype eq "d");
$tmp1 = HTML::Template->new(filename => "$languagefiles/$language/tan_desc_one.tmpl") if ($tantype eq "1");
my $oneormore=$tmp1->output;
$template = HTML::Template->new(filename => "$languagefiles/$language/tan_desc.tmpl");
$template->param(OWNURL => "$ownurl");
$template->param(COUNT => "$count");
$template->param(ONEORMORE => "$oneormore");
$template->param(JETZT => "$jetzt");
print $template->output;
$time=time;
my @temp;
foreach my $lauf(1..$count) {
my $tan=&getid($tanlength);
while ($tans{$tan}) {
$tan=&getid($tanlength);
}
push @temp,$tan;
$tans{$tan} = $time .$t. # Erzeugungsdatum
$tanlivetime .$t. # Lebenszeit in Tagen
$email .$t. # Emailadresse fuer Benachrichtigung bei Einloesung
0 .$t. # Einloesedatum oder 0, wenn noch gueltig oder -1, wenn abgelaufen
$tantype; # 1 wenn nur einmal gueltig, d wenn bis Ablaufdatum gueltig
print qq#
$lauf
$tan
$ende
$email
#;
}
print qq##;
if ($count > 1) {
$template = HTML::Template->new(filename => "$languagefiles/$language/tan_desc_cup.tmpl");
$template->param(TANS => join(" ",@temp));
print $template->output;
}
&log("Tancreation by ".$query->param("radiususer")." from ".$query->remote_host()) if ($tanradiuscreate);
&log("Tancreation with tanpassword from ".$query->remote_host()) if ($tanpasswordcreate);
&stophtml;
}
# -----------------------------------
sub tancreatemaske {
my ($template,$tmp1,$tmp2);
&starthtml;
my $defaultpw="";
foreach $i(@iprange) {
$defaultpw=&getpassword($tancreatepasswordfile) if(&remotehost=~m/^$i/);
}
my $password;
my $passwordtext;
if ($defaultpw) {
$template = HTML::Template->new(filename => "$languagefiles/$language/tancreate_pwd.tmpl");
# $template->param(DEFAULTPW => $defaultpw);
$password=$template->output;
$template = HTML::Template->new(filename => "$languagefiles/$language/tancreate_pwdtext.tmpl");
$passwordtext=$template->output;
} else {
$template = HTML::Template->new(filename => "$languagefiles/$language/tancreate_nopwd.tmpl");
$password=$template->output;
$template = HTML::Template->new(filename => "$languagefiles/$language/tancreate_nopwdtext.tmpl");
$passwordtext=$template->output;
}
my $radiustext ="";
my $radiusdesc ="";
if ($useradius and $uploadwithpassword and (not $defaultpw)) {
$template = HTML::Template->new(filename => "$languagefiles/$language/tancreate_radiustext.tmpl");
$template->param(RADIUSNAME2SHOW => $radiusname2show);
$radiustext=$template->output;
$template = HTML::Template->new(filename => "$languagefiles/$language/tancreate_radiusdesc.tmpl");
$template->param(RADIUSDOMAIN => $radiusdomain);
$radiusdesc=$template->output;
}
$template = HTML::Template->new(filename => "$languagefiles/$language/tancreate.tmpl");
$template->param(UPLOADURL => $uploadurl);
$template->param(TANLIVETIME => $tanlivetime);
$template->param(RADIUSDESC => $radiusdesc);
$template->param(RADIUSTEXT => $radiustext);
$template->param(PASSWORDTEXT => $passwordtext);
$template->param(MAXTANSTOCREATE => $maxtanstocreate);
$template->param(PASSWORD => $password);
print $template->output;
&stophtml;
}
# -----------------------------------
sub help {
my $template;
&starthtml;
$template = HTML::Template->new(filename => "$languagefiles/$language/help.tmpl");
$template->param(OWNURL => $ownurl);
$template->param(LANGUAGE => $language);
print $template->output;
&stophtml;
}
# -----------------------------------
sub checkforbruteforce {
my $adr=$query->remote_host();
my $snooze=0;
tie our %bruteforce, "DB_File", $bruteforcelocation or die "Could not open $bruteforcelocation: $!";
if (not defined $bruteforce{$adr}) {
$bruteforce{$adr} = join($t,&Today_and_Now).$t.1;
} else {
my ($y,$m,$d,$H,$M,$S,$count) = split(/$t/,$bruteforce{$adr});
$count++;
if ($count >= $bruteforceconnects) {
if (&Date_to_Time(&Today_and_Now) - &Date_to_Time($y,$m,$d,$H,$M,$S) < $bruteforcetime*60) {
$snooze=1;
$bruteforce{$adr} = join($t,&Today_and_Now).$t.$count;
&log("Possible bruteforce from ".$query->remote_host()) if ($syslog>1);
} else {
$bruteforce{$adr} = join($t,&Today_and_Now).$t.1;
}
} else {
$bruteforce{$adr} = join($t,&Today_and_Now).$t.$count;
}
}
untie %bruteforce;
sleep($bruteforcetime2wait) if ($snooze);
}
# -----------------------------------
################ program starts here #############################
&checkforbruteforce if ($bruteforceconnects > 0);
tie our %filenames, "DB_File", $hashlocation or die "Could not open $hashlocation: $!";
tie our %statistics, "DB_File", $statistlocation or die "Could not open $statistlocation: $!";
tie our %filestats, "DB_File", $filestatlocation or die "Could not open $filestatlocation: $!";
if ($tanenable) {
tie our %tans, "DB_File", $tanlocation or die "Could not open $tanlocation: $!";
}
# Falls leer: Init.
$statistics{"menue"}||=0;
$statistics{"showlist"}||=0;
$statistics{"upload"}||=0;
$statistics{"dn-success"}||=0;
$statistics{"dn-unsuccess"}||=0;
$statistics{"up-success"}||=0;
$statistics{"up-unsuccess"}||=0;
$statistics{"maxfiles"}||=0;
$statistics{"maxstoresize"}||=0;
my $temp=&getsizeofstore;
$statistics{"maxstoresize"}=$temp if ($temp > $statistics{"maxstoresize"});
$temp=scalar(keys %filenames);
$statistics{"maxfiles"}=$temp if ($temp > $statistics{"maxfiles"});
&cleanstore;
if ($query->param($nameinform)) { # Upload
&log("Upload called from ".$query->remote_host()) if ($syslog>1);
&upload;
} elsif ($query->param("g")) { # Download
&log("Download called from ".$query->remote_host()) if ($syslog>1);
&download;
} elsif ($query->param("help")) { # Hilfeseite
&log("Help called from ".$query->remote_host()) if ($syslog>1);
&help;
} elsif ($query->param("admin") and $query->param("admin") eq $adminpassword) { # Adminschnittstelle
if ($query->param("showalltans")) {
&log("Admin showalltans called from ".$query->remote_host()) if ($syslog>1);
&showalltans;
} elsif ($query->param("deakttan")) {
&log("Admin (de)akttan ".$query->param("deakttan")." called from ".$query->remote_host()) if ($syslog>1);
&deakttan($query->param("deakttan"));
&showalltans;
} else {
&log("Admin called from ".$query->remote_host()) if ($syslog>1);
&admin;
}
} elsif ($query->param("tans") and $tanenable) { # Tans erzeugen
my $iprangeok=0;
if ($query->param("iprange")) {
foreach my $i(@iprange) {
$iprangeok=1 if(&remotehost=~m/^$i/);
}
}
if ($iprangeok
or ($useradius and $query->param("radiususer") and $query->param("radiuspassword"))
or ($query->param("password"))) {
# radiusauth oder iprange oder password dabei: Tans sollen erzeugt werden
&log("Tancreation called from ".$query->remote_host()) if ($syslog>1);
&tancreate($query->param("count")||"1");
} else { # Passwort nicht dabei: TAN-Maske zeigen
&log("Tancreationform called from ".$query->remote_host()) if ($syslog>1);
&tancreatemaske;
}
} else { # Kein Parameter?
&log("Form called from ".$query->remote_host()) if ($syslog>1);
&maske;
}
untie %filenames;
untie %statistics;
untie %filestats;
untie %tans;