概要

  • ファイルが添付できるメールフォーム。
  • 宛先は config.yaml で指定する。フォームから宛先の追加も可能。
  • 名前, 宛先は Cookie に保存される。(1ヶ月)
  • アクセス元のホスト名を表示。
  • cookie の path を設定。

ソース

index.cgi

#!/usr/bin/perl
# MailForm
# Web フォームから入力されたコメントとファイルを、
# 特定の Email アドレスへ添付ファイル付きで送信する。

use strict;
use warnings;
use utf8;
use Encode;
use YAML::Syck;
use JSON::Syck;
use FindBin;
use CGI::Pretty qw( -no_xhtml *table );	# //HTML 4.01 Transitional//EN
use CGI::Cookie;
use Email::Sender::Simple qw( sendmail );
use Email::Sender::Transport::SMTP;
use Email::MIME;
use Email::MIME::Creator;
use Net::DNS::Resolver;

$YAML::Syck::ImplicitUnicode = 1;
$YAML::Syck::ImplicitTyping = 1;
$YAML::Syck::Headless = 1;
$JSON::Syck::ImplicitUnicode = 1;

my $charset_console	= 'UTF-8';
my $charset_file	= 'UTF-8';
my $charset_input	= 'UTF-8';

#binmode( STDIN,  ":encoding($charset_console)" );	# バイナリファイルが化ける
binmode( STDIN,  ":raw" );							# バイナリファイルをアップロードする場合に必要
binmode( STDOUT, ":encoding($charset_console)" );
binmode( STDERR, ":encoding($charset_console)" );

my $base_path = $FindBin::RealBin . '/';
my $config_file = $base_path . 'config.yaml';
my $cgi_name = 'MailForm';
my $cookie_name = $cgi_name;

my $q = new CGI;
$q->charset( $charset_console );
my $br = $q->br();

$JSON::Syck::ImplicitUnicode = 1;
my $cookies = CGI::Cookie->fetch;
my $cookie = ( $cookies && $cookies->{$cookie_name} )
	? JSON::Syck::Load( $cookies->{$cookie_name}->value || '{}' ) 
	: {} ;
# クッキーにゴミデータが入っていた場合に消去
if ( ref( $cookie ) ne 'HASH' ){
	$cookie = {};
}

my $config = YAML::Syck::LoadFile( $config_file ) or die( "$config_file: $!\n" );

my $command = $q->param( 'Command' ) || '';
my $comment = decode( $charset_input, $q->param( 'Comment' ) || '' );
my $file_name = $q->param( 'Attachment' ) || '';
my $file_type = $q->uploadInfo( $file_name ) 
	? $q->uploadInfo( $file_name )->{ 'Content-Type' } || '' 
	: '';
$file_name = decode( $charset_input, $file_name );
my $file_body = '';
if ( my $lightweight_fh = $q->upload( 'Attachment' ) ){
	my $io_handle = $lightweight_fh->handle;
	while ( my $bytesread = $io_handle->read( my $buffer, 1024 ) ){
		$file_body .= $buffer;
	}
}
my $user_name = decode( $charset_input, $q->param( 'UserName' ) || '' ) 
	|| $cookie->{ 'UserName' } || '';
my $user_email = decode( $charset_input, $q->param( 'UserEmail' ) || '' ) 
	|| $cookie->{ 'UserEmail' } || '';

$cookie = {
	'UserName' => $user_name, 
	'UserEmail' => $user_email, 
};

my $remote_ip = $ENV{ 'REMOTE_ADDR' };
my $remote_name = getHostName( $remote_ip );

print makeHeader();
if ( $command eq 'doPost' ){
	my $mail_result;
	if ( length( $file_body ) > 0 ){
		$mail_result = sendMail();
	}
	print showPostedInfo();
} else {
	print makeForm();
}
print makeFooter();

exit;

sub makeHeader
{
	my $ret = '';
	$JSON::Syck::ImplicitUnicode = 0;
	my $cookie_header = CGI::Cookie->new( 
		-name		=> $cookie_name, 
		-value		=> JSON::Syck::Dump( $cookie ), 
		-expires	=> '+1M', 
		-path		=> $ENV{'REQUEST_URI'}, 
	);
	$ret .= $q->header( -cookie => [ $cookie_header ] );
	$ret .= $q->start_html(
		-title	=> $cgi_name,
		-lang	=> 'ja-JP',
		-head	=> [
			$q->meta( { -http_equiv => 'Content-style-type',	-content => 'text/css' } ),
			$q->meta( { -http_equiv => 'Content-script-type',	-content => 'text/javascript' } ),
		],
		-style	=> [ { -src => $config->{ 'CSSFile' } }, ], 
	);
	$ret .= $q->h1( $q->a( { -href => $q->url }, $cgi_name ) );
#	$ret .= $q->pre( YAML::Syck::Dump( $cookie ) );
	return $ret;
}

sub makeFooter
{
	my $ret = '';
	$ret .= $q->end_html . "\n";
	return $ret;
}

sub makeForm
{
	my $ret = '';
	$ret .= $q->start_multipart_form( -action => $q->url, );
	$ret .= $q->table( 
		$q->Tr( 
			$q->th( '名前' ), 
			$q->td( $q->textfield( 
				-name => 'UserName', 
				-default => $user_name, 
				-size => 60, 
				-override => 1, 
			) ), 
		), 
		$q->Tr( 
			$q->th( 'Email' ), 
			$q->td( $q->textfield( 
				-name => 'UserEmail', 
				-default => $user_email, 
				-size => 60, 
				-override => 1, 
			) ), 
		), 
		$q->Tr( 
			$q->th( '添付ファイル' ), 
			$q->td( $q->filefield( 
				-name => 'Attachment', 
				-default => '', 
				-size => 60, 
				-override => 1, 
			) ), 
		), 
		$q->Tr( 
			$q->th( 'コメント' ), 
			$q->td( $q->textarea( 
				-name => 'Comment', 
				-default => '', 
				-columns => 60, 
				-rows => 5, 
				-override => 1, 
			) ), 
		), 
		$q->Tr( 
			$q->th( 'アクセス元' ), 
			$q->td( "$remote_ip; $remote_name" ), 
		), 
		$q->Tr( $q->td( 
			{ -colspan => 2, -align => 'center', },
			$q->submit( -name => 'Submit', -value => 'Submit' ), 
		), ), 
	);
	$ret .= $q->hidden( -name => 'Command', -default => 'doPost', -override => 1 );
	$ret .= $q->end_multipart_form;
	return $ret;
}

sub showPostedInfo
{
	my $ret = '';
	$ret .= $q->table(
		$q->Tr( $q->th( '名前' ), $q->td( $user_name ), ), 
		$q->Tr( $q->th( 'Email' ), $q->td( $user_email ), ), 
		$q->Tr( $q->th( 'コメント' ), $q->td( $comment ), ), 
		$q->Tr( $q->th( 'アクセス元' ), $q->td( "$remote_ip; $remote_name" ), ), 
		$q->Tr( $q->th( 'ファイル名' ), $q->td( $file_name ), ), 
		$q->Tr( $q->th( 'ファイルタイプ' ), $q->td( $file_type ), ), 
		$q->Tr( $q->th( 'ファイルサイズ' ), $q->td( length( $file_body ), ), ), 
		$q->Tr( $q->th( 'Hex' ), $q->td( dumpStr( $file_body ) ), ), 
	);
	return $ret;
}

sub dumpStr
{
	my $dump_limit = 64;
	my $str = shift || '';
	my $head = shift || $dump_limit;
	if ( $head > $dump_limit ){
		$head = $dump_limit;
	}
	if ( $head > length( $str ) ){
		$head = length( $str );
	}
	$str = substr( $str, 0, $head );
	my $ret = '';
	my @buffer = ();
	for( my $i=0; $i<$head; $i+=16 ){
		for( my $j=0; $j<16 && ( $i + $j < $head ); ++$j ){
			push( @buffer, unpack( "H*", substr( $str, $i + $j, 1 ) ) );
		}
		push( @buffer, $br );
	}
	$ret = join( " ", @buffer );
	return $ret;
}

sub sendMail
{
	my $body = "名前:\n${user_name}\n\nEmail:\n${user_email}\n\nコメント:\n${comment}\n\n"
		. "アクセス元:\n${remote_ip}; ${remote_name}\n\n";
	my $email = Email::MIME->create(
		attributes => {
			content_type	=> 'text/plain',
			charset			=> 'UTF-8',
			encoding		=> '8bit',
			#encoding		=> 'base64',
		},
		header_str => [
			From	=> $config->{ 'FromAddress' },
			To		=> join( ", ",  $config->{ 'ToAddress' }, $user_email, ) ,
			Subject	=> $config->{ 'MailTitle' },
		],
		parts => [
			Email::MIME->create(
				attributes => {
					content_type	=> 'text/plain',
					charset			=> 'UTF-8',
					#encoding		=> '8bit',
					encoding		=> 'base64',
				},
				body => encode( $charset_input, $body ),
			),
			Email::MIME->create(
				attributes => {
					content_type	=> $file_type,
					name			=> encode( 'MIME-Header', $file_name ),
					filename		=> encode( 'MIME-Header', $file_name ),
					encoding		=> 'base64',
					disposition		=> 'attachment',
				},
				body => $file_body,
			),
		],
	);

	return sendmail($email);
}

sub getHostName
{
	my $ip_address = shift || '';
	my $ret = '';

	my $resolver = Net::DNS::Resolver->new;
	if ( my $ans = $resolver->query( $ip_address ) ){
		for my $rr ( $ans->answer ){
			#print $rr->string, "\n";
			if ( $rr->type eq 'PTR' ){
				$ret = $rr->ptrdname;
				last;
			}
		}
	}

	return $ret;
}

# EOF

config.yaml

# MailForm 設定
FromAddress: '"メールフォーム" <MailForm@example.com>'
ToAddress:   '"YourAddress" <YourAddress@example.com>'
MailTitle:   "レポート"
CSSFile:     "/take.css"

mod_security

  • セッション使わず、クッキーの中にユーザ名と Email がそのまま入っていて、mod_security の crs でエラーになる。
  • 該当するルール
    • file: modsecurity_crs_41_sql_injection_attacks.conf
    • id: 960024, 981172, 981243, 981245, 981246, 981257

リンク