|
|
Copyright(C)AllRightsReserved
|
ERR_HTML
}
##
## get_rhost リモートホストを調べる
##
sub get_rhost()
{
my $phost;
my $raddr = $ENV{'REMOTE_ADDR'};
my $rhost = $ENV{'REMOTE_HOST'};
my $paddr = $ENV{'HTTP_X_FORWARDED_FOR'};
if(($rhost eq '') or ($rhost eq $raddr)){
$rhost = gethostbyaddr(pack('CCCC', split(/\./, $raddr)), 2);
}
if($rhost eq ''){
$rhost = $raddr;
}
# 漏れ串なら、漏れた内容も収集する
if($paddr ne ''){
if($paddr =~ s/^(\d+)\.(\d+)\.(\d+)\.(\d+)(\D*).*/$1.$2.$3.$4/){
$phost = gethostbyaddr(pack('CCCC', split(/\./, $paddr)), 2);
}
if($phost eq ''){
$phost = $paddr;
}
$rhost = "$phost($rhost)";
}elsif($ENV{'HTTP_VIA'} ne ''){
$rhost = "$rhost(PROXY)";
}
return $rhost;
}
##
## cnv_msg - HTMLからのメッセージをSJISに変換する。
##
sub cnv_msg()
{
my( $str ) = @_;
# POSTされたデータをデコードし、さらにSJISに変換する
$str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
&jcode'convert(\$str, 'sjis');
return $str;
}
##
## get_msg - 送られてきたメッセージの内容を取得する
##
sub get_msg(){
my( $msghash ) = @_;
my $buf;
# FORMに入力されたメッセージを読み込む
if($ENV{'CONTENT_LENGTH'} < $MSGMAXLEN){
read(STDIN, $buf, $ENV{'CONTENT_LENGTH'});
}else{
&exit_err("メッセージが長すぎます。");
}
# メッセージをハッシュに記憶
my @pairs = split(/\&/, $buf);
my $key, $val;
foreach $pair (@pairs) {
($key, $val) = split(/=/, $pair);
$val =~ s/\+/ /g; # + をスペースに変換
$key = &cnv_msg($key);
$val = &cnv_msg($val);
if($key =~ /^\[(\d*)(.)\](.*)/){ # 先頭が[]で囲まれている
if($$msghash{$key} ne ''){
$$msghash{$key} .= ',';
}
$$msghash{$key} .= $val;
}else{
$$msghash{$key} = $val; # ハッシュに記憶
}
}
}
##
## make_body - メッセージの本文を作成する
##
sub make_body(){
my( %msghash ) = @_;
my $key, $item, $val, $num, $opt, $buf;
$buf = "";
foreach $key (sort keys %msghash) {
if($key =~ /^\[(\d*)(.)\](.*)/){ # 先頭が[]で囲まれている
$num = $1; $opt = $2; $item = $3;
$val = $msghash{$key};
if(($opt eq "n") && ($val eq "")){
&show_err("必須項目 \{$item\} が入力されていません。");
exit;
}
$buf .= "$item: $msghash{$key}\n";
}
}
return $buf;
}
#
# バイナリーをBASE64エンコードする
#
sub encode_mime64()
{
@mimetbl = ('A'..'Z','a'..'z','0'..'9','+','/');
my( $strsrc ) = @_;
my @dat8;
my $datsrc, $strb6, $strb24, $int8;
my $srclen, $padlen, $padform, $i, $j; # 整数
my $strmime;
# 3バイトの整数倍になるようパディングする
$srclen = length($strsrc);
$padlen = (3 - ($srclen % 3)) % 3;
$padform = "a".($srclen + $padlen);
$datsrc = pack($padform, $strsrc);
# 1バイトずつに分解
@dat8 = split(//, $datsrc);
# 3バイトずつ取り出しBASE64エンコードを行なう
$strmime = "";
for($i = 0; $i < ($srclen + $padlen); $i += 3){
# 8ビット3バイトのデータを24ビットのバイナリ文字列に変換
$strb24 = unpack("B8", $dat8[ $i ] )
.unpack("B8", $dat8[ $i+1 ] )
.unpack("B8", $dat8[ $i+2 ] );
print "B24:$strb24\n";
# 24ビットのバイナリ文字列を6ビット4バイトの文字列に変換
for($j = 0; $j < 4; ++$j){
$strb6 = substr($strb24, $j * 6, 6);
$int8 = unpack("C", pack("B8", "00".$strb6));
$strmime .= $mimetbl[$int8];
}
}
# パッドした文字を 'A' から '=' に置き換える
if($padlen > 0){
substr($strmime, -$padlen) = substr('==', 0, $padlen);
}
return $strmime;
}
#
# ISO-2022-JP?B エンコードを行なう。
#
sub encode_iso2022b()
{
my( $strsrc ) = @_;
my $itopjis, $strjis, $strdst;
# JISコードに変換する
&jcode'convert(\$strsrc, 'jis');
# 漢字の最初の文字(代わりに ESC(0x1b))を見つける。
$itopjis = index($strsrc, "\x1b");
if($itopjis == -1){ # 漢字が含まれない
return $strsrc;
}
if($itopjis == 0){ # 先頭から漢字
return "\=\?ISO\-2022\-JP\?B\?".&encode_mime64($strsrc)."\?\=";
}
# 先頭は英数字で途中から漢字(途中にASCIIがでてもまとめてエンコード)
return substr($strsrc, 0, $itopjis)."\=\?ISO\-2022\-JP\?B\?"
.&encode_mime64(substr($strsrc, $itopjis))."\?\=";
}
#
# make_mail - メールを作成する。
#
sub make_mail()
{
my( $mailbody, %msghash ) = @_;
my $buf, $sbj, $fromaddr;
# メールアドレスのコメント(差出人名を反映)
if($msghash{'FROMNAME'} ne ""){
$fromaddr = "\"".&encode_iso2022b($msghash{'FROMNAME'})."\"";
$fromaddr = $fromaddr." <".$msghash{'FROMADDR'}.">";
}else{
$fromaddr = $msghash{'FROMADDR'};
}
# サブジェクトの作成 (iso-2022-jpエンコード)
if($msghash{'SUBJECT'} ne ""){
$SUBJECT = $msghash{'SUBJECT'};
}
$sbj = &encode_iso2022b($SUBJECT);
# メールの作成
$buf = "To: $TOADDR\n";
$buf .= "From: $TOADDR\n";
$buf .= "Subject: $sbj\n";
$buf .= "X-Mailer: $VERSION\n";
$buf .= "Content-Transfer-Encoding: 7bit\n";
$buf .= "Content-Type: text/plain; charset=iso-2022-jp\n";
$buf .= "\n"; # セパレータ
$buf .= $mailbody; # 本文
return $buf;
}
#
# make_ackmail - 確認用メールを作成する。
#
sub make_ackmail()
{
my( $mailbody, %msghash ) = @_;
my $buf, $sbj, $headmsg, $fromaddr;
# サブジェクトの作成 (iso-2022-jpエンコード)
if($msghash{'SUBJECT'} ne ''){
$SUBJECT = $msghash{'SUBJECT'};
}
$sbj = &encode_iso2022b($SUBJECT);
# メールの作成
$buf = "To: $fromaddr\n"; # 差出人へ
if($ACKFROMADDR eq ''){
$buf .= "From: $TOADDR\n";
}else{
$buf .= "From: $ACKFROMADDR\n";
}
$buf .= "Subject: $sbj\n";
$buf .= "X-Mailer: $VERSION\n";
$buf .= "Content-Transfer-Encoding: 7bit\n";
$buf .= "Content-Type: text/plain; charset=iso-2022-jp\n";
$buf .= "\n"; # セパレータ(ヘッダの終り)
if($msghash{'ACKHEADMSG'} ne ''){
$headmsg = $msghash{'ACKHEADMSG'};
jcode'convert(\$headmsg, 'jis');
$buf .= "$headmsg\n";
}
$buf .= $mailbody; # 本文
return $buf;
}
#
# send_mail - メールを送信する。
#
sub send_mail()
{
my( $mailmsg, $sendaddr ) = @_;
open(OUT, "| $MAILCMD $sendaddr") || &show_err("メール送信に失敗しました。");
print OUT $mailmsg;
close(OUT);
}
#
# show_end - 終了メッセージを表示
#
sub show_end()
{
my( $donemsg ) = @_;
print $HTMLOUTS;
print << "DONE_HTML1";
インターネット広告WEB企画制作JSP(株式会社ジェイエスピー)【お問い合わせ】
インターネット広告WEB企画制作JSP(株式会社ジェイエスピー)【お問い合わせ】
|
|
|
|
|
Copyright(C)AllRightsReserved
|
DONE_HTML1
}
#
# jump_end - 最後に所定のURLにジャンプして終了
#
sub jump_end()
{
my( $donemsg, $jumpurl) = @_;
print $HTMLOUTS;
print << "DONE_HTML2";
インターネット広告WEB企画制作JSP(株式会社ジェイエスピー)【お問い合わせ】
インターネット広告WEB企画制作JSP(株式会社ジェイエスピー)【お問い合わせ】
|
|
|
|
|
<
|
Copyright(C)AllRightsReserved
|
DONE_HTML2
}
#
# main - メイン処理
#
sub main()
{
my %postmsg;
my $mailbody, $mailmsg, $donemsg;
my $ackbody, $ackmsg;
if($TOADDR eq 'hoge@page'){
&show_err("CGIの設置エラーです(宛先未設定)。");
exit;
}
if($ENV{REQUEST_METHOD} eq 'POST'){
&get_msg(\%postmsg); # メッセージを読み出す
}else{
&show_err("CGIの呼び出しが不正です。");
exit;
}
$mailbody = &make_body(%postmsg);
$ackbody = $mailbody;
# 登録アドレス($TOADDR)にメールを送る
$mailbody .= "";
jcode'convert(\$mailbody, 'jis');
$mailmsg = &make_mail($mailbody, %postmsg);
&send_mail($mailmsg, $TOADDR);
if($SENDACK){
# FROMアドレス(POSTされたFROMADDR)に確認メールを送る
jcode'convert(\$ackbody, 'jis');
$ackmsg = &make_ackmail($ackbody, %postmsg);
&send_mail($ackmsg, $postmsg{'FROMADDR'});
}
if($postmsg{'DONEMSG'} ne ""){
$donemsg = $postmsg{'DONEMSG'};
}else{
$donemsg = $DONEMSG;
}
if($postmsg{'NEXTURL'} ne ""){
&jump_end($donemsg, $postmsg{'NEXTURL'});
}else{
&show_end($donemsg);
}
}
# 本プログラムのライセンスについて。
#
# 本スクリプトは、自ら使用する目的にあっては、個人・団体(会社含む)を問わず
# フリーです。但し、第三者に提供又は利用させて対価をとるような場合については
# E-mailで問い合わせ下さい。また個人レベル(個人からその友人など特定少数の
# 配布)を除く、再配布(雑誌への掲載等)についてもE-mailで問い合わせ下さい。
#
# 自ら使用する場合、改造は自由です。ただし改造したものの配布は禁止します。
#
# このプログラムの改良点を見つけた場合には、作者 O.K.U. にお知らせ下さい。
# 広く有効なものであれば、次回のバージョンアップ時に取り入れたいと思います。
# その場合でも、このライセンス条件が変わることはありません。
#
# 自分自身が利用するに当たっての改造は自由ですが、再配布は禁止します。
#
# このライセンスは、この perl プログラムにのみ適用されます。jcode.pl に
# 関して、このライセンスが制約することはありません。
| | |