Formmail-Skript

[Erwin]

Hallo,

Gibt es ein idiotensicheres formmail skript? Ich versuche mich

su, Erwin

=cut
#!/usr/bin/perl

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

Konfiguration des Scripts

eMail - Adresse Empfaenger, bitte einfache Hochkomma

$to = '[e-mail]';

Bestaetigungsseite

$confirm = 'http://home.vr-web.de/~rolfrost/confirm.html';
###########################################################################

Optionale Konfiguration

Postausgangsserver, Hostname eines Rechners mit sendmail, postfix o.ae.

Normalerweise ist das der localhost und muss nicht geaendet werden

$host = 'localhost';

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

Ende der Konfiguration

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

use strict;
use vars qw($to $host $confirm);
use subs qw(compute abbruch);
use CGI 'param';
use Net::SMTP;

compute;

exit;
###########################################################################

Funktionen

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

SMTP_Mail senden

sub mail{
 # needs 5 or 6 arguments
 my ($smtp_host, $rcpt, $subject, $msg, $abs_email, $abs_name) = @_;
 my $from = ();

if($abs_name){ $from = "$abs_name <$abs_email>" }
 else{ $from = "<$abs_email>"}

# Neues Objekt erstellen
 my $s = new Net::SMTP($smtp_host);

# format the message
 my $message = <<"--MSG";
From: $from
To: <$rcpt>
Subject: $subject

$msg

--MSG

# Ab geht die Post        # dem SMTP Protocol entsprechendes Kommando
 $s->mail($abs_email);  # mail from:roro@local
 $s->to( $rcpt );       # rcpt to:otto@local
 $s->data( $message );  # data: eintippen der message, abschluss mit einem Punkt
 $s->quit();            # quit
 return 1;
}
###########################################################################

Die Abbruchfunktion

sub abbruch{
 print "Content-type: text/html\n\n";
 print qq(
  <h1>$_[0]</h1>
  <p>
  $_[1]
 );
 exit;
}
###########################################################################

Die Hauptfunkion, es werden Pruefungen gemacht:

1. Wurden die richtigen Feldnamen verwendet?

2. Ist der angegebene Postausgangsserver verfuegbar (port 25 offen)?

3. Ist jedes Eingabefeld ausgefuellt?

sub compute{
 # Kontrolle der verwendeten Paramaternamen, diese Namen muss es geben
 my %control = (
  'from', 1,
  'name', 1,
  'subject',1,
  'text',1,
 );
 my @names = param;
 my $names = join "<br>", @names;
 foreach my $name(@names){
  if(not $control{$name}){
   abbruch("Konfigurationsfehler","Falscher oder fehlender Parameter, bitte die Feldnamen from, name, subject und text verwenden, siehe Beschreibung im Script. Verwendet wurden die Feldnamen:<p>$names ");
  }
 }

# Testen des Postausgangsservers auf Port 25
 my $client_sock = new IO::Socket::INET (
  PeerAddr => $host,
  PeerPort => 25,
  Proto    => 'tcp') or abbruch "Konfiguration oder Socketfehler","Der eingetragene Postausgangsserver $host ist an Port 25 nicht offen";
 $client_sock->close();

# Nun die Parameter einlesen
 my $from = param 'from' or abbruch "Fehleingabe","eMail ist erforderlich, Backbutton...";
 my $name = param 'name' or abbruch "Fehleingabe","Name ist erforderlich, Backbutton...";
 my $subject = param 'subject' or abbruch "Fehleingabe","Betreff ist erforderlich, Backbutton...";
 my $text = param 'text' or abbruch "Fehleingabe","Text ist erforderlich, Backbutton...";

# Mail wird nun gesendet
 mail($host,$to,$subject,$text,$from,$name) or abbruch "Fehler","Die Mail wurde nicht gesendet, moeglicherweise steht das Modul Net::SMTP nicht zur Verfuegung oder es wurde ein nicht funktionaler Postausgangsserver eingetragen.";

# Umleitung zu Bestaetigung
 redir($confirm);
}

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

entfernt Leerzeichen am Anfang und am Ende eines Strings

Auch Tabulatoren

sub trim{
 my $s = shift;
 $s =~ s/^\s+|\s+$//g;
 return $s;
}

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

Redirection

sub redir{
        my $url = shift;
        print "Status: 302 Moved\n";
        print "location: $url\n\n";
}
###########################################################################