1# proftpd-lib.pl
2# Common functions for the proftpd server config file
3
4BEGIN { push(@INC, ".."); };
5use WebminCore;
6&init_config();
7
8# Load the site-specific information on the server executable
9&read_file("$module_config_directory/site", \%site);
10@ftpaccess_files = split(/\s+/, $site{'ftpaccess'});
11opendir(DIR, ".");
12foreach $f (readdir(DIR)) {
13	if ($f =~ /^(mod_\S+)\.pl$/) {
14		push(@module_files, $1);
15		do $f;
16		}
17	}
18closedir(DIR);
19
20# get_config()
21# Returns the entire proftpd config structure
22sub get_config
23{
24if (@get_config_cache) {
25	return \@get_config_cache;
26	}
27@get_config_cache = &get_config_file($config{'proftpd_conf'});
28return \@get_config_cache;
29}
30
31# get_config_file(filename)
32sub get_config_file
33{
34local @rv;
35local $fn = $_[0];
36if ($fn !~ /^\//) {
37	$config{'proftpd_conf'} =~ /^(.*)\//;
38	$fn = "$1/$fn";
39	}
40if (opendir(DIR, $fn)) {
41	# Is a directory .. parse all files!
42	local @files = readdir(DIR);
43	closedir(DIR);
44	foreach $f (@files) {
45		next if ($f =~ /^\./);
46		push(@rv, &get_config_file("$fn/$f"));
47		}
48	}
49else {
50	# Just a normal config file
51	local $lnum = 0;
52	if (open(CONF, "<".$fn)) {
53		@rv = &parse_config_file(CONF, $lnum, $fn);
54		close(CONF);
55		foreach $inc (&find_directive("Include", \@rv)) {
56			push(@rv, &get_config_file($inc));
57			}
58		}
59	}
60return @rv;
61}
62
63# parse_config_file(handle, lines, file)
64# Parses lines of text from some config file into a data structure. The
65# return value is an array of references, one for each directive in the file.
66# Each reference points to an associative array containing
67#  line -	The line number this directive is at
68#  eline -	The line number this directive ends at
69#  file -	The file this directive is from
70#  type -	0 for a normal directive, 1 for a container directive
71#  name -	The name of this directive
72#  value -	Value (possibly with spaces)
73#  members -	For type 1, a reference to the array of members
74sub parse_config_file
75{
76local($fh, @rv, $line, %dummy);
77$fh = $_[0];
78$dummy{'line'} = $dummy{'eline'} = $_[1]-1;
79$dummy{'file'} = $_[2];
80$dummy{'type'} = 0;
81$dummy{'name'} = "dummy";
82@rv = (\%dummy);
83local %defs;
84foreach my $d (&get_httpd_defines()) {
85        if ($d =~ /^(\S+)=(.*)$/) {
86                $defs{$1} = $2;
87                }
88        else {
89                $defs{$d} = '';
90                }
91        }
92while($line = <$fh>) {
93	chop;
94	$line =~ s/^\s*#.*$//g;
95	if ($line =~ /^\s*<\/(\S+)\s*(.*)>/) {
96		# end of a container directive. This can only happen in a
97		# recursive call to this function
98		$_[1]++;
99		last;
100		}
101	elsif ($line =~ /^\s*<IfModule\s+(\!?)(\S+)\.c>/i) {
102		# start of an IfModule block. Read it, and if the module
103		# exists put the directives in this section.
104		local ($not, $mod) = ($1, $2);
105		local $oldline = $_[1];
106		$_[1]++;
107		local @dirs = &parse_config_file($fh, $_[1], $_[2]);
108		if (!$not && $httpd_modules{$mod} ||
109		    $not && !$httpd_modules{$mod}) {
110			# use the directives..
111			push(@rv, { 'line', $oldline,
112				    'eline', $oldline,
113				    'file', $_[2],
114				    'name', "<IfModule $not$mod>" });
115			push(@rv, @dirs);
116			push(@rv, { 'line', $_[1]-1,
117				    'eline', $_[1]-1,
118				    'file', $_[2],
119				    'name', "</IfModule>" });
120			}
121		}
122	elsif ($line =~ /^\s*<IfDefine\s+(\!?)(\S+)>/i) {
123		# start of an IfDefine block. Read it, and if the define
124		# exists put the directives in this section
125		local ($not, $def) = ($1, $2);
126		local $oldline = $_[1];
127		$_[1]++;
128		local @dirs = &parse_config_file($fh, $_[1], $_[2]);
129		if (!$not && defined($defs{$def}) ||
130		    $not && !defined($defs{$def})) {
131			# use the directives..
132			push(@rv, { 'line', $oldline,
133				    'eline', $oldline,
134				    'file', $_[2],
135				    'name', "<IfDefine $not$def>" });
136			push(@rv, @dirs);
137			push(@rv, { 'line', $_[1]-1,
138				    'eline', $_[1]-1,
139				    'file', $_[2],
140				    'name', "</IfDefine>" });
141			}
142		}
143	elsif ($line =~ /^\s*<(\S+)\s*(.*)>/) {
144		# start of a container directive. The first member is a dummy
145		# directive at the same line as the container
146		local(%dir, @members);
147		%dir = ('line', $_[1],
148			'file', $_[2],
149			'type', 1,
150			'name', $1,
151			'value', $2);
152		$dir{'value'} =~ s/\s+$//g;
153		$dir{'words'} = &wsplit($dir{'value'});
154		$_[1]++;
155		@members = &parse_config_file($fh, $_[1], $_[2]);
156		$dir{'members'} = \@members;
157		$dir{'eline'} = $_[1]-1;
158		push(@rv, \%dir);
159		}
160	elsif ($line =~ /^\s*(\S+)\s*(.*)$/) {
161		# normal directive
162		local(%dir);
163		%dir = ('line', $_[1],
164			'eline', $_[1],
165			'file', $_[2],
166			'type', 0,
167			'name', $1,
168			'value', $2);
169		if ($dir{'value'} =~ s/\\$//g) {
170			# multi-line directive!
171			while($line = <$fh>) {
172				chop($line);
173				$cont = ($line =~ s/\\$//g);
174				$dir{'value'} .= $line;
175				$dir{'eline'} = ++$_[1];
176				if (!$cont) { last; }
177				}
178			}
179		$dir{'value'} =~ s/\s+$//g;
180		$dir{'words'} = &wsplit($dir{'value'});
181		push(@rv, \%dir);
182		$_[1]++;
183		}
184	else {
185		# blank or comment line
186		$_[1]++;
187		}
188	}
189return @rv;
190}
191
192# wsplit(string)
193# Splits a string like  foo "foo \"bar\"" bazzz  into an array of words
194sub wsplit
195{
196local($s, @rv); $s = $_[0];
197$s =~ s/\\\"/\0/g;
198while($s =~ /^"([^"]*)"\s*(.*)$/ || $s =~ /^(\S+)\s*(.*)$/) {
199	$w = $1; $s = $2;
200	$w =~ s/\0/"/g; push(@rv, $w);
201	}
202return \@rv;
203}
204
205# wjoin(word, word, ...)
206sub wjoin
207{
208local(@rv, $w);
209foreach $w (@_) {
210	if ($w =~ /^\S+$/) { push(@rv, $w); }
211	else { push(@rv, "\"$w\""); }
212	}
213return join(' ', @rv);
214}
215
216# find_directive(name, &directives)
217# Returns the values of directives matching some name
218sub find_directive
219{
220local(@rv, $i, @vals, $dref);
221foreach $ref (@{$_[1]}) {
222	if (lc($ref->{'name'}) eq lc($_[0])) {
223		push(@vals, $ref->{'words'}->[0]);
224		}
225	}
226return wantarray ? @vals : !@vals ? undef : $vals[$#vals];
227}
228
229# find_directive_struct(name, &directives)
230# Returns references to directives matching some name
231sub find_directive_struct
232{
233local(@rv, $i, @vals);
234foreach $ref (@{$_[1]}) {
235	if (lc($ref->{'name'}) eq lc($_[0])) {
236		push(@vals, $ref);
237		}
238	}
239return wantarray ? @vals : !@vals ? undef : $vals[$#vals];
240}
241
242# find_vdirective(name, &virtualdirectives, &directives)
243# Looks for some directive in a <VirtualHost> section, and then in the
244# main section
245sub find_vdirective
246{
247if ($_[1]) {
248	$rv = &find_directive($_[0], $_[1]);
249	if ($rv) { return $rv; }
250	}
251return &find_directive($_[0], $_[2]);
252}
253
254# make_directives(ref, version, module)
255sub make_directives
256{
257local @rv;
258local $ver = $_[1];
259if ($ver =~ /^(1)\.(2)(\d+)$/) {
260	$ver = sprintf "%d.%d%2.2d", $1, $2, $3;
261	}
262foreach $d (@{$_[0]}) {
263	local(%dir);
264	$dir{'name'} = $d->[0];
265	$dir{'multiple'} = $d->[1];
266	$dir{'type'} = $d->[2];
267	$dir{'module'} = $_[2];
268	$dir{'version'} = $_[1];
269	$dir{'priority'} = $d->[5];
270	foreach $c (split(/\s+/, $d->[3])) { $dir{$c}++; }
271	if (!$d->[4]) { push(@rv, \%dir); }
272	elsif ($d->[4] =~ /^-([\d\.]+)$/ && $ver < $1) { push(@rv, \%dir); }
273	elsif ($d->[4] =~ /^([\d\.]+)$/ && $ver >= $1) { push(@rv, \%dir); }
274	elsif ($d->[4] =~ /^([\d\.]+)-([\d\.]+)$/ && $ver >= $1 && $ver < $2)
275		{ push(@rv, \%dir); }
276	}
277return @rv;
278}
279
280# editable_directives(type, context)
281# Returns an array of references to associative arrays, one for each
282# directive of the given type that can be used in the given context
283sub editable_directives
284{
285local($m, $func, @rv);
286local @mods = split(/\s+/, $site{'modules'});
287foreach $m (@module_files) {
288	if (&indexof($m, @mods) != -1) {
289		$func = $m."_directives";
290		push(@rv, &$func($site{'version'}));
291		}
292	}
293@rv = grep { $_->{'type'} == $_[0] && $_->{$_[1]} } @rv;
294@rv = sort { $pd = $b->{'priority'} - $a->{'priority'};
295	     $md = $a->{'module'} cmp $b->{'module'};
296	     $pd == 0 ? ($md == 0 ? $a->{'name'} cmp $b->{'name'} : $md) : $pd }
297		@rv;
298return @rv;
299}
300
301# generate_inputs(&editors, &directives)
302# Displays a 2-column list of options, for use inside a table
303sub generate_inputs
304{
305local($e, $sw, @args, @rv, $func);
306foreach $e (@{$_[0]}) {
307	if (!$sw) { print "<tr>\n"; }
308
309	# Build arg list for the editing function. Each arg can be a single
310	# directive struct, or a reference to an array of structures.
311	$func = "edit";
312	undef(@args);
313	foreach $ed (split(/\s+/, $e->{'name'})) {
314		local(@vals);
315		$func .= "_$ed";
316		@vals = &find_directive_struct($ed, $_[1]);
317		if ($e->{'multiple'}) { push(@args, \@vals); }
318		elsif (!@vals) { push(@args, undef); }
319		else { push(@args, $vals[$#vals]); }
320		}
321	push(@args, $e);
322
323	# call the function
324	@rv = &$func(@args);
325	if ($rv[0] == 2) {
326		# spans 2 columns..
327		if ($sw) {
328			# need to end this row
329			print "<td colspan=2></td> </tr><tr>\n";
330			}
331		else { $sw = !$sw; }
332		print "<td valign=top width=25%><b>$rv[1]</b></td>\n";
333		print "<td nowrap valign=top colspan=3 width=75%>$rv[2]</td>\n";
334		}
335	else {
336		# only spans one column
337		print "<td valign=top width=25%><b>$rv[1]</b></td>\n";
338		print "<td nowrap valign=top width=25%>$rv[2]</td>\n";
339		}
340
341	if ($sw) { print "</tr>\n"; }
342	$sw = !$sw;
343	}
344}
345
346# parse_inputs(&editors, &directives, &config)
347# Reads user choices from a form and update the directives and config files.
348sub parse_inputs
349{
350# First call editor functions to get new values. Each function returns
351# an array of references to arrays containing the new values for the directive.
352local ($i, @chname, @chval);
353&before_changing();
354foreach $e (@{$_[0]}) {
355	local @dirs = split(/\s+/, $e->{'name'});
356	local $func = "save_".join('_', @dirs);
357	local @rv = &$func($e);
358	for($i=0; $i<@dirs; $i++) {
359		push(@chname, $dirs[$i]);
360		push(@chval, $rv[$i]);
361		}
362	}
363
364# Assuming everything went OK, update the configuration
365for($i=0; $i<@chname; $i++) {
366	&save_directive($chname[$i], $chval[$i], $_[1], $_[2]);
367	}
368&flush_file_lines();
369&after_changing();
370}
371
372# opt_input(value, name, default, size, [units])
373sub opt_input
374{
375return sprintf "<input type=radio name=$_[1]_def value=1 %s> $_[2]\n".
376	       "<input type=radio name=$_[1]_def value=0 %s>\n".
377	       "<input name=$_[1] size=$_[3] value='%s'> %s\n",
378	defined($_[0]) ? "" : "checked",
379	defined($_[0]) ? "checked" : "",
380	$_[0], $_[4];
381}
382
383# parse_opt(name, regexp, error)
384sub parse_opt
385{
386local($i, $re);
387if ($in{"$_[0]_def"}) { return ( [ ] ); }
388for($i=1; $i<@_; $i+=2) {
389	$re = $_[$i];
390	if ($in{$_[0]} !~ /$re/) { &error($_[$i+1]); }
391	}
392return ( [ $in{$_[0]} =~ /^\S+$/ ? $in{$_[0]} : '"'.$in{$_[0]}.'"' ] );
393}
394
395# choice_input(value, name, default, [choice]+)
396# Each choice is a display,value pair
397sub choice_input
398{
399local($i, $rv);
400for($i=3; $i<@_; $i++) {
401	$_[$i] =~ /^([^,]*),(.*)$/;
402	$rv .= sprintf "<input type=radio name=$_[1] value=\"$2\" %s> $1\n",
403		lc($2) eq lc($_[0]) ||
404		lc($2) eq 'on' && lc($_[0]) eq 'yes' ||
405		lc($2) eq 'off' && lc($_[0]) eq 'no' ||
406		!defined($_[0]) && lc($2) eq lc($_[2]) ? "checked" : "";
407	}
408return $rv;
409}
410
411# choice_input_vert(value, name, default, [choice]+)
412# Each choice is a display,value pair
413sub choice_input_vert
414{
415local($i, $rv);
416for($i=3; $i<@_; $i++) {
417	$_[$i] =~ /^([^,]*),(.*)$/;
418	$rv .= sprintf "<input type=radio name=$_[1] value=\"$2\" %s> $1<br>\n",
419		lc($2) eq lc($_[0]) || !defined($_[0]) &&
420				       lc($2) eq lc($_[2]) ? "checked" : "";
421	}
422return $rv;
423}
424
425# parse_choice(name, default)
426sub parse_choice
427{
428if (lc($in{$_[0]}) eq lc($_[1])) { return ( [ ] ); }
429else { return ( [ $in{$_[0]} ] ); }
430}
431
432# select_input(value, name, default, [choice]+)
433sub select_input
434{
435local($i, $rv);
436$rv = "<select name=\"$_[1]\">\n";
437for($i=3; $i<@_; $i++) {
438	$_[$i] =~ /^([^,]*),(.*)$/;
439	$rv .= sprintf "<option value=\"$2\" %s>$1</option>\n",
440		lc($2) eq lc($_[0]) || !defined($_[0]) && lc($2) eq lc($_[2]) ? "selected" : "";
441	}
442$rv .= "</select>\n";
443return $rv;
444}
445
446# parse_choice(name, default)
447sub parse_select
448{
449return &parse_choice(@_);
450}
451
452# config_icons(contexts, program)
453# Displays up to 17 icons, one for each type of configuration directive, for
454# some context (global, virtual, directory or htaccess)
455sub config_icons
456{
457local($m, $func, $e, %etype, $i, $c);
458local @mods = split(/\s+/, $site{'modules'});
459local @ctx = split(/\s+/, $_[0]);
460foreach $m (sort { $a cmp $b } (@module_files)) {
461	if (&indexof($m, @mods) != -1) {
462		$func = $m."_directives";
463		foreach $e (&$func($site{'version'})) {
464			foreach $c (@ctx) {
465				$etype{$e->{'type'}}++ if ($e->{$c});
466				}
467			}
468		}
469        }
470local (@titles, @links, @icons);
471for($i=0; $text{"type_$i"}; $i++) {
472	if ($etype{$i}) {
473		push(@links, $_[1]."type=$i");
474		push(@titles, $text{"type_$i"});
475		push(@icons, "images/type_icon_$i.gif");
476		}
477	}
478for($i=2; $i<@_; $i++) {
479	push(@links, $_[$i]->{'link'});
480	push(@titles, $_[$i]->{'name'});
481	push(@icons, $_[$i]->{'icon'});
482	}
483&icons_table(\@links, \@titles, \@icons, 5);
484print "<p>\n";
485}
486
487sub lock_proftpd_files
488{
489local $conf = &get_config();
490foreach $f (&unique(map { $_->{'file'} } @$conf)) {
491	&lock_file($f);
492	}
493}
494
495sub unlock_proftpd_files
496{
497local $conf = &get_config();
498foreach $f (&unique(map { $_->{'file'} } @$conf)) {
499	&unlock_file($f);
500	}
501}
502
503# save_directive(name, &values, &directives, &config)
504# Updates the config file(s) and the directives structure with new values
505# for the given directives.
506# If a directive's value is merely being changed, then its value only needs
507# to be updated in the directives array and in the file.
508sub save_directive
509{
510local($i, @old, $lref, $change, $len, $v);
511@old = &find_directive_struct($_[0], $_[2]);
512for($i=0; $i<@old || $i<@{$_[1]}; $i++) {
513	$v = ${$_[1]}[$i];
514	if ($i >= @old) {
515		# a new directive is being added. If other directives of this
516		# type exist, add it after them. Otherwise, put it at the end of
517		# the first file in the section
518		if ($change) {
519			# Have changed some old directive.. add this new one
520			# after it, and update change
521			local(%v, $j);
522			%v = (	"line", $change->{'line'}+1,
523				"eline", $change->{'line'}+1,
524				"file", $change->{'file'},
525				"type", 0,
526				"name", $_[0],
527				"value", $v);
528			$j = &indexof($change, @{$_[2]})+1;
529			&renumber($_[3], $v{'line'}, $v{'file'}, 1);
530			splice(@{$_[2]}, $j, 0, \%v);
531			$lref = &read_file_lines($v{'file'});
532			splice(@$lref, $v{'line'}, 0, "$_[0] $v");
533			$change = \%v;
534			}
535		else {
536			# Adding a new directive to the end of the list
537			# in this section
538			local($f, %v, $j, $l);
539			$f = $_[2]->[0]->{'file'};
540			for($j=0; $_[2]->[$j]->{'file'} eq $f; $j++) { }
541			$l = $_[2]->[$j-1]->{'eline'}+1;
542			%v = (	"line", $l,
543				"eline", $l,
544				"file", $f,
545				"type", 0,
546				"name", $_[0],
547				"value", $v);
548			&renumber($_[3], $l, $f, 1);
549			splice(@{$_[2]}, $j, 0, \%v);
550			$lref = &read_file_lines($f);
551			splice(@$lref, $l, 0, "$_[0] $v");
552			}
553		}
554	elsif ($i >= @{$_[1]}) {
555		# a directive was deleted
556		$lref = &read_file_lines($old[$i]->{'file'});
557		$idx = &indexof($old[$i], @{$_[2]});
558		splice(@{$_[2]}, $idx, 1);
559		$len = $old[$i]->{'eline'} - $old[$i]->{'line'} + 1;
560		splice(@$lref, $old[$i]->{'line'}, $len);
561		&renumber($_[3], $old[$i]->{'line'}, $old[$i]->{'file'}, -$len);
562		}
563	else {
564		# just changing the value
565		$lref = &read_file_lines($old[$i]->{'file'});
566		$len = $old[$i]->{'eline'} - $old[$i]->{'line'} + 1;
567		&renumber($_[3], $old[$i]->{'eline'}+1,
568			  $old[$i]->{'file'},1-$len);
569		$old[$i]->{'value'} = $v;
570		$old[$i]->{'eline'} = $old[$i]->{'line'};
571		splice(@$lref, $old[$i]->{'line'}, $len, "$_[0] $v");
572		$change = $old[$i];
573		}
574	}
575}
576
577# renumber(&config, line, file, offset)
578# Recursively changes the line number of all directives from some file
579# beyond the given line.
580sub renumber
581{
582local($d);
583if (!$_[3]) { return; }
584foreach $d (@{$_[0]}) {
585	if ($d->{'file'} eq $_[2] && $d->{'line'} >= $_[1]) {
586		$d->{'line'} += $_[3];
587		}
588	if ($d->{'file'} eq $_[2] && $d->{'eline'} >= $_[1]) {
589		$d->{'eline'} += $_[3];
590		}
591	if ($d->{'type'}) {
592		&renumber($d->{'members'}, $_[1], $_[2], $_[3]);
593		}
594	}
595}
596
597sub def
598{
599return $_[0] ? $_[0] : $_[1];
600}
601
602# get_virtual_config(index)
603sub get_virtual_config
604{
605local($conf, $c, $v);
606$conf = &get_config();
607if (!$_[0]) { $c = $conf; $v = undef; }
608else {
609	$c = $conf->[$_[0]]->{'members'};
610	$v = $conf->[$_[0]];
611	}
612return wantarray ? ($c, $v) : $c;
613}
614
615# get_ftpaccess_config(file)
616sub get_ftpaccess_config
617{
618local($lnum, @conf);
619open(FTPACCESS, "<".$_[0]);
620@conf = &parse_config_file(FTPACCESS, $lnum, $_[0]);
621close(FTPACCESS);
622return \@conf;
623}
624
625# get_or_create_global(&config)
626# Returns an array ref of members of the <Global> section, creating if necessary
627sub get_or_create_global
628{
629local ($conf) = @_;
630local $global = &find_directive_struct("Global", $conf);
631if ($global) {
632	# Already exists .. just return member list
633	return $global->{'members'};
634	}
635else {
636	# Need to add it!
637	local $lref = &read_file_lines($config{'proftpd_conf'});
638	local $olen = @$lref;
639	push(@$lref, "<Global>", "</Global>");
640	&flush_file_lines();
641	$global = { 'name' => 'Global',
642		    'members' => [ { 'line' => $olen,
643				     'eline' => $olen,
644				     'file' => $config{'proftpd_conf'},
645				     'type' => 0,
646				     'name' => 'dummy' } ],
647		    'line' => $olen,
648		    'eline' => $olen+1,
649		    'file' => $config{'proftpd_conf'},
650		    'type' => 1,
651		    'value' => undef,
652		    'words' => [ ] };
653	push(@{$_[0]}, $global);
654	return $global->{'members'};
655	}
656}
657
658# test_config()
659# If possible, test the current configuration and return an error message,
660# or undef.
661sub test_config
662{
663if ($site{'version'} >= 1.2) {
664	# Test the configuration with -t flag
665	local $cmd = "$config{'proftpd_path'} -t -c $config{'proftpd_conf'}";
666	local $out = `$cmd 2>&1 </dev/null`;
667	return $out if ($?);
668	}
669return undef;
670}
671
672# before_changing()
673# If testing all changes, backup the config files so they can be reverted
674# if necessary.
675sub before_changing
676{
677if ($config{'test_always'}) {
678	local $conf = &get_config();
679	local @files = &unique(map { $_->{'file'} } @$conf);
680	local $/ = undef;
681	foreach $f (@files) {
682		if (open(BEFORE, "<".$f)) {
683			$before_changing{$f} = <BEFORE>;
684			close(BEFORE);
685			}
686		}
687	}
688}
689
690# after_changing()
691# If testing all changes, test now and revert the configs and show an error
692# message if a problem was found.
693sub after_changing
694{
695if ($config{'test_always'}) {
696	local $err = &test_config();
697	if ($err) {
698		# Something failed .. revert all files
699		local $f;
700		foreach $f (keys %before_changing) {
701			&open_tempfile(AFTER, ">$f");
702			&print_tempfile(AFTER, $before_changing{$f});
703			&close_tempfile(AFTER);
704			}
705		&error(&text('eafter', "<pre>$err</pre>"));
706		}
707	}
708}
709
710# restart_button()
711# Returns HTML for a link to put in the top-right corner of every page
712sub restart_button
713{
714local $r = &is_proftpd_running();
715return undef if ($r < 0);
716local $args = "redir=".&urlize(&this_url());
717if ($r) {
718	$rv .= "<a href=\"apply.cgi?$args&pid=$1\">$text{'proftpd_apply'}</a><br>\n";
719	$rv .= "<a href=\"stop.cgi?$args&pid=$1\">$text{'proftpd_stop'}</a>\n";
720	}
721else {
722	$rv = "<a href=\"start.cgi?$args\">$text{'proftpd_start'}</a><br>\n";
723	}
724return $rv;
725}
726
727# is_proftpd_running()
728# Returns the PID if ProFTPd is running, 0 if down, -1 if running under inetd
729sub is_proftpd_running
730{
731local $conf = &get_config();
732local $st = &find_directive("ServerType", $conf);
733return -1 if (lc($st) eq "inetd");
734local $pid = &get_proftpd_pid();
735return $pid;
736}
737
738# this_url()
739# Returns the URL in the apache directory of the current script
740sub this_url
741{
742local($url);
743$url = $ENV{'SCRIPT_NAME'};
744if ($ENV{'QUERY_STRING'} ne "") { $url .= "?$ENV{'QUERY_STRING'}"; }
745return $url;
746}
747
748# running_under_inetd()
749# Returns the inetd/xinetd object and program if ProFTPd is running under one
750sub running_under_inetd
751{
752# Never under inetd if not set so in config
753local $conf = &get_config();
754local $st = &find_directive("ServerType", $conf);
755return ( ) if (lc($st) eq "inetd");
756
757local ($inet, $inet_mod);
758if (&foreign_check('inetd')) {
759        # Check if proftpd is in inetd
760        &foreign_require('inetd', 'inetd-lib.pl');
761	local $i;
762        foreach $i (&foreign_call('inetd', 'list_inets')) {
763                if ($i->[1] && $i->[3] eq 'ftp') {
764                        $inet = $i;
765                        last;
766                        }
767                }
768        $inet_mod = 'inetd';
769        }
770elsif (&foreign_check('xinetd')) {
771        # Check if proftpd is in xinetd
772        &foreign_require('xinetd', 'xinetd-lib.pl');
773	local $xi;
774        foreach $xi (&foreign_call("xinetd", "get_xinetd_config")) {
775                if ($xi->{'quick'}->{'disable'}->[0] ne 'yes' &&
776                    $xi->{'value'} eq 'ftp') {
777                        $inet = $xi;
778                        last;
779                        }
780                }
781        $inet_mod = 'xinetd';
782        }
783else {
784        # Not supported on this OS .. assume so
785        $inet = 1;
786	}
787return ($inet, $inet_mod);
788}
789
790# get_proftpd_pid()
791sub get_proftpd_pid
792{
793if ($config{'pid_file'}) {
794	return &check_pid_file($config{'pid_file'});
795	}
796else {
797	local ($pid) = &find_byname("proftpd");
798	return $pid;
799	}
800}
801
802# get_proftpd_version([&output])
803sub get_proftpd_version
804{
805local $out = &backquote_command("$config{'proftpd_path'} -v 2>&1");
806${$_[0]} = $out if ($_[0]);
807if ($out =~ /ProFTPD\s+Version\s+(\d+)\.([0-9\.]+)/i ||
808    $out =~ /ProFTPD\s+(\d+)\.([0-9\.]+)/i) {
809	local ($v1, $v2) = ($1, $2);
810	$v2 =~ s/\.//g;
811	return "$v1.$v2";
812	}
813return undef;
814}
815
816# apply_configuration()
817# Activate the ProFTPd configuration, either by sending a HUP signal or
818# by stopping and starting
819sub apply_configuration
820{
821# Check if running from inetd
822local $conf = &get_config();
823local $st = &find_directive("ServerType", $conf);
824if ($st eq 'inetd') {
825	return $text{'stop_einetd'};
826	}
827if (&get_proftpd_version() > 1.22) {
828	# Stop and re-start
829	local $err = &stop_proftpd();
830	return $err if ($err);
831	sleep(1);	# Wait for clean shutdown
832	return &start_proftpd();
833	}
834else {
835	# Can just HUP
836	local $pid = &get_proftpd_pid();
837	$pid || return $text{'apply_egone'};
838	&kill_logged('HUP', $pid);
839	return undef;
840	}
841}
842
843# stop_proftpd()
844# Halts the running ProFTPd process, and returns undef on success or any error
845# message on failure.
846sub stop_proftpd
847{
848# Check if running from inetd
849local $conf = &get_config();
850local $st = &find_directive("ServerType", $conf);
851if ($st eq 'inetd') {
852	return $text{'stop_einetd'};
853	}
854if ($config{'stop_cmd'}) {
855	local $out = &backquote_logged("$config{'stop_cmd'} 2>&1 </dev/null");
856	if ($?) {
857		return "<pre>$out</pre>";
858		}
859	}
860else {
861	local $pid = &get_proftpd_pid();
862	$pid && &kill_logged('TERM', $pid) ||
863		return $text{'stop_erun'};
864	}
865return undef;
866}
867
868# start_proftpd()
869# Attempt to start the FTP server, and return undef on success or an error
870# messsage on failure.
871sub start_proftpd
872{
873local $conf = &get_config();
874local $st = &find_directive("ServerType", $conf);
875if ($st eq 'inetd') {
876	return $text{'start_einetd'};
877	}
878local $out;
879if ($config{'start_cmd'}) {
880	$out = &backquote_logged("$config{'start_cmd'} 2>&1 </dev/null");
881	}
882else {
883	$out = &backquote_logged("$config{'proftpd_path'} 2>&1 </dev/null");
884	}
885return $? ? "<pre>$out</pre>" : undef;
886}
887
888# get_httpd_defines()
889# Returns a list of defines that need to be passed to ProFTPd
890sub get_httpd_defines
891{
892if (@get_httpd_defines_cache) {
893	return @get_httpd_defines_cache;
894	}
895local @rv;
896if ($config{'defines_file'}) {
897	# Add defines from an environment file, which can be in
898	# the format :
899	# OPTIONS='-Dfoo -Dbar'
900	# or regular name=value format
901	local %def;
902	&read_env_file($config{'defines_file'}, \%def);
903	if ($config{'defines_name'} && $def{$config{'defines_name'}}) {
904		# Looking for var like OPTIONS='-Dfoo -Dbar'
905		local $var = $def{$config{'defines_name'}};
906		foreach my $v (split(/\s+/, $var)) {
907			if ($v =~ /^-[Dd](\S+)$/) {
908				push(@rv, $1);
909				}
910			else {
911				push(@rv, $v);
912				}
913			}
914		}
915	else {
916		# Looking for regular name=value directives.
917		# Remove $SUFFIX variable seen on debian that is computed
918		# dynamically, but is usually empty.
919		foreach my $k (keys %def) {
920			$def{$k} =~ s/\$SUFFIX//g;
921			push(@rv, $k."=".$def{$k});
922			}
923		}
924	}
925foreach my $md (split(/\t+/, $config{'defines_mods'})) {
926	# Add HAVE_ defines from modules
927	opendir(DIR, $md);
928	while(my $m = readdir(DIR)) {
929		if ($m =~ /^(mod_|lib)(.*).so$/i) {
930			push(@rv, "HAVE_".uc($2));
931			}
932		}
933	closedir(DIR);
934	}
935foreach my $d (split(/\s+/, $config{'defines'})) {
936	push(@rv, $d);
937	}
938@get_httpd_defines_cache = @rv;
939return @rv;
940}
941
9421;
943
944