#! /usr/bin/perl
#
# fmail.cgi
# CAPTCHA付きフォームメール
#
# 1.003 : 12/2/06 : メールチェックを修正
# 1.002 : 11/28/06 : デフォルトをCAPTCHAオフに修正
# 1.001 : 11/23/06 : 受取人メールには送信アドレスを表示するように修正
# 1.0 : 11/21/06 : Initial revision
#
# http://www.hidekik.com
#
# Copyright(c) 2005-2006, Hideki Kanayama All rights reserved

use strict;
use CGI qw(:cgi-lib);
use CGI::Carp qw(fatalsToBrowser);
use File::Basename;
use Jcode;
use GD::SecurityImage::AC;

my $lastupdatedyear = 2006;
my $version = "1.003";

my $script = basename($0);

my $setupfile = "fmail_setup.pl";
my $admindat = "adminpwd.dat";

my $charset = "Shift_JIS";

my $lang = 0;

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

# Enable mail
our $enable_mail = 1;

# Title
our $title = ('フォームメール','Form mail')[$lang];

# Background
our $bgimage_en = 0;
our $bgimage_file = '';
our $bgcolor = "#ffffff";

# Back link
our $backlink_en = 1;
our $backlink = '..';
our $backlink_name = '戻る';

# Body width
our $body_width = '100';

# Display admin link
our $setup_en = 1;
our $setup_name = '管理用';

# return page after sending a mail
# 0: form mail, 1: done page, 2: top page
our $return_page = 0;

# mail command
our $mail_cmd = '/usr/sbin/sendmail -t';

# Recipient
our $to_mail = 'yourname@yourdomain.com';

# Name on To:, From:, Bcc:
# 1: display, 0:no display
our $mail_name = 1;

# body_head
our $body_head = "
<center><h1>フォームメール</h1></center><p>
";

# body_tail
our $body_tail = '
';

#セキュリティイメージ
our $captcha_en = 0;
our $capimage_width = 230;
our $capimage_height = 80;
our $scramble_en = 1;
our $cap_text_num = 4; #文字数
our $cap_expire = 60;  #有効期限（分）

# セキュリティイメージデータディレクトリ
our $capdatadir = 'capdata';

# ttffontファイルを絶対パスで。 "Document and Setting"のようなパス内のspace禁止
our $ttffont = "c:/windows/fonts/cour.ttf";

# ttfrontのポイントサイズ
our $ttffont_ptsize = 30;

# Style Sheet
our $style_sheet_en = 0;
our $style_sheet = '
';

# Head insert
our $head_insert_en = 0;
our $head_insert = '
';

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

require "$setupfile" if (-e "$setupfile");

my $mail_pattern = '(^[\w\.\-]+\@[\w\.\-]+\.[a-zA-Z]{2,4}$|^$)';

my $q = CGI->new;
my $cgierror = $q->cgi_error;
&error($cgierror) if ($cgierror);
my %in = $q->Vars;

if (! -e "$admindat"){
    if ($in{mode} eq 'wradminpwd'){
	&wradminpwd($in{pwd},$admindat);
    } else {
	&setadminpwd($admindat);
    }
}

my $captcha;
if ($captcha_en){
    $captcha = GD::SecurityImage::AC->new;
    $captcha->gdsi(
		   new => {
		       width => $capimage_width,
		       height => $capimage_height,
		       lines => 10,
		       scramble => $scramble_en,
		       font => "$ttffont",
		       ptsize => $ttffont_ptsize,
		   },
		   create => ['ttf', 'rect', '#000000', '#555555'],
		   particle => [500],
		   );
    if (! -d "$capdatadir") {mkdir $capdatadir;}
    $captcha->data_folder($capdatadir);
    $captcha->output_folder($capdatadir);
    $captcha->expire($cap_expire * 60);
}

if ($in{mode} eq 'setup'){
    &setup;
} elsif ($in{mode} eq 'setupwrite'){
    &setupwrite;
} elsif ($in{mode} eq 'send'){
    &send;
} else {
    &mainpage;
}

sub mainpage {

    &htmlhead($title);

    print $body_head;
    print "<a href=\"$backlink\">$backlink_name</a><br>" if ($backlink_en);

    print qq(<form method=post name="mailform" action="$script">\n);
    print qq(<input type=hidden name=mode value=send>\n);

    print qq(送信者の名前<br>\n);
    print qq(<INPUT type="text" size="40" name="sender"><p>\n);
    print qq(送信者のメールアドレス<br>\n);
    print qq(<INPUT type="text" size="40" name="mailaddress1"><BR>\n);
    print qq(メールアドレスの確認（もう一度入力してください）<br>\n);
    print qq(<INPUT type="text" size="40" name="mailaddress2"><p>\n);

    print qq(タイトル<BR>\n);
    print qq(<INPUT type="text" size="60" name="subject"><BR>\n);

    print qq(<br>本文<BR>\n);
    print qq(<TEXTAREA rows="15" cols="80" name="main" wrap="soft"></TEXTAREA><p>\n);

    &wrticket;

    print qq(<P><INPUT type="submit" value="送信"><p>\n);

    print "$body_tail";

    print "<div align=\"right\"><a href=\"$script?mode=setup\">管理用</a></div>\n" if ($setup_en);
    &htmltail;
}

sub wrticket {
    if ($captcha_en){
	my $md5sum = $captcha->generate_code($cap_text_num);
	print "<img src=\"$capdatadir/$md5sum.png\"><br>\n";
	print "<input type=\"hidden\" name=capmd5 value=\"$md5sum\">\n";
	print "投稿するためには上の文字を下のテキストボックスに入力してください。<br>";
	print "<input type=\"text\" name=ticket size=10><p>\n";
    }
}

sub security_check {
    if ($captcha_en){
	my $result = $captcha->check_code($in{ticket},$in{capmd5});
	if ($result == 0){
	    &retry_captcha("コードのチェックに失敗しました。");
	} elsif ($result == -1){
	    &retry_captcha("コードの有効期限が過ぎています。");
	} elsif ($result == -2){
	    &retry_captcha("無効なコードです。");
	} elsif ($result == -3){
	    &retry_captcha("コードがマッチしません。");
	}
    }
}

sub retry_captcha {
    my $msg = shift;
    &htmlhead($msg);
    print "<br><center>$msg<p>\n";
    print "もう一度コードを入力してください。<p>\n";

    foreach (qw(sender mailaddress1 mailaddress2 subject main)){
	$in{$_} =~ s/<br>/\n/gi;
	$in{$_} =~ s/&lt;/</g;
	$in{$_} =~ s/&gt;/>/g;
	$in{$_} =~ s/&\#44;/,/g;
    }
    
    print "<FORM action=\"$script\" method=\"post\">\n";
    print "<INPUT type=\"hidden\" name=\"sender\" value=\"$in{sender}\">\n";
    print "<INPUT type=\"hidden\" name=\"mailaddress1\" value=\"$in{mailaddress1}\">\n";
    print "<INPUT type=\"hidden\" name=\"mailaddress2\" value=\"$in{mailaddress2}\">\n";
    print "<INPUT type=\"hidden\" name=\"subject\" value=\"$in{subject}\">\n";
    print "<input type=\"hidden\" name=\"main\" value=\"$in{main}\">";
    &wrticket;

    print "<INPUT type=\"submit\" value=\"再度送信\">";
    print "<INPUT type=\"hidden\" name=\"mode\" value=\"$in{mode}\">\n";
    print "</form>\n";

    print "</center>\n";
    &htmltail;
}

sub send {

    my $subject = $in{subject};
    my $sender = $in{sender};
    my $contents = $in{main};
    my $mailaddress = $in{mailaddress1};

    &error("送信者の名前を記入してください。") if ($sender eq '');
    &error("送信者のメールアドレスは必ず記入してください。") if ($mailaddress eq '');
    &error("メールアドレスが一致しません。") if ($mailaddress ne $in{mailaddress2});
    &error('タイトルと本文は必ず書いてください。') if ($subject eq '' or $contents eq '');

    if ($mailaddress !~ /$mail_pattern/){
	my $message = ('無効なメールアドレスです','Invalid mail address')[$lang];
	&error("$mailaddress:$message");
    }

    unless ($enable_mail){
	&error('メール機能は現在無効になっています。');
    }

    &security_check;

    $contents = jcode($contents)->jis;

    my $from_mail;
    $from_mail = $mail_name ? "$sender <$mailaddress>" : "$mailaddress";
    
    my $header;
    foreach my $repeat (0 .. 1) {
	$header = "From: " . jcode("$from_mail")->mime_encode . "\n";
	$header .= "To: " . jcode("$to_mail")->mime_encode . "\n" if ($repeat == 0);
	$header .= "Bcc: " . jcode("$from_mail")->mime_encode . "\n"  if ($repeat == 1);
	$header .= "Subject: " . jcode($subject)->mime_encode . "\n";
	$header .= "MIME-Version: 1.0\n";
	$header .= "Content-type: text/plain; charset=ISO-2022-JP\n";
	$header .= "Content-Transfer-Encoding: 7bit\n\n";

	if (open(SMAIL, "| $mail_cmd")){
	    print SMAIL $header;
	    print SMAIL $contents;
	    close(SMAIL);
	} else {
	    &error("メールコマンドが実行できません。<br>$mail_cmdが正しいか確認してください。");
	}
    }

    if ($return_page == 0) {
	print "Location: $script\n\n";
    } elsif ($return_page == 1) {
	&error("送信しました。<p><a href=\"$script\">$title</a><p><a href=\"$backlink\">$backlink_name</a>");
    } else {
	print "Location: $backlink\n\n";
    }
}

sub htmlhead {
  
  my $title = shift;
  
  my $bgimage;
  if ($bgimage_en == 1){
    $bgimage = "background=\"$bgimage_file\"";
  } else {
    $bgimage = "bgcolor=\"$bgcolor\"";
  }

  print $q->header(-charset=>$charset);
  print "<html>\n";
  print "<HEAD>\n";
  print "<META HTTP-EQUIV=\"Content-Type\" CONTENT=\"text/html; charset=$charset\">\n";
  print "<TITLE>$title</TITLE>\n";
  if ($head_insert_en == 1){
    print "$head_insert\n";
  }
  
  if ($style_sheet_en == 1){
    print "<STYLE type=\"text/css\">\n";
    print "$style_sheet";
    print "\n</style>\n";
  }

  print "</HEAD>\n";
  print "<BODY TEXT=\"#000000\" $bgimage LINK=\"#0000EE\" VLINK=\"#551A8B\" ALINK=\"#FF0000\">\n";
  print "<table cols=1 border=0 width=\"${body_width}%\" style=\"border:0px\" align=center><tr><td style=\"border:0px;background-color:transparent\" >\n";
  
}

sub copyright {
    my $mysite = ('http://www.hidekik.com/','http://www.hidekik.com/en/')[$lang];
  print "<div align=\"right\"><i>fmail.cgi Ver. $version</i><br>\n";
  print "<i>Copyright(C) $lastupdatedyear, <a href=\"$mysite\" target=\"_blank\">hidekik.com</a></i></div>\n";
}

sub htmltail {
  &copyright;
  print "</td></tr></table></body></html>\n";
  exit;
}

sub error {
  my ($msg) = shift;
  &htmlhead($msg);
  print "<br><center>$msg</center>\n";
  print "<br><div align=\"right\">";
  print "</div>";
  &htmltail;
  exit;
}

sub makecrypt {
    my $plain = shift;
    my $salt = join "", ('.', '/', 0..9, 'A'..'Z', 'a'..'z')[rand 64, rand 64];
    my $result = crypt($plain,$salt) or crypt($plain,'$1$'.$salt.'$');
    return $result;
}

sub setadminpwd {
    my $file = shift;
    &htmlhead('パスワードを入力してください');
  
    print "<form name=\"setpwd\" action=\"$script\" method=\"post\">\n";
  
    if (! defined $file){
	print "<center>管理者用パスワードを入力してください。<br>\n";
	print "<input type=password name=\"pwd\" size=20>\n";
	print "<input type=submit name=\"sub\" value=\"入力\">\n";
	print "<input type=hidden name=\"mode\" value=\"$in{mode}\">\n";
    } else {
	print "<center>管理者用パスワードを設定してください。<br>\n";
	print "<input type=hidden name=\"mode\" value=\"wradminpwd\">\n";
	print "<input type=input name=\"pwd\" size=20>\n";
	print "<input type=submit name=\"sub\" value=\"設定\">\n";
    }
    
    print "<p><div align=\"right\">";
    print "</div>";
    &htmltail;
    exit;
}

sub wradminpwd {
  my $plain = shift;
  my $file = shift;
  $file = "$admindat" unless (defined $file);
  my $passwd = &makecrypt($plain);
  
  if (open(FILE,"> $file")){
    print FILE "$passwd";
    close(FILE);
  } else {
    &error('パスワードファイル作成に失敗しました');
  }
 
  print "Location: $script\n\n";
  
}

sub checkadmin {
  my $pwd = shift;
  my $file = shift;
  $file = "$admindat" unless (defined $file);
  
  if (open(FILE,"< $file")){
    my $filepwd = <FILE>;
    close(FILE);
    my $inpwd = crypt($pwd,$filepwd);
    return ("$inpwd" eq "$filepwd");
  } else {
    &error('パスワードファイルが存在しません');
  }
  
}

sub setup {
  my $subname = 'setup';
  &setadminpwd if ($in{pwd} eq '');
  &error(('管理用パスワードが違います。','Wrong admin password')[$lang]) unless &checkadmin($in{pwd});

  &htmlhead($title);
  
  my %check;
  
  $check{backlink}[$backlink_en] = "checked";
  $check{bgimage}[$bgimage_en] = "checked";
  $check{setup}[$setup_en] = "checked";
  $check{style_sheet}[$style_sheet_en] = "checked";
  $check{head_insert}[$head_insert_en] = "checked";
  $check{return_page}[$return_page] = "checked";
  $check{mail_name}[$mail_name] = "checked";
  $check{enable_mail}[$enable_mail] = "checked";
    
  my @captcha_check;
  my @scramble_check;
  $captcha_check[$captcha_en] = "checked";
  $scramble_check[$scramble_en] = "checked";

  print "<form name=\"setup\" action=\"$script\" method=\"post\">\n";
  print "<input type=hidden name=\"mode\" value=\"setupwrite\">\n";
  print "<input type=hidden name=\"pwd\" value=\"$in{pwd}\">\n";

  my $notice = ("<li>
セットアップリンクを非表\示にしている場合は、$script?mode=setupからパスワードを入力してこのページに入ってください。
</li>
<li><font color=red>数字やカラー指定は必ず半角で指定してください。全角やブランクだとＣＧＩが起動しなくなります。</font>万一間違って全角で書いてしまった場合は、$setupfileをエディタで開きその場所を半角に正しく修正してください。それで直ります。</li>",
"<li>If you disable to display admin setup link, you can open the page with $script?mode=setup and change the setting.</li>")[$lang];

  print <<END;
<table cols=2 border=1 width="100%">
<tr>
<td colspan=2>
<ul>
$notice
</ul>
</td>
</tr>

<tr>
<td width=30%>
メール送信機能\
</td>
<td>
<input type=radio name=enable_mail value=1 $check{enable_mail}[1]>有効
<input type=radio name=enable_mail value=0 $check{enable_mail}[0]>無効<br>
</td>
</tr>

<tr>
<td>
END

print (('バックグランド','background')[$lang]);

print <<END;
</td>
<td>
<input type=radio name=bgimage_en value=1 $check{bgimage}[1]>
END

print (('画像を使う','image')[$lang]);

  print "
<input type=radio name=bgimage_en value=0 $check{bgimage}[0]>";

print (('カラー設定にする','color')[$lang]);

print <<END;
<br>
<input type=text name="bgimage_file" value="$bgimage_file" size=30>
END

print (('画像を使う場合の画像ファイル','image file')[$lang]);

  print <<END;
<br>
<input type=text name="bgcolor" value="$bgcolor" size=10>
END

print (('カラー設定の場合のカラー番号（白：#ffffff 又は white）','color code(white:white or #ffff)')[$lang]);

print <<END;
</td>
</tr>

<tr>
<td>
END

print (('タイトル名','title')[$lang]);

print <<END;
</td>
<td>
<input type=text name="title" value="$title" size=30><br>
ブラウザのタイトルバーに表\示されるタイトルです。ページのタイトルは「ページ上部」で自由にタイトル表\示させることができます。
</td>
</tr>

<tr>
<td>
END

  print (('トップへのリンク','link to top')[$lang]);
  my $disp = ('表示','display')[$lang];
  my $nondisp = ('非表示','not display')[$lang];
  my $linkname = ('リンク名','link name')[$lang];

print <<END;
</td>
<td>
<input type=radio name=backlink_en value=1 $check{backlink}[1]>$disp
<input type=radio name=backlink_en value=0 $check{backlink}[0]>$nondisp<br>
<input type=text name="backlink_name" value="$backlink_name" size=30>$linkname<br>
<input type=text name="backlink" value="$backlink" size=30>URL<br>
</td>
</tr>

<tr>
<td>
END

  print (('表示幅','table width')[$lang]);

print "</td>
<td>
";

  print (('ブラウザ全体の','')[$lang]);

  print <<END;
<input type=text name="body_width" value="$body_width" size=5>%
</td>
</tr>

<tr>
<td>
END

print (('セットアップのリンク','link to setup')[$lang]);

print <<END;
</td>
<td>
<input type=radio name=setup_en value=1 $check{setup}[1]>$disp
<input type=radio name=setup_en value=0 $check{setup}[0]>$nondisp<br>
<input type=text name="setup_name" value="$setup_name" size=30>$linkname<br>
</td>
</tr>

<tr>
<td>
END

print "送信後の戻りページ";

print <<END;
</td>
<td>
<input type=radio name=return_page value=0 $check{return_page}[0]>$title<br>
<input type=radio name=return_page value=1 $check{return_page}[1]>送信完了ページ<br>
<input type=radio name=return_page value=2 $check{return_page}[2]>「$backlink_name」ページ
</td>
</tr>

<tr>
<td>
END

print (('メールコマンド','Mail command')[$lang]);

print qq(</td><td>To:などのヘッダ情報が本文に埋め込まれて送信されるのでsendmailの場合は「sendmail -t」のように-tを必ず付けてください。<br>\n<input type=text name="mail_cmd" value="$mail_cmd" size=30>\n);

  print "</td></tr>\n";

  print <<END;
</td>
</tr>

<tr>
<td>
END

print (('宛先','To address')[$lang]);

print qq(</td>\n<td><input type=text name="to_mail" value="$to_mail" size=30>\n);

  print "</td></tr>\n";

  print <<END;
</td>
</tr>

<tr>
<td>
END

  print (('From:に名前を表示','Display name on From:')[$lang]);

  print "</td>\n<td>\n";
print <<END;
<input type=radio name=mail_name value=1 $check{mail_name}[1]>$disp
<input type=radio name=mail_name value=0 $check{mail_name}[0]>$nondisp<br>
END

  print "</td></tr>\n";
  print "<tr><td>\n";

  print (('&lt;head&gt;内挿入文','sentense in &lt;head&gt;')[$lang]);
  
  my $valid = (('有効','valid')[$lang]);
  my $invalid = (('無効','invalid')[$lang]);

  print <<END;
</td>
<td>
<input type=radio name=head_insert_en value=1 $check{head_insert}[1]>$valid
<input type=radio name=head_insert_en value=0 $check{head_insert}[0]>$invalid<br>
END

print (('
ＨＴＭＬ書式<br>
ポップアップ広告やJavascript、&lt;META&gt;を挿入したい場合にここに記述する。<br>
以下の記述が&lt;head&gt;〜&lt;/head&gt;内に挿入される。<br>
','HTML format. Javascript, popup ads, &lt;META&gt; and so on can be inserted in here.
')[$lang]);

  print <<END;
<textarea name="head_insert" cols=50 rows=3>$head_insert</textarea><br>
</td>
</tr>

<tr>
<td>セキュリティイメージ設定</td>
<td>
<input type=radio name=captcha_en value=1 $captcha_check[1]>有効
<input type=radio name=captcha_en value=0 $captcha_check[0]>無効<br>
画像サイズ：幅<input type=text name=capimage_width value=$capimage_width size=5>、
高さ<input type=text name=capimage_height value=$capimage_height size=5><br>
スクランブル
<input type=radio name=scramble_en value=1 $scramble_check[1]>有効
<input type=radio name=scramble_en value=0 $scramble_check[0]>無効<br>
スクランブルを有効にすると文字が散らばるので画像サイズを大きめに設定しないといけません。<br>
文字数<input type=text name=cap_text_num value=$cap_text_num size=5><br>
コードの有効期限<input type=text name=cap_expire value=$cap_expire size=5>分<br>
データディレクトリ<input type=text name=capdatadir value=$capdatadir size=20><br>
TTFフォントファイル<input type=text name=ttffont value=$ttffont size=30>（絶対パス）<br>
"Document and Setting"のようなパス内のspace無効<br>
TTFフォントポイントサイズ<input type=text name=ttffont_ptsize value=$ttffont_ptsize size=5><br>
</td>
</tr>
END

  my $stylesheetname = ('スタイルシート','style sheet')[$lang];

print <<END;
<tr>
<td>$stylesheetname</td>
<td>
<input type=radio name=style_sheet_en value=1 $check{style_sheet}[1]>$valid
<input type=radio name=style_sheet_en value=0 $check{style_sheet}[0]>$invalid<br>
<textarea name="style_sheet" cols=50 rows=3>$style_sheet</textarea><br>
</td>
</tr>

<tr>
<td>ページ上部</td>
<td>
ページ上部に表\示させるものをＨＴＭＬ表\記<br>
<textarea name="body_head" cols=50 rows=3 wrap=soft>$body_head</textarea><br>
</td>
</tr>

<tr>
<td>ページ下部</td>
<td>
ページ下部に表\示させるものをＨＴＭＬ表\記<br>
<textarea name="body_tail" cols=50 rows=3 wrap=soft>$body_tail</textarea><br>
</td>
</tr>

</table>
END

my $setting = (('設定','setting')[$lang]);
  print "<input type=submit name=\"sub\" value=\"$setting\">\n";
  print "</form>\n";

  &htmltail;
}

sub setupwrite {

    &error(('管理人パスワードが違います','Wrong admin password')[$lang]) unless ( &checkadmin($in{pwd}));

    foreach (keys(%in)){
	$in{$_} =~ s/\s*$//;
    }

  open(SETUP,"> $setupfile");

    print SETUP <<END;
# Enable mail
\$enable_mail = $in{enable_mail};

# Title
\$title = '$in{title} ';

# Background
\$bgimage_en = $in{bgimage_en};
\$bgimage_file = '$in{bgimage_file}';
\$bgcolor = "$in{bgcolor}";

# Back link
\$backlink_en = $in{backlink_en};
\$backlink = '$in{backlink}';
\$backlink_name = '$in{backlink_name}';

# Body width
\$body_width = '$in{body_width}';

# Display admin link
\$setup_en = $in{setup_en};
\$setup_name = '$in{setup_name}';

# body_head
\$body_head = "$in{body_head} ";

# body_tail
\$body_tail = '$in{body_tail} ';

# return page after sending a mail
# 0: form mail, 1: done page, 2: top page
\$return_page = $in{return_page};

# mail command
\$mail_cmd = '$in{mail_cmd}';

# Recipient
\$to_mail = '$in{to_mail}';

# Name on From:, Bcc:
# 1: display, 0:no display
\$mail_name = $in{mail_name};

#セキュリティイメージ
\$captcha_en = $in{captcha_en};
\$capimage_width = $in{capimage_width};
\$capimage_height = $in{capimage_height};
\$scramble_en = $in{scramble_en};
\$cap_text_num = $in{cap_text_num};
\$cap_expire = $in{cap_expire};

# セキュリティイメージデータディレクトリ
\$capdatadir = '$in{capdatadir}';

# ttffontファイルを絶対パスで。 "Document and Setting"のようなパス内のspace禁止
\$ttffont = "$in{ttffont}";

# ttfrontのポイントサイズ
\$ttffont_ptsize = $in{ttffont_ptsize};

# Style Sheet
\$style_sheet_en = $in{style_sheet_en};
\$style_sheet = '$in{style_sheet}';

# Head insert
\$head_insert_en = $in{head_insert_en};
\$head_insert = '$in{head_insert}';

1;
END

close(SETUP);

print "Location: $script\n\n";

}