<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;"># procmail-lib.pl
# Functions for parsing the .procmailrc file

BEGIN { push(@INC, ".."); };
use WebminCore;
&amp;init_config();
%minfo = &amp;get_module_info($module_name);
if ($minfo{'usermin'}) {
	&amp;switch_to_remote_user();
	&amp;create_user_config_dirs();
	$procmailrc = "$remote_user_info[7]/.procmailrc";
	$includes = $userconfig{'includes'};
	}
else {
	$procmailrc = $config{'procmailrc'};
	$includes = $config{'includes'};
	}

# get_procmailrc()
# Parses the .procmailrc file into recipes
sub get_procmailrc
{
return &amp;parse_procmail_file($procmailrc);
}

# parse_procmail_file(file)
sub parse_procmail_file
{
local (@rv, $rec, $_);
local $lnum = 0;
local $fh = $_[0];
open($fh, $_[0]);
while(&lt;$fh&gt;) {
	local $slnum = $lnum;
	s/\s+$//;
	while(s/\\$//) {
		local $cont = &lt;$fh&gt;;
		$cont =~ s/\s+$//;
		$cont =~ s/^\s+//;
		$_ .= $cont;
		$lnum++;
		}
	while(/^\s*([^\s=]+)\s*=([^"]*)"([^"]*)$/) {
		# Quote in environment variable that is not ended!
		local $cont = &lt;$fh&gt;;
		$cont =~ s/\r|\n//g;
		$_ .= "\n".$cont;
		$lnum++;
		}
	if (!/^\*/) {
		s/#.*$//;
		s/\s+$//;
		}
	if (/^\s*([^\s=]+)\s*=\s*"((.|\n)*)"$/ ||
	    /^\s*([^\s=]+)\s*=\s*'((.|\n)*)'$/ ||
	    /^\s*([^\s=]+)\s*=\s*((.|\n)*)$/) {
		if ($1 eq "INCLUDERC") {
			local $ifile = $2;
			if ($includes &amp;&amp; $ifile !~ /\$/) {
				# Including another file
				local @inc = &amp;parse_procmail_file(
					&amp;make_absolute($ifile, $procmailrc));
				map { $_-&gt;{'index'} += scalar(@rv) } @inc;
				push(@rv, @inc);
				}
			else {
				# Just indicate the include
				local $inc = { 'index' =&gt; scalar(@rv),
					       'file' =&gt; $_[0],
					       'line' =&gt; $slnum,
					       'eline' =&gt; $lnum,
					       'include' =&gt; $ifile };
				push(@rv, $inc);
				}
			}
		elsif ($1 eq "SWITCHRC") {
			# Change to another file
			local @inc = &amp;parse_procmail_file(
					&amp;make_absolute("$2", $procmailrc));
			map { $_-&gt;{'index'} += scalar(@rv) } @inc;
			push(@rv, @inc);
			last;
			}
		elsif ($rec) {
			# Environment variable as action for recipe
			$rec-&gt;{'type'} = "=";
			$rec-&gt;{'action'} = "$1=$2";
			$rec-&gt;{'eline'} = $lnum;
			$rec = undef;
			}
		else {
			# Environment variable assignment
			local $env = { 'index' =&gt; scalar(@rv),
				       'file' =&gt; $_[0],
				       'line' =&gt; $slnum,
				       'eline' =&gt; $lnum,
				       'name' =&gt; $1,
				       'value' =&gt; $2 };
			push(@rv, $env);
			}
		}
	elsif (/^\s*:0\s*(\S*)\s*:\s*(.*)$/ || /^:0\s*(\S*)/) {
		# Start of a new recipe
		$rec = { 'index' =&gt; scalar(@rv),
			 'file' =&gt; $_[0],
			 'line' =&gt; $slnum,
			 'eline' =&gt; $lnum,
			 'lockfile' =&gt; $2,
			 'flags' =&gt; [ split(//, $1) ] };
		push(@rv, $rec);
		}
	elsif (/^\s*\*\s*(\!|\$|\?|&lt;|&gt;|)(.*)$/) {
		# A condition for a recipe
		push(@{$rec-&gt;{'conds'}}, [ $1, $2 ]);
		$rec-&gt;{'eline'} = $lnum;
		}
	elsif (/^\s*\{\s*$/) {
		# A conditional action .. read till the end
		local $nest = 1;
		$rec-&gt;{'block'} = "";
		while(&lt;$fh&gt;) {
			$lnum++;
			if (/^\{\s*$/) {
				$nest++;
				}
			elsif (/^\}\s*$/) {
				last if (!--$nest);
				}
			$rec-&gt;{'block'} .= $_;
			}
		$rec-&gt;{'eline'} = $lnum;
		$rec = undef;
		}
	elsif (/^\s*\{(.*)\}\s*$/) {
		# A single-line conditional action .. 
		$rec-&gt;{'block'} = $1;
		$rec-&gt;{'eline'} = $lnum;
		$rec = undef;
		}
	elsif (/^\s*(\!|\|)\s*(.*)$/) {
		# The action for a recipe
		$rec-&gt;{'type'} = $1;
		$rec-&gt;{'action'} = $2;
		$rec-&gt;{'eline'} = $lnum;
		$rec = undef;
		}
	elsif (/\S/) {
		if ($rec-&gt;{'action'}) {
			# Unknown line
			&amp;error(&amp;text('config_eline', $slnum+1,
				     $_[0], "&lt;tt&gt;$_&lt;/tt&gt;"));
			}
		else {
			# File delivery action
			$rec-&gt;{'type'} = undef;
			$rec-&gt;{'action'} = $_;
			$rec-&gt;{'eline'} = $lnum;
			if ($rec-&gt;{'action'} =~ /^\"(.*)\"$/) {
				# Quoted path .. un-quote
				$rec-&gt;{'action'} = $1;
				}
			$rec = undef;
			}
		}
	$lnum++;
	}
close($fh);
return @rv;
}

# create_recipe(&amp;recipe, [file])
sub create_recipe
{
local $lref = &amp;read_file_lines($_[1] || $procmailrc);
push(@$lref, &amp;recipe_lines($_[0]));
&amp;flush_file_lines();
}

# create_recipe_before(&amp;recipe, &amp;before, [file])
sub create_recipe_before
{
local $lref = &amp;read_file_lines($_[2] || $procmailrc);
local @lines = &amp;recipe_lines($_[0]);
splice(@$lref, $_[1]-&gt;{'line'}, 0, @lines);
$_[1]-&gt;{'line'} += @lines;
$_[1]-&gt;{'eline'} += @lines;
&amp;flush_file_lines();
}

# delete_recipe(&amp;recipe)
sub delete_recipe
{
local $lref = &amp;read_file_lines($_[0]-&gt;{'file'});
splice(@$lref, $_[0]-&gt;{'line'}, $_[0]-&gt;{'eline'} - $_[0]-&gt;{'line'} + 1);
&amp;flush_file_lines();
}

# modify_recipe(&amp;recipe)
sub modify_recipe
{
local $lref = &amp;read_file_lines($_[0]-&gt;{'file'});
splice(@$lref, $_[0]-&gt;{'line'}, $_[0]-&gt;{'eline'} - $_[0]-&gt;{'line'} + 1,
       &amp;recipe_lines($_[0]));
&amp;flush_file_lines();
}

# swap_recipes(&amp;recipe1, &amp;recipe2)
sub swap_recipes
{
local $lref0 = &amp;read_file_lines($_[0]-&gt;{'file'});
local $lref1 = &amp;read_file_lines($_[1]-&gt;{'file'});
local @lines0 = @$lref0[$_[0]-&gt;{'line'} .. $_[0]-&gt;{'eline'}];
local @lines1 = @$lref1[$_[1]-&gt;{'line'} .. $_[1]-&gt;{'eline'}];
if ($_[0]-&gt;{'line'} &lt; $_[1]-&gt;{'line'}) {
	splice(@$lref1, $_[1]-&gt;{'line'}, $_[1]-&gt;{'eline'} - $_[1]-&gt;{'line'} + 1,
	       @lines0);
	splice(@$lref0, $_[0]-&gt;{'line'}, $_[0]-&gt;{'eline'} - $_[0]-&gt;{'line'} + 1,
	       @lines1);
	}
else {
	splice(@$lref0, $_[0]-&gt;{'line'}, $_[0]-&gt;{'eline'} - $_[0]-&gt;{'line'} + 1,
	       @lines1);
	splice(@$lref1, $_[1]-&gt;{'line'}, $_[1]-&gt;{'eline'} - $_[1]-&gt;{'line'} + 1,
	       @lines0);
	}
&amp;flush_file_lines();
}

sub recipe_lines
{
if ($_[0]-&gt;{'name'}) {
	# Environment variable
	local $v = $_[0]-&gt;{'value'} =~ /\n/ ? $_[0]-&gt;{'value'} :
		   $_[0]-&gt;{'value'} =~ /^\`/ ? $_[0]-&gt;{'value'} :
		   $_[0]-&gt;{'value'} =~ /^\S+$/ ? $_[0]-&gt;{'value'} :
		   $_[0]-&gt;{'value'} =~ /"/ ? "'$_[0]-&gt;{'value'}'" :
					    "\"$_[0]-&gt;{'value'}\"";
	return ( $_[0]-&gt;{'name'}."=".$v );
	}
elsif ($_[0]-&gt;{'include'}) {
	# Included file
	local $v = $_[0]-&gt;{'include'} =~ /^\`/ ? $_[0]-&gt;{'include'} :
		   $_[0]-&gt;{'include'} =~ /^\S+$/ ? $_[0]-&gt;{'include'} :
		   $_[0]-&gt;{'include'} =~ /"/ ? "'$_[0]-&gt;{'include'}'" :
					    "\"$_[0]-&gt;{'include'}\"";
	return ( "INCLUDERC=".$v );
	}
else {
	# Recipe with conditions and action
	local (@rv, $c);
	push(@rv, ":0".join("", @{$_[0]-&gt;{'flags'}}));
	if (defined($_[0]-&gt;{'lockfile'})) {
		$rv[0] .= ":".$_[0]-&gt;{'lockfile'};
		}
	foreach $c (@{$_[0]-&gt;{'conds'}}) {
		push(@rv, "* ".$c-&gt;[0].$c-&gt;[1]);
		}
	if (defined($_[0]-&gt;{'block'})) {
		push(@rv, "{", split(/\n/, $_[0]-&gt;{'block'}), "}");
		}
	elsif ($_[0]-&gt;{'type'} &amp;&amp; $_[0]-&gt;{'type'} ne '=') {
		push(@rv, $_[0]-&gt;{'type'}." ".$_[0]-&gt;{'action'});
		}
	elsif ($_[0]-&gt;{'action'} =~ /^(\S+)=/) {
		# Variable assignment .. don't quote
		push(@rv, $_[0]-&gt;{'action'});
		}
	elsif ($_[0]-&gt;{'action'} !~ /^\S+$/) {
		# File with a space .. need to quote
		push(@rv, "\"$_[0]-&gt;{'action'}\"");
		}
	else {
		# File delivery
		push(@rv, $_[0]-&gt;{'action'});
		}
	return @rv;
	}
}

# parse_action(&amp;recipe)
sub parse_action
{
if ($_[0]-&gt;{'type'} eq '|') {
	return (4, $_[0]-&gt;{'action'});
	}
elsif ($_[0]-&gt;{'type'} eq '!') {
	return (3, $_[0]-&gt;{'action'});
	}
elsif ($_[0]-&gt;{'type'} eq '=') {
	local ($n, $v) = split(/=/, $_[0]-&gt;{'action'}, 2);
	return (6, $n);
	}
elsif (defined($_[0]-&gt;{'block'})) {
	return (5);
	}
elsif ($_[0]-&gt;{'action'} =~ /^(.*)\/$/) {
	return (2, $1);
	}
elsif ($_[0]-&gt;{'action'} =~ /^(.*)\/\.$/) {
	return (1, $1);
	}
else {
	return (0, $_[0]-&gt;{'action'});
	}
}

# make_absolute(file, basefile)
sub make_absolute
{
return $_[0] if ($_[0] =~ /^\//);
$_[1] =~ /^(.*)\/[^\/]+$/;
return "$1/$_[0]";
}

# check_mailserver_config()
# Works out which mail server appears to be installed, and returns the
# module name and possibly an error message if Procmail is not setup
sub check_mailserver_config
{
# Find a running mail server
local $ms = &amp;foreign_installed("qmailadmin") &amp;&amp;
	     &amp;qmailadmin::is_qmail_running() ? "qmailadmin" :
	    &amp;foreign_installed("postfix") &amp;&amp;
	     &amp;postfix::is_postfix_running() ? "postfix" :
	    &amp;foreign_installed("sendmail") &amp;&amp;
	     &amp;sendmail::is_sendmail_running() ? "sendmail" : undef;
# Fall back to installed mail server
local $ms = &amp;foreign_installed("qmailadmin") ? "qmailadmin" :
	    &amp;foreign_installed("postfix") ? "postfix" :
	    &amp;foreign_installed("sendmail") ? "sendmail" : undef;
return () if (!$ms);
local $err;
local $procmail_cmd = &amp;has_command($config{'procmail'});
if ($ms eq "qmailadmin") {
	# Don't know how to check for this
	$err = undef;
	}
elsif ($ms eq "postfix") {
	# Check mailbox_command
	&amp;foreign_require("postfix", "postfix-lib.pl");
	local $cmd = &amp;postfix::get_real_value("mailbox_command");
	if ($cmd !~ /procmail/) {
		$err = &amp;text('check_epostfix', "mailbox_command",
			     $postfix::config{'postfix_config_file'},
			     $procmail_cmd);
		}
	}
elsif ($ms eq "sendmail") {
	# Check for local or procmail mailer
	&amp;foreign_require("sendmail", "sendmail-lib.pl");
	local $conf = &amp;sendmail::get_sendmailcf();
	local $found;
	foreach my $c (@$conf) {
		if ($c-&gt;{'type'} eq 'M' &amp;&amp; $c-&gt;{'value'} =~ /procmail/) {
			$found++;
			last;
			}
		}
	if (!$found) {
		$err = &amp;text('check_esendmail','../sendmail/list_features.cgi');
		}
	}
return ($ms, $err);
}

@known_flags = ('H', 'B', 'D', 'h', 'b', 'c', 'w', 'W', 'i', 'r', 'f');

1;

</pre></body></html>