<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;"># proftpd-lib.pl
# Common functions for the proftpd server config file

BEGIN { push(@INC, ".."); };
use WebminCore;
&amp;init_config();

# Load the site-specific information on the server executable
&amp;read_file("$module_config_directory/site", \%site);
@ftpaccess_files = split(/\s+/, $site{'ftpaccess'});
opendir(DIR, ".");
foreach $f (readdir(DIR)) {
	if ($f =~ /^(mod_\S+)\.pl$/) {
		push(@module_files, $1);
		do $f;
		}
	}
closedir(DIR);

# get_config()
# Returns the entire proftpd config structure
sub get_config
{
if (@get_config_cache) {
	return \@get_config_cache;
	}
@get_config_cache = &amp;get_config_file($config{'proftpd_conf'});
return \@get_config_cache;
}

# get_config_file(filename)
sub get_config_file
{
local @rv;
local $fn = $_[0];
if ($fn !~ /^\//) {
	$config{'proftpd_conf'} =~ /^(.*)\//;
	$fn = "$1/$fn";
	}
if (opendir(DIR, $fn)) {
	# Is a directory .. parse all files!
	local @files = readdir(DIR);
	closedir(DIR);
	foreach $f (@files) {
		next if ($f =~ /^\./);
		push(@rv, &amp;get_config_file("$fn/$f"));
		}
	}
else {
	# Just a normal config file
	local $lnum = 0;
	if (open(CONF, $fn)) {
		@rv = &amp;parse_config_file(CONF, $lnum, $fn);
		close(CONF);
		foreach $inc (&amp;find_directive("Include", \@rv)) {
			push(@rv, &amp;get_config_file($inc));
			}
		}
	}
return @rv;
}

# parse_config_file(handle, lines, file)
# Parses lines of text from some config file into a data structure. The
# return value is an array of references, one for each directive in the file.
# Each reference points to an associative array containing
#  line -	The line number this directive is at
#  eline -	The line number this directive ends at
#  file -	The file this directive is from
#  type -	0 for a normal directive, 1 for a container directive
#  name -	The name of this directive
#  value -	Value (possibly with spaces)
#  members -	For type 1, a reference to the array of members
sub parse_config_file
{
local($fh, @rv, $line, %dummy);
$fh = $_[0];
$dummy{'line'} = $dummy{'eline'} = $_[1]-1;
$dummy{'file'} = $_[2];
$dummy{'type'} = 0;
$dummy{'name'} = "dummy";
@rv = (\%dummy);
local %defs;
foreach my $d (&amp;get_httpd_defines()) {
        if ($d =~ /^(\S+)=(.*)$/) {
                $defs{$1} = $2;
                }
        else {
                $defs{$d} = '';
                }
        }
while($line = &lt;$fh&gt;) {
	chop;
	$line =~ s/^\s*#.*$//g;
	if ($line =~ /^\s*&lt;\/(\S+)\s*(.*)&gt;/) {
		# end of a container directive. This can only happen in a
		# recursive call to this function
		$_[1]++;
		last;
		}
	elsif ($line =~ /^\s*&lt;IfModule\s+(\!?)(\S+)\.c&gt;/i) {
		# start of an IfModule block. Read it, and if the module
		# exists put the directives in this section.
		local ($not, $mod) = ($1, $2);
		local $oldline = $_[1];
		$_[1]++;
		local @dirs = &amp;parse_config_file($fh, $_[1], $_[2]);
		if (!$not &amp;&amp; $httpd_modules{$mod} ||
		    $not &amp;&amp; !$httpd_modules{$mod}) {
			# use the directives..
			push(@rv, { 'line', $oldline,
				    'eline', $oldline,
				    'file', $_[2],
				    'name', "&lt;IfModule $not$mod&gt;" });
			push(@rv, @dirs);
			push(@rv, { 'line', $_[1]-1,
				    'eline', $_[1]-1,
				    'file', $_[2],
				    'name', "&lt;/IfModule&gt;" });
			}
		}
	elsif ($line =~ /^\s*&lt;IfDefine\s+(\!?)(\S+)&gt;/i) {
		# start of an IfDefine block. Read it, and if the define
		# exists put the directives in this section
		local ($not, $def) = ($1, $2);
		local $oldline = $_[1];
		$_[1]++;
		local @dirs = &amp;parse_config_file($fh, $_[1], $_[2]);
		if (!$not &amp;&amp; defined($defs{$def}) ||
		    $not &amp;&amp; !defined($defs{$def})) {
			# use the directives..
			push(@rv, { 'line', $oldline,
				    'eline', $oldline,
				    'file', $_[2],
				    'name', "&lt;IfDefine $not$def&gt;" });
			push(@rv, @dirs);
			push(@rv, { 'line', $_[1]-1,
				    'eline', $_[1]-1,
				    'file', $_[2],
				    'name', "&lt;/IfDefine&gt;" });
			}
		}
	elsif ($line =~ /^\s*&lt;(\S+)\s*(.*)&gt;/) {
		# start of a container directive. The first member is a dummy
		# directive at the same line as the container
		local(%dir, @members);
		%dir = ('line', $_[1],
			'file', $_[2],
			'type', 1,
			'name', $1,
			'value', $2);
		$dir{'value'} =~ s/\s+$//g;
		$dir{'words'} = &amp;wsplit($dir{'value'});
		$_[1]++;
		@members = &amp;parse_config_file($fh, $_[1], $_[2]);
		$dir{'members'} = \@members;
		$dir{'eline'} = $_[1]-1;
		push(@rv, \%dir);
		}
	elsif ($line =~ /^\s*(\S+)\s*(.*)$/) {
		# normal directive
		local(%dir);
		%dir = ('line', $_[1],
			'eline', $_[1],
			'file', $_[2],
			'type', 0,
			'name', $1,
			'value', $2);
		if ($dir{'value'} =~ s/\\$//g) {
			# multi-line directive!
			while($line = &lt;$fh&gt;) {
				chop($line);
				$cont = ($line =~ s/\\$//g);
				$dir{'value'} .= $line;
				$dir{'eline'} = ++$_[1];
				if (!$cont) { last; }
				}
			}
		$dir{'value'} =~ s/\s+$//g;
		$dir{'words'} = &amp;wsplit($dir{'value'});
		push(@rv, \%dir);
		$_[1]++;
		}
	else {
		# blank or comment line
		$_[1]++;
		}
	}
return @rv;
}

# wsplit(string)
# Splits a string like  foo "foo \"bar\"" bazzz  into an array of words
sub wsplit
{
local($s, @rv); $s = $_[0];
$s =~ s/\\\"/\0/g;
while($s =~ /^"([^"]*)"\s*(.*)$/ || $s =~ /^(\S+)\s*(.*)$/) {
	$w = $1; $s = $2;
	$w =~ s/\0/"/g; push(@rv, $w);
	}
return \@rv;
}

# wjoin(word, word, ...)
sub wjoin
{
local(@rv, $w);
foreach $w (@_) {
	if ($w =~ /^\S+$/) { push(@rv, $w); }
	else { push(@rv, "\"$w\""); }
	}
return join(' ', @rv);
}

# find_directive(name, &amp;directives)
# Returns the values of directives matching some name
sub find_directive
{
local(@rv, $i, @vals, $dref);
foreach $ref (@{$_[1]}) {
	if (lc($ref-&gt;{'name'}) eq lc($_[0])) {
		push(@vals, $ref-&gt;{'words'}-&gt;[0]);
		}
	}
return wantarray ? @vals : !@vals ? undef : $vals[$#vals];
}

# find_directive_struct(name, &amp;directives)
# Returns references to directives matching some name
sub find_directive_struct
{
local(@rv, $i, @vals);
foreach $ref (@{$_[1]}) {
	if (lc($ref-&gt;{'name'}) eq lc($_[0])) {
		push(@vals, $ref);
		}
	}
return wantarray ? @vals : !@vals ? undef : $vals[$#vals];
}

# find_vdirective(name, &amp;virtualdirectives, &amp;directives)
# Looks for some directive in a &lt;VirtualHost&gt; section, and then in the 
# main section
sub find_vdirective
{
if ($_[1]) {
	$rv = &amp;find_directive($_[0], $_[1]);
	if ($rv) { return $rv; }
	}
return &amp;find_directive($_[0], $_[2]);
}

# make_directives(ref, version, module)
sub make_directives
{
local @rv;
local $ver = $_[1];
if ($ver =~ /^(1)\.(2)(\d+)$/) {
	$ver = sprintf "%d.%d%2.2d", $1, $2, $3;
	}
foreach $d (@{$_[0]}) {
	local(%dir);
	$dir{'name'} = $d-&gt;[0];
	$dir{'multiple'} = $d-&gt;[1];
	$dir{'type'} = $d-&gt;[2];
	$dir{'module'} = $_[2];
	$dir{'version'} = $_[1];
	$dir{'priority'} = $d-&gt;[5];
	foreach $c (split(/\s+/, $d-&gt;[3])) { $dir{$c}++; }
	if (!$d-&gt;[4]) { push(@rv, \%dir); }
	elsif ($d-&gt;[4] =~ /^-([\d\.]+)$/ &amp;&amp; $ver &lt; $1) { push(@rv, \%dir); }
	elsif ($d-&gt;[4] =~ /^([\d\.]+)$/ &amp;&amp; $ver &gt;= $1) { push(@rv, \%dir); }
	elsif ($d-&gt;[4] =~ /^([\d\.]+)-([\d\.]+)$/ &amp;&amp; $ver &gt;= $1 &amp;&amp; $ver &lt; $2)
		{ push(@rv, \%dir); }
	}
return @rv;
}

# editable_directives(type, context)
# Returns an array of references to associative arrays, one for each 
# directive of the given type that can be used in the given context
sub editable_directives
{
local($m, $func, @rv);
local @mods = split(/\s+/, $site{'modules'});
foreach $m (@module_files) {
	if (&amp;indexof($m, @mods) != -1) {
		$func = $m."_directives";
		push(@rv, &amp;$func($site{'version'}));
		}
	}
@rv = grep { $_-&gt;{'type'} == $_[0] &amp;&amp; $_-&gt;{$_[1]} } @rv;
@rv = sort { $pd = $b-&gt;{'priority'} - $a-&gt;{'priority'};
	     $md = $a-&gt;{'module'} cmp $b-&gt;{'module'};
	     $pd == 0 ? ($md == 0 ? $a-&gt;{'name'} cmp $b-&gt;{'name'} : $md) : $pd }
		@rv;
return @rv;
}

# generate_inputs(&amp;editors, &amp;directives)
# Displays a 2-column list of options, for use inside a table
sub generate_inputs
{
local($e, $sw, @args, @rv, $func);
foreach $e (@{$_[0]}) {
	if (!$sw) { print "&lt;tr&gt;\n"; }

	# Build arg list for the editing function. Each arg can be a single
	# directive struct, or a reference to an array of structures.
	$func = "edit";
	undef(@args);
	foreach $ed (split(/\s+/, $e-&gt;{'name'})) {
		local(@vals);
		$func .= "_$ed";
		@vals = &amp;find_directive_struct($ed, $_[1]);
		if ($e-&gt;{'multiple'}) { push(@args, \@vals); }
		elsif (!@vals) { push(@args, undef); }
		else { push(@args, $vals[$#vals]); }
		}
	push(@args, $e);

	# call the function
	@rv = &amp;$func(@args);
	if ($rv[0] == 2) {
		# spans 2 columns..
		if ($sw) {
			# need to end this row
			print "&lt;td colspan=2&gt;&lt;/td&gt; &lt;/tr&gt;&lt;tr&gt;\n";
			}
		else { $sw = !$sw; }
		print "&lt;td valign=top width=25%&gt;&lt;b&gt;$rv[1]&lt;/b&gt;&lt;/td&gt;\n";
		print "&lt;td nowrap valign=top colspan=3 width=75%&gt;$rv[2]&lt;/td&gt;\n";
		}
	else {
		# only spans one column
		print "&lt;td valign=top width=25%&gt;&lt;b&gt;$rv[1]&lt;/b&gt;&lt;/td&gt;\n";
		print "&lt;td nowrap valign=top width=25%&gt;$rv[2]&lt;/td&gt;\n";
		}

	if ($sw) { print "&lt;/tr&gt;\n"; }
	$sw = !$sw;
	}
}

# parse_inputs(&amp;editors, &amp;directives, &amp;config)
# Reads user choices from a form and update the directives and config files.
sub parse_inputs
{
# First call editor functions to get new values. Each function returns
# an array of references to arrays containing the new values for the directive.
local ($i, @chname, @chval);
&amp;before_changing();
foreach $e (@{$_[0]}) {
	local @dirs = split(/\s+/, $e-&gt;{'name'});
	local $func = "save_".join('_', @dirs);
	local @rv = &amp;$func($e);
	for($i=0; $i&lt;@dirs; $i++) {
		push(@chname, $dirs[$i]);
		push(@chval, $rv[$i]);
		}
	}

# Assuming everything went OK, update the configuration
for($i=0; $i&lt;@chname; $i++) {
	&amp;save_directive($chname[$i], $chval[$i], $_[1], $_[2]);
	}
&amp;flush_file_lines();
&amp;after_changing();
}

# opt_input(value, name, default, size, [units])
sub opt_input
{
return sprintf "&lt;input type=radio name=$_[1]_def value=1 %s&gt; $_[2]\n".
	       "&lt;input type=radio name=$_[1]_def value=0 %s&gt;\n".
	       "&lt;input name=$_[1] size=$_[3] value='%s'&gt; %s\n",
	defined($_[0]) ? "" : "checked",
	defined($_[0]) ? "checked" : "",
	$_[0], $_[4];
}

# parse_opt(name, regexp, error)
sub parse_opt
{
local($i, $re);
if ($in{"$_[0]_def"}) { return ( [ ] ); }
for($i=1; $i&lt;@_; $i+=2) {
	$re = $_[$i];
	if ($in{$_[0]} !~ /$re/) { &amp;error($_[$i+1]); }
	}
return ( [ $in{$_[0]} =~ /^\S+$/ ? $in{$_[0]} : '"'.$in{$_[0]}.'"' ] );
}

# choice_input(value, name, default, [choice]+)
# Each choice is a display,value pair
sub choice_input
{
local($i, $rv);
for($i=3; $i&lt;@_; $i++) {
	$_[$i] =~ /^([^,]*),(.*)$/;
	$rv .= sprintf "&lt;input type=radio name=$_[1] value=\"$2\" %s&gt; $1\n",
		lc($2) eq lc($_[0]) ||
		lc($2) eq 'on' &amp;&amp; lc($_[0]) eq 'yes' ||
		lc($2) eq 'off' &amp;&amp; lc($_[0]) eq 'no' ||
		!defined($_[0]) &amp;&amp; lc($2) eq lc($_[2]) ? "checked" : "";
	}
return $rv;
}

# choice_input_vert(value, name, default, [choice]+)
# Each choice is a display,value pair
sub choice_input_vert
{
local($i, $rv);
for($i=3; $i&lt;@_; $i++) {
	$_[$i] =~ /^([^,]*),(.*)$/;
	$rv .= sprintf "&lt;input type=radio name=$_[1] value=\"$2\" %s&gt; $1&lt;br&gt;\n",
		lc($2) eq lc($_[0]) || !defined($_[0]) &amp;&amp;
				       lc($2) eq lc($_[2]) ? "checked" : "";
	}
return $rv;
}

# parse_choice(name, default)
sub parse_choice
{
if (lc($in{$_[0]}) eq lc($_[1])) { return ( [ ] ); }
else { return ( [ $in{$_[0]} ] ); }
}

# select_input(value, name, default, [choice]+)
sub select_input
{
local($i, $rv);
$rv = "&lt;select name=\"$_[1]\"&gt;\n";
for($i=3; $i&lt;@_; $i++) {
	$_[$i] =~ /^([^,]*),(.*)$/;
	$rv .= sprintf "&lt;option value=\"$2\" %s&gt;$1&lt;/option&gt;\n",
		lc($2) eq lc($_[0]) || !defined($_[0]) &amp;&amp; lc($2) eq lc($_[2]) ? "selected" : "";
	}
$rv .= "&lt;/select&gt;\n";
return $rv;
}

# parse_choice(name, default)
sub parse_select
{
return &amp;parse_choice(@_);
}

# config_icons(contexts, program)
# Displays up to 17 icons, one for each type of configuration directive, for
# some context (global, virtual, directory or htaccess)
sub config_icons
{
local($m, $func, $e, %etype, $i, $c);
local @mods = split(/\s+/, $site{'modules'});
local @ctx = split(/\s+/, $_[0]);
foreach $m (sort { $a cmp $b } (@module_files)) {
	if (&amp;indexof($m, @mods) != -1) {
		$func = $m."_directives";
		foreach $e (&amp;$func($site{'version'})) {
			foreach $c (@ctx) {
				$etype{$e-&gt;{'type'}}++ if ($e-&gt;{$c});
				}
			}
		}
        }
local (@titles, @links, @icons);
for($i=0; $text{"type_$i"}; $i++) {
	if ($etype{$i}) {
		push(@links, $_[1]."type=$i");
		push(@titles, $text{"type_$i"});
		push(@icons, "images/type_icon_$i.gif");
		}
	}
for($i=2; $i&lt;@_; $i++) {
	push(@links, $_[$i]-&gt;{'link'});
	push(@titles, $_[$i]-&gt;{'name'});
	push(@icons, $_[$i]-&gt;{'icon'});
	}
&amp;icons_table(\@links, \@titles, \@icons, 5);
print "&lt;p&gt;\n";
}

sub lock_proftpd_files
{
local $conf = &amp;get_config();
foreach $f (&amp;unique(map { $_-&gt;{'file'} } @$conf)) {
	&amp;lock_file($f);
	}
}

sub unlock_proftpd_files
{
local $conf = &amp;get_config();
foreach $f (&amp;unique(map { $_-&gt;{'file'} } @$conf)) {
	&amp;unlock_file($f);
	}
}

# save_directive(name, &amp;values, &amp;directives, &amp;config)
# Updates the config file(s) and the directives structure with new values
# for the given directives.
# If a directive's value is merely being changed, then its value only needs
# to be updated in the directives array and in the file.
sub save_directive
{
local($i, @old, $lref, $change, $len, $v);
@old = &amp;find_directive_struct($_[0], $_[2]);
for($i=0; $i&lt;@old || $i&lt;@{$_[1]}; $i++) {
	$v = ${$_[1]}[$i];
	if ($i &gt;= @old) {
		# a new directive is being added. If other directives of this
		# type exist, add it after them. Otherwise, put it at the end of
		# the first file in the section
		if ($change) {
			# Have changed some old directive.. add this new one
			# after it, and update change
			local(%v, $j);
			%v = (	"line", $change-&gt;{'line'}+1,
				"eline", $change-&gt;{'line'}+1,
				"file", $change-&gt;{'file'},
				"type", 0,
				"name", $_[0],
				"value", $v);
			$j = &amp;indexof($change, @{$_[2]})+1;
			&amp;renumber($_[3], $v{'line'}, $v{'file'}, 1);
			splice(@{$_[2]}, $j, 0, \%v);
			$lref = &amp;read_file_lines($v{'file'});
			splice(@$lref, $v{'line'}, 0, "$_[0] $v");
			$change = \%v;
			}
		else {
			# Adding a new directive to the end of the list
			# in this section
			local($f, %v, $j, $l);
			$f = $_[2]-&gt;[0]-&gt;{'file'};
			for($j=0; $_[2]-&gt;[$j]-&gt;{'file'} eq $f; $j++) { }
			$l = $_[2]-&gt;[$j-1]-&gt;{'eline'}+1;
			%v = (	"line", $l,
				"eline", $l,
				"file", $f,
				"type", 0,
				"name", $_[0],
				"value", $v);
			&amp;renumber($_[3], $l, $f, 1);
			splice(@{$_[2]}, $j, 0, \%v);
			$lref = &amp;read_file_lines($f);
			splice(@$lref, $l, 0, "$_[0] $v");
			}
		}
	elsif ($i &gt;= @{$_[1]}) {
		# a directive was deleted
		$lref = &amp;read_file_lines($old[$i]-&gt;{'file'});
		$idx = &amp;indexof($old[$i], @{$_[2]});
		splice(@{$_[2]}, $idx, 1);
		$len = $old[$i]-&gt;{'eline'} - $old[$i]-&gt;{'line'} + 1;
		splice(@$lref, $old[$i]-&gt;{'line'}, $len);
		&amp;renumber($_[3], $old[$i]-&gt;{'line'}, $old[$i]-&gt;{'file'}, -$len);
		}
	else {
		# just changing the value
		$lref = &amp;read_file_lines($old[$i]-&gt;{'file'});
		$len = $old[$i]-&gt;{'eline'} - $old[$i]-&gt;{'line'} + 1;
		&amp;renumber($_[3], $old[$i]-&gt;{'eline'}+1,
			  $old[$i]-&gt;{'file'},1-$len);
		$old[$i]-&gt;{'value'} = $v;
		$old[$i]-&gt;{'eline'} = $old[$i]-&gt;{'line'};
		splice(@$lref, $old[$i]-&gt;{'line'}, $len, "$_[0] $v");
		$change = $old[$i];
		}
	}
}

# renumber(&amp;config, line, file, offset)
# Recursively changes the line number of all directives from some file 
# beyond the given line.
sub renumber
{
local($d);
if (!$_[3]) { return; }
foreach $d (@{$_[0]}) {
	if ($d-&gt;{'file'} eq $_[2] &amp;&amp; $d-&gt;{'line'} &gt;= $_[1]) {
		$d-&gt;{'line'} += $_[3];
		}
	if ($d-&gt;{'file'} eq $_[2] &amp;&amp; $d-&gt;{'eline'} &gt;= $_[1]) {
		$d-&gt;{'eline'} += $_[3];
		}
	if ($d-&gt;{'type'}) {
		&amp;renumber($d-&gt;{'members'}, $_[1], $_[2], $_[3]);
		}
	}
}

sub def
{
return $_[0] ? $_[0] : $_[1];
}

# get_virtual_config(index)
sub get_virtual_config
{
local($conf, $c, $v);
$conf = &amp;get_config();
if (!$_[0]) { $c = $conf; $v = undef; }
else {
	$c = $conf-&gt;[$_[0]]-&gt;{'members'};
	$v = $conf-&gt;[$_[0]];
	}
return wantarray ? ($c, $v) : $c;
}

# get_ftpaccess_config(file)
sub get_ftpaccess_config
{
local($lnum, @conf);
open(FTPACCESS, $_[0]);
@conf = &amp;parse_config_file(FTPACCESS, $lnum, $_[0]);
close(FTPACCESS);
return \@conf;
}

# get_or_create_global(&amp;config)
# Returns an array ref of members of the &lt;Global&gt; section, creating if necessary
sub get_or_create_global
{
local ($conf) = @_;
local $global = &amp;find_directive_struct("Global", $conf);
if ($global) {
	# Already exists .. just return member list
	return $global-&gt;{'members'};
	}
else {
	# Need to add it!
	local $lref = &amp;read_file_lines($config{'proftpd_conf'});
	local $olen = @$lref;
	push(@$lref, "&lt;Global&gt;", "&lt;/Global&gt;");
	&amp;flush_file_lines();
	$global = { 'name' =&gt; 'Global',
		    'members' =&gt; [ { 'line' =&gt; $olen,
				     'eline' =&gt; $olen,
				     'file' =&gt; $config{'proftpd_conf'},
				     'type' =&gt; 0,
				     'name' =&gt; 'dummy' } ],
		    'line' =&gt; $olen,
		    'eline' =&gt; $olen+1,
		    'file' =&gt; $config{'proftpd_conf'},
		    'type' =&gt; 1,
		    'value' =&gt; undef,
		    'words' =&gt; [ ] };
	push(@{$_[0]}, $global);
	return $global-&gt;{'members'};
	}
}

# test_config()
# If possible, test the current configuration and return an error message,
# or undef.
sub test_config
{
if ($site{'version'} &gt;= 1.2) {
	# Test the configuration with -t flag
	local $cmd = "$config{'proftpd_path'} -t -c $config{'proftpd_conf'}";
	local $out = `$cmd 2&gt;&amp;1 &lt;/dev/null`;
	return $out if ($?);
	}
return undef;
}

# before_changing()
# If testing all changes, backup the config files so they can be reverted
# if necessary.
sub before_changing
{
if ($config{'test_always'}) {
	local $conf = &amp;get_config();
	local @files = &amp;unique(map { $_-&gt;{'file'} } @$conf);
	local $/ = undef;
	foreach $f (@files) {
		if (open(BEFORE, $f)) {
			$before_changing{$f} = &lt;BEFORE&gt;;
			close(BEFORE);
			}
		}
	}
}

# after_changing()
# If testing all changes, test now and revert the configs and show an error
# message if a problem was found.
sub after_changing
{
if ($config{'test_always'}) {
	local $err = &amp;test_config();
	if ($err) {
		# Something failed .. revert all files
		local $f;
		foreach $f (keys %before_changing) {
			&amp;open_tempfile(AFTER, "&gt;$f");
			&amp;print_tempfile(AFTER, $before_changing{$f});
			&amp;close_tempfile(AFTER);
			}
		&amp;error(&amp;text('eafter', "&lt;pre&gt;$err&lt;/pre&gt;"));
		}
	}
}

# restart_button()
# Returns HTML for a link to put in the top-right corner of every page
sub restart_button
{
local $r = &amp;is_proftpd_running();
return undef if ($r &lt; 0);
local $args = "redir=".&amp;urlize(&amp;this_url());
if ($r) {
	$rv .= "&lt;a href=\"apply.cgi?$args&amp;pid=$1\"&gt;$text{'proftpd_apply'}&lt;/a&gt;&lt;br&gt;\n";
	$rv .= "&lt;a href=\"stop.cgi?$args&amp;pid=$1\"&gt;$text{'proftpd_stop'}&lt;/a&gt;\n";
	}
else {
	$rv = "&lt;a href=\"start.cgi?$args\"&gt;$text{'proftpd_start'}&lt;/a&gt;&lt;br&gt;\n";
	}
return $rv;
}

# is_proftpd_running()
# Returns the PID if ProFTPd is running, 0 if down, -1 if running under inetd
sub is_proftpd_running
{
local $conf = &amp;get_config();
local $st = &amp;find_directive("ServerType", $conf);
return -1 if (lc($st) eq "inetd");
local $pid = &amp;get_proftpd_pid();
return $pid;
}

# this_url()
# Returns the URL in the apache directory of the current script
sub this_url
{
local($url);
$url = $ENV{'SCRIPT_NAME'};
if ($ENV{'QUERY_STRING'} ne "") { $url .= "?$ENV{'QUERY_STRING'}"; }
return $url;
}

# running_under_inetd()
# Returns the inetd/xinetd object and program if ProFTPd is running under one
sub running_under_inetd
{
# Never under inetd if not set so in config
local $conf = &amp;get_config();
local $st = &amp;find_directive("ServerType", $conf);
return ( ) if (lc($st) eq "inetd");

local ($inet, $inet_mod);
if (&amp;foreign_check('inetd')) {
        # Check if proftpd is in inetd
        &amp;foreign_require('inetd', 'inetd-lib.pl');
	local $i;
        foreach $i (&amp;foreign_call('inetd', 'list_inets')) {
                if ($i-&gt;[1] &amp;&amp; $i-&gt;[3] eq 'ftp') {
                        $inet = $i;
                        last;
                        }
                }
        $inet_mod = 'inetd';
        }
elsif (&amp;foreign_check('xinetd')) {
        # Check if proftpd is in xinetd
        &amp;foreign_require('xinetd', 'xinetd-lib.pl');
	local $xi;
        foreach $xi (&amp;foreign_call("xinetd", "get_xinetd_config")) {
                if ($xi-&gt;{'quick'}-&gt;{'disable'}-&gt;[0] ne 'yes' &amp;&amp;
                    $xi-&gt;{'value'} eq 'ftp') {
                        $inet = $xi;
                        last;
                        }
                }
        $inet_mod = 'xinetd';
        }
else {
        # Not supported on this OS .. assume so
        $inet = 1;
	}
return ($inet, $inet_mod);
}

# get_proftpd_pid()
sub get_proftpd_pid
{
if ($config{'pid_file'}) {
	return &amp;check_pid_file($config{'pid_file'});
	}
else {
	local ($pid) = &amp;find_byname("proftpd");
	return $pid;
	}
}

sub get_proftpd_version
{
local $out = `$config{'proftpd_path'} -v 2&gt;&amp;1`;
${$_[0]} = $out if ($_[0]);
if ($out =~ /ProFTPD\s+Version\s+(\d+)\.([0-9\.]+)/i ||
    $out =~ /ProFTPD\s+(\d+)\.([0-9\.]+)/i) {
	local ($v1, $v2) = ($1, $2);
	$v2 =~ s/\.//g;
	return "$v1.$v2";
	}
return undef;
}

# apply_configuration()
# Activate the ProFTPd configuration, either by sending a HUP signal or
# by stopping and starting
sub apply_configuration
{
# Check if running from inetd
local $conf = &amp;get_config();
local $st = &amp;find_directive("ServerType", $conf);
if ($st eq 'inetd') {
	return $text{'stop_einetd'};
	}
if (&amp;get_proftpd_version() &gt; 1.22) {
	# Stop and re-start
	local $err = &amp;stop_proftpd();
	return $err if ($err);
	sleep(1);	# Wait for clean shutdown
	return &amp;start_proftpd();
	}
else {
	# Can just HUP
	local $pid = &amp;get_proftpd_pid();
	$pid || return $text{'apply_egone'};
	&amp;kill_logged('HUP', $pid);
	return undef;
	}
}

# stop_proftpd()
# Halts the running ProFTPd process, and returns undef on success or any error
# message on failure.
sub stop_proftpd
{
# Check if running from inetd
local $conf = &amp;get_config();
local $st = &amp;find_directive("ServerType", $conf);
if ($st eq 'inetd') {
	return $text{'stop_einetd'};
	}
if ($config{'stop_cmd'}) {
	local $out = &amp;backquote_logged("$config{'stop_cmd'} 2&gt;&amp;1 &lt;/dev/null");
	if ($?) {
		return "&lt;pre&gt;$out&lt;/pre&gt;";
		}
	}
else {
	local $pid = &amp;get_proftpd_pid();
	$pid &amp;&amp; &amp;kill_logged('TERM', $pid) ||
		return $text{'stop_erun'};
	}
return undef;
}

# start_proftpd()
# Attempt to start the FTP server, and return undef on success or an error
# messsage on failure.
sub start_proftpd
{
local $conf = &amp;get_config();
local $st = &amp;find_directive("ServerType", $conf);
if ($st eq 'inetd') {
	return $text{'start_einetd'};
	}
local $out;
if ($config{'start_cmd'}) {
	$out = &amp;backquote_logged("$config{'start_cmd'} 2&gt;&amp;1 &lt;/dev/null");
	}
else {
	$out = &amp;backquote_logged("$config{'proftpd_path'} 2&gt;&amp;1 &lt;/dev/null");
	}
return $? ? "&lt;pre&gt;$out&lt;/pre&gt;" : undef;
}

# get_httpd_defines()
# Returns a list of defines that need to be passed to ProFTPd
sub get_httpd_defines
{
if (@get_httpd_defines_cache) {
	return @get_httpd_defines_cache;
	}
local @rv;
if ($config{'defines_file'}) {
	# Add defines from an environment file, which can be in
	# the format :
	# OPTIONS='-Dfoo -Dbar'
	# or regular name=value format
	local %def;
	&amp;read_env_file($config{'defines_file'}, \%def);
	if ($config{'defines_name'} &amp;&amp; $def{$config{'defines_name'}}) {
		# Looking for var like OPTIONS='-Dfoo -Dbar'
		local $var = $def{$config{'defines_name'}};
		foreach my $v (split(/\s+/, $var)) {
			if ($v =~ /^-[Dd](\S+)$/) {
				push(@rv, $1);
				}
			else {
				push(@rv, $v);
				}
			}
		}
	else {
		# Looking for regular name=value directives.
		# Remove $SUFFIX variable seen on debian that is computed
		# dynamically, but is usually empty.
		foreach my $k (keys %def) {
			$def{$k} =~ s/\$SUFFIX//g;
			push(@rv, $k."=".$def{$k});
			}
		}
	}
foreach my $md (split(/\t+/, $config{'defines_mods'})) {
	# Add HAVE_ defines from modules
	opendir(DIR, $md);
	while(my $m = readdir(DIR)) {
		if ($m =~ /^(mod_|lib)(.*).so$/i) {
			push(@rv, "HAVE_".uc($2));
			}
		}
	closedir(DIR);
	}
foreach my $d (split(/\s+/, $config{'defines'})) {
	push(@rv, $d);
	}
@get_httpd_defines_cache = @rv;
return @rv;
}

1;

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