# boxes-lib.pl
# Functions to parsing user mail files

use POSIX;

# list_mails(user|file, [start], [end])
# Returns a subset of mail from a mbox format file
sub list_mails
{
local (@rv, $h, $done);
local @index = &build_index($_[0]);
local ($start, $end);
if (@_ == 1) {
	$start = 0; $end = @index-1;
	}
elsif ($_[2] < 0) {
	$start = @index+$_[2]-1; $end = @index+$_[1]-1;
	$start = $start<0 ? 0 : $start;
	}
else {
	$start = $_[1]; $end = $_[2];
	$end = @index-1 if ($end >= @index);
	}
@rv = map { undef } @index;
open(MAIL, &user_mail_file($_[0]));
for($i=$start; $i<=$end; $i++) {
	local ($mail, $line, @headers);
	seek(MAIL, $index[$i]->[0], 0);

	# read RFC822 headers
	$mail->{'line'} = $index[$i]->[1];
	local $lnum = 0;
	while(1) {
		$lnum++;
		$line = <MAIL>;
		$mail->{'size'} += length($line);
		$line =~ s/\r|\n//g;
		last if ($line =~ /^$/);
		if ($line =~ /^(\S+):\s*(.*)/) {
			push(@headers, [ $1, $2 ]);
			}
		elsif ($line =~ /^(\s+.*)/) {
			$headers[$#headers]->[1] .= $1 unless($#headers < 0);
			}
		elsif ($line =~ /^From\s+(\S+).*\d+/ && $1 ne '-') {
			$mail->{'fromline'} = $line;
			}
		}
	$mail->{'headers'} = \@headers;
	foreach $h (@headers) {
		$mail->{'header'}->{lc($h->[0])} = $h->[1];
		}

	# read the mail body
	while(1) {
		$line = <MAIL>;
		last if (!$line || $line =~ /^From\s+(\S+).*\d+\n/ && $1 ne '-');
		$lnum++;
		$mail->{'size'} += length($line);
		$mail->{'body'} .= $line;
		}
	$mail->{'eline'} = $mail->{'line'} + $lnum - 1;
	$mail->{'idx'} = $i;
	$rv[$i] = $mail;
	}
return @rv;
}

# search_mail(user, field, match)
# Returns an array of messages matching some search
sub search_mail
{
local $field = $_[1];
local $neg = ($field =~ s/^\!//);
local @index = &build_index($_[0]);
local (@rv, $i);
open(MAIL, &user_mail_file($_[0]));
for($i=@index-1; $i>=0; $i--) {
	local ($mail, $line, @headers);
	seek(MAIL, $index[$i]->[0], 0);

	# read mail headers
	$mail->{'line'} = $index[$i]->[1];
	local $lnum = 0;
	while(1) {
		$lnum++;
		($line = <MAIL>) =~ s/\r|\n//g;
		$mail->{'size'} += length($line);
		last if ($line =~ /^$/);
		if ($line =~ /^(\S+):\s*(.*)/) {
			push(@headers, [ $1, $2 ]);
			}
		elsif ($line =~ /^(\s+.*)/) {
			$headers[$#headers]->[1] .= $1;
			}
		elsif ($line =~ /^From\s+(\S+).*\d+/ && $1 ne '-') {
			$mail->{'fromline'} = $line;
			}
		}
	$mail->{'headers'} = \@headers;
	foreach $h (@headers) {
		$mail->{'header'}->{lc($h->[0])} = $h->[1];
		}

	# read mail body
	while(1) {
		$line = <MAIL>;
		last if (!$line || $line =~ /^From\s+(\S+).*\d+\n/ && $1 ne '-');
		$lnum++;
		$mail->{'size'} += length($line);
		$mail->{'body'} .= $line;
		}
	$mail->{'eline'} = $mail->{'line'} + $lnum - 1;
	$mail->{'idx'} = $i;
	if ($field eq 'body') {
		push(@rv, $mail) if (!$neg && $mail->{'body'} =~ /\Q$_[2]\E/i ||
				      $neg && $mail->{'body'} !~ /\Q$_[2]\E/i);
		}
	elsif ($field eq 'size') {
		push(@rv, $mail) if (!$neg && $mail->{'size'} > $_[2] ||
				      $neg && $mail->{'size'} < $_[2]);
		}
	else {
		push(@rv, $mail)
		    if (!$neg && $mail->{'header'}->{$field} =~ /\Q$_[2]\E/i ||
		         $neg && $mail->{'header'}->{$field} !~ /\Q$_[2]\E/i);
		}
	}
return @rv;

}

# build_index(user|file)
sub build_index
{
local @index;
local $ifile = &user_index_file($_[0]);
local $umf = &user_mail_file($_[0]);
local @ist = stat($ifile);
local @st = stat($umf);

if (open(INDEX, $ifile)) {
	@index = map { /(\d+)\s+(\d+)/; [ $1, $2 ] } <INDEX>;
	close(INDEX);
	}

if (!@ist || !@st || $ist[9] < $st[9]) {
	# The mail file is newer than the index
	local $fromok = 1;
	local ($l, $ll);
	if ($st[7] < $config{'index_min'}) {
		$fromok = 0;	# Always re-index
		open(MAIL, $umf);
		}
	else {
		if (open(MAIL, $umf)) {
			local $il = $#index;
			local $i;
			for($i=($il>100 ? 100 : $il); $i>=0; $i--) {
				$l = $index[$il-$i];
				seek(MAIL, $index[$il-$i]->[0], 0);
				$ll = <MAIL>;
				$fromok = 0 if ($ll !~ /^From\s+(\S+).*\d+\n/ ||
						$1 eq '-');
				}
			}
		else {
			$fromok = 0;	# No mail file yet
			}
		}
	local ($pos, $lnum);
	if (scalar(@index) && $fromok && $st[7] > $l->[0]) {
		# Mail file seems to have gotten bigger, most likely
		# because new mail has arrived ... only reindex the new mails
		$pos = $l->[0] + length($ll);
		$lnum = $l->[1] + 1;
		}
	else {
		# Mail file has changed in some other way ... do a rebuild
		$pos = 0;
		$lnum = 0;
		undef(@index);
		seek(MAIL, 0, 0);
		}
	while(<MAIL>) {
		if (/^From\s+(\S+).*\d+\n/ && $1 ne '-') {
			push(@index, [ $pos, $lnum ]);
			}
		$pos += length($_);
		$lnum++;
		}
	close(MAIL);
	open(INDEX, ">$ifile");
	print INDEX map { $_->[0]." ".$_->[1]."\n" } @index;
	close(INDEX);
	}
return @index;
}

# parse_mail(&mail, [&parent])
# Extracts the attachments from the mail body
sub parse_mail
{
local $ct = $_[0]->{'header'}->{'content-type'};
local (@attach, $h, $a);
if ($ct =~ /multipart\/(\S+)/i && ($ct =~ /boundary="([^"]+)"/i ||
				   $ct =~ /boundary=([^;\s]+)/i)) {
	# Multipart MIME message
	local $bound = "--".$1;
	local @lines = split(/\n/, $_[0]->{'body'});
	local $l;
	local $max = @lines;
	while($l < $max && $lines[$l++] ne $bound) {
		# skip to first boundary
		}
	while(1) {
		# read attachment headers
		local (@headers, $attach);
		while($lines[$l]) {
			$attach->{'raw'} .= $lines[$l]."\n";
			if ($lines[$l] =~ /^(\S+):\s*(.*)/) {
				push(@headers, [ $1, $2 ]);
				}
			elsif ($lines[$l] =~ /^(\s+.*)/) {
				$headers[$#headers]->[1] .= $1;
				}
			$l++;
			}
		$attach->{'raw'} .= $lines[$l]."\n";
		$l++;
		$attach->{'headers'} = \@headers;
		foreach $h (@headers) {
			$attach->{'header'}->{lc($h->[0])} = $h->[1];
			}
		if ($attach->{'header'}->{'content-type'} =~ /^([^;]+)/) {
			$attach->{'type'} = lc($1);
			}
		else {
			$attach->{'type'} = 'text/plain';
			}
		if ($attach->{'header'}->{'content-disposition'} =~
		    /filename\s*=\s*"([^"]+)"/i) {
			$attach->{'filename'} = $1;
			}
		elsif ($attach->{'header'}->{'content-disposition'} =~
		       /filename\s*=\s*([^;\s]+)/i) {
			$attach->{'filename'} = $1;
			}
		elsif ($attach->{'header'}->{'content-type'} =~
		    /name\s*=\s*"([^"]+)"/i) {
			$attach->{'filename'} = $1;
			}

		# read the attachment body
		while($l < $max && $lines[$l] ne $bound && $lines[$l] ne "$bound--") {
			$attach->{'data'} .= $lines[$l]."\n";
			$attach->{'raw'} .= $lines[$l]."\n";
			$l++;
			}
		$attach->{'data'} =~ s/\n\n$/\n/;	# Lose trailing blank line
		$attach->{'raw'} =~ s/\n\n$/\n/;

		# decode if necessary
		if (lc($attach->{'header'}->{'content-transfer-encoding'}) eq
		    'base64') {
			$attach->{'data'} = &b64decode($attach->{'data'});
			}
		elsif (lc($attach->{'header'}->{'content-transfer-encoding'}) eq
		       'x-uue') {
			$attach->{'data'} = &uudecode($attach->{'data'});
			}
		elsif (lc($attach->{'header'}->{'content-transfer-encoding'}) eq
		       'quoted-printable') {
			$attach->{'data'} = &quoted_decode($attach->{'data'});
			}
		elsif (lc($attach->{'type'}) eq 'application/mac-binhex40' && &has_command("hexbin")) {
			local $temp = &tempname();
			mkdir($temp, 0700);
			open(HEXBIN, "| (cd $temp ; hexbin -n attach -d 2>/dev/null)");
			print HEXBIN $attach->{'data'};
			close(HEXBIN);
			if (!$?) {
				open(HEXBIN, "$temp/attach.data");
				local $/ = undef;
				$attach->{'data'} = <HEXBIN>;
				close(HEXBIN);
				local $ct = &guess_type($attach->{'filename'});
				$attach->{'type'} = $ct;
				$attach->{'header'} = { 'content-type' => $ct };
				$attach->{'headers'} = [ 'Content-Type', $ct ];
				}
			unlink("$temp/attach.data");
			rmdir($temp);
			}

		$attach->{'idx'} = scalar(@attach);
		$attach->{'parent'} = $_[1] ? $_[1] : $_[0];
		push(@attach, $attach) if (@headers || $attach->{'data'});
		if ($attach->{'type'} =~ /multipart\/(\S+)/i) {
			# This attachment contains more attachments
			local $amail = { 'header' => $attach->{'header'},
					 'body' => $attach->{'data'} };
			&parse_mail($amail, $attach);
			$attach->{'attach'} = [ @{$amail->{'attach'}} ];
			map { $_->{'idx'} += scalar(@attach) }
			    @{$amail->{'attach'}};
			push(@attach, @{$amail->{'attach'}});
			}
		last if ($l >= $max || $lines[$l] eq "$bound--");
		$l++;
		}
	$_[0]->{'attach'} = \@attach;
	}
elsif ($_[0]->{'body'} =~ /begin\s+([0-7]+)\s+(.*)/i) {
	# Message contains uuencoded file(s)
	local @lines = split(/\n/, $_[0]->{'body'});
	local ($attach, $rest);
	foreach $l (@lines) {
		if ($l =~ /^begin\s+([0-7]+)\s+(.*)/i) {
			$attach = { 'type' => &guess_type($2),
				    'idx' => scalar(@{$_[0]->{'attach'}}),
				    'parent' => $_[1],
				    'filename' => $2 };
			push(@{$_[0]->{'attach'}}, $attach);
			}
		elsif ($l =~ /^end/ && $attach) {
			$attach = undef;
			}
		elsif ($attach) {
			$attach->{'data'} .= unpack("u", $l);
			}
		else {
			$rest .= $l."\n";
			}
		}
	if ($rest =~ /\S/) {
		# Some leftover text
		push(@{$_[0]->{'attach'}},
			{ 'type' => "text/plain",
			  'idx' => scalar(@{$_[0]->{'attach'}}),
			  'parent' => $_[1],
			  'data' => $rest });
		}
	}
elsif (lc($_[0]->{'header'}->{'content-transfer-encoding'}) eq 'base64') {
	# Signed body section
	$ct =~ s/;.*$//;
	$_[0]->{'attach'} = [ { 'type' => lc($ct),
				'idx' => 0,
				'parent' => $_[1],
				'data' => &b64decode($_[0]->{'body'}) } ];
	}
else {
	# One big attachment (probably text)
	local ($type, $body);
	($type = $ct) =~ s/;.*$//;
	$type = 'text/plain' if (!$type);
	if (lc($_[0]->{'header'}->{'content-transfer-encoding'}) eq 'base64') {
		$body = &b64decode($_[0]->{'body'});
		}
	elsif (lc($_[0]->{'header'}->{'content-transfer-encoding'}) eq 
	       'quoted-printable') {
		$body = &quoted_decode($_[0]->{'body'});
		}
	else {
		$body = $_[0]->{'body'};
		}
	$_[0]->{'attach'} = [ { 'type' => lc($type),
				'idx' => 0,
				'parent' => $_[1],
				'data' => $body } ];
	}
delete($_[0]->{'body'});
}

# delete_mail(user|file, &mail, ...)
# Delete mail messages from a user by copying the file and rebuilding the index
sub delete_mail
{
local @m = sort { $a->{'line'} <=> $b->{'line'} } @_[1..@_-1];
local $i = 0;
local $f = &user_mail_file($_[0]);
local $ifile = &user_index_file($_[0]);
local $lnum = 0;
local %dline;
local ($dpos = 0, $dlnum = 0);
local @index;

local $tmpf = $< == 0 ? "$f.del" :
	      $_[0] =~ /^\/.*\/([^\/]+)$/ ?
	   	"$user_module_config_directory/$1.del" :
	      "$user_module_config_directory/$_[0].del";
open(SOURCE, $f) || &error("Read failed : $!");
open(DEST, ">$tmpf") || &error("Open of $tmpf failed : $e");
while(<SOURCE>) {
	if ($i >= @m || $lnum < $m[$i]->{'line'}) {
		if (/^From\s+(\S+).*\d+\n/ && $1 ne '-') {
			push(@index, [ $dpos, $dlnum ]);
			}
		$dpos += length($_);
		$dlnum++;
		local $w = (print DEST $_);
		if (!$w) {
			local $e = "$?";
			close(DEST);
			close(SOURCE);
			unlink($tmpf);
			&error("Write to $tmpf failed : $e");
			}
		}
	elsif ($lnum == $m[$i]->{'eline'}) {
		$dline{$m[$i]->{'line'}}++;
		$i++;
		}
	$lnum++;
	}
close(SOURCE);
close(DEST) || &error("Write to $tmpf failed : $?");
local @st = stat($f);
unlink($f);
open(INDEX, ">$ifile");
print INDEX map { $_->[0]." ".$_->[1]."\n" } @index;
close(INDEX);
if ($< == 0) {
	rename($tmpf, $f);
	}
else {
	system("cat '$tmpf' > '$f' && rm -f '$tmpf'");
	}
chown($st[4], $st[5], $f);
chmod($st[2], $f);
}

# modify_mail(user|file, old, new, textonly)
# Modify one email message in a mailbox by copying the file and rebuilding
# the index.
sub modify_mail
{
local $f = &user_mail_file($_[0]);
local $ifile = &user_index_file($_[0]);
local $lnum = 0;
local ($sizediff, $linesdiff);
local @index = &build_index($_[0]);

# Replace the email that gets modified
local $tmpf = $< == 0 ? "$f.del" :
	      $_[0] =~ /^\/.*\/([^\/]+)$/ ?
		"$user_module_config_directory/$1.del" :
	      "$user_module_config_directory/$_[0].del";
open(SOURCE, $f);
open(DEST, ">$tmpf");
while(<SOURCE>) {
	if ($lnum < $_[1]->{'line'} || $lnum > $_[1]->{'eline'}) {
		# before or after the message to change
		local $w = (print DEST $_);
		if (!$w) {
			local $e = "$?";
			close(DEST);
			close(SOURCE);
			unlink($tmpf);
			&error("Write to $tmpf failed : $e");
			}
		}
	elsif ($lnum == $_[1]->{'line'}) {
		# found start of message to change .. put in the new one
		close(DEST);
		local @ost = stat($tmpf);
		local $nlines = &send_mail($_[2], $tmpf, $_[3]);
		local @nst = stat($tmpf);
		local $newsize = $nst[7] - $ost[7];
		$sizediff = $newsize - $_[1]->{'size'};
		$linesdiff = $nlines - ($_[1]->{'eline'} - $_[1]->{'line'} + 1);
		open(DEST, ">>$tmpf");
		}
	$lnum++;
	}
close(SOURCE);
close(DEST) || &error("Write failed : $!");

# Now update the index and delete the temp file
foreach $i (@index) {
	if ($i->[1] > $_[1]->{'line'}) {
		# Shift mails after the modified
		$i->[0] += $sizediff;
		$i->[1] += $linesdiff;
		}
	}
local @st = stat($f);
unlink($f);
open(INDEX, ">$ifile");
print INDEX map { $_->[0]." ".$_->[1]."\n" } @index;
close(INDEX);
if ($< == 0) {
	rename($tmpf, $f);
	}
else {
	system("cat $tmpf >$f && rm -f $tmpf");
	}
chown($st[4], $st[5], $f);
chmod($st[2], $f);

}

# send_mail(&mail, [file], [textonly])
# Send out some email message or append it to a file.
# Returns the number of lines written.
sub send_mail
{
local (%header, $h);
local $lnum = 0;
foreach $h (@{$_[0]->{'headers'}}) {
	$header{lc($h->[0])} = $h->[1];
	}
local @from = &address_parts($header{'from'});
if ($_[1]) {
	# Just append the email to a file using mbox format
	local @tm = localtime(time());
	open(MAIL, ">>$_[1]") || &error("Write failed : $!");
	$lnum++;
	print MAIL $_[0]->{'fromline'} ? $_[0]->{'fromline'}."\n" :
		   strftime("From $from[0] %a %b %e %H:%M:%S %Y\n", @tm);
	push(@{$_[0]->{'headers'}},
	     [ 'Date', strftime("%a, %d %b %Y %H:%M:%S %Z", @tm) ])
		if (!$header{'date'});
	}
elsif ($config{'send_mode'}) {
	# Connect to SMTP server
	&open_socket($config{'send_mode'}, 25, MAIL);
	&smtp_command(MAIL);
	&smtp_command(MAIL, "helo ".&get_system_hostname()."\n");
	&smtp_command(MAIL, "mail from: $from[0]\n");
	foreach $u (&address_parts($header{'to'}.",".$header{'cc'}.
						 ",".$header{'bcc'})) {
		&smtp_command(MAIL, "rcpt to: $u\n");
		}
	&smtp_command(MAIL, "data\n");
	}
elsif ($config{'qmail_dir'}) {
	# Start qmail
	open(MAIL, "| $config{'qmail_dir'}/bin/qmail-inject");
	}
elsif ($config{'postfix_control_command'}) {
	# Start postfix's sendmail wrapper
	local $cmd = -x "/usr/lib/sendmail" ? "/usr/lib/sendmail" :
			&has_command("sendmail");
	$cmd || &error($text{'send_ewrapper'});
	open(MAIL, "| $cmd -t -f$from[0] >/dev/null 2>&1");
	}
else {
	# Start sendmail
	&has_command($config{'sendmail_path'}) ||
	    &error(&text('send_epath', "<tt>$config{'sendmail_path'}</tt>"));
	open(MAIL, "| $config{'sendmail_path'} -t -f$from[0] >/dev/null 2>&1");
	}
local $ctype = "multipart/mixed";
foreach $h (@{$_[0]->{'headers'}}) {
	if (defined($_[0]->{'body'}) || $_[2]) {
		print MAIL $h->[0],": ",$h->[1],"\n";
		$lnum++;
		}
	else {
		if ($h->[0] !~ /^(MIME-Version|Content-Type)$/i) {
			print MAIL $h->[0],": ",$h->[1],"\n";
			$lnum++;
			}
		elsif ($h->[0] eq 'Content-Type') {
			$ctype = $h->[1];
			}
		}
	}
if (defined($_[0]->{'body'})) {
	# Use original mail body
	print MAIL "\n";
	$lnum++;
	(print MAIL $_[0]->{'body'}) || &error("Write failed : $!");
	$lnum += ($_[0]->{'body'} =~ tr/\n/\n/);
	}
elsif (!$_[2]) {
	# Sending MIME-encoded email
	$ctype =~ s/;.*$//;
	print MAIL "MIME-Version: 1.0\n";
	local $bound = "bound".time();
	print MAIL "Content-Type: $ctype; boundary=\"$bound\"\n";
	print MAIL "\n";
	$lnum += 3;

	# Send attachments
	print MAIL "This is a multi-part message in MIME format.\n";
	$lnum++;
	foreach $a (@{$_[0]->{'attach'}}) {
		print MAIL "\n";
		print MAIL "--",$bound,"\n";
		$lnum += 2;
		local $enc;
		foreach $h (@{$a->{'headers'}}) {
			print MAIL $h->[0],": ",$h->[1],"\n";
			$enc = $h->[1]
				if (lc($h->[0]) eq 'content-transfer-encoding');
			$lnum++;
			}
		print MAIL "\n";
		$lnum++;
		if (lc($enc) eq 'base64') {
			local $enc = &encode_base64($a->{'data'});
			print MAIL $enc;
			$lnum += ($enc =~ tr/\n/\n/);
			}
		else {
			print MAIL $a->{'data'};
			$lnum += ($a->{'data'} =~ tr/\n/\n/);
			if ($a->{'data'} !~ /\n$/) {
				print MAIL "\n";
				$lnum++;
				}
			}
		}
	print MAIL "\n";
	(print MAIL "--",$bound,"--\n") || &error("Write failed : $!");
	$lnum += 2;
	}
else {
	# Sending text-only mail from first attachment
	local $a = $_[0]->{'attach'}->[0];
	print MAIL "\n";
	$lnum++;
	(print MAIL $a->{'data'}) || &error("Write failed : $!");
	$lnum += ($a->{'data'} =~ tr/\n/\n/);
	if ($a->{'data'} !~ /\n$/) {
		print MAIL "\n";
		$lnum++;
		}
	}
if ($config{'send_mode'} && !$_[1]) {
	&smtp_command(MAIL, ".\n");
	&smtp_command(MAIL, "quit\n");
	}
close(MAIL) || &error("Write failed : $e");
return $lnum;
}

# b64decode(string)
# Converts a string from base64 format to normal
sub b64decode
{
    local($str) = $_[0];
    local($res);
    $str =~ tr|A-Za-z0-9+=/||cd;
    $str =~ s/=+$//;
    $str =~ tr|A-Za-z0-9+/| -_|;
    while ($str =~ /(.{1,60})/gs) {
        my $len = chr(32 + length($1)*3/4);
        $res .= unpack("u", $len . $1 );
    }
    return $res;
}

sub guess_type
{
local $e;
if (!%mime_types) {
	open(MIME, "$root_directory/mime.types");
	while(<MIME>) {
		s/\r|\n//g;
		s/#.*$//g;
		local @s = split(/\s+/);
		foreach $e (@s[1..$#s]) {
			$mime_types{$e} = $s[0];
			}
		}
	close(MIME);
	}
if ($_[0] =~ /\.([A-z0-9]+)$/ && $mime_types{$1}) {
	return $mime_types{$1};
	}
return "application/octet-stream";
}

# can_read_mail(user)
sub can_read_mail
{
return 1 if ($_[0] && $access{'sent'} eq $_[0]);
local @u = getpwnam($_[0]);
return 0 if (!@u);
return 0 if ($_[0] =~ /\.\./);
return 0 if ($access{'mmode'} == 0);
return 1 if ($access{'mmode'} == 1);
local $u;
if ($access{'mmode'} == 2) {
	foreach $u (split(/\s+/, $access{'musers'})) {
		return 1 if ($u eq $_[0]);
		}
	return 0;
	}
elsif ($access{'mmode'} == 4) {
	return 1 if ($_[0] eq $remote_user);
	}
elsif ($access{'mmode'} == 5) {
	return $u[3] eq $access{'musers'};
	}
elsif ($access{'mmode'} == 3) {
	foreach $u (split(/\s+/, $access{'musers'})) {
		return 0 if ($u eq $_[0]);
		}
	return 1;
	}
elsif ($access{'mmode'} == 6) {
	return ($_[0] =~ /^$access{'musers'}$/);
	}
return 0;	# can't happen!
}

# from_hostname()
sub from_hostname
{
local ($d, $masq);
local $conf = &get_sendmailcf();
foreach $d (&find_type("D", $conf)) {
	if ($d->{'value'} =~ /^M\s*(\S*)/) { $masq = $1; }
	}
return $masq ? $masq : &get_system_hostname();
}

# mail_from_queue(qfile, dfile)
sub mail_from_queue
{
local $mail;
open(QF, $_[0]);
while(<QF>) {
	s/\r|\n//g;
	if (/^H\?[^\?]*\?(\S+):\s+(.*)/ || /^H(\S+):\s+(.*)/) {
		push(@headers, [ $1, $2 ]);
		}
	elsif (/^(\s+.*)/) {
		$headers[$#headers]->[1] .= $1;
		}
	}
close(QF);
$mail->{'headers'} = \@headers;
foreach $h (@headers) {
	$mail->{'header'}->{lc($h->[0])} = $h->[1];
	}

# Read the mail body
open(DF, $_[1]);
while(<DF>) {
	$mail->{'body'} .= $_;
	}
close(DF);
return $mail;
}

# wrap_lines(text, width)
# Given a multi-line string, return an array of lines wrapped to
# the given width
sub wrap_lines
{
local @rv;
local $w = $_[1];
foreach $rest (split(/\n/, $_[0])) {
	if ($rest =~ /\S/) {
		while($rest =~ /^(.{1,$w}\S*)\s*([\0-\377]*)$/) {
			push(@rv, $1);
			$rest = $2;
			}
		}
	else {
		# Empty line .. keep as it is
		push(@rv, $rest);
		}
	}
return @rv;
}

# smtp_command(handle, command)
sub smtp_command
{
local ($m, $c) = @_;
print $m $c;
local $r = <$m>;
if ($r !~ /^[23]\d+/) {
	&error(&text('send_esmtp', "<tt>$c</tt>", "<tt>$r</tt>"));
	}
}

# address_parts(string)
sub address_parts
{
local @rv;
local $rest = $_[0];
while($rest =~ /([^<>\s,'"\@]+\@[A-z0-9\-\.\!]+)(.*)/) {
	push(@rv, $1);
	$rest = $2;
	}
return @rv;
}

# link_urls(text)
sub link_urls
{
local $r = $_[0];
$r =~ s/((http|ftp|https|mailto):[^><"'\s]+[^><"'\s\.\)])/<a href="$1">$1<\/a>/g;
return $r;
}

# uudecode(text)
sub uudecode
{
local @lines = split(/\n/, $_[0]);
local ($l, $data);
for($l=0; $lines[$l] !~ /begin\s+([0-7]+)\s/i; $l++) { }
while($lines[++$l]) {
	$data .= unpack("u", $lines[$l]);
	}
return $data;
}

sub simplify_date
{
if ($_[0] =~ /^(\S+),\s+0*(\d+)\s+(\S+)\s+(\d+)\s+(\d+):(\d+)/) {
	return "$2/$3/$4 $5:$6";
	}
return $_[0];
}

# simplify_from(from)
# Simplifies a From: address for display in the mail list. Only the first
# address is returned.
sub simplify_from
{
local $rv = &eucconv(&decode_mimewords($_[0]));
local @sp = &split_addresses($rv);
if (!@sp) {
	return $text{'mail_nonefrom'};
	}
else {
	return &html_escape($sp[0]->[1] ? $sp[0]->[1] : $sp[0]->[2]).
	       (@sp > 1 ? " , ..." : "");
	}
}

# simplify_subject(subject)
sub simplify_subject
{
local $rv = &eucconv(&decode_mimewords($_[0]));
$rv = substr($rv, 0, 80)." .." if (length($rv) > 80);
return $rv =~ /\S/ ? &html_escape($rv) : "<br>";
}

# quoted_decode(text)
sub quoted_decode
{
local $t = $_[0];
$t =~ s/=\n//g;
$t =~ s/=(\S\S)/pack("c",hex($1))/ge;
return $t;
}

# quoted_encode(text)
sub quoted_encode
{
local $t = $_[0];
$t =~ s/([=\177-\377])/sprintf("=%2.2X",ord($1))/ge;
return $t;
}

sub decode_mimewords {
    my $encstr = shift;
    my %params = @_;
    my @tokens;
    $@ = '';           ### error-return

    ### Collapse boundaries between adjacent encoded words:
    $encstr =~ s{(\?\=)\r?\n[ \t](\=\?)}{$1$2}gs;
    pos($encstr) = 0;
    ### print STDOUT "ENC = [", $encstr, "]\n";

    ### Decode:
    my ($charset, $encoding, $enc, $dec);
    while (1) {
	last if (pos($encstr) >= length($encstr));
	my $pos = pos($encstr);               ### save it

	### Case 1: are we looking at "=?..?..?="?
	if ($encstr =~    m{\G             # from where we left off..
			    =\?([^?]*)     # "=?" + charset +
			     \?([bq])      #  "?" + encoding +
			     \?([^?]+)     #  "?" + data maybe with spcs +
			     \?=           #  "?="
			    }xgi) {
	    ($charset, $encoding, $enc) = ($1, lc($2), $3);
	    $dec = (($encoding eq 'q') ? _decode_Q($enc) : _decode_B($enc));
	    push @tokens, [$dec, $charset];
	    next;
	}

	### Case 2: are we looking at a bad "=?..." prefix? 
	### We need this to detect problems for case 3, which stops at "=?":
	pos($encstr) = $pos;               # reset the pointer.
	if ($encstr =~ m{\G=\?}xg) {
	    $@ .= qq|unterminated "=?..?..?=" in "$encstr" (pos $pos)\n|;
	    push @tokens, ['=?'];
	    next;
	}

	### Case 3: are we looking at ordinary text?
	pos($encstr) = $pos;               # reset the pointer.
	if ($encstr =~ m{\G                # from where we left off...
			 ([\x00-\xFF]*?    #   shortest possible string,
			  \n*)             #   followed by 0 or more NLs,
		         (?=(\Z|=\?))      # terminated by "=?" or EOS
			}xg) {
	    length($1) or die "MIME::Words: internal logic err: empty token\n";
	    push @tokens, [$1];
	    next;
	}

	### Case 4: bug!
	die "MIME::Words: unexpected case:\n($encstr) pos $pos\n\t".
	    "Please alert developer.\n";
    }
    return join('',map {$_->[0]} @tokens);
}

# _decode_Q STRING
#     Private: used by _decode_header() to decode "Q" encoding, which is
#     almost, but not exactly, quoted-printable.  :-P
sub _decode_Q {
    my $str = shift;
    $str =~ s/_/\x20/g;                                # RFC-1522, Q rule 2
    $str =~ s/=([\da-fA-F]{2})/pack("C", hex($1))/ge;  # RFC-1522, Q rule 1
    $str;
}

# _decode_B STRING
#     Private: used by _decode_header() to decode "B" encoding.
sub _decode_B {
    my $str = shift;
    &decode_base64($str);
}

# user_mail_file(user|file, [other details])
sub user_mail_file
{
if ($_[0] =~ /^\//) {
	return $_[0];
	}
elsif ($config{'mail_dir'}) {
	return &mail_file_style($_[0], $config{'mail_dir'},
				$config{'mail_style'});
	}
elsif (@_ > 1) {
	return "$_[7]/$config{'mail_file'}";
	}
else {
	local @u = getpwnam($_[0]);
	return "$u[7]/$config{'mail_file'}";
	}
}

# mail_file_style(user, basedir, style)
sub mail_file_style
{
if ($_[2] == 0) {
	return "$_[1]/$_[0]";
	}
elsif ($_[2] == 1) {
	return $_[1]."/".substr($_[0], 0, 1)."/".$_[0];
	}
elsif ($_[2] == 2) {
	return $_[1]."/".substr($_[0], 0, 1)."/".
		substr($_[0], 0, 2)."/".$_[0];
	}
else {
	return $_[1]."/".substr($_[0], 0, 1)."/".
		substr($_[0], 1, 1)."/".$_[0];
	}
}

# user_index_file(user|file)
sub user_index_file
{
local $f = $_[0] =~ /^\/.*\/([^\/]+)$/ ?
	($user_module_config_directory ? "$user_module_config_directory/$1.findex" : "$module_config_directory/$1.findex") :
       $user_module_config_directory ?
	"$user_module_config_directory/$_[0].index" :
	"$module_config_directory/$_[0].index";
local $hn = &get_system_hostname();
return -r $f && !-r "$f.$hn" ? $f : "$f.$hn";
}

# extract_mail(data)
# Converts the text of a message into mail object.
sub extract_mail
{
local ($amail, @aheaders, $i);
local @alines = split(/\n/, $_[0]);
while($i < @alines && $alines[$i]) {
	if ($alines[$i] =~ /^(\S+):\s*(.*)/) {
		push(@aheaders, [ $1, $2 ]);
		}
	elsif ($alines[$i] =~ /^(\s+.*)/) {
		$aheaders[$#aheaders]->[1] .= $1;
		}
	$i++;
	}
$amail->{'headers'} = \@aheaders;
foreach $h (@aheaders) {
	$amail->{'header'}->{lc($h->[0])} = $h->[1];
	}
splice(@alines, 0, $i);
$amail->{'body'} = join("\n", @alines)."\n";
return $amail;
}

# split_addresses(string)
# Splits a comma-separated list of addresses into [ email, real-name, original ]
# triplets
sub split_addresses
{
local (@rv, $str = $_[0]);
while(1) {
	if ($str =~ /^[\s,]*(([^<>\(\)\s]+)\s+\(([^\(\)]+)\))(.*)$/) {
		push(@rv, [ $2, $3, $1 ]);
		$str = $4;
		}
	elsif ($str =~ /^[\s,]*("([^"]+)"\s+<([^\s<>]+)>)(.*)$/ ||
	       $str =~ /^[\s,]*(([^<>]+)\s+<([^\s<>]+)>)(.*)$/ ||
	       $str =~ /^[\s,]*(([^<>\[\]]+)\s+\[mailto:([^\s\[\]]+)\])(.*)$/||
	       $str =~ /^[\s,]*(()<([^\s<>]+)>)(.*)/ ||
	       $str =~ /^[\s,]*(()([^\s<>,]+))(.*)/) {
		push(@rv, [ $3, $2, $1 ]);
		$str = $4;
		}
	else {
		last;
		}
	}
return @rv;
}

$match_ascii = '\x1b\([BHJ]([\t\x20-\x7e]*)';
$match_jis = '\x1b\$[@B](([\x21-\x7e]{2})*)';

sub eucconv {
	local($_) = @_;
	if ($current_lang eq 'ja_JP.euc') {
		s/$match_jis/&j2e($1)/geo;
		s/$match_ascii/$1/go;
		}
	$_;
}

sub j2e {
	local($_) = @_;
	tr/\x21-\x7e/\xa1-\xfe/;
	$_;
}

# list_maildir(file, [start], [end])
# Returns a subset of mail from a maildir format directory
sub list_maildir
{
local (@rv, $i, $f, @files);
foreach $d ("$_[0]/cur", "$_[0]/new") {
	opendir(DIR, $d);
	while($f = readdir(DIR)) {
		push(@files, "$d/$f") if ($f !~ /^\./);
		}
	closedir(DIR);
	}
@files = sort { $a =~ /([^\/]+)$/; local $an = $1;
		$b =~ /([^\/]+)$/; local $bn = $1;
		$an cmp $bn } @files;
local ($start, $end);
if (!defined($_[1])) {
	$start = 0;
	$end = @files - 1;
	}
elsif ($_[2] < 0) {
	$start = @files + $_[2] - 1;
	$end = @files + $_[1] - 1;
	$start = 0 if ($start < 0);
	}
else {
	$start = $_[1];
	$end = $_[2];
	$end = @files-1 if ($end >= @files);
	}
foreach $f (@files) {
	if ($i < $start || $i > $end) {
		# Skip files outside requested index range
		push(@rv, undef);
		$i++;
		next;
		}
	local $mail = &read_mail_file($f);
	$mail->{'idx'} = $i++;
	push(@rv, $mail);
	}
return @rv;
}

# search_maildir(file, field, what)
# Search for messages in a maildir directory, and return the result
sub search_maildir
{
local @rv;
local $field = $_[1];
local $neg = ($field =~ s/^\!//);
foreach $mail (&list_maildir($_[0])) {
	if ($field eq 'body') {
		push(@rv, $mail)
			if (!$neg && $mail->{'body'} =~ /\Q$_[2]\E/i ||
			     $neg && $mail->{'body'} !~ /\Q$_[2]\E/i);
		}
	elsif ($field eq 'size') {
		push(@rv, $mail)
			if (!$neg && $mail->{'size'} > $_[2] ||
			     $neg && $mail->{'size'} < $_[2]);
		}
	else {
		push(@rv, $mail)
		 if (!$neg && $mail->{'header'}->{$field} =~ /\Q$_[2]\E/i ||
		      $neg && $mail->{'header'}->{$field} !~ /\Q$_[2]\E/i);
		}
	}
return @rv;
}

# delete_maildir(&mail, ...)
# Delete messages from a maildir directory
sub delete_maildir
{
local $m;
foreach $m (@_) {
	unlink($m->{'file'});
	}
}

# modify_maildir(&oldmail, &newmail, textonly)
# Replaces a message in a maildir directory
sub modify_maildir
{
unlink($_[0]->{'file'});
&send_mail($_[1], $_[0]->{'file'}, $_[2]);
}

# list_mhdir(file, [start], [end])
# Returns a subset of mail from an MH format directory
sub list_mhdir
{
local ($start, $end, $f, $i, @rv);
opendir(DIR, $_[0]);
local @files = map { "$_[0]/$_" }
		sort { $a <=> $b }
		 grep { /^\d+$/ } readdir(DIR);
closedir(DIR);
if (!defined($_[1])) {
	$start = 0;
	$end = @files - 1;
	}
elsif ($_[2] < 0) {
	$start = @files + $_[2] - 1;
	$end = @files + $_[1] - 1;
	$start = 0 if ($start < 0);
	}
else {
	$start = $_[1];
	$end = $_[2];
	$end = @files-1 if ($end >= @files);
	}
foreach $f (@files) {
	if ($i < $start || $i > $end) {
		# Skip files outside requested index range
		push(@rv, undef);
		$i++;
		next;
		}
	local $mail = &read_mail_file($f);
	$mail->{'idx'} = $i++;
	push(@rv, $mail);
	}
return @rv;
}

# search_mhdir(file, field, what)
# Search for messages in an MH directory, and return the result
sub search_mhdir
{
local @rv;
local $field = $_[1];
local $neg = ($field =~ s/^\!//);
foreach $mail (&list_mhdir($_[0])) {
	if ($field eq 'body') {
		push(@rv, $mail)
			if (!$neg && $mail->{'body'} =~ /\Q$_[2]\E/i ||
			     $neg && $mail->{'body'} !~ /\Q$_[2]\E/i);
		}
	elsif ($field eq 'size') {
		push(@rv, $mail)
			if (!$neg && $mail->{'size'} > $_[2] ||
			     $neg && $mail->{'size'} < $_[2]);
		}
	else {
		push(@rv, $mail)
		 if (!$neg && $mail->{'header'}->{$field} =~ /\Q$_[2]\E/i ||
		      $neg && $mail->{'header'}->{$field} !~ /\Q$_[2]\E/i);
		}
	}
return @rv;
}

# delete_mhdir(&mail, ...)
# Delete messages from an MH directory
sub delete_mhdir
{
local $m;
foreach $m (@_) {
	unlink($m->{'file'});
	}
}

# modify_mhdir(&oldmail, &newmail, textonly)
# Replaces a message in a maildir directory
sub modify_mhdir
{
unlink($_[0]->{'file'});
&send_mail($_[1], $_[0]->{'file'}, $_[2]);
}

# max_mhdir(dir)
# Returns the maximum message ID in the directory
sub max_mhdir
{
local $max = 1;
opendir(DIR, $_[0]);
foreach $f (readdir(DIR)) {
	$max = $f if ($f =~ /^\d+$/ && $f > $max);
	}
closedir(DIR);
return $max;
}

# read_mail_file(file)
# Read a single message from a file
sub read_mail_file
{
local (@headers, $mail);
$mail->{'file'} = $_[0];

# Read the headers
open(MAIL, $_[0]);
while(1) {
	local $line = <MAIL>;
	$mail->{'size'} += length($line);
	$line =~ s/\r|\n//g;
	last if ($line eq '');
	if ($line =~ /^(\S+):\s*(.*)/) {
		push(@headers, [ $1, $2 ]);
		}
	elsif ($line =~ /^(\s+.*)/) {
		$headers[$#headers]->[1] .= $1 unless($#headers < 0);
		}
	}
$mail->{'headers'} = \@headers;
foreach $h (@headers) {
	$mail->{'header'}->{lc($h->[0])} = $h->[1];
	}

# Read the mail body
while(read(MAIL, $buf, 1024) > 0) {
	$mail->{'size'} += length($buf);
	$mail->{'body'} .= $buf;
	}
close(MAIL);
return $mail;
}

1;
