proftpd/proftpd-lib.pl

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