#┏━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
#┃■(ＳＳ)Ｃ−ＢＯＡＲＤライブラリ
#┠──────────────────────────────────────
#┃「multipart/form-data」読み込み関係の関数が含まれています。
#┃
#┗━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

package MULTIPART;

#┏━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
#┃   読み込み
#┗━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
sub read {
	my $buf_size = 8192; binmode(STDIN);

	#── デバッグ用に投稿データをあらかじめファイルに書き出しておく
	if ($::FLAG{'debug'} && &::lock('pst')) {
		if (open(STD, ">$CNF::place{'data'}{'path'}/stdin.dat")) {
			binmode(STD); my $buf;
			while (read(STDIN, $buf, 16384)) { print STD $buf;}
			close(STD); open(STDIN, "<$CNF::place{'data'}{'path'}/stdin.dat");
			binmode(STDIN);
		}
	}

	#── 区切り文字を取得
	($ENV{'CONTENT_TYPE'} =~ /boundary="?([^"]+)"?/)
		or &error(\'区切り文字列がありません。');
	my $boundary = '--' . $1; my $boundary_length = length($boundary);

	#── メモリ節約のため少しずつ読み込む
	my $left = $ENV{'CONTENT_LENGTH'};
	my ($buf, $name, $file, $mac_bin, $size);
	MAIN: while (1) {
		my $read = ($left > $buf_size - length($buf))
				 ? ($buf_size - length($buf)) : $left;
		if ($read > 0) {
			(read(STDIN, $buf, $read, length($buf)) != $read)
				&& &error(\'不正なデータです。(1)');
			$left -= $read;
		}
		my $buf_pos;
		while (($buf_pos = index($buf, $boundary)) == -1) {
			$left or &error(\'不正なデータです。(2)');
			if (defined $name) {
				if (defined $file) {
					if ($mac_bin) {
						print FLE substr($buf, 128,
										 $buf_size - $boundary_length);
						undef $mac_bin;
					}
					else {
						print FLE substr($buf, 0,
										 $buf_size - $boundary_length);
					}
				}
				else {
					$::FORM{$name}
						.= substr($buf, 0, $buf_size - $boundary_length);
				}
			}
			substr($buf, 0, $buf_size - $boundary_length) = '';
			$read = ($left > $buf_size - length($buf))
				  ? ($buf_size - length($buf)) : $left;
			(read(STDIN, $buf, $read, length($buf)) != $read)
				&& &error(\'不正なデータです。(3)');
			$left -= $read;
		}
		($left > 1) && ($left -= read(STDIN, $buf, 2, length($buf)));
		if (defined $name) {
			if (defined $file) {
				if ($mac_bin) {
					print FLE substr($buf, 128, $buf_pos - 130);
					undef $mac_bin;
				}
				else { print FLE substr($buf, 0, $buf_pos - 2); close(FLE);}
				undef $file;
				$::FLAG{'file'}[-1]{'size'}
					= -s "$CNF::place{'file'}{'path'}/"
					   . $::FLAG{'file'}[-1]{'name'};
				$size += $::FLAG{'file'}[-1]{'size'};
				if ($size > $CNF::upload{'size'}{'max'}) {
					&::error(\'ファイルサイズが大きすぎます。');
				}
				elsif (!$::FLAG{'file'}[-1]{'size'}) {
					&error(\('ファイルサイズが０です。アップロードに'
						   . '失敗している可能性があります。'));
				}
			}
			else { $::FORM{$name} .= substr($buf, 0, $buf_pos - 2);}
		}
		undef $name;
		if (substr($buf, $buf_pos + $boundary_length, 2) eq '--') { last MAIN;}
		substr($buf, 0, $buf_pos + $boundary_length + 2) = '';
		$read = ($left > $buf_size - length($buf))
			  ? ($buf_size - length($buf)) : $left;
		if ($read > 0) {
			(read(STDIN, $buf, $read, length($buf)) != $read)
				&& &error(\'不正なデータです。(4)');
			$left -= $read;
		}
		my $head;
		while (($buf_pos = index($buf, "\r\n\r\n")) == -1) {
			$left or &error(\'不正なデータです。(5)');
			$head .= substr($buf, 0, $buf_size - 4);
			substr($buf, 0, $buf_size - 4) = '';
			$read = ($left > $buf_size - length($buf) - 4)
				  ? ($buf_size - length($buf) - 4) : $left;
			(read(STDIN, $buf, $read, length($buf)) != $read)
				&& &error(\'不正なデータです。(6)');
			$left -= $read;
		}
		$head .= substr($buf, 0, $buf_pos + 2);
		my @head = split(/\r\n/, $head);
		my $content_type = (grep(/^Content-Type:/i, @head))[0];
		($content_type =~ /application\/x-macbinary/i) && ($mac_bin = 1);
		my $dispos = (grep(/^Content-Disposition:/i, @head))[0];
		($dispos =~ / name="?([^"]+)"?/i) && ($name = $1);
		($dispos =~ / filename="?([^"]+)"?/i) && ($file = $1);
		my $encode = (grep(/^Content-Transfer-Encoding:/i, @head))[0];
		$encode =~ s/:\s*(\w+)/lc($1)/e; #!
		if (defined $file) {
			require './lib/str.pl'; my %file; $file{'name'} = $file;

			if (length($file{'name'}) > $CNF::upload{'name'}{'max'}) {
				&::error(\("ファイル名が長すぎます。"
						 . "$CNF::upload{'name'}{'max'}文字以内に"
						 . "して下さい。"));
			}
			
			&STRING::sjis2euc(&STRING::etc2sjis(\$file{'name'}));
			$file{'name'} = ($file{'name'} =~ /([^\\\/:]+)$/)[0];

			($file{'name'} =~ /[<>";| ]/)
				&& &::error(\('ファイル名に「&lt;, &gt;, &quot;, ;, |, /, &nbsp;(半角スペース)」は'
							. '使えません。'));
			
			($file{'name'} !~ /^(.*)\.(\w+)$/)
				&& &::error(\'ファイルに拡張子がありません。');
				
			&STRING::euc2sjis(\$file{'name'});


			my $type = lc($2);
			grep($_ eq $type, @{$CNF::upload{'enable'}{'ext'}})
				or &::error(\('このタイプのファイルはアップロードが'
							. '禁止されています。'));
			if (-e "$CNF::place{'file'}{'path'}/$file{'name'}") {
				my($name1, $name2, $name3) = ($1, $2, 2);
				while (-e $CNF::place{'file'}{'path'}
						. "/$name1($name3).$name2") { $name3++;}
				$file{'name'} = "$name1($name3).$name2";
			}
			if ($file{'name'}) {
				open(FLE, ">$CNF::place{'file'}{'path'}/$file{'name'}")
					or &::error(\'添付ファイルを書き込めませんでした。');
				binmode(FLE);
			}
			push(@{$::FLAG{'file'}}, \%file);
		}
		length($name) && (exists $::FORM{$name}) && ($::FORM{$name} .= "\t");
		substr($buf, 0, $buf_pos + 4) = '';
	}
	$::FLAG{'debug'} && &::unlock('pst');
}

#┏━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
#┃   エラー
#┗━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
sub error {
	my $r_error = shift;
	$::FLAG{'debug'} or &::error($r_error);
	my $debug = "[CONTENT_TYPE: $ENV{'CONTENT_TYPE'}]\n"
			  . "[CONTENT_LENGTH: $ENV{'CONTENT_LENGTH'}]\n"
			  . "[HTTP_USER_AGENT: $ENV{'HTTP_USER_AGENT'}]\n"
			  . ${$r_error} . "\n\n";
	if (open(STD, "<$CNF::place{'data'}{'path'}/stdin.dat")) {
		my $buf; while (read(STD, $buf, 16384)) { $debug .= $buf;}
		close(STD); unlink("$CNF::place{'data'}{'path'}/stdin.dat");
	}
	else { $debug .= "[Can't read STDIN.]";}
	&::unlock('pst'); &::debug('UPLOAD', \$debug); &::error($r_error);
}

1;

# $Id: mlf.pl,v 1.1.1.3 2002/04/04 08:15:00 N.Hirai Exp $;