<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">#!/usr/bin/perl
# --
# webform.pl - a simple web form script to generate email with
# X-OTRS-Queue header for an OTRS system (x-headers for dispatching!).
# Copyright (C) 2001-2014 OTRS AG, http://otrs.com/
# --
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU AFFERO General Public License as published by
# the Free Software Foundation; either version 3 of the License, or
# any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU Affero General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301 USA
# or see http://www.gnu.org/licenses/agpl.txt.
# --

use strict;
use warnings;

# to get the errors on screen
use CGI::Carp qw(fatalsToBrowser);

# Simple Common Gateway Interface Class
use CGI;

# --------------------------
# web form options
# --------------------------
my $Ident = 'ahfiw2Fw32r230dddl2foeo3r';

# sendmail location and options
my $Sendmail = '/usr/sbin/sendmail -t -i -f';

# email where the emails of the form will send to
my $OTRSEmail = 'otrs-system@example.com';

# topics and dest. queues
my %Topics = (

    # topic =&gt; OTRS queue
    'Info'      =&gt; 'info',
    'Support'   =&gt; 'support',
    'Bugs'      =&gt; 'bugs',
    'Sales'     =&gt; 'sales',
    'Billing'   =&gt; 'billing',
    'Webmaster' =&gt; 'webmaster',
);

# --------------------------
# html header
# --------------------------

sub Header {
    my (%Param) = @_;

    # html quote
    for my $Value (qw(Title)) {
        $Param{$Value} = _Ascii2Html( $Param{$Value} );
    }

    my $Output = &lt;&lt;EOF;
Content-Type: text/html

&lt;html&gt;
&lt;head&gt;
    &lt;title&gt;$Param{Title}&lt;/title&gt;
&lt;/head&gt;
&lt;body&gt;

&lt;h1&gt;$Param{Title}&lt;/h1&gt;
&lt;hr&gt;
EOF
    return $Output;
}

# -------------------------
# html footer
# -------------------------

sub Footer {
    my $Output = &lt;&lt;EOF;
&lt;hr&gt;

&lt;/body&gt;
&lt;/html&gt;
EOF
    return $Output;
}

# -------------------------
# Thanks
# -------------------------

sub Thanks {
    my (%Param) = @_;

    # html quote
    for my $Value (qw(From)) {
        $Param{$Value} = _Ascii2Html( $Param{$Value} );
    }

    my $Output = &lt;&lt;EOF;
Thanks &lt;b&gt;$Param{From}&lt;/b&gt;! Your request is forwarded to us. &lt;br&gt;
We will answer ASAP.&lt;br&gt;
EOF
    return $Output;
}

# ----------------------
# error
# ----------------------

sub Error {
    my (%Param) = @_;

    # html quote
    for my $Value (qw(Message)) {
        $Param{$Value} = _Ascii2Html( $Param{$Value} );
    }

    my $Output = &lt;&lt;EOF;
&lt;font color="red"&gt;$Param{Message}&lt;/font&gt;&lt;br&gt;
EOF
    return $Output;
}

# ------------------------
# start the real actions
# ------------------------
my $CGI      = new CGI;
my %GetParam = ();
for (qw(Action From FromEmail Subject Topic Body)) {
    $GetParam{$_} = $CGI-&gt;param($_) || '';
}

# what should I do?
if ( $GetParam{Action} eq 'SendMail' ) {
    SendMail(%GetParam);
}
else {
    WebForm();
}

# ------------------------
# web form
# ------------------------
sub WebForm {
    print Header( Title =&gt; 'Submit Request' );
    print '
    &lt;form action="webform.pl" method="post"&gt;
        &lt;input type="hidden" name="Action" value="SendMail"&gt;
        &lt;table&gt;
            &lt;tr&gt;
                &lt;td&gt;Topic:&lt;/td&gt;
                &lt;td&gt;
';
    for my $Key ( sort keys %Topics ) {
        my $HTMLKey   = _Ascii2Html($Key);
        my $HTMLValue = _Ascii2Html( $Topics{$Key} );
        print $HTMLKey . '&lt;input type="radio" name="Topic" value="' . $HTMLValue . '"&gt;';
    }
    print '
                &lt;/td&gt;
            &lt;/tr&gt;
            &lt;tr&gt;
                &lt;td&gt;From:&lt;/td&gt;
                &lt;td&gt;&lt;input type="text" name="From" size="45" value=""&gt;&lt;/td&gt;
            &lt;/tr&gt;
            &lt;tr&gt;
                &lt;td&gt;Email:&lt;/td&gt;
                &lt;td&gt;&lt;input type="text" name="FromEmail" size="45" value=""&gt;&lt;/td&gt;
            &lt;/tr&gt;
            &lt;tr&gt;
                &lt;td&gt;Subject:&lt;/td&gt;
                &lt;td&gt;&lt;input type="text" name="Subject" size="45" value=""&gt;&lt;/td&gt;
            &lt;/tr&gt;
            &lt;tr valign="top"&gt;
                &lt;td&gt;Message:&lt;/td&gt;
                &lt;td&gt;&lt;textarea name="Body" rows="15" cols="45"&gt;&lt;/textarea&gt;&lt;/td&gt;
            &lt;/tr&gt;
            &lt;tr&gt;
                &lt;td&gt;&lt;/td&gt;
                &lt;td&gt;&lt;input type="submit" value="Submit"&gt;&lt;/td&gt;
            &lt;/tr&gt;
        &lt;/table&gt;
    &lt;/form&gt;
';
    print Footer();
}

# --------------------------
# send email
# --------------------------

sub SendMail {
    my (%Param) = @_;

    # check needed params
    my $Output = '';
    for (qw(From FromEmail Subject Topic Body)) {
        if ( !$Param{$_} ) {
            $Output .= Error( Message =&gt; "Param $_ is needed!" );
        }
    }
    if ($Output) {
        print Header( Title =&gt; 'Error!' ) . $Output . Footer();
        return;
    }

    # simple email check
    my $NonAscii     = "\x80-\xff";                            # Non-ASCII-Chars are not allowed
    my $Nqtext       = "[^\\\\$NonAscii\015\012\"]";
    my $Qchar        = "\\\\[^$NonAscii]";
    my $Protocol     = '(?:mailto:)';
    my $NormUser     = '[a-zA-Z0-9][a-zA-Z0-9_.-]*';
    my $QuotedString = "\"(?:$Nqtext|$Qchar)+\"";
    my $UserPart     = "(?:$NormUser|$QuotedString)";
    my $DomMainPart  = '[a-zA-Z0-9][a-zA-Z0-9._-]*\\.';
    my $DomSubPart   = '(?:[a-zA-Z0-9][a-zA-Z0-9._-]*\\.)*';
    my $DomTldPart   = '[a-zA-Z]{2,5}';
    my $DomainPart   = "$DomSubPart$DomMainPart$DomTldPart";
    my $Regex        = "$Protocol?$UserPart\@$DomainPart";

    if ( $Param{FromEmail} !~ /^$Regex$/ ) {
        my $Output = Header( Title =&gt; 'Error!' );
        $Output .= Error( Message =&gt; "Your email '$Param{FromEmail}' is invalid!" );
        $Output .= Footer();
        print $Output;
        return;
    }

    # quoting (take care to not injection any other header)
    for my $Key (qw(From FromEmail Topic Subject Topic)) {
        $Param{$Key} =~ s/(\n|\r)//g;
    }

    # build email
    my @Mail = ("From: $Param{From} &lt;$Param{FromEmail}&gt;\n");
    push @Mail, "To: $Param{Topic} &lt;$OTRSEmail&gt;\n";
    push @Mail, "Subject: $Param{Subject}\n";
    push @Mail, "X-OTRS-Ident: $Ident\n";
    push @Mail, "X-OTRS-Queue: $Param{Topic}\n";
    push @Mail, "X-OTRS-ArticleKey1: Sent via\n";
    push @Mail, "X-OTRS-ArticleValue1: Webform\n";
    push @Mail, "X-OTRS-ArticleKey2: Orig. sort\n";
    push @Mail, "X-OTRS-ArticleValue2: $Param{Topic}\n";
    push @Mail, "X-Mailer: OTRS WebForm\n";
    push @Mail, "X-Powered-By: OTRS (http://otrs.org/)\n";
    push @Mail, "\n";
    push @Mail, $Param{Body};
    push @Mail, "\n";

    # send mail
    my $FromEmail = $Param{FromEmail};
    $FromEmail =~ s/"|;|'|&lt;|&gt;|\||\s|\r|\n|\t|`//ig;
    $FromEmail = quotemeta $FromEmail;
    if ( open my $Mail, '|-', "$Sendmail $FromEmail" ) {    ## no critic
        print $Mail @Mail;
        close $Mail;

        # thanks!
        my $Output = Header( Title =&gt; 'Thanks!' );
        $Output .= Thanks(%Param);
        $Output .= Footer();
        print $Output;
    }
    else {

        # error
        my $Output = Header( Title =&gt; 'Error!' );
        $Output .= Error( Message =&gt; "Can't send email: $!" );
        $Output .= Footer();
        print $Output;
    }
}

sub _Ascii2Html {
    my $Text = shift;

    $Text =~ s/&amp;/&amp;amp;/g;
    $Text =~ s/&lt;/&amp;lt;/g;
    $Text =~ s/&gt;/&amp;gt;/g;
    $Text =~ s/"/&amp;quot;/g;

    return $Text;
}
</pre></body></html>