#!/usr/bin/perl -w use strict; use warnings; use IO::Handle; STDOUT -> autoflush (1); use CGI; ####################################### my %config = ( mailprog => '|/usr/sbin/sendmail -t', from_name => 'carsten1976', from_mail => 'carsten@weissichnicht.de', ); ####################################### my $q = CGI -> new; print $q -> header; my $fehler = ''; open my $mh,$config{mailprog} or $fehler = $!; if ($fehler eq '') { my $mail = "Mime-Version: 1.0\n"; $mail .= &MIMEENCODE ("From: $config{from_name} <$config{from_mail}>",'ISO-8859-1'); $mail .= &MIMEENCODE ("To: empfaenger\@domain.de",'ISO-8859-1'); $mail .= &MIMEENCODE ("Subject: Testmail äöüßÖÄÜ",'ISO-8859-1'); $mail .= "Content-Type: text/plain;\n charset=\"ISO-8859-1\"\nContent-Transfer-Encoding: quoted-printable\n\n"; $mail .= &QP_ENCODE ('Guten Tag, dies ist ein kleiner Text für eine Mail'); print $mh $mail; close ($mh); print "Mail verschickt\n"; } else { print "Fehler >$fehler<\n"; } ####################################### sub MIMEENCODE() { return '' if !defined $_[0] || $_[0] eq ''; my $return = $_[0]; my $charset = $_[1] || 'ISO-8859-1'; my $noprint = "\\x00-\\x1F\\x7F-\\xFF"; my ($word,@lines); my $line = ''; $return =~ s{[a-zA-Z0-9\x7F-\xFF]{1,18}}{ $word = $&; (($word !~ /[$noprint]/o) ? $word : "=?$charset?Q?".&_encode($word,$noprint)."?="); }xeg; my @words = split(/ /,$return); foreach $word (@words) { my $sameword = 0; if (length($word) > 75) { while ($word) { if ($word =~ /^(.+?\?=)(=\?.*)$/) { &addword($1,\$line,\@lines,$sameword); $word = $2; } else { &addword($word,\$line,\@lines,$sameword); $word = ''; } $sameword = 1; } } else { &addword($word,\$line,\@lines,$sameword) } } push(@lines,$line."\n") if ($line); return substr(join('',@lines),1); sub addword { my ($word,$line,$lines,$sameword) = @_; if (!$sameword && $word =~ /^=\?[^\?]+?\?[Qq]\?(.+\?=)$/) { my $newword = $1; if ($$line =~ /^(.+)\?=$/) { $$line = $1.'_'; if (length($$line) + length($newword) > 75) { $$line .= '?='; push(@$lines,$$line."\n"); $$line = ' '.$word; } else { $$line .= $newword } return 0; } } if (length($$line) > 0 && length($$line) + length($word) > 75) { push(@$lines,$$line."\n"); $$line = ''; } $$line .= ' '.$word; } sub _encode { my ($str,$noprint) = @_; $str =~ s{[\?\=\_$noprint]}{sprintf("=%02X",ord($&))}eog; $str; } } ####################################### sub QP_ENCODE { my $text = shift; my $schneiden = shift || ''; my $blanks = shift || ''; $text =~ s/([^ \t\n!-<>-~])/sprintf("=%02X", ord($1))/eg; $text =~ s/([ \t]+)$/ join('', map { sprintf("=%02X", ord($_)) } split('', $1))/egm; $text =~ s/ /=20/g if $blanks; my $gebrochen = ''; if (!$schneiden) { $gebrochen .= "$1=\n" while $text =~ s/(.*?^[^\n]{73} (?: [^=\n]{2} (?! [^=\n]{0,1} $) |[^=\n] (?! [^=\n]{0,2} $) | (?! [^=\n]{0,3} $) ))//xsm; } return "$gebrochen$text"; }