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