![]() |
Grundlagen CGI-Programmierung mit Perlvon Prof. Jürgen Plate |
$|=1;
Kontrollieren Sie auch den Pfad auf die Perl-Installation (#!/usr/bin/perl) der ersten Zeile der Programme. Passen Sie diesen gegebenenfalls an.
if ($ENV{'REQUEST_METHOD'} eq "GET") { $buffer = $ENV{'QUERY_STRING'}; }
else { read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'}); }
@nvpairs = split(/&/,$buffer);
foreach $pair (@nvpairs)
{
($name, $value) = split(/=/, $pair);
$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$in{$name} = $value;
}
Durch die Speicherung der Werte in einem assoziativen Array kann der Programmierer
den Zugriff auf die einzelnen Werte flexibel handhaben. Beim Zugriff auf ein Feld
mit dem Namen "Text" wird im Code mit $in{'Text'} darauf zugegriffen.
#!/usr/bin/perl
# Perl-Programm zum Bearbeiten von HTML-Formularen
# Verarbeitet GET und POST
# Hash for Form Data
my %entries = ();
my $key;
&InsertHeader("CGI generated text");
%entries = &Parse;
foreach $key (keys %entries)
{
print "entry\{\"$key\"\} = $entries{$key}<BR>\n";
}
&InsertTrailer;
# Unterprogramme
sub Parse
{
my (@pairs, $pair, $value, $name, $in, %entry);
if ($ENV{'REQUEST_METHOD'} eq "GET")
{ $in = $ENV{'QUERY_STRING'}; }
elsif ($ENV{'REQUEST_METHOD'} eq "POST")
{ read(STDIN, $in, $ENV{'CONTENT_LENGTH'}+1); }
@pairs = split(/&/, $in);
foreach $pair (@pairs)
{
# do the special character conversion (%xx)
$pair =~ tr/+/ /;
$pair =~ s/%([0-9a-fA-F][0-9a-fA-F])/pack("C",hex($1))/ge;
# prevent from SSI
$pair =~ s/<!--(.|\n)*-->//g;
($name, $value) = split(/=/, $pair);
if (defined($entry{$name}))
{ $entry{$name} .= ":" . $value; }
else
{ $entry{$name} = $value; }
}
return %entry;
}
sub InsertHeader
{
my ($htmltitle) = @_;
print "Content-type: text/html\n\n";
print "<HTML>\n<HEAD>\n";
print "<TITLE> $htmltitle </TITLE>\n</HEAD>\n";
print "<BODY>\n";
}
sub InsertTrailer
{
print "</BODY>\n</HTML>\n";
}
Zum Testen kann man das CGI-Script vom Browser aus in der URL-Zeile mit
http://host.domain/cgi-bin/test.cgi?name1=wert1&name2=wert2 ...aufrufen.
Ein weiteres Beispiel, das auch zum Testen verwendet werden kann ist das folgende Script, das alle Umgebungsvariablen ausgibt:
#!/usr/bin/perl
print "Content-type: text/html\n\n";
print "<h1>ENVIRONMENT</h1>\n";
foreach (keys %ENV)
{
print "<B>$_</B> = $ENV{$_}<br>\n";
}
<form method="get" action="/cgi-bin/mailme.cgi"> Absender-EMail-Adresse: <input type="text" name="mailadresse" size=30> <p> <input type="reset" value="Reset"> <input type="submit" value="Send"> </form>
An die angegeben Mailadresse werden dann die Infos geschickt, die als sogenanntes "Hier-Dokument" in das Programm eingebettet. Alternativ könnte man die Information auch aus einer Datei lesen.
Das Script selbst filtert aus der angegebenen Mailadresse alle "bösen" Zeichen heraus, damit kein Unheil angerichtet werden kann. Bei UNIX lassen sich mehrere Kommandos durch Strichpunkt getrennt oder als Pipe hintereinanderhängen. Das Perl-Skript nimmt eine Mailadresse entgegen und erzeugt daraus eine Kommandozeile:
/bin/mail user@domainWenn der Benutzer beim Ausfüllen des Formulars statt einer Mailadresse beispielsweise die Zeichenkette "user@domain; cd / ; rm -rf *" eingibt, resultiert das in der Kommandofolge:
/bin/mail user@domain; cd / ; rm -rf *Auch wenn der Webserver und damit das Script mit relativ geringen Benutzerrechten läuft, kann doch einiges gelöscht werden.
#!/usr/bin/perl
my %entry = ();
&InsertHeader("CGI generated text");
%entry = &Parse; # sub Parse siehe oben
# Hackversuche verhindern
# ';' und '|' durch Leerzeichen ersetzen
$entry{'mailadresse'} =~ s/\;/ /ge;
$entry{'mailadresse'} =~ s/\|/ /ge;
# Nur die Zeichenkette bis zum ersten Leerzeichen nehmen
($entry{'mailadresse'}, @dummy) = split(/ /, $entry{'mailadresse'});
# Nur einen Klammeraffen zulassen
($nx, $na, @dummy ) = split(/@/, $entry{'mailadresse'});
$entry{'mailadresse'} = $nx . "@" . $na;
# Mail versenden
open(MAIL, "| /bin/mail $entry{'mailadresse'}");
print MAIL<<END_OF_PRINT;
Hier kommt die Mail-Nachricht
END_OF_PRINT
close(MAIL);
print "Mail abgeschickt!<br>"
&InsertTrailer;

Das zugehörige Perl-Skript sehen Sie unten. Zur Verwendung sind die folgenden Einstellung nötig:
$url = $ENV{'HTTP_REFERER'};
#!/usr/bin/perl
# Diese Variablen muessen Sie anpassen
$mailer = "/usr/lib/sendmail -t -n"; # Name und Pfad des Mailers
$webmaster = "webmaster\@host.domain"; # Mailadresse des Webmasters
$url = "/index.html"; # Return-Pfad
# ab hier kann alles bleiben
my %FORM = ();
# Formulardaten parsen
%FORM = &Parse;
&InsertHeader("Mailer-Antwort");
# Senden E-Mail
if ($FORM{'brief'} ne '')
{
open(FILE, "| $mailer");
# Mail-Header schreiben (Leerzeile nach dem Header)
print FILE "From: $FORM{'email'}\n";
print FILE "To: $webmaster\n";
print FILE "X-Remote-Host: $ENV('REMOTE_ADDR')\n\n";
# Mail-Body schreiben
print FILE "$FORM{'brief'}\n" ;
close (FILE);
print "Ihr Brief wurde gesendet!\n";
}
else
{
print "Fehler: leere Mitteilung <b>nicht</b> abgesendet!\n";
}
print "<a href=\"$url\">Zurück</a>\n";
&InsertTrailer;
Umgekehrt kann es auch vorkommen, daß in einem Formular eine Datei angefordert wird, die dann per Mail geschickt werden soll. Bei Textdateien ist das nicht weiter kompliziert. Bei Binärdateien wird es schon schwieriger, denn die müssen als Attachment verschickt werden. Das Programm muß also:
Das folgende Programm ist kein CGI-Skript, sondern erwartet als Parameter den Dateinamen und die E-Mail-Adresse des Empfängers, läßt sich aber sehr schnell in ein CGI-Script einbinden.
#!/usr/bin/perl
#
# Automatisches Versenden einer E-Mail
# Programmaufruf:
# send.pl <Datei> <Empfaenger>
#
use strict;
# Folgende Variablen muessen vor Inbetriebnahme konfiguriert werden:
# ---------------------------------------------------------------------
# Pfad zum sendmail-Programm
my $MailProgram = '/usr/lib/sendmail -t';
# Absender der Automatik-Mail
#my $Mailfrom = 'automat@host.domain';
my $Mailfrom = 'plate@netzmafia.de';
# Betreff der E-Mail
my $Subject = 'Automatische E-Mail';
# Klartext-Nachricht
my $Message = "Dies ist eine automatisch generierte E-Mail\n";
$Message .= "mit einem Attachment.";
# ---------------------------------------------------------------------
############## AB HIER MUSS NICHTS MEHR GEAENDERT WERDEN ##############
my $Mailto = ''; # Empfaenger der E-Mail
my $file = ''; # zu sendende Datei
my $ext = ''; # Datei-Extension
my $fext = ''; # MIME-Typ dazu
my $buf = ''; # Dateipuffer
my $boundary = ''; # Mime-Begrenzer
die "Dateiangabe fehlt!" if ($ARGV[0] eq '');
die "Empfaengerangabe fehlt!" if ($ARGV[1] eq '');
$file = $ARGV[0];
$Mailto = $ARGV[1];
my @BoundaryChars = (0..9, 'A'..'F'); # Zeichen fuer Begrenzer
my %mime = # Mime-Typen
(
#-------------------------------------<TEXT>-----
'HTML', "text/html",
'HTM', "text/html",
'STM', "text/html",
'SHTML', "text/html",
.
. # Liste gekuerzt, das vollstaendige
. # Programm finden Sie in den >Beispielen.
.
'SVR', "x-world/x-svr",
'WRL', "x-world/x-vrml",
'VRML', "x-world/x-vrml",
'VRJ', "x-world/x-vrt",
'VRJT', "x-world/x-vrt",
);
# Begrenzer basteln
srand($$);
for (my $i = 0; $i++ < 24;)
{
$boundary .= $BoundaryChars[rand(@BoundaryChars)];
}
$boundary = "Next_Part_" . $boundary;
#--------------------------------------------------- Send attatchments etc...
open MAIL, "| $MailProgram" || die "Cannot open $MailProgram";
print MAIL "To: $Mailto\n";
print MAIL "From: $Mailfrom\n";
print MAIL "X-Mailer: Fax-to-Mail-Gateway\n";
print MAIL "MIME-Version: 1.0\n";
print MAIL "Subject: $Subject\n";
print MAIL "Content-Type: multipart/mixed; boundary=\"$boundary\"\n";
print MAIL "\n";
print MAIL "This is a multi-part message in MIME format.\n";
print MAIL "--$boundary\n";
print MAIL "Content-Type: text/plain; charset=\"iso-8859-1\"\n";
print MAIL "Content-Transfer-Encoding: 8bit\n\n";
print MAIL "\n\n$Message\n";
# Attachment anhaengen
($ext) = $file =~ m/\.([^\.]*)$/;
$ext =~ tr/a-z/A-Z/;
$fext = $mime{$ext};
if ($fext && $fext =~ /^text/)
{
print MAIL "--$boundary\n";
print MAIL "Content-Type: $fext; charset=\"iso-8859-1\"; name=\"$file\"\n";
print MAIL "Content-Transfer-Encoding: 8bit\n";
print MAIL "Content-Disposition: attachment; filename=\"$file\"\n\n";
open INPUT, "$file";
print MAIL while (<INPUT>);
close INPUT;
}
else
{
print MAIL "--$boundary\n";
print MAIL "Content-Type: $fext; name=\"$file\"\n";
print MAIL "Content-Transfer-Encoding: base64\n";
print MAIL "Content-Disposition: attachment; filename=\"$file\"\n\n";
open INPUT, "$file" || die "Cannot open [$file].";
binmode INPUT;
while(read(INPUT, $buf, 60*57))
{
print MAIL &encode_base64($buf);
}
close INPUT;
}
# Attachment Ende
print MAIL "\n--$boundary--\n";
print MAIL "\n";
close MAIL;
sub encode_base64
{
my $res = '';
my $eol = "\n";
my $padding;
while (($_[0] =~ /(.{1,45})/gs))
{
$res .= substr(pack('u', $1), 1);
chop $res;
}
$res =~ tr|` -_|AA-Za-z0-9+/|; # translate from uuencode to base64
$padding = (3 - length($_[0]) % 3) % 3; # fix padding at the end
$res =~ s/.{$padding}$/'=' x $padding/e if $padding; # Fix the end padding
$res =~ s/(.{1,76})/$1$eol/g if (length $eol); # lines of at least 76 characters
return $res;
}
Natürlich gibt es dafür auch Perl-Module, die einem das Leben erleichtern. Sowohl zum Erstellen von MIME-Mails mit PERL als auch zum Parsen von MIME mit PERL gibt es Module, die das Schreiben von Programmen erleichtern. Die MIME-Tools (http://www.zeegee.com/ ermöglichen das Parsen und Erstellen von MIME-Nachrichten.
MIME::Lite ist das Modul schlechthin zum Erstellen von MIME-Mails, also ein idealer Ersatz für das Beispiel oben. Mit den Methoden in MIME::Lite wird das Erstellen vom Mails mit Attachment zum Kinderspiel, die Mail läßt sich einschließlich Header komplett zusammenstellen und wird dann einfach an den MTA (sendmail) übergeben.
Beispiel 1: Ein Bild verschicken auf einfachste Art und Weise
#!/usr/bin/perl -w
use strict;
use MIME::Lite;
my $msg = MIME::Lite->new(
From =>'jack@daniels.org',
To =>'johnny@walker.org',
Subject =>'Look at this',
Type =>'image/gif',
Encoding =>'base64',
Path =>'schweinebild.gif'
);
$msg->send();
Beispiel 2: Datei per Mail versenden - etwas komfortabler.
Mit Begleittext; der Dateiname wird per
Kommandozeile übergeben:
#!/usr/bin/perl
use MIME::Lite;
use strict;
if (@ARGV !=1 ) {die "usage: mailit.pl file\n" }
# Pfad vom Dateinamen abtrennen
my $dateiname=$ARGV[0];
$dateiname =~ s|^.*/||;
# Text der Mail
my $text=qq~
Dieses ist eine automatisch erstellte Mail und deshalb
nicht sehr persoenlich ;-)
Im Anhang finden Sie die Datei $dateiname.
Viele Gruesse
Johnny
~;
my $msg = MIME::Lite->new(
From => 'johnny@walker.org',
To => 'jim@beam.de',
Subject => "Datei: $dateiname",
Type => "TEXT",
Data => $text );
$msg->attach( # include binary
Type => 'octet/stream', # binary type
Path => $ARGV[0], # source file
Encoding => 'base64', # encoding scheme
Filename => $dateiname ); # name after arrival
$msg->send(); # send with sendmail
# $msg->send('smtp','mailhost',Timeout=>60); # or via smtp
Falls es sich um eine Multipart/Alternative-Nachricht handelt, enthält das zurückgegebene Entity-Objekt weitere Entity-Objekte, die ihrerseits Head- und Body-Objekte enthalten; das Ganze kann also durchaus rekursiv sein. Eine kleine Auswahl aus der Vielzahl der Methoden:
| read [INSTREAM] |
Diese Methode liest einen MIME-Stream und parst bzw. splittet
diesen in seine einzelnen Bestandteile auf. Sie liefert ein
MIME-Entity-Objekt zurück.
$infile = 'testmail'; $parser = MIME::Parser->new(); open(INPUTSTREAM,"<$infile") or die $!; $entity = $parser->read(\*INPUTSTREAM); |
| parse_data [SKALAR VARIABLE] |
Falls sich eine einzelne vollständige Nachricht bereits in einer Variablen befindet,
bietet sich parse_data() an. Sie liefert ein MIME-Entity-Objekt zurück.
$entity = $parser->parse_data($message); # oder $entity = $parser->parse_data(\@message); |
| dump_skeleton | Dies ist eine Debugging Methode. Sie druckt die Struktur der MIME-Nachricht aus. |
| output_to_core |
Diese Methode legt fest, ob die Attachments im Speicher (core) oder
auf der Festplatte gespeichert werden sollen.
# Keine Dateien auf der Platte speichern
# Alle Daten müssen in den Hauptspeicher passen
$parser->output_to_core('ALL');
# Alle Daten werden auf der Festplatte zwischengelagert
$parser->output_to_core();
# Alles was grösser als 20000 Byte ist, wird auf der Festplatte zwischengelagert
$parser->output_to_core(20000);
Falls die Dateien auf der Platte gespeichert werden, werden Dateien mit
identischen Dateinamen überschrieben. |
| output_dir | Legt das Verzeichnis fest, in dem die geparsten Dateien (Attachments) gespeichert werden sollen, falls die Dateien auf der Platte zwischengespeichert werden sollen. |
| purge | Löscht die geparsten (temporären) Dateien (Attachments) auf der Festplatte. |
| print_header() |
Gibt den kompletten Header der Entity aus.
$entity->print_header(\*STDOUT); |
| print_body |
Gibt den kompletten Body einschliesslich aller
Teile (weitere Entities) kodiert aus.
$entity->print_body(\*STDOUT); |
| parts() |
Liefert die Anzahl der Entities zurück.
$num_parts = $entity->parts; print "Anzahl MIME-Parts: $num_parts\n"; |
| head() |
Gibt das aktuelle MIME::Head-Objekt zurück.
$head = $entity->head(); |
| bodyhandle() |
Gibt das aktuelle MIME::Body-Objekt zurück.
$body = $entity->bodyhandle();Multipart/Alternative-Nachrichten sind keine Body-Objekte, sondern eigenständige Entity-Objekte. |
| decode() |
Geht durch alle Header-Felder und decodiert diese.
|
| unfold() [FIELD] | Entfernt alle Newlines im angegeben Header-Feld. Wenn kein Feld spezifiziert wird, werden alle Header-Felder behandelt. |
| mime_type() |
Ermittelt den MIME-Type.
Wenn kein MIME-Type ermittelt werden kann, wird
'text/plain' zurückgeben.
print "MIME-Type: ", head->mime_type() , "\n"; |
| mime_encoding() |
Versucht die Kodiermethode zu ermitteln.
Wenn keine Methode ermittelt werden kann, wird '7-bit' zurückgegeben.
print "Encoding: ", $head->mime_encoding() , "\n"; |
| mime_attr() [FIELD] |
Setzt bzw. holt die Werte des MIME-Header-Felds.
# Set
$head->mime_attr("content-type" => "text/html");
# Get
print "Content-type: ", $head->mime_attr('content-type'), "\n";
|
| recommended_filename() | Liefert den empfohlenen Dateinamen für das Attachment oder 'undef' zurück. |
| get FIELD, INDEX |
Ermittelt den Inhalt des Feldes.
print "Subject: ", $head->get('Subject'), "\n";
Falls ein Field mehrfach auftauchen kann, z.B "Received", können Sie über den
Index darauf zugreifen. Falls kein INDEX angegeben wird, wird im skalaren Kontext
das erste Auftauchen des Feldes gewählt.
print "Erster Mail-Router: ", $head->get('received', 0), "\n";
print "Letzter Mail-Router: ", $head->get('received',-1), "\n";
Falls kein INDEX angegeben wird, werden in einem Listen-Kontext
alle Vorkommen des Feldes gewählt.
@all_received = $head->get('Received');
|
| count FIELD |
Zählt die Anzahl der Vorkommen von FIELD.
$hops = $head->count('Received');
Sie können diese Methode zum Testen auf das Vorkommen eines Feldes verwenden:
if ($head->count('Subject')) {
print "Subject: ", $head->get('Subject');
}
|
| path() |
Liefert den Pfad zu der externen Datei zurück, in der das aktuelle
Attachment gespeichert ist.
if (defined($body->path)) { # data is on disk:
print "Data is stored on Disk: ", $body->path() , "\n";
}
else {
print "Data is stored in Core\n";
} ## if else
|
| print(FILEHANDLE) |
Gibt den Body auf as angebene Dateihandle aus. Falls kein Handle
spezifiziert wird, wird das zuletzt gewählte Dateihandle verwendet.
$body->print(\*STDOUT); |
| as_string |
Gibt die Daten des Bodies als einen String zurück. Der Body wird vollständig
in den Speicher gelesen. Die Daten werden nicht kodiert, d.h. falls es
sich um ein z.B. um ein Bild handelt, werden die binären Daten ausgegeben.
Falls es sich um einen leeren Body handelt, wird ein leerer String
zurückgegeben und 'undef' im Misserfolgsfall.
$string = $body->as_string; # oder open(FH,">Datei") or die $!; print FH $body->as_string(); close(FH) or die $!;Diese Methode verwendet intern die Methode print(). Ihre Subklasse kann dieses Verhalten überschreiben. |
| as_lines |
Gibt die Daten des Bodies als einen Array von Zeilen zurück.
Die Zeilen werden durch Newlines getrennt. Es ist möglich, daß das Newline-Zeichen
für die letzte Zeile fehlt. Diese Methode gibt im Misserfolgsfall und bei einem
leeren Body eine leere Liste zurück. Die Daten werden nicht kodiert, d.h. falls es
sich um ein z.B. um ein Bild handelt, werden die binären Daten ausgegeben.
@lines = $body->as_lines(); |
Received: <snipp> Message-Id: <41A60DC8.6080004@fhm.edu> Date: Thu, 25 Nov 2004 17:52:24 +0100 From: "Juergen Plate" <plate@fhm.edu> MIME-Version: 1.0 To: plate@ee.fhm.edu Subject: Testmail Content-Type: multipart/mixed; boundary="------------040307040001050305060304" X-Virus-Scanned: by amavisd-new at mailrelay.ee.fhm.edu This is a multi-part message in MIME format. --------------040307040001050305060304 Content-Type: multipart/alternative; boundary="------------7040001050D4B8DB02AFFE78" --------------7040001050D4B8DB02AFFE78 Content-Type: text/plain; charset=ISO-8859-1; format=flowed Content-Transfer-Encoding: 8bit Hallo Jürgen, hier eine kleine Testmail mit zwei angehängten Bildchen. Viel Spaß damit. Grüße, Jürgen --------------7040001050D4B8DB02AFFE78 Content-Type: text/html; charset=ISO-8859-1; format=flowed Content-Transfer-Encoding: 8bit <HTML> <BODY TEXT="#000000" BGCOLOR="#FFFFFF" LINK="#0000FF" VLINK="#FF0000" ALINK="#000088"> <FONT COLOR="#FFFF00"<Hallo Jürgen,</FONT> <P> hier eine kleine Testmail mit zwei angehängten Bildchen. Viel Spaß damit. <P> <BR> <HR WIDTH="100%"> Grüße, Jürgen </BODY> </HTML> --------------7040001050D4B8DB02AFFE78-- --------------040307040001050305060304 Content-Type: image/gif; name="nobtn.gif" Content-Transfer-Encoding: base64 Content-Disposition: inline; filename="nobtn.gif" R0lGODdhRQAtAMIAAAAAALIiIr6+vv8AAP///3CAkAAAAAAAACwAAAAARQAtAAAD/ii63P4w ysmIsPjqzLfv4CeGmQKcaKqubOu+70LAdG3flgkQfO//wKBwSPwJAAAZsshsOoeCwnKxzFGu 2GxUmlTMdlateLwocK1VsnpsRirB14F8vha3d1S4RB7o++V1WHdvPBFzfoh9gIESd2h6Dnx9 SJQAfwGMEYNeaZEDkwBmolKXmQ+OeYUNkgGjrgWJpg2bF50Lkp+tZg6wAZ9dsltTOqq3iLkS iAUQy81Rz87Ls1yEYXyhin3Jk9KmqMTW3L3IELmhszpUzNNunJDmogLZmOXcD+1HgmepVvC7 8r60PYDHQFqSLsDQFaTmrpg/BvMGinNw0ISOhOzwgDMW8SBUNwURV01UYNBiRYvPFuL74nAk xID0OHqkaDIfSl77Nip46CDkTpcl0wHr8lEYMJbhOhZdENLf0qEnbeIcdgSSgFytIkT85bFb UJSUymSsJrLPUqYBncr6VrXYTqzbzHUteDHsqbENw4CEawhUvLU52+oFCXOAJ79/0UWDxhhv Lasv/8xhhWRUMKOP3DawlChR5cSAV9o6haTzZ9ChNQqecKfSq8tlGD7WzOwV6stsR7N2BXvq Ud291+SGHFwNLZZbbCtfzry5c6punEufTv2V6ErYs2vfzr2790qPvosfT567jBHoSaRfr159 8fcKEgAAOw== --------------040307040001050305060304 Content-Type: image/gif; name="yesbtn.gif" Content-Transfer-Encoding: base64 Content-Disposition: inline; filename="yesbtn.gif" R0lGODdhRQAtAMIAAAAAAAD/AL6+vi6LVwAAgP///3CAkAAAACwAAAAARQAtAAAD/ii63P4w yrmKsPjqzLfv4CeGnQCcaKqubOu+r2LBdG3fmgkUfO//wKBwSPzpZLqicskcCgyn3IlHqVqv CwMUgJxasOBwQxv9esXoMJmrOaff1bV094ULAoGBnSFv0/d4AwRae09bc1RwgYKEe30zf2+L jAaFcmaRaJMEg5WOh36JYpudhJWnT6moq2OHmKJgpFqNdo9JdViys2+eCpcKbg14gQ66tGwL yFe2wQx5A4LCz4KlqCYNyhG9hmXAmQubjZOUtMnmaqCQsArTlHftnLu+DFzKKMnI27+3xdDQ nePilXNgzxybbL7S8RPmj1HAanyw0UsBLGIWV97W3Wk4ruDhrG0PChKEwOwbO44cBQ5MRa9l xYPzLnZb6AylP5UgIWS7542kwmYnbeIkyYsPRprghEKcwAJdlFC4gjYcqq2oTC6vokql9rFQ nJ8mFxD4t5QCq7Oq0hqdCZQBp7JeJ5TUaFReXLNH27bKedfnU3Va+6bZp1ewmLmBDTvFmjGx YixzDX2cTLmy5cuYLbPlkrmz58+Y/+q4Qbo0DkymU6tegYTEiNeuY8Oe/fhxAgA7 --------------040307040001050305060304--
Struktur mittels dump_skeleton():
Content-type: multipart/mixed
Effective-type: multipart/mixed
Body-file: NONE
Subject: Testmail
Num-parts: 3
--
Content-type: multipart/alternative
Effective-type: multipart/alternative
Body-file: NONE
Num-parts: 2
--
Content-type: text/plain
Effective-type: text/plain
Body-file: NONE
--
Content-type: text/html
Effective-type: text/html
Body-file: NONE
--
Content-type: image/gif
Effective-type: image/gif
Body-file: NONE
--
Content-type: image/gif
Effective-type: image/gif
Body-file: NONE
--
Noch deutlicher wird das anhand einer Skizze:
Alle MIME-Entities enthalten ein MIME::Head-Objekt und gegebenenfalls ein MIME::Body-Objekt. Falls es sich um "multipart/..."-Nachrichten handelt, enthält die Entity nur ein Head-Objekt. Es gibt kein Body-Objekt, sondern weitere Entity-Objekte (parts), die selbst wieder Head- und gegebenenfalls Body-Objekte enthalten. Die erste Entity wird auch als Top-Entity bezeichnet.
#!/bin/perl
use strict;
use MIME::Parser;
my $infile = 'test.eml';
my $top_entity;
my $pfad = '/home/plate';
my $prefix = "Message";
# Datei mit MIME-Nachricht einlesen und parsen
$top_entity = &parse_MIME_Stream($infile);
# Mail_Header der TOP-Entity (Nachricht) ausgeben
&handle_Mail_header($top_entity);
# MIME-Nachricht rekursiv durchlaufen
&walk($top_entity);
exit;
sub parse_MIME_Stream #(Eingabedatei)
{
my $file = shift;
my $parser = '';
die "NO FILE $!" unless defined $file;
# Neues Parser-Objekt
# Daten auf Festplatte speichern
$parser = MIME::Parser->new();
$parser->output_to_core('NONE');
$parser->output_dir($pfad);
$parser->output_prefix($prefix);
open(INPUT,$file) or die $!;
my $top_entity = $parser->read(\*INPUT);
close(INPUT) or die $!;
return $top_entity;
}
sub walk #(Entity)
{
my $entity = shift if @_;
return unless defined $entity;
my $head = $entity->head();
if ($head->mime_type() =~ m/multipart/i)
{ # mehrteilige Nachricht
my $i;
my $num_alt_parts = $entity->parts();
my $current_entity;
# alle Teile der Nachricht rekursiv abarbeiten
for ($i = 0; $i < $num_alt_parts; $i++)
{
$current_entity = $entity->parts($i);
&walk($current_entity);
}
}
else
{ # einteilige Nachricht
&handle_head($head) if (defined $head);
my $body = $entity->bodyhandle();
&handle_body($body) if (defined $body);
}
}
sub handle_head #(Header)
{
my $current_head = shift;
$current_head->decode;
$current_head->unfold;
# Headerinformationen ausgeben
print "MIME-Type: ", $current_head->mime_type(), "\n";
print "Encoding: ", $current_head->mime_encoding(), "\n";
print "Content-type: ", $current_head->mime_attr('content-type'), "\n";
print "Charset: ", $current_head->mime_attr('content-type.charset'), "\n";
print "Content-Disposition: ", $current_head->mime_attr('content-disposition'), "\n";
print "Filename: ", $current_head->recommended_filename(), "\n";
}
sub handle_body
{
my $current_body = shift;
if (defined($current_body->path))
{ # data is on disk:
print "Data is stored on Disk: ", $current_body->path() , "\n";
print '-' x 60 . "\n\n";
# Your code goes here
}
else
{
# How to get the data
# $Content = $current_body->as_string;
# @Content = $current_body->as_lines();
# $current_body->print(\*OUTSTREAM);
# Your code goes here
}
}
sub handle_Mail_header
{
my $entity = shift;
# $entity->print_header(\*STDOUT);
my $head = $entity->head();
$head->decode;
$head->unfold;
# Mail-Nachrichten-Header-Felder ausgeben
print "Subject: ", $head->get('Subject'), "\n";
print "From: ", $head->get('From'), "\n";
print "Sender: ", $head->get('Sender'), "\n";
print "Return-Path: ", $head->get('Return-Path'), "\n";
print "Date: ", $head->get('Date'), "\n";
print "To: ", $head->get('To'), "\n";
print "Organization: ", $head->get('Organization'), "\n";
print "Return-Path: ", $head->get('Return-Path'), "\n";
print "Status: ", $head->get('Status'), "\n";
print "Message-ID: ", $head->get('Message-ID'), "\n";
print "Precedence: ", $head->get('Precedence'), "\n";
print "References: ", $head->get('References'), "\n";
print "X-Priority: ", $head->get('X-Priority'), "\n";
print "X-Mailer: ", $head->get('X-Mailer'), "\n";
print "X-Virus-Scanned: ", $head->get('X-Virus-Scanned'), "\n";
print "Ref. Count: ", $head->count('References'), "\n";
if ($head->count('References') == 0)
{ print "New thread\n"; }
else
{ print "Reply\n"; }
print "Number of Hops: " , $head->count('Received') , "\n";
my @hops = $head->get_all('Received');
for (my $x = 0; $x <= $#hops; $x++)
{
print "Mail-Host [" , $x + 1, "] $hops[$x] \n";
}
print "\n\n";
}

Im Quelltext:
<FORM ACTION="/cgi-bin/nettool.cgi" METHOD="POST"> <TABLE BORDER=0 CELLSPACING=0 CELLPADDING=5> <TR><TD VALIGN=TOP><INPUT TYPE="RADIO" NAME="program" VALUE="N-PING"> </TD><TD VALIGN=TOP> Ping auf einen Host oder von hier zu Ihrem Rechner, falls Sie nichts eingeben.</TD> </TR><TR> <TD VALIGN=TOP><INPUT TYPE="RADIO" NAME="program" VALUE="N-TRACE"> </TD><TD VALIGN=TOP> Traceroute von hier zu einem Host oder von hier zu Ihrem Rechner, falls Sie nichts eingeben.</TD> </TR><TR> <TD VALIGN=TOP><INPUT TYPE="RADIO" NAME="program" VALUE="P-LOOK"></TD> <TD VALIGN=TOP> Einzelhost-Nameserverabfrage mit dem Programm "host". Bitte Hostname oder IP-Nummer angeben.</TD> </TR><TR> <TD VALIGN=TOP><INPUT TYPE="RADIO" NAME="program" VALUE="P-LOOKA"> </TD><TD VALIGN=TOP> Nameserverabfrage einer kompletten Domain mit dem Programm "host". Vorsicht! Das kann unter Umständen sehr viel Output ergeben. Bitte Domainnamen angeben.</TD> </TR><TR> <TD VALIGN=TOP><INPUT TYPE="RADIO" NAME="program" VALUE="P-FING"> </TD><TD VALIGN=TOP> Finger-Abfrage. Bitte User (name@host.domain) oder Domain (@host.domain) angeben.</TD> </TR><TR> <TD VALIGN=TOP><INPUT TYPE="RADIO" NAME="program" VALUE="N-UP" CHECKED></TD> <TD VALIGN=TOP> Uptime und Load.</TD> </TR><TR> <TD VALIGN=TOP>Host/User: </TD> <TD VALIGN=TOP> <INPUT TYPE="TEXT" NAME="target" VALUE="" SIZE=40 MAXLENGTH=100></TD> </TR><TR> <TD VALIGN=TOP> </TD> <TD VALIGN=TOP><INPUT TYPE="SUBMIT" VALUE=" Anfrage absenden "></TD> </TR> </TABLE> </FORM>
Im Programm wird ein Hash verwendet, der jeweils den Programmnamen einem Kommando zuordnet. Damit wird kein Kommando vom Formular aus gesendet, ebenso sind alle Kommandoparameter festgelegt. Das Programm kann auch leicht durch weitere Einträge im Hash erweitert werden - wozu nicht einmal große Perl-Kenntnisse notwendig sind. Die Namen im Hash haben noch eine weitere Funktion. Jeder Name beginnt mit einem Kennbuchstaben und einen Bindestrich. Die Kennbuchstaben haben folgende Bedeutung:
#!/usr/bin/perl
$|=1;
use strict;
# Definieren Sie hier Ihre Kommandoliste
my %commands = (
'N-PING', '/bin/ping -c 5 -w 5',
'N-TRACE', '/usr/sbin/traceroute ',
'P-LOOK', '/usr/bin/host -a ',
'P-LOOKA', '/usr/bin/host -l -v -t any ',
'P-FING', '/usr/bin/finger ',
'R-UP', '/usr/bin/uptime'
);
# Ab hier sind keine Aenderungen noetig
##################################################################
my $PROGRAMM = ''; # Programmname (1. Wert des Hashes %commands)
my $ZIELHOST = ''; # Eingabeparameter
my $temp = ''; # Hilfvariable
my $i = 0; # Zaehlvariable
my $content = ''; # Variablen zur Aufbereitung der CGI-Parameter
my $key = '';
my %fields = ();
# to prevent runaways, call it quits after 60 seconds.
$SIG{'ALRM'} =\&alarm_handle;
alarm(60);
print "Content-type: text/html\n\n";
print "<HTML><HEAD><TITLE>Network Tools</TITLE></HEAD>", "\n";
print "<BODY>", "\n";
print "<H2>Netzmafia Network Tools</H2>", "\n";
# Sicherheitsmassnahmen:
# 1. Eingabe auf zulaessige Zeichen beschraenken
# 2. Laengenueberpruefung der Eingabe
if ($ENV{'REQUEST_METHOD'} ne "POST")
{ $temp = $ENV{'QUERY_STRING'}; }
else
{ read(STDIN,$temp,$ENV{'CONTENT_LENGTH'}); }
foreach (split("&",$temp))
{
/(.*)=(.*)/;
$key = $1;
$content = $2;
$content =~ s/\+/ /g;
$content =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$fields{$key} = $content;
}
$PROGRAMM = $fields{'program'};
if ($fields{'target'} =~ /^([-\@\w.]+)$/ || $fields{'target'} eq "")
{
$ZIELHOST = $fields{'target'};
}
else
{
$ZIELHOST = "";
print "Unzul\ässige Zeichen im Parameter. Abbruch!";
print "</BODY></HTML>", "\n";
exit 0;
}
if (length($ZIELHOST) > 255)
{
$ZIELHOST = "";
print "Parameter zu lang (mehr als 255 Zeichen). Abbruch!";
print "</BODY></HTML>", "\n";
exit 0;
}
if ($commands{$PROGRAMM} eq "")
{
print "<H2>Fehler</H2>", "\n";
print "Kein Kommando angegeben!\n";
print "</BODY></HTML>", "\n";
exit 0;
}
if ($ZIELHOST eq "")
{
if ($PROGRAMM =~ /^P-/)
{
print "<H2>Fehler</H2>", "\n";
print "Das Kommando ben\ötigt eine Angabe im Eingabefeld!\n";
print "</BODY></HTML>", "\n";
exit 0;
}
else
{
if ($ENV{'REQUEST_METHOD'} eq "POST")
{
$ZIELHOST = $ENV{'REMOTE_ADDR'};
}
}
}
if ($PROGRAMM =~ /^R-/)
{
$ZIELHOST = "";
}
$temp = $commands{$PROGRAMM};
# eventuelle Pfadangabe weg (Zeilenanfang bis zum letzen '/')
$temp =~ s/^..*\///;
print "Bitte etwas Geduld, bis die gew\ünschten";
print "Daten ermittelt sind.<P>", "\n";
print "<B>Ergebnisse von Kommando: $temp</B>", "\n";
if ($ZIELHOST ne "")
{
print "<B> $ZIELHOST</B>", "\n";
}
print "<PRE>", "\n";
open (INP, "$commands{$PROGRAMM} $ZIELHOST |");
while (<INP>)
{
chop $_;
print "$_\n";
}
close (INP);
print "</PRE></BODY></HTML>", "\n";
exit 0;
# Unterprogramm fuer Timeout
#
sub alarm_handle
{
alarm(0);
print "<P><H2>Fehler</H2>", "\n";
print "Zeit\überschreitung beim Bearbeiten, Abbruch!", "\n";
print "</BODY></HTML>", "\n";
exit 0;
}
Content-type: multipart/x-mixed-replace;boundary=ich-bin-ein-kleiner-separator --ich-bin-ein-kleiner-separator Content-type: image/gif [Hier Bild 1] --ich-bin-ein-kleiner-separator Content-type: image/gif [Hier Bild 2] --ich-bin-ein-kleiner-separator Content-type: image/gif [Hier Bild 3] --ich-bin-ein-kleiner-separator--Wenn das Multipart-Dokument per CGI-Programm generiert wird, kann durch eine Wartezeit zwischen den einzelnen Teilen auch der Ablauf wie bei einer Dia-Show gesteuert werden. Dudelt dann noch parallel ein Soundfile (per <EMBED>-Tag ausgelöst), wird es richtig nervig. Das folgende Beispiel holt sich nacheinander Bilder aus einen vorgegebenen Verzeichnis ($IMAGEDIR) und zeigt sie nacheinander an. Das Array @images enthält für jedes Bild einen Hash, der Bildname und Delay-Zeit enthält. Durch Anpassen des Bildverzeichnisses und der Bilderliste kann das Programm beliebig konfiguriert werden. Es können neben GIF- und JPG-Bildern auch HTML-Dateien abgespielt werden.
#!/usr/bin/perl
use strict;
$|= 1;
# ****************************************************************
# Configuration - These need to be modified for your needs
# ****************************************************************
# wo liegen die Bilder
my $IMAGEDIR = ".../bilder/freak";
# Endlosschleife = 1, nur ein Durchlauf = 0
my $Continuous = 1;
# Liste der Bilder und Dauer der Wartezeit
my @images = (
{'name' => "freak1.gif",'sleeptime' => 1},
{'name' => "freak2.gif",'sleeptime' => 1},
{'name' => "freak3.gif",'sleeptime' => 1},
{'name' => "freak4.gif",'sleeptime' => 1},
{'name' => "freak5.gif",'sleeptime' => 1},
{'name' => "freak6.gif",'sleeptime' => 1},
{'name' => "freak7.gif",'sleeptime' => 1},
{'name' => "freak8.gif",'sleeptime' => 1},
);
# ****************************************************************
my $ANHEAD="Content-type: multipart/x-mixed-replace;boundary=135792468TraLaLa00\n";
my $BOUNDARY="\n--135792468TraLaLa00\n";
my $ENDBOUNDS="\n--135792468TraLaLa00--\n";
my $GIFTYPE="Content-type: image/gif\n\n";
my $JPGTYPE="Content-type: image/jpeg\n\n";
my $HTMLTYPE="Content-type: text/html\n\n";
# ****************************************************************
# Main Routine
# ****************************************************************
&animate;
exit(0);
# ****************************************************************
# Animate - Routine to display server push animation
# ****************************************************************
sub animate
{
my ($TYPE, $image, $count, $image_file, $data, $bc);
print $ANHEAD;
print $BOUNDARY;
$count = 0;
while(1)
{
$image_file = "$IMAGEDIR/$images[$count]->{'name'}";
$TYPE = $GIFTYPE if ($image_file =~ /gif$/i);
$TYPE = $JPGTYPE if ($image_file =~ /jpg$/i);
$TYPE = $HTMLTYPE if ($image_file =~ /html$/i);
print $TYPE;
open (DAT,$image_file) || print "cannot open $image_file: $!\n";
while (read(DAT,$data,8192,$bc))
{ print $data; }
close DAT;
print $BOUNDARY;
sleep($images[$count]->{'sleeptime'});
$count++;
if ($count == $#images+1)
{
last if (! $Continuous);
$count = 0;
}
}
print $ENDBOUNDS;
}
1;oder auch return(1);.
| Die hier besprochenen Programme und viele weitere Beispiele finden sie in der Beispielsammlung. |
Dort finden Sie auch eine Anleitung zur Netzwerkprogrammierung in Perl:
Zum vorhergehenden Abschnitt |
Zum Inhaltsverzeichnis |
Zum nächsten Abschnitt |