fork download
copy 
  1. #!/usr/bin/perl
  2.  
  3. # フォームメール v1.70  <FREESOFT>
  4. # (Ｗｅｂ上のフォームから送信された内容を電子メールで配信する)
  5. #
  6. ;$vers = '1.70';
  7. #
  8. #  製作・著作 CGI-RESCUE
  9. #  http://w...content-available-to-author-only...e.jp/
  10. #  http://w...content-available-to-author-only...e.jp/cgi/form2mail/
  11. #
  12. # [設計履歴]
  13. # 01/FEB/1999 v1.00 <WebFORM> + <FileUPLOADER> = <FORM2MAIL>
  14. # 12/FEB/1999 v1.01 エラー処理の修正(一時ファイルの削除トラブル)
  15. # 24/MAR/1999 v1.10 アクセス元チェックの処理の設定
  16. # 25/JUL/1999 v1.11 テーブルタグ内のフォームについて修正
  17. # 16/DEC/1999 v1.12 $ref_urlの処理ミス修正
  18. # 07/FEB/2000 v1.13 再梱包
  19. # 09/FEB/2000 v1.14 抜けていたタグ処理を追加,CSV出力添付機能の付加
  20. # 26/JUL/2000 v1.15 メールヘッダの修正
  21. # 05/OCT/2004 v1.20 SubjectのRFC2045対応(簡易),UUENCODE/BASE64選択,外部プログラムnkfおよびuuencodeを使わない設計
  22. # 31/JAN/2005 v1.21 Content-Type出力の修正
  23. # 16/Feb/2006 v1.22 スパムに対する脆弱性を修正
  24. # 18/Mar/2006 v1.23 メールのタイトルをＢエンコードにしない場合にタイトルが設定されない不具合を修正
  25. # 12/May/2006 v1.30 必須項目エラーの表示順を、フォームで羅列した順に修正
  26. # 31/May/2006 v1.31 v1.30修正のバグの修正
  27. # 22/Jun/2006 v1.32 Ｂエンコードしない場合にタイトルの文字コードがJISにならないバグの修正
  28. # 13/Nov/2006 v1.40 スパム防止機能を追加（スパムキー機能）
  29. # 16/Jan/2007 v1.41 スパムキー機能を使わない場合に送信できなくなるバグの修正
  30. # 12/Dec/2008 v1.42 任意の宛て先、内容でメール送信可能な脆弱性を修正(※1)
  31. # 30/Sep/2009 v1.50 送信先振り分け機能の追加,デザイン変更など
  32. # 15/Oct/2009 v1.51 添付なしの場合に確認画面を出すとマルチパートで送信されてしまう不具合の修正
  33. # 30/Dec/2009 v1.52 マルチパート指定であっても添付が無い場合はマルチパートにしないように変更
  34. # 02/Sep/2011 v1.60 自動返信機能の追加
  35. # 19/Sep/2013 v1.70 メールアドレス再度入力チェック機能の追加
  36.  
  37. #-------------------------------------------------------------------------------------------
  38.  
  39. # [設置例] ( )内はパーミッションの相当値
  40. #
  41. # /任意のディレクトリ/
  42. #         |
  43. #         |-- /tmp/ <777> ... 作業用
  44. #         |-- base64.pl <644> ... ＭＩＭＥ変換ライブラリ
  45. #         |-- cgi-lib217.pl <644> ... ＣＧＩライブラリ
  46. #         |-- form2mail.cgi <755> ... 本体（このプログラム）
  47. #         |-- jcode.pl <644> ... 日本語コード変換ライブラリ
  48. #
  49.  
  50. #------ 初期設定 ---------------------------------------------------------------------------
  51.  
  52. #■日本語コード変換ライブラリ    # require './***.pl';(同じフォルダ上にある場合) と require '***.pl'; は意味が違いますので、注意。
  53. #
  54. require './jcode.pl';
  55.  
  56. #■ＣＧＩライブラリ
  57. #
  58. require "./cgi-lib217.pl";
  59.  
  60. #■ＭＩＭＥ変換ライブラリ
  61. #
  62. require "./base64.pl";
  63.  
  64. #■sendmailの設定
  65. #
  66. $sendmail = '/usr/sbin/sendmail';
  67.  
  68. #■作業用ディレクトリの設定
  69. #　同じディレクトリにtmpという名前のディレクトリを作成し、パーミッションを777(サーバの最適な値にあわせること)にします。
  70. #
  71. $tmp = "./tmp/";
  72.  
  73. #■宛先メールアドレス(既定)
  74. #
  75. $mailto = test@xxxx.com';
  76.  
  77. #■メール題名により宛先を変える場合(任意)
  78. #  name="_subject" の value または option 値に '題名' を設定し、それが送信または選択されると、
  79. #  対応するメールアドレスが宛先となります。該当がない場合は既定アドレスに送信されます。
  80. #
  81. # <設定例>
  82. #
  83. #  %mailto = (
  84. #    '題名' => 'メールアドレス',
  85. #    '技術的なお問い合わせ' => 'メール１@メールアドレス',
  86. #    'その他のお問い合わせ' => 'メール２@メールアドレス',
  87. #  );
  88. #
  89.  
  90. #■参照チェック
  91. #送信フォームのＵＲＬがここに設定した文字列を含まない場合は送信しない
  92. #
  93. $ref_url = '';
  94.  
  95. #■このスクリプトを設置する日本語コード (sjis,euc) ※ヘッダ出力設定と合わせること
  96. #
  97. $convert = 'utf8';
  98.  
  99. #■ヘッダ出力設定  $header = <<"EOF"; の次の行から EOF の前の行に書く
  100. #  <TITLE>～</TITLE> はブラウザのタイトルバーに表示される
  101. #
  102. $header = <<'EOF';
  103. <meta charset="utf-8">
  104. <TITLE>フォームメール送信</TITLE>
  105. EOF
  106.  
  107. #■アクセス元をチェックする(いたずらで困っている場合のみ) 0:しない 1:する
  108. #
  109. $ref_check = 0;
  110.  
  111. #■スパムキー機能を使う場合のキーワード設定
  112. #
  113. #  画面に表示した単語、文章、文字列を入力させたり、それを画像にしたものを入力させる（目の不自由な方には対応できないことに留意）、
  114. #  または質問の答えを書かせるなどして、このＣＧＩの送信機能を悪用して自動で送信してくるスパムを、
  115. #  自動（ロボット）では処理できない段取りを挿入することにより防止する機能です。
  116. #
  117. #  スパムキー <input type="text" name="_spamkey">
  118. #
  119. #  のように、｢name=｣を｢spam_key｣にして入力した内容は、ＣＧＩ内に設定したキーワードと
  120. # 「一致」(半角・全角・大文字・小文字などは区別される)しなければ送信しないという機能です。
  121. #  これを設定しても、ＣＧＩ内にキーワードを設定しない場合は設定エラーになります。キーワードを設定しても、フォームに設定しない場合は無視されます。
  122. #  キーワードは '' の間に設定してください。例：'日本' 例：'123'
  123. #
  124. $spam_base_key = '00';
  125.  
  126. #■自動返信を行うかどうか？
  127. #
  128. #　メールアドレスを入力する(判定する)欄に記載される宛先に、自動返信メールを行うかどうかの設定です。
  129. #　任意のメールアドレス宛に送信出来てしまうので、利用する場合は注意が必要です。
  130. #
  131. # (※注) 任意のメールアドレス宛に "記入内容" を匿名に近い形で送りつけることが出来てしまうので、利用する場合は注意が必要です。
  132. #
  133. $auto_resp = 1; #-- 1:行う 0:行わない
  134. $hikae = 1;     #-- 1:記入控えを自動返信メール内に記載する(※注) 0:しない
  135.  
  136. $auto_resp_subject = '問い合わせをお受けしました'; #-- 自動返信メールの題名
  137.  
  138. $auto_resp_message = <<'EOF';
  139. お客様へ
  140.  
  141. お問い合わせを受信しました。
  142. 折り返しご案内いたしますのでお待ちください。
  143.  
  144. -----------------------------
  145.  ○○○株式会社 03-0000-0000
  146. -----------------------------
  147. ※このメールに覚えがない場合は無視していただくかご一報ください。
  148.  
  149. EOF
  150.  
  151.  
  152. #■メールのタイトルをＢエンコード化するかどうか -- 0:しない 1:する
  153. #
  154. $EncodeB = 0;
  155.  
  156. 	# (参考) メール"Subject"について
  157. 	# メールのヘッダ部分に２バイト文字を使う場合は、RFC2045に依り、BASE64でエンコードしたＢエンコード形式
  158. 	# =?ISO-2022-JP?B?<BASE64コード>?= にしなければなりませんが、昨今のほとんどのメールソフトでは、そう
  159. 	# しなくても正しく表示してくれます。この規則に従うように加工することは非常に面倒なため、その特殊な加工
  160. 	# を必要としない程度の仕様に留めているため、メール題名の文字数に制限を設けています。
  161.  
  162. #■ファイル添付形式 # 0:BASE64 1:UUENCODE
  163. #
  164. $uuencode = 0;
  165.  
  166. 	# (参考) このプログラムのuuencodeの仕様
  167. 	# メールゲートウェイの中に行末を含む空白文字を除去してしまうものがあるため、空白文字は"`"(0x60)に変換しています。
  168. 	# デコードする際はそれは空白文字(0x00)として解釈してください。<MODE>は当プログラムでは600に設定しています。
  169. 	#
  170. 	# begin <MODE> <ファイル名>
  171. 	# ～内容～
  172. 	# `
  173. 	# end
  174.  
  175. #■処理画面の上部に挿入するＨＴＭＬ  $head = <<"EOF"; の次の行から EOF の前の行に書く
  176. #
  177. $head = <<'EOF';
  178. <b>ヘッドメッセージ</b>
  179. <hr>
  180. EOF
  181.  
  182. #■処理画面の下部に挿入するＨＴＭＬ  $bottom = <<"EOF"; の次の行から EOF の前の行に書く
  183. #
  184. $bottom = <<'EOF';
  185. <hr>
  186. <b>ボトムメッセージ</b>
  187. EOF
  188.  
  189. #■送信前確認画面における色設定
  190. #
  191. #↓「項目と内容」部分の背景色
  192. $cellColor = "#800000";
  193. #↓「項目と内容」部分の文字色
  194. $fontColor = "#ffffff";
  195. #↓「項目と内容」の交互色１
  196. $tableColor1 = "#eeeeee";
  197. #↓「項目と内容」の交互色２
  198. $tableColor2 = "#e0e0e0";
  199.  
  200. #-------------------------------------------------------------------------------------------
  201.  
  202. ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
  203. @mon_array = ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec');
  204. @wday_array = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat');
  205. $date_now = sprintf("%s, %02d %s %04d %02d:%02d:%02d +0900 (JST)",$wday_array[$wday],$mday,$mon_array[$mon],$year +1900,$hour,$min,$sec);
  206.  
  207. #-------------------------------------------------------------------------------------------
  208.  
  209. $ref = $ENV{'HTTP_REFERER'};
  210. $addr = $ENV{'REMOTE_ADDR'};
  211. if ($host eq "" || $host eq $addr) { $host = gethostbyaddr(pack('C4',split(/\./,$addr)),2) || $addr; }
  212. $via = $ENV{'HTTP_VIA'};
  213. $xfor = $ENV{'HTTP_X_FORWARDED_FOR'};
  214. $for = $ENV{'HTTP_FORWARDED'};
  215. $agent = $ENV{'HTTP_USER_AGENT'}; $agent =~ s/</(/g; $agent =~ s/>/)/g;
  216. if ($via ne "") { $trueip = $xfor; }
  217. else { $trueip = $addr; }
  218. if ($xfor ne "") { $xfor_name = gethostbyaddr(pack('C4',split(/\./,$xfor)),2) || $xfor; }
  219. $access_data = "host;$host addr;$addr via;$via xfor;$xfor for;$for agent;$agent trueip;$trueip xfor_name;$xfor_name";
  220. $access_data =~ s/\n|\r//g;
  221.  
  222. #-------------------------------------------------------------------------------------------
  223.  
  224. $ret = &ReadParse;
  225. if ($ret == 0) { &error('入力がありません.'); }
  226.  
  227. if ($ref_check) {
  228.  
  229. 	$ref =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
  230. 	$ref =~ s/\n|\r//g; # ※1
  231.  
  232. 	if (!($ref =~ /$ref_url/i)) { &error('不正な手順を検知しました','正規のフォーム以外からのアクセスです.'); }
  233. }
  234.  
  235. #-------------------------------------------------------------------------------------------
  236.  
  237. $filenum = 0;
  238. foreach $data (@in) {
  239.  
  240. 	unless ($ENV{'CONTENT_TYPE'} =~ m#^multipart/form-data#) {
  241.  
  242. 		$data =~ s/\+/ /g;
  243. 		($key,$val) = split(/=/,$data,2);
  244. 		$key =~ s/%([A-Fa-f0-9]{2})/pack("c",hex($1))/ge;
  245. 		push(@name,"$key\0$filename");
  246. 	}
  247. 	else {
  248. 		($key) = $data =~ /\bname="([^"]+)"/i;
  249. 		($filename) = $data =~ /\bfilename="([^"]*)"/i;
  250. 		if ($filename eq '' && $data =~ /\bfilename="([^"]*)"/i) { next; }
  251. 		push(@name,"$key\0$filename");
  252. 	}
  253. }
  254.  
  255. #-------------------------------------------------------------------------------------------
  256.  
  257. $fileC1 = $fileC2 = 0;
  258. foreach $name (@name) {
  259.  
  260. 	($name,$filename) = split("\0",$name);
  261.  
  262. 	if ($filename ne '') {
  263.  
  264. 		if (exists $out{$name}) { $fileC1 = 1; next; }
  265. 		$fileC2 = 1;
  266.  
  267. 		$ps = $$;
  268. 		if ($ps eq '') { $ps = time; }
  269.  
  270. 		$filename = reverse(($filename) = split(/\\|\/|\:/,reverse($filename)));
  271. 		push(@FILE,"$name\0$ps\_$filenum\0$filename");
  272. 		push(@FILEDATA,$in{$name});
  273.  
  274. 		$filenum++;
  275. 		$out{$name} = $name;
  276. 		push(@atf,"$name\0$filename");
  277.  
  278. 		next;
  279. 	}
  280.  
  281. 	&jcode'convert(*name,$convert);
  282.  
  283. 	$num = $lastspc = 0;
  284.  
  285. 	foreach $value (split("\0",$in{$name})) {
  286.  
  287. 		if (!exists $out{$name}{$num}) {
  288.  
  289. 			$lastspc = 1;
  290. 			&jcode'convert(*value,$convert);
  291.  
  292. 			($cmd) = &checkval($name,$value);
  293. 			if ($cmd) { next; }
  294.  
  295. 			$value =~ s/\r\n/\n/g;
  296. 			$value =~ s/\r/\n/g;
  297. 			$value =~ s/&/&amp;/g;
  298. 			$value =~ s/"/&quot;/g;
  299. 			$value =~ s/</&lt;/g;
  300. 			$value =~ s/>/&gt;/g;
  301.  
  302. 			push(@out,"$name\0$value");
  303. 			$out{$name}{$num} = $value;
  304. 			last;
  305. 		}
  306.  
  307. 		$num++;
  308. 	}
  309.  
  310. 	if (!$lastspc) {
  311.  
  312. 		if ($name =~ /^_(.*)$/) { next; }
  313. 		push(@out,$name);
  314. 	}
  315. }
  316.  
  317. #-------------------------------------------------------------------------------------------
  318.  
  319. if ($auto_resp) { # 自動返信する場合
  320.  
  321. 	if ($in{'_emailset'} eq '' || !exists $in{$in{'_emailset'}}) { &error('設定エラー','Ｅメール入力欄として扱うラベルが設定されていません.'); }
  322. }
  323.  
  324. if ($in{'_emailset'} ne '') {
  325.  
  326. 	$EMAIL = $in{$in{'_emailset'}};
  327.  
  328. 	if ($EMAIL ne '') {
  329.  
  330. 		if ($EMAIL =~ /\s|\,/) { &error('エラー','Ｅメールを正しくご記入ください.'); }
  331. 		unless ($EMAIL =~ /\b[-\w.]+@[-\w.]+\.[-\w]+\b/) { &error('エラー','Ｅメールは半角で正しくご記入ください.'); }
  332. 	}
  333. 	elsif ($auto_resp) { &error('エラー','Ｅメールをご記入ください.'); }
  334.  
  335. 	if ($in{'_emailset2'} ne '') { # メールアドレス再入力チェック
  336.  
  337. 		$EMAIL2 = $in{$in{'_emailset2'}};
  338.  
  339. 		if ($EMAIL ne $EMAIL2) { &error('エラー','Ｅメールが一致しません.'); }
  340. 	}
  341. }
  342.  
  343. $EMAIL =~ s/\n//g; $EMAIL =~ s/\r//g;
  344. if (length($EMAIL) > 255) { &error('エラー','メールアドレスの長さ制限は255文字までです.'); }
  345. if ($EMAIL =~ /\,/) { &error('エラー','メールアドレスを１つだけ入力してください.'); }
  346.  
  347. if ($EMAIL eq '') { $EMAIL = 'Undisclosed-Recipient'; }
  348.  
  349. #-------------------------------------------------------------------------------------------
  350.  
  351. foreach $out (@out) {
  352.  
  353. 	($name,$value) = split("\0",$out);
  354. 	if ($indispen{$name} && $in{$name} eq '') { push(@INDISPENs,"「 $name 」"); }
  355. }
  356.  
  357. if (@INDISPENs) { &error("未記入があります","@INDISPENs を入力してください。"); }
  358.  
  359. #-------------------------------------------------------------------------------------------
  360.  
  361. if ($spam_base_key eq '' && defined $in{'_spamkey'}) { &error('設定エラー','スパムキー用のキーワードが設定されていません.'); }
  362. if ($spam_base_key ne '' && $spam_base_key ne $in{'_spamkey'} && defined $in{'_spamkey'}) { &error('送信できません','確認用キーワードを入力してください.'); }
  363.  
  364. #-------------------------------------------------------------------------------------------
  365.  
  366. if ($fileC1) { &error('エラー','アップロードファイルの項目名が重複しています.'); }
  367.  
  368. if ($fileC2) { 
  369.  
  370. 	foreach $file (0 .. $#FILE) {
  371.  
  372. 		($name,$filenum,$filename) = split("\0",$FILE[$file]);
  373.  
  374. 		if (!open(BIN,"> $tmp$filenum")) { &error('設定エラー','アップロードファイルの一時ファイルが作成できません.','テンポラリーフォルダのパーミッションを確認してください.'); }
  375. 		binmode(BIN);
  376. 		print BIN $FILEDATA[$file];
  377. 		close(BIN);
  378.  
  379. 		$mix = 1;
  380. 	}
  381. }
  382.  
  383. if ($check{'_check'} && $mix) { &error('設定エラー','マルチパートおよびファイルアップロードを使う場合は、内容確認処理(_check)は利用できません.'); }
  384.  
  385. if ($check{'_check'}) { &check; }
  386.  
  387. &sendmail;
  388. exit;
  389.  
  390. #-------------------------------------------------------------------------------------------
  391.  
  392. sub check {
  393.  
  394. 	print "Content-type: text/html\n\n";
  395. 	print "<HTML>\n";
  396. 	print "<HEAD>\n";
  397. 	print $header;
  398. 	print "</HEAD>\n";
  399. 	print "<body $check{'_body'}>\n";
  400.  
  401. 	print <<"EOF";
  402. 	$head
  403. 	<h2>送信前確認</h2>
  404. 	<form method="$ENV{'REQUEST_METHOD'}" action="form2mail.cgi">
  405.  
  406. 	<table border=0 cellpadding=5 cellspacing=2 width=100%>
  407. 	<tr bgcolor="$cellColor"><td width=20%><b><font size=+1 color="$fontColor">項目</font></b></td><td><b><font size=+1 color="$fontColor">内容</font></b></td></tr>
  408. EOF
  409.  
  410. 	foreach (@out) {
  411.  
  412. 		($name,$value) = split("\0");
  413.  
  414. 		if ($i % 2) { $bgcolor = $tableColor1; }
  415. 		else { $bgcolor = $tableColor2; }
  416.  
  417. 		print "<tr><input type=hidden name=\"$name\" value=\"$value\">\n";
  418. 		print "<td bgcolor=\"$bgcolor\">$name</td>\n";
  419.  
  420. 		if ($value =~ /\n/) { print "<td bgcolor=\"$bgcolor\"><pre>$value</pre></td></tr>\n"; }
  421. 		else { print "<td bgcolor=\"$bgcolor\">$value</td></tr>\n"; }
  422.  
  423. 		print "</td></tr>\n";
  424.  
  425. 		$i++;
  426. 	}
  427.  
  428. 	print "</table><p>\n";
  429.  
  430. 	while (($key,$val) = each %check) {
  431.  
  432. 		if ($key =~ /^_check$/i) { next; }
  433. 		print "<input type=hidden name=\"$key\" value=\"$val\">\n";
  434. 	}
  435.  
  436. 	while (($key,$val) = each %indispen) {
  437.  
  438. 		print "<input type=hidden name=\"_indispen\" value=\"$key\">\n";
  439. 	}
  440.  
  441. 	print "<input type=hidden name=\"_refurl\" value=\"$ref\">\n";
  442. 	print "<input type=submit value=\"   メ  ー  ル  送  信   \"><p>\n";
  443.  
  444. 	print "</form>\n";
  445.  
  446. 	print $bottom;
  447. 	print &HtmlBot;
  448. 	exit;
  449. }
  450.  
  451. #-------------------------------------------------------------------------------------------
  452.  
  453. sub sendmail {
  454.  
  455. 	push(@MailValue,"Date: $date_now\n");
  456. 	push(@MailValue,"X-Sender: $access_data\n");
  457. 	push(@MailValue,"X-Mailer: form2mail $vers by CGI-RESCUE\n");
  458. 	push(@MailValue,"X-Referer: $ref\n");
  459.  
  460. 	if ($mailto{$in{'_subject'}} ne "") { $mailto = $mailto{$in{'_subject'}}; }
  461.  
  462. 	push(@MailValue,"To: $mailto\n");
  463. 	if ($EMAIL eq 'Undisclosed-Recipient') { push(@MailValue,"Reply-To: $mailto\n"); }
  464.  
  465. 	push(@MailValue,"From: $EMAIL\n");
  466.  
  467. 	$SUBJECT = $in{'_subject'};
  468. 	$SUBJECT =~ s/\n//g; $SUBJECT =~ s/\r//g;
  469.  
  470. 	if ($EncodeB) {
  471.  
  472. 		$SUBJECT = &mailSubject_base64encode($SUBJECT);
  473. 		if (!$SUBJECT) { &error("エラー","メールのタイトル(題名)を短くしてください。"); }
  474. 	}
  475. 	else { $SUBJECT = &jis("Subject: $SUBJECT\n"); }
  476.  
  477. 	push(@MailValue,$SUBJECT);
  478. 	push(@MailValue,"MIME-Version: 1.0\n");
  479. 	push(@MailValue,"Content-Transfer-Encoding: 7bit\n");
  480.  
  481. 	if ($mix) { &send_mix; }
  482. 	else { &send; }
  483.  
  484. 	if (open(OUT,"| $sendmail -t")) {
  485.  
  486. 		foreach (@MailValue) { print OUT $_; }
  487. 		close(OUT);
  488. 	}
  489.  
  490. 	if ($auto_resp) { # 自動返信
  491.  
  492. 		undef @MailValue;
  493.  
  494. 		push(@MailValue,"Date: $date_now\n");
  495. 		push(@MailValue,"X-Sender: $access_data\n");
  496. 		push(@MailValue,"X-Mailer: form2mail $vers by CGI-RESCUE\n");
  497. 		push(@MailValue,"X-Referer: $ref\n");
  498.  
  499. 		if ($EncodeB) {
  500.  
  501. 			$auto_resp_subject = &mailSubject_base64encode($auto_resp_subject);
  502. 			if (!$auto_resp_subject) { &error("設定エラー","自動返信メールのタイトル(題名)を短くしてください。"); }
  503. 		}
  504. 		else { $auto_resp_subject = &jis("Subject: $auto_resp_subject\n"); }
  505.  
  506. 		push(@MailValue,$auto_resp_subject);
  507. 		push(@MailValue,"MIME-Version: 1.0\n");
  508. 		push(@MailValue,"Content-Transfer-Encoding: 7bit\n");
  509. 		push(@MailValue,"Content-Type: text/plain; charset=\"ISO-2022-JP\"\n");
  510. 		push(@MailValue,"From: $mailto\n");
  511. 		push(@MailValue,"To: $EMAIL\n");
  512. 		push(@MailValue,"\n");
  513. 		push(@MailValue,$auto_resp_message);
  514.  
  515. 		if ($hikae) {
  516.  
  517. 			push(@MailValue,"\n送信控え\n");
  518. 			push(@MailValue,"-----------------------------\n");
  519. 			push(@MailValue,"$BODY2\n");
  520. 			push(@MailValue,"\n");
  521. 		}
  522.  
  523. 		if (open(OUT,"| $sendmail -t")) {
  524.  
  525. 			foreach (@MailValue) { print OUT $_; }
  526. 			close(OUT);
  527. 		}
  528. 	}
  529.  
  530. 	if ($check{'_ccopy'} && $check{'_location'} ne '') {
  531.  
  532. 		print "Content-type: text/html\n\n";
  533. 		print "<HTML>\n";
  534. 		print "<HEAD>\n";
  535. 		print $header;
  536. 		print "</HEAD>\n";
  537. 		print "<body $check{'_body'}>\n";
  538. 		print $head;
  539. 		print "<h2>送信しました</h2>\n";
  540. 		print "<table><tr><td>";
  541. 		&cc;
  542. 		print "</td></tr></table><p>\n";
  543. 		print "<div align=right>[ <a href=\"$check{'_location'}\" target=\"_top\"><b>次へ</b></a>]</div>";
  544. 	}
  545. 	elsif ($check{'_ccopy'}) {
  546.  
  547. 		print "Content-type: text/html\n\n";
  548. 		print "<HTML>\n";
  549. 		print "<HEAD>\n";
  550. 		print $header;
  551. 		print "</HEAD>\n";
  552. 		print "<body $check{'_body'}>\n";
  553. 		print $head;
  554. 		print "<h2>送信しました</h2>\n";
  555. 		print "<table><tr><td>";
  556. 		&cc;
  557. 		print "</td></tr></table><p>\n";
  558. 		if ($check{'_gourl'} ne '' && $check{'_goname'} ne '') { print "<div align=right>[ <a href=\"$check{'_gourl'}\" target=\"_top\"><b>$check{'_goname'}</b></a>]</div>"; }
  559. 	}
  560. 	elsif ($check{'_location'} ne '') { print "Location: $check{'_location'}\n\n"; exit; }
  561. 	else {
  562. 		print "Content-type: text/html\n\n";
  563. 		print "<HTML>\n";
  564. 		print "<HEAD>\n";
  565. 		print $header;
  566. 		print "</HEAD>\n";
  567. 		print "<body $check{'_body'}>\n";
  568. 		print $head;
  569. 		print "<h2>送信しました</h2>\n";
  570. 		if ($check{'_gourl'} ne '' && $check{'_goname'} ne '') { print "<div align=right>[ <a href=\"$check{'_gourl'}\" target=\"_top\"><b>$check{'_goname'}</b></a>]</div>"; }
  571. 	}
  572.  
  573. 	print $bottom;
  574. 	print &HtmlBot;
  575. }
  576.  
  577. #-------------------------------------------------------------------------------------------
  578.  
  579. sub cc {
  580.  
  581. 	print "■$in{'_subject'}<p>\n";
  582.  
  583. 	foreach (@out) {
  584.  
  585. 		s/&lt;/</g;
  586. 		s/&gt;/>/g;
  587.  
  588. 		($name,$value) = split("\0");
  589.  
  590. 		if ($value =~ /\n/) {
  591.  
  592. 			$value =~ s/\n/<br>\n/g;
  593. 			print "[<b>$name</b>]<br>\n$value<p>\n";
  594. 		}
  595. 		elsif ($check{'_type'} == 1) { print "[<b>$name</b>]<br>\n$value<p>\n"; }
  596. 		else { print "[<b>$name</b>] $value<p>\n"; }
  597. 	}
  598.  
  599. 	print "\n";
  600.  
  601. 	foreach (@atf) {
  602.  
  603. 		($name,$value) = split("\0");
  604. 		if ($check{'_type'} == 1) { print "[<b>$name</b>]<br>\n$value<p>\n"; }
  605. 		else { print "[<b>$name</b>] $value<p>\n"; }
  606. 	}
  607.  
  608. 	print "<p><small>[ $date_now ]</small><br>\n";
  609. }
  610.  
  611. #-------------------------------------------------------------------------------------------
  612.  
  613. sub send {
  614.  
  615. 	push(@MailValue,"Content-Type: text/plain; charset=\"ISO-2022-JP\"\n");
  616.  
  617. 	$BODY .= "\n"; # ヘッダ終了の区切り
  618.  
  619. 	$BODY .= "フォームメールが届きました。\n";
  620. 	$BODY .= "-----------------------------\n\n";
  621.  
  622. 	foreach $line (@out) {
  623.  
  624. 		($name,$value) = split("\0",$line,2);
  625.  
  626. 		$value =~ s/&amp;/&/g;
  627. 		$value =~ s/&quot;/"/g;
  628. 		$value =~ s/&lt;/</g;
  629. 		$value =~ s/&gt;/>/g;
  630.  
  631. 		if ($check{'_csv'} == 1) {
  632.  
  633. 			if ($value =~ /\n/) { $value =~ s/\n/ /g; }
  634. 			push(@CSV,$value);
  635. 		}
  636.  
  637. 		if ($check{'_type'} == 1 || $value =~ /\n/) { $BODY .= "[$name]\n$value\n\n"; $BODY2 .= "[$name]\n$value\n\n"; }
  638. 		else { $BODY .= "[$name] $value\n\n"; $BODY2 .= "[$name] $value\n\n"; }
  639. 	}
  640.  
  641. 	$BODY .= "-----------------------------\n";
  642. 	$BODY .= "送信者情報：$access_data at $date_now\n";
  643.  
  644. 	$BODY .= "\n";
  645. 	$BODY .= &EncodeCSV(@CSV) . "\n\n";
  646.  
  647. 	push(@MailValue,&jis($BODY));
  648. 	push(@MailValue,$BODY);
  649. }
  650.  
  651. #-------------------------------------------------------------------------------------------
  652.  
  653. sub send_mix {
  654.  
  655. 	($boundary) = $ENV{'CONTENT_TYPE'} =~ m#multipart/form-data; boundary=(.*)#;
  656. 	if ($boundary eq "") { $boundary = '0123456789zxcvbnmasdfghjklqwertyuiop'; }
  657. 	$bound = "--" . $boundary;
  658.  
  659. 	$BODY .= "Content-Type: multipart/mixed; boundary=\"$bound\"\n\n";
  660. 	$BODY .= 'This is multipart message.' . "\n\n";
  661.  
  662. 	$BODY .= "--$bound\n";
  663. 	$BODY .= "Content-Transfer-Encoding: 7bit\n";
  664. 	$BODY .= 'Content-Type: text/plain; charset="ISO-2022-JP"' . "\n";
  665.  
  666. 	$BODY .= "\n"; # ヘッダ終了の区切り
  667.  
  668. 	$BODY .= "フォームメールが届きました。\n";
  669. 	$BODY .= "----------------------------\n\n";
  670.  
  671. 	foreach $line (@out) {
  672.  
  673. 		($name,$value) = split("\0",$line,2);
  674.  
  675. 		$value =~ s/&amp;/&/g;
  676. 		$value =~ s/&quot;/"/g;
  677. 		$value =~ s/&lt;/</g;
  678. 		$value =~ s/&gt;/>/g;
  679.  
  680. 		if ($check{'_csv'} == 1) { push(@CSV,$value); }
  681.  
  682. 		if ($check{'_type'} == 1 || $value =~ /\n/) { $BODY .= "[$name]\n$value\n\n"; }
  683. 		else { $BODY .= "[$name] $value\n\n"; }
  684. 	}
  685.  
  686. 	foreach $line (@atf) {
  687.  
  688. 		($name,$value) = split("\0",$line,2);
  689.  
  690. 		if ($check{'_type'} == 1) { $BODY .= "[$name]\n$value\n\n"; }
  691. 		else { $BODY .= "[$name] $value\n\n"; }
  692. 	}
  693.  
  694. 	$BODY .= "----------------------------\n";
  695. 	$BODY .= "送信者情報：$access_data at $date_now\n";
  696.  
  697. 	$BODY .= "\n";
  698. 	if ($check{'_csv'} == 1) { $BODY .= &EncodeCSV(@CSV) . "\n\n"; }
  699.  
  700. 	push(@MailValue,&jis($BODY));
  701. 	push(@MailValue,$BODY);
  702.  
  703. 	#-----------------------------------------------------------------------------------
  704.  
  705. 	$BODY = "";
  706.  
  707. 	foreach $file (0 .. $#FILE) {
  708.  
  709. 		($name,$filenum,$filename) = split("\0",$FILE[$file],3);
  710.  
  711. 		$BODY .= "--$bound\n";
  712. 		$BODY .= "Content-Type: application/octet-stream; name=\"$filename\"\n";
  713.  
  714. 		if ($uuencode) { $BODY .= 'Content-Transfer-Encoding: X-uuencode' . "\n"; }
  715. 		else { $BODY .= 'Content-Transfer-Encoding: base64' . "\n"; }
  716.  
  717. 		$BODY .= "Content-Disposition: attachment; filename=\"$filename\"\n\n";
  718.  
  719. 		$binary_string = "";
  720. 		if (open(UU,"$tmp$filenum")) {
  721.  
  722. 			while (<UU>) { $binary_string .= $_; }
  723. 			close(UU);
  724. 		}
  725.  
  726. 		if ($uuencode) {
  727.  
  728. 			$ascii_string = &base64'uuencode($binary_string);
  729. 			$BODY .= "begin 600 $filename\n$ascii_string\`\n" . "end\n\n";
  730. 		}
  731. 		else {
  732. 			$ascii_string = &base64'b64encode($binary_string);
  733. 			$BODY .= "$ascii_string\n";
  734. 		}
  735.  
  736. 		if (-e "$tmp$filenum") { unlink("$tmp$filenum"); }
  737. 	}
  738.  
  739. 	$BODY .= "--$bound\-\-\n";
  740. 	push(@MailValue,$BODY);
  741. }
  742.  
  743. #-------------------------------------------------------------------------------------------
  744.  
  745. sub checkval {
  746.  
  747. 	local($key,$val) = @_;
  748. 	local($num,$cmd);
  749.  
  750. 	if ($key =~ /^_indispen$/i) {
  751.  
  752. 		$indispen{$val} = 1;
  753. 		return 1;
  754. 	}
  755.  
  756. 	elsif ($key =~ /^_(.*)$/i) { $cmd = "\_$1"; $check{$cmd} = $val; return 1; }
  757. 	else { return 0; }
  758. }
  759.  
  760. #-------------------------------------------------------------------------------------------
  761.  
  762. sub EncodeCSV {
  763.  
  764. 	local(@fields) = @_;
  765. 	local(@CSV) = ();
  766.  
  767. 	foreach $text (@fields) {
  768.  
  769. 		$text =~ s/"/""/g;
  770. 		if ($text =~ /,|"/) { $text = "\"$text\""; }
  771.  
  772. 		push(@CSV,$text);
  773. 	}
  774.  
  775. 	return join(',',@CSV);
  776. }
  777.  
  778. #-------------------------------------------------------------------------------------------
  779.  
  780. sub mailSubject_base64encode {
  781.  
  782. 	local($line) = @_;
  783. 	jcode::convert(\$line,'jis','sjis','z');
  784. 	$line = &base64'b64encode($line);
  785. 	eval 'chomp($line);'; chop($line) if $@ ne '';
  786. 	if (length($line) > 64) { return 0; }
  787. 	return "Subject: =?ISO-2022-JP?B?$line?=\n";
  788. }
  789.  
  790. #-------------------------------------------------------------------------------------------
  791.  
  792. sub jis {
  793.  
  794. 	local($line) = @_;
  795. 	&jcode'convert(*line,'jis');
  796. 	$line;
  797. }
  798.  
  799. #-------------------------------------------------------------------------------------------
  800.  
  801. sub error {
  802.  
  803. 	local (@msg) = @_;
  804. 	local ($i);
  805.  
  806. 	foreach $file (@FILE) {
  807.  
  808. 		($name,$filenum,$filename) = split("\0",$FILE[$file]);
  809. 		if (-e "$tmp$filenum") { unlink("$tmp$filenum"); }
  810. 	}
  811.  
  812. 	print "Content-type: text/html\n\n";
  813. 	print "<HTML>\n";
  814. 	print "<HEAD>\n";
  815. 	print $header;
  816. 	print "</HEAD>\n";
  817. 	print "<body $check{'_body'}>\n";
  818.  
  819. 	print <<"EOF";
  820. 	$head
  821. 	<h1>■$_[0]</h1>
  822. EOF
  823. 	foreach $i (1 .. $#msg) { print "$msg[$i]<br>\n"; }
  824.  
  825. 	print <<"EOF";
  826. 	<SCRIPT language="JavaScript">
  827. 	<!--
  828. 	function PageBack(){ history.back(); }
  829. 	//-->
  830. 	</SCRIPT>
  831. 	<div align=right>[ <A HREF="JavaScript:history.back()">戻る</A> ]</div>
  832. EOF
  833. 	print $bottom;
  834. 	print &HtmlBot;
  835. 	exit;
  836. }
  837.  
Runtime error #stdin #stdout #stderr 0.01s 4972KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
Standard output is empty
stderr
copy 
Array found where operator expected at prog.pl line 75, near "test@xxxx"
syntax error at prog.pl line 75, near "test@xxxx"
Bad name after com' at prog.pl line 75.
https://ideone.com/OamLZF
language:
Perl (perl 5.28.1)
created:
3 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!