#! c:/perl/bin/perl
#
# smail.cgi
# SSIモードフォームメール CAPTCHA付き
#
# 1.001 : 2/11/07 : デフォルトでCAPTCHAをオフに修正
# 1.0 : 2/9/07 : Initial revision
#
# http://www.hidekik.com
#
# Copyright(c) 2007, 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 = 2007;
my $version = "1.001";

my $script = basename($0);

my $setupfile = "smail_setup.pl";

my $charset = "Shift_JIS";

my $lang = 0;

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

# Enable mail
our $enable_mail = 0;

# SSIを設置するshtmlからみたこのCGIへのパス
our $path_from_shtml = "smail";

# Back link
our $backlink = '../toppage.shtml';   # CGIからみた戻りページへのパスとファイル
our $backlink_name = '戻る';

# return page after sending a mail
# 0: $backlinkのページへ 1:送信完了ページへ
our $return_page = 0;

# mail command
# sendmailの場合、-tは必ず必用です。
our $mail_cmd = '/usr/sbin/sendmail -t';

# メール受信者
our $to_mail = 'yourname@yourdomain.com';

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

# 名前のtextboxのサイズ
our $name_textsize = 10;

# メールのtextboxのサイズ
our $mail_textsize = 15;

# タイトルのtextboxのサイズ
our $title_textsize = 15;

# 本文のtextareaのサイズ
our $textarea_rows = 5;
our $textarea_cols = 30;

#セキュリティイメージ 1:有効 0:無効
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;

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

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;

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 'send'){
    &send;
} else {
    &mainpage;
}

sub mainpage {

    print $q->header;

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

    print qq(送信者の名前<br>\n);
    print qq(<INPUT type="text" size="$name_textsize" name="sender"><br>\n);
    print qq(送信者のメールアドレス<br>\n);
    print qq(<INPUT type="text" size="$mail_textsize" name="mailaddress1"><BR>\n);

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

    print qq(本文<BR>\n);
    print qq(<TEXTAREA rows="$textarea_rows" cols="$textarea_cols" name="main" wrap="soft"></TEXTAREA>\n);

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

}

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){
	if ($in{capmd5} eq ''){
		&retry_captcha("セキュリティチェック");
	} else {
	    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 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=\"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 ($subject eq '' or $contents eq '');

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

    &security_check;

    unless ($enable_mail){
	&error('メール機能は現在無効になっています。<p>' . "<a href=\"$backlink\">$backlink_name</a>");
    }

    $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 == 1) {
	&error("送信しました。<p><a href=\"$backlink\">$backlink_name</a>");
    } else {
	print "Location: $backlink\n\n";
    }
}

sub htmlhead {
  
  my $title = shift;
  
  my $bgimage;
  $bgimage = "bgcolor=\"#ffffff\"";

  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";

  print "</HEAD>\n";
  print "<BODY TEXT=\"#000000\" $bgimage LINK=\"#0000EE\" VLINK=\"#551A8B\" ALINK=\"#FF0000\">\n";
  
}

sub copyright {
    my $mysite = ('http://www.hidekik.com/','http://www.hidekik.com/en/')[$lang];
  print "<div align=\"right\"><i>smail.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 "</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;
}