«11C» upload.pl «PDF», «POD»

#!/usr/bin/perl

use warnings;
use strict;

use constant {
  MAX_SIZE  => 512 * 1024,
  STAMPFILE => "/tmp/klasse11-upload.stamp",
  DELAY     => 60 * 5,
  TO        => 'iblech@web.de',
  SUBJECT   => '[klasse11] Neue Datei: "%s"',
};

use CGI;
use CGI::Carp "fatalsToBrowser";
use MIME::Lite;
use File::Touch;
use POSIX "strftime";
# Maximal erlaubte Dateigröße: 512 KiB
$CGI::POST_MAX = MAX_SIZE;
my $q = CGI->new;


die "Du hast keine Datei oder eine zu große Datei angegeben!\n" unless
  my $fh = $q->upload("file");

my $last = (stat STAMPFILE)[9];
if(defined $last and time - $last <= DELAY) {
  die "Bitte versuche es in einem Moment nochmal (genauer gesagt: Versuche es " . strftime("%c %Z (%z)", localtime($last + DELAY)) . "), der letzte Upload war grade eben, und um Spamming einzuschränken erzwinge ich eine kleine Pause zwischen zwei Uploads.\n";
}
touch STAMPFILE or die "touch(STAMPFILE) schlug fehl: $!\n";


my %info = (
  name      => $q->param("name"),
  from      => $q->param("from"),
  type      => $q->uploadInfo($q->param("file"))->{'Content-Type'},
  host      => $q->remote_host,
  referer   => $q->referer,
  useragent => $q->user_agent,
  date      => strftime("%c %Z", localtime),
);
for($info{name}, $info{from}) {
  $_ = "(undef)" if not defined $_ or length $_ == 0;
  $_ = substr $_, 0, 100;
}
$info{referer} = "(undef)" if not defined $info{referer} or length $info{referer} == 0;
$info{type}    = "text/plain" unless defined $info{type};

my $mail = MIME::Lite->new(
  To      => TO,
  Subject => sprintf(SUBJECT, $info{name}),
  Type    => "multipart/mixed",

  "X-Uploader-Host"       => $info{host},
  "X-Uploader-Name"       => $info{from},
  "X-Uploader-Referer"    => $info{referer},
  "X-Uploader-User-Agent" => $info{useragent},
);

$mail->attach(Type => "TEXT", Data => <<EOM);
Eine Datei wurde hochgeladen.

Dateiinformationen:
Name:       "$info{name}"
Sender:     $info{from}
MIME-Typ:   $info{type}

Uploaderinformationen:
Host:       $info{host}
Referer:    "$info{referer}"
User-Agent: "$info{useragent}"
Datum:      $info{date}

Die Datei befindet sich im Anhang.
EOM

$mail->attach(
  Type        => $info{type},
  Filename    => $info{name},
  Disposition => "attachment",
  Data        => do { local $/; <$fh> }
);

$mail->send;

print $q->header,
      $q->start_html("Danke"),
      $q->h1("Danke"),
      $q->p("Die Datei wurde &uuml;bertragen."),
      $q->end_html;