boxes-lib.pl

Unix下基于Web的管理工具

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

# list_mails(user, [start], [end])
sub list_mails
{
local (@rv, $h, $done, @index, @lindex);
local @ist = stat("$module_config_directory/$_[0].index");
local @st = stat("$config{'mail_dir'}/$_[0]");
if (!@ist || $ist[9] < $st[9]) {
	# Need to build index
	local $pos = 0;
	local $lnum = 0;
	open(MAIL, "$config{'mail_dir'}/$_[0]");
	while(<MAIL>) {
		if (/^From\s+/) {
			push(@index, [ $pos, $lnum ]);
			}
		$pos += length($_);
		$lnum++;
		}
	close(MAIL);
	open(INDEX, ">$module_config_directory/$_[0].index");
	print INDEX map { $_->[0]." ".$_->[1]."\n" } @index;
	close(INDEX);
	}
else {
	# Read the index file
	open(INDEX, "$module_config_directory/$_[0].index");
	@index = map { /(\d+)\s+(\d+)/; [ $1, $2 ] } <INDEX>;
	close(INDEX);
	}

# Read the specified emails
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];
	}
@rv = map { undef } @index;
open(MAIL, "$config{'mail_dir'}/$_[0]");
for($i=$start; $i<=$end; $i++) {
	local ($mail, $line, @headers);
	seek(MAIL, $index[$i]->[0], 0);
	$line = <MAIL>;	# skip From line

	# read mail headers
	$mail->{'line'} = $index[$i]->[1];
	local $lnum = 1;
	while(1) {
		$lnum++;
		($line = <MAIL>) =~ s/\r|\n//g;
		$mail->{'size'} += length($line);
		if ($line =~ /^(\S+):\s*(.*)/) {
			push(@headers, [ $1, $2 ]);
			}
		elsif ($line =~ /^(\s+.*)/) {
			$headers[$#headers]->[1] .= $1;
			}
		else { last; }
		}
	$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/);
		$lnum++;
		$mail->{'size'} += length($line);
		$mail->{'body'} .= $line;
		}
	$mail->{'eline'} = $mail->{'line'} + $lnum - 1;
	$mail->{'idx'} = $i;
	$rv[$i] = $mail;
	}
return @rv;
}

# parse_mail(&mail)
# 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;
	while($l < @lines && $lines[$l++] ne $bound) {
		# skip to first boundary
		}
	while(1) {
		# read attachment headers
		local (@headers, $attach);
		while($lines[$l]) {
			if ($lines[$l] =~ /^(\S+):\s*(.*)/) {
				push(@headers, [ $1, $2 ]);
				}
			elsif ($lines[$l] =~ /^(\s+.*)/) {
				$headers[$#headers]->[1] .= $1;
				}
			$l++;
			}
		$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="([^"]+)"/i) {
			$attach->{'filename'} = $1;
			}
		elsif ($attach->{'header'}->{'content-disposition'} =~
		       /filename=([^;\s]+)/i) {
			$attach->{'filename'} = $1;
			}
		elsif ($attach->{'header'}->{'content-type'} =~
		    /name="([^"]+)"/i) {
			$attach->{'filename'} = $1;
			}

		# read the attachment body
		while($l < @lines && $lines[$l] !~ /^$bound(--)?$/) {
			$attach->{'data'} .= $lines[$l]."\n";
			$l++;
			}

		# decode if necessary
		if (lc($attach->{'header'}->{'content-transfer-encoding'}) eq
		    'base64') {
			$attach->{'data'} = &b64decode($attach->{'data'});
			}

		$attach->{'idx'} = scalar(@attach);
		push(@attach, $attach);
		if ($attach->{'type'} eq 'message/rfc822') {
			# Decode this included email as well
			local ($amail, @aheaders, $i);
			local @alines = split(/\n/, $attach->{'data'});
			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";
			&parse_mail($amail);
			map { $_->{'idx'} += scalar(@attach) }
			    @{$amail->{'attach'}};
			push(@attach, @{$amail->{'attach'}});
			}
		elsif ($attach->{'type'} =~ /multipart\/(\S+)/i) {
			# This attachment contains more attachments
			local $amail = { 'header' => $attach->{'header'},
					 'body' => $attach->{'data'} };
			&parse_mail($amail);
			pop(@attach);
			map { $_->{'idx'} += scalar(@attach) }
			    @{$amail->{'attach'}};
			push(@attach, @{$amail->{'attach'}});
			}
		last if ($lines[$l] eq "$bound--");
		$l++;
		}
	$_[0]->{'attach'} = \@attach;
	}
elsif ($_[0]->{'body'} =~ /begin\s+([0-7]+)\s+(\S+)/i) {
	# Looks like a uuencoded message!
	local $filename = $2;
	local @lines = split(/\n/, $_[0]->{'body'});
	local ($l, $data);
	for($l=0; $lines[$l] !~ /begin\s+([0-7]+)\s/i; $l++) { }
	while($lines[++$l]) {
		$data .= unpack("u", $lines[$l]);
		}
	$_[0]->{'attach'} = [ { 'type' => &guess_type($filename),
				'idx' => 0,
				'filename' => $filename,
				'data' => $data } ];
	}
elsif ($_[0]->{'header'}->{'content-transfer-encoding'} eq 'base64') {
	# Signed body section
	$ct =~ s/;.*$//;
	$_[0]->{'attach'} = [ { 'type' => $ct,
				'idx' => 0,
				'data' => &b64decode($_[0]->{'body'}) } ];
	}
else {
	# One big attachment (probably text)
	local ($type, $body);
	($type = $ct) =~ s/;.*$//;
	$type = 'text/plain' if (!$type);
	if ($_[0]->{'header'}->{'content-transfer-encoding'} eq 'base64') {
		$body = &b64decode($_[0]->{'body'});
		}
	else {
		$body = $_[0]->{'body'};
		}
	$_[0]->{'attach'} = [ { 'type' => $type,
				'idx' => 0,
				'data' => $body } ];
	}
}

# delete_mail(&mail, user)
sub delete_mail
{
local $lref = &read_file_lines("$config{'mail_dir'}/$_[1]");
splice(@$lref, $_[0]->{'line'}, $_[0]->{'eline'} - $_[0]->{'line'} + 1);
&flush_file_lines();
}

# send_mail(&mail)
sub send_mail
{
# Start sendmail and write headers
open(MAIL, "| $config{'sendmail_path'} -t >/dev/null 2>&1");
foreach $h (@{$_[0]->{'headers'}}) {
	print MAIL $h->[0],": ",$h->[1],"\n";
	}
print MAIL "MIME-Version: 1.0\n";
local $bound = "--------".time();
print MAIL "Content-Type: multipart/mixed; boundary=\"$bound\"\n";
print MAIL "\n";

# Send attachments
print MAIL "This is a multi-part message in MIME format.\n";
foreach $a (@{$_[0]->{'attach'}}) {
	print MAIL "--",$bound,"\n";
	local $enc;
	foreach $h (@{$a->{'headers'}}) {
		print MAIL $h->[0],": ",$h->[1],"\n";
		$enc = $h->[1] if (lc($h->[0]) eq 'content-transfer-encoding');
		}
	print MAIL "\n";
	if (lc($enc) eq 'base64') {
		print MAIL &encode_base64($a->{'data'});
		}
	else {
		print MAIL $a->{'data'};
		print MAIL "\n" if ($a->{'data'} !~ /\n$/);
		}
	}
print MAIL "--",$bound,"--\n";
close(MAIL);
}

# 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, "../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 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;
	}
else {
	foreach $u (split(/\s+/, $access{'musers'})) {
		return 0 if ($u eq $_[0]);
		}
	return 1;
	}
}

# 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;
}

1;