# FILE: fcn-mtp.pl
# DESCRIPTION: Functions to manage input from "multipart" (i.e., upload) forms
#-------------------------------------------------------------------------------
# DISCUS COPYRIGHT NOTICE
#
# Discus is copyright (c) 2002 by DiscusWare, LLC, all rights reserved.
# The use of Discus is governed by the Discus License Agreement which is
# available from the Discus WWW site at:
#    http://www.discusware.com/discus/license
#
# Pursuant to the Discus License Agreement, this copyright notice may not be
# removed or altered in any way.
#-------------------------------------------------------------------------------

use strict;
use vars qw($GLOBAL_OPTIONS $DCONF $PARAMS);

###
### parse_multipart
###
### Parse a multipart form (dump regular variables into standard form constructs
### and store files separately)
###

sub parse_multipart {
	my ($clength) = @_;
	$clength = $ENV{'CONTENT_LENGTH'} if $clength == 0;
	undef my $output;
	my $type = $ENV{'CONTENT_TYPE'}; my $boundary = ""; my $len = 0;
	my $input = ""; my $counter = 0;
	binmode(STDIN);
	if ($type =~ /boundary=(.*)/) {
		$boundary = join("--" , $1);
	} else {
		error_message("Upload Error", "Your browser did not properly encode this form.", 0, 1);
	}
	while ($len < $clength) {
		my $buf = "";
		$len += sysread(STDIN, $buf, $clength);
		$input .= $buf;
		$counter += 1;
		$counter = 0 if $buf ne "";
		error_message("Upload Error", "The upload timed out after reading $len of $clength bytes.  Please try again by hitting your browser's RELOAD button.", 0, 1) if $counter >= 100;
	}
	my @input_pairs = split(/$boundary/, $input);
	my $formname = "";
	my $filename = "";
	foreach my $line (@input_pairs) {
		my ($header, $body) = split(/\r\n\r\n|\n\n/, $line, 2);
		$body =~ s/\r\n-*$//;
		if ($header =~ /name="([^"]+)"/) { $formname = $1; } else { $formname = ""; }
		if ($header =~ /filename="([^"]+)"/) { $filename = $1; } else { $filename = ""; }
		if ($header =~ /Type: (.*)/) {
			$output->{'*files*'}->{$formname}->{content_type} = $1;
			$output->{'*files*'}->{$formname}->{filename} = parse_filename($filename);
			$output->{'*files*'}->{$formname}->{data} = $body;
		} elsif ($header =~ m|filename="|) {
			$output->{'*files*'}->{$formname}->{content_type} = "mac/unknown";
			$output->{'*files*'}->{$formname}->{filename} = parse_filename($filename);
			$output->{'*files*'}->{$formname}->{data} = $body;
		} elsif ($formname =~ /^(\w+)$/) {
			$output->{$formname} .= ",$body" if $output->{$formname} ne "";
			$output->{$formname} = $body if $output->{$formname} eq "";
			$output->{$formname} =~ s/\r//g;
		}
		$output->{'*files*'}->{$formname}->{content_type} = $` if $output->{'*files*'}->{$formname}->{content_type} =~ /;/;
	}
	my $cbuffer = $ENV{'HTTP_COOKIE'};
	if ($ENV{'HTTP_COOKIE'} eq "" && $ENV{'COOKIE'} ne "") {
		$cbuffer = $ENV{'COOKIE'};  #O'Reilly WebSitePro
	}
	my @cpairs = split(/; /, $cbuffer);
	foreach my $cpair (@cpairs) {
		my ($cname, $cvalue) = split(/=/, $cpair);
		$cname =~ s/$DCONF->{COOKIE_ID}$//;
		$output->{'COOKIE'}->{$cname} = unescape($cvalue);
	}
	return $output;
}

###
### parse_filename
###
### Cleans up file names from various operating systems
###

sub parse_filename {
	my ($line_in) = @_;
	if ($line_in =~ m|^(\w+):\\|) {
		$line_in =~ m|(.*)\\|;
		return $';
	}
	if ($line_in =~ m|^/|) {
		$line_in =~ m|(.*)/|;
		return $';
	}
	if ($line_in =~ m|:|) {
		$line_in =~ m|(.*):|;
		return $';
	}
	return $line_in;
}

###
### multipart_post_upload_control
###
### Controls image/attachment uploading features
###

sub multipart_post_upload_control {
	my ($FORMref, $dir_override, $cancel) = @_;
	my $p = post_read_image_tempfile($FORMref->{tempfile});
	if ($p->{var}->{ip} ne $ENV{REMOTE_ADDR} && $GLOBAL_OPTIONS->{images_require_ip_match}) {
		error_message("Upload Security Violation", "Your IP address does not match the IP address from which this message was posted.", 0, 1);
	}
	dreq("mime-PRO") if $DCONF->{pro};
	my @result = ();
	my $errors = scalar @{$p->{upload}};
	my $ctr = 0;
	my @new_x = ();
	my @nf = @{ $p->{fragment} };
	foreach my $u (@{ $p->{upload} }) {
		$ctr++;
		my $f = shift @nf;
		my $q = $FORMref->{'*files*'}->{"attach$ctr"};
		if (defined $q) {
			my $type = post_get_extension_and_tag($q->{content_type}, $u->{type} eq 'i' ? 1 : 0, $q->{filename});
			if (! defined $type) {
				push @result, { descr => $u->{descr}, error => 2 };
				push (@new_x, { f => $f } );
				push (@new_x, { u => $u } );
				next;
			}
			my $fi = $type->{fi};
			my $maxs = post_is_upload_too_large($p->{var}->{author_status}, length($q->{data}));
			my $height = 0;
			my $width = 0;
			if ($DCONF->{pro} && $fi) {
				dreq("upload-PRO");
				($width, $height) = post_is_upload_too_large_vpr_dimension($p->{var}->{author_status}, $q->{data});
			}
			if ($width != 0 || $height != 0) {
				push (@result, { descr => $u->{descr}, error => 6, width => $width, height => $height });
			} elsif (length($q->{data}) == 0) {
				push @result, { descr => $u->{descr}, error => 3 };
			} elsif (! defined $type) {
				push @result, { descr => $u->{descr}, content => $q->{content_type}, error => 2 };
			} elsif ($maxs != 0) {
				push (@result, { descr => $u->{descr}, error => 4, maxsize => $maxs, yoursize => sprintf("%.1f", length($q->{data})/1000) });
			} else {
				my $psua = post_save_uploaded_attachment($q, $q->{content_type}, $fi, $p->{tempfile}, $u->{descr}, $type);
				if (! $psua) {
					push @result, { descr => $u->{descr}, error => 5 };
				} else {
					$errors -= 1;
					my $newtag = join("", "\\", $type->{tag}, "{", $psua, "}");
					push @new_x, { f => join("", $f, $newtag ) };
					next;
				}
			}
			push (@new_x, { f => $f } );
			push (@new_x, { u => $u } );
		} else {
			push @result, { descr => $u->{descr}, error => 1 };
			push (@new_x, { f => $f } );
			push (@new_x, { u => $u } );
		}
	}
	while (my $l = shift @nf) {
		push (@new_x, { f => $l });
	}
	if (! $errors) {
		my $src = "";
		while (my $u = shift @new_x) {
			$src .= $u->{f};
		}
		my $tf = $p->{tempfile};
		my $dir = (-e "$DCONF->{message_dir}/$p->{var}->{topic_number}" ? "$DCONF->{message_dir}/$p->{var}->{topic_number}" : "$DCONF->{secdir}/$p->{var}->{topic_number}");
		$dir = "$DCONF->{admin_dir}/queue" if $p->{var}->{queued} == 1;
		$dir = $dir_override if $dir_override ne "";
		opendir(DIR, "$DCONF->{admin_dir}/msg_index/uploads");
		while (my $i = readdir(DIR)) {
			if ($i =~ m|\-$tf$|) {
				my $fn = $`;
				open (FILE, "$DCONF->{admin_dir}/msg_index/uploads/$fn-$tf");
				binmode(FILE);
				open (DEST, "> $dir/$fn");
				binmode(DEST);
				while (<FILE>) {
					print DEST;
				}
				close (DEST);
				close (FILE);
				chmod(oct($DCONF->{perms0666}), "$dir/$fn");
				unlink "$DCONF->{admin_dir}/msg_index/uploads/$fn-$tf";
			}
		}
		close (DIR);
		if ($p->{var}->{queued} && $DCONF->{pro}) {
			dreq("queue1-PRO");
			return queue_finished_upload($p, $src);
		}
		dreq("webtags");
		$PARAMS->{topic_number} = $p->{var}->{topic_number};
		my $GP = GetPage($p->{var}->{topic_number}, $p->{var}->{pagenum}, { lock => 1 });
		foreach my $u (@{ $GP->{messages} }) {
			if ($u->{number} == $p->{var}->{postnum}) {
				my ($foo, $txt) = webtags($src, 0, 1, 1, 1);
				while ($txt =~ /alt="([^"]*?)<.*?>([^"]*)"/i) {
					my ($bef, $one, $two, $aft) = ($`, $1, $2, $');
					$one =~ s/&#?(\w+);/-/g; $two =~ s/&#?(\w+);/-/g;
					$txt = join("", $bef, "alt=", '"', $one, $two, '"', $aft);
				}
				$u->{text} = $txt;
			}
		}
		$GP->{general}->{messages_raw} = 0;
		SetPage($GP, { unlock => 1 });
		unlink "$DCONF->{admin_dir}/msg_index/temp/$tf.TMP";
		seturl(post_get_result_url($p->{var}));
	}
	post_rewrite_temp_file($p, \@new_x);
	undef my $subst;
	$subst->{attachments} = \@result;
	$subst->{general}->{tempfile} = $FORMref->{tempfile};
	return \@result if $cancel;
	screen_out("upload", $subst);
}

###
### post_format_attachment_file
###
### Gets a file name for the attachment in question
###

sub post_format_attachment_file {
	my ($attachment_info, $content_type, $fi, $descr, $ct) = @_;
	if ($fi) {
		my $gn = get_number();
		my $td = join(",", $gn, $descr);
		return { tagfile => $td, filename => join(".", $gn, $ct->{ext}) };
	}
	return mime_format_file($attachment_info, $content_type, $descr);
}

###
### post_read_image_tempfile
###
### Reads an image/attachment temporary file into a handy format
###

sub post_read_image_tempfile {
	my ($tempfile) = @_;
	$tempfile =~ s/\D//g;
	my $u = readfile("$DCONF->{admin_dir}/msg_index/temp/$tempfile.TMP", "post_read_image_tempfile");
	undef my $r;
	$r->{tempfile} = $tempfile;
	foreach my $x (@{ $u }) {
		if ($x =~ m|^(\w+)=(.*)|) {
			$r->{var}->{$1} = unescape($2);
		} elsif ($x =~ m|^=\[f\](.*)|) {
			push (@{ $r->{fragment} }, unescape($1));
		} elsif ($x =~ m|^=\[u\](.*)|) {
			my @y = split(/&/, $1);
			undef my $h;
			foreach my $l (@y) {
				if ($l =~ m|(\w+)=>(.*)|) {
					$h->{$1} = unescape($2);
				}
			}
			push (@{ $r->{upload} }, $h);
		}
	}
	return $r;
}

###
### post_get_extension_and_tag
###
### Gets the extension and corresponding formatting tag for a file

sub post_get_extension_and_tag {
	my ($mime_type, $force_image, $filename) = @_;
	if ($GLOBAL_OPTIONS->{upload_thumbnails_gifs}) {
		return { fi => 1, ext => "gif", tag => "image_alreadyuploaded_t" } if $mime_type eq "image/gif";
	} else {
		return { fi => 1, ext => "gif", tag => "image_alreadyuploaded" } if $mime_type eq "image/gif";
	}
	if ($GLOBAL_OPTIONS->{upload_thumbnails_jpegs}) {
		return { fi => 1, ext => "jpg", tag => "jpeg_alreadyuploaded_t" } if $mime_type =~ m|^image/p?jpeg$|;
	} else {
		return { fi => 1, ext => "jpg", tag => "jpeg_alreadyuploaded" } if $mime_type =~ m|^image/p?jpeg$|;
	}
	if ($GLOBAL_OPTIONS->{upload_thumbnails_pngs}) {
		return { fi => 1, ext => "png", tag => "png_alreadyuploaded_t" } if $mime_type eq "image/x-png";
		return { fi => 1, ext => "png", tag => "png_alreadyuploaded_t" } if $mime_type eq "image/png";
	} else {
		return { fi => 1, ext => "png", tag => "png_alreadyuploaded" } if $mime_type eq "image/x-png";
		return { fi => 1, ext => "png", tag => "png_alreadyuploaded" } if $mime_type eq "image/png";
	}
	return undef if ! $DCONF->{pro};
	return undef if $force_image;
	dreq("mime-PRO");
	return mime_file_extension_and_tag($mime_type, $filename);
}

###
### post_is_upload_too_large
###
### Compares an attachment length to the maximum limit
###

sub post_is_upload_too_large {
	my ($author_status, $filesize) = @_;
	my $u = 0;
	return 0 if $GLOBAL_OPTIONS->{images_admin_unlimited} ne "0" && $author_status == 10;
	$u = $GLOBAL_OPTIONS->{'registered_mod_maxsize'} * 1000 if $author_status >= 9;
	$u = $GLOBAL_OPTIONS->{'registered_maxsize'} * 1000 if $author_status < 9 && $author_status > 2;
	$u = $GLOBAL_OPTIONS->{'public_maxsize'} * 1000 if $author_status < 3;
	return 0 if $u == 0;
	return 0 if $filesize < $u;
	return sprintf("%.1f", $u/1000);
}

###
### post_save_uploaded_attachment
###
### Saves an uploaded attachment in a temporary directory
###

sub post_save_uploaded_attachment {
	my ($attachment_info, $content_type, $fi, $tempfile, $descr, $ct) = @_;
	my $res = post_format_attachment_file($attachment_info, $content_type, $fi, $descr, $ct);
	my $d = (defined $res->{data} ? $res->{data} : $attachment_info->{data});
	if (! -d "$DCONF->{admin_dir}/msg_index/uploads") {
		mkdir("$DCONF->{admin_dir}/msg_index/uploads", oct($DCONF->{perms0777})) || error_message("Create Directory Error", "Could not create 'uploads' directory under 'msg_index'.  Post with image/attachments failed.");
		chmod(oct($DCONF->{perms0777}), "$DCONF->{admin_dir}/msg_index/uploads");
	}
	if (open (FILE, "> $DCONF->{admin_dir}/msg_index/uploads/$res->{filename}-$tempfile")) {
		binmode(FILE);
		print FILE $d;
		close (FILE);
		return $res->{tagfile};
	}
	return undef;
}

###
### post_rewrite_temp_file
###
### Rewrites a temporary file for image uploading
###

sub post_rewrite_temp_file {
	my ($p, $new_x) = @_;
	my @d = ();
	my $fcache = undef;
	foreach my $k (keys(%{ $p->{var} })) {
		push @d, "$k=" . escape($p->{var}->{$k}) . "\n";
	}
	foreach my $l (@{ $new_x }) {
		if (defined $l->{f}) {
			$fcache .= $l->{f};
		} else {
			push @d, "=[f]" . escape($fcache) . "\n";
			my $line = "=[u]";
			foreach my $ll (keys(%{ $l->{u} })) {
				$line .= "&$ll=>" . escape($l->{u}->{$ll});
			}
			$line .= "\n";
			push @d, "$line";
			$fcache = undef;
		}
	}
	push @d, "=[f]" . escape($fcache) . "\n" if $fcache;
	my $tempfile = $p->{tempfile};
	writefile("$DCONF->{admin_dir}/msg_index/temp/$tempfile.TMP", \@d, "post_rewrite_temp_file");
}

1;
