apache/apache-lib.pl

   1 # apache-lib.pl
   2 # Common functions for apache configuration
   3
   4 BEGIN { push(@INC, ".."); };
   5 use WebminCore;
   6 $directive_type_count = 20;
   7
   8 if ($module_name ne 'htaccess') {
   9         &init_config();
  10         %access = &get_module_acl();
  11         @access_types = $access{'types'} eq '*' ? (0 .. $directive_type_count)
  12                                         : split(/\s+/, $access{'types'});
  13         }
  14 else {
  15         @access_types = (0 .. $directive_type_count);
  16         }
  17 map { $access_types{$_}++ } @access_types;
  18 $site_file = ($config{'webmin_apache'} || $module_config_directory)."/site";
  19
  20 # Check if a list of supported modules needs to be built. This is done
  21 # if the Apache binary changes, when Webmin is upgraded, or once every five
  22 # minutes if automatic rebuilding is enabled.
  23 if ($module_name ne 'htaccess') {
  24         local %oldsite;
  25         local $httpd = &find_httpd();
  26         local @st = stat($httpd);
  27         &read_file($site_file, \%oldsite);
  28         local @sst = stat($site_file);
  29         if ($oldsite{'path'} ne $httpd ||
  30             $oldsite{'size'} != $st[7] ||
  31             $oldsite{'webmin'} != &get_webmin_version() ||
  32             $config{'auto_mods'} && $sst[9] < time()-5*60) {
  33                 # Need to build list of supported modules
  34                 local ($ver, $mods) = &httpd_info($httpd);
  35                 if ($ver) {
  36                         local @mods = map { "$_/$ver" } &configurable_modules();
  37                         foreach my $m (@mods) {
  38                                 if ($m =~ /(\S+)\/(\S+)/) {
  39                                         $httpd_modules{$1} = $2;
  40                                         }
  41                                 }
  42                         # Call again now that known modules have been set, as
  43                         # sometimes there are dependencies due to LoadModule
  44                         # statements in an IfModule block
  45                         @mods = map { "$_/$ver" } &configurable_modules();
  46                         local %site = ( 'size' => $st[7],
  47                                         'path' => $httpd,
  48                                         'modules' => join(' ', @mods),
  49                                         'webmin' => &get_webmin_version() );
  50                         &lock_file($site_file);
  51                         &write_file($site_file, \%site);
  52                         chmod(0644, $site_file);
  53                         &unlock_file($site_file);
  54                         }
  55                 }
  56         }
  57
  58 # Read the site-specific setup file, then require in all the module-specific
  59 # .pl files
  60 if (&read_file($site_file, \%site)) {
  61         local($m, $f, $d);
  62         $httpd_size = $site{'size'};
  63         foreach $m (split(/\s+/, $site{'modules'})) {
  64                 if ($m =~ /(\S+)\/(\S+)/) {
  65                         $httpd_modules{$1} = $2;
  66                         }
  67                 }
  68         foreach $m (keys %httpd_modules) {
  69                 if (!-r "$module_root_directory/$m.pl") {
  70                         delete($httpd_modules{$m});
  71                         }
  72                 }
  73         foreach $f (split(/\s+/, $site{'htaccess'})) {
  74                 if (-r $f) { push(@htaccess_files, $f); }
  75                 }
  76         foreach $m (keys %httpd_modules) {
  77                 do "$m.pl";
  78                 }
  79         foreach $d (split(/\s+/, $site{'defines'})) {
  80                 $httpd_defines{$d}++;
  81                 }
  82         }
  83
  84 $apache_docbase = $config{'apache_docbase'} ? $config{'apache_docbase'} :
  85                   $httpd_modules{'core'} >= 2.0 ?
  86                         "http://httpd.apache.org/docs-2.0/mod/" :
  87                         "http://httpd.apache.org/docs/mod/";
  88
  89 # parse_config_file(handle, lines, file, [recursive])
  90 # Parses lines of text from some config file into a data structure. The
  91 # return value is an array of references, one for each directive in the file.
  92 # Each reference points to an associative array containing
  93 #  line -       The line number this directive is at
  94 #  eline -      The line number this directive ends at
  95 #  file -       The file this directive is from
  96 #  type -       0 for a normal directive, 1 for a container directive
  97 #  name -       The name of this directive
  98 #  value -      Value (possibly with spaces)
  99 #  members -    For type 1, a reference to the array of members
 100 sub parse_config_file
 101 {
 102 local($fh, @rv, $line, %dummy);
 103 $fh = $_[0];
 104 $dummy{'line'} = $dummy{'eline'} = $_[1]-1;
 105 $dummy{'file'} = $_[2];
 106 $dummy{'type'} = 0;
 107 $dummy{'name'} = "dummy";
 108 @rv = (\%dummy);
 109 local %defs;
 110 foreach my $d (&get_httpd_defines()) {
 111         if ($d =~ /^(\S+)=(.*)$/) {
 112                 $defs{$1} = $2;
 113                 }
 114         else {
 115                 $defs{$d} = '';
 116                 }
 117         }
 118 while($line = <$fh>) {
 119         chop;
 120         $line =~ s/^\s*#.*$//g;
 121         if ($line =~ /^\s*<\/(\S+)\s*(.*)>/) {
 122                 # end of a container directive. This can only happen in a
 123                 # recursive call to this function
 124                 $_[1]++;
 125                 last if (lc($_[3]) eq lc($1));
 126                 }
 127         elsif ($line =~ /^\s*<IfModule\s+(\!?)(\S+)\.c>/i ||
 128                $line =~ /^\s*<IfModule\s+(\!?)(\S+)>/i) {
 129                 # start of an IfModule block. Read it, and if the module
 130                 # exists put the directives in this section.
 131                 local ($not, $mod) = ($1, $2);
 132                 local $oldline = $_[1];
 133                 $_[1]++;
 134                 local @dirs = &parse_config_file($fh, $_[1], $_[2], 'IfModule');
 135                 local $altmod = $mod;
 136                 $altmod =~ s/^(\S+)_module$/mod_$1/g;
 137                 local $mpmmod = $mod;
 138                 $mpmmod =~ s/^mpm_//; $mpmmod =~ s/_module$//;
 139                 if (!$not && $httpd_modules{$mod} ||
 140                     $not && !$httpd_modules{$mod} ||
 141                     !$not && $httpd_modules{$altmod} ||
 142                     $not && !$httpd_modules{$altmod} ||
 143                     !$not && $httpd_modules{$mpmmod} ||
 144                     $not && !$httpd_modules{$mpmmod}
 145                     ) {
 146                         # use the directives..
 147                         push(@rv, { 'line', $oldline,
 148                                     'eline', $oldline,
 149                                     'file', $_[2],
 150                                     'name', "<IfModule $not$mod>" });
 151                         push(@rv, @dirs);
 152                         push(@rv, { 'line', $_[1]-1,
 153                                     'eline', $_[1]-1,
 154                                     'file', $_[2],
 155                                     'name', "</IfModule>" });
 156                         }
 157                 }
 158         elsif ($line =~ /^\s*<IfDefine\s+(\!?)(\S+)>/i) {
 159                 # start of an IfDefine block. Read it, and if the define
 160                 # exists put the directives in this section
 161                 local ($not, $def) = ($1, $2);
 162                 local $oldline = $_[1];
 163                 $_[1]++;
 164                 local @dirs = &parse_config_file($fh, $_[1], $_[2], 'IfDefine');
 165                 if (!$not && defined($defs{$def}) ||
 166                     $not && !defined($defs{$def})) {
 167                         # use the directives..
 168                         push(@rv, { 'line', $oldline,
 169                                     'eline', $oldline,
 170                                     'file', $_[2],
 171                                     'name', "<IfDefine $not$def>" });
 172                         push(@rv, @dirs);
 173                         push(@rv, { 'line', $_[1]-1,
 174                                     'eline', $_[1]-1,
 175                                     'file', $_[2],
 176                                     'name', "</IfDefine>" });
 177                         }
 178                 }
 179         elsif ($line =~ /^\s*<IfVersion\s+(\!?)(\S*)\s*(\S+)>/i) {
 180                 # Start of an IfVersion block. Read it, and if the version
 181                 # matches put the directives in this section
 182                 local ($not, $op, $ver) = ($1, $2, $3);
 183                 local $oldline = $_[1];
 184                 $_[1]++;
 185                 local @dirs = &parse_config_file($fh, $_[1], $_[2], 'IfVersion');
 186                 $op ||= "=";
 187                 local $match = 0;
 188                 local $myver = $httpd_modules{'core'};
 189                 $myver =~ s/^(\d+)\.(\d)(\d+)$/$1.$2.$3/;
 190                 if ($op eq "=" || $op eq "==") {
 191                         if ($ver =~ /^\/(.*)\/$/) {
 192                                 $match = 1 if ($myver =~ /$1/);
 193                                 }
 194                         else {
 195                                 $match = 1 if ($myver eq $ver);
 196                                 }
 197                         }
 198                 elsif ($op eq ">") {
 199                         $match = 1 if ($myver > $ver);
 200                         }
 201                 elsif ($op eq ">=") {
 202                         $match = 1 if ($myver >= $ver);
 203                         }
 204                 elsif ($op eq "<") {
 205                         $match = 1 if ($myver < $ver);
 206                         }
 207                 elsif ($op eq "<=") {
 208                         $match = 1 if ($myver <= $ver);
 209                         }
 210                 elsif ($op eq "~") {
 211                         $match = 1 if ($myver =~ /$ver/);
 212                         }
 213                 $match = !$match if ($not);
 214                 if ($match) {
 215                         # use the directives..
 216                         push(@rv, { 'line', $oldline,
 217                                     'eline', $oldline,
 218                                     'file', $_[2],
 219                                     'name', "<IfVersion $not$op $ver>" });
 220                         push(@rv, @dirs);
 221                         push(@rv, { 'line', $_[1]-1,
 222                                     'eline', $_[1]-1,
 223                                     'file', $_[2],
 224                                     'name', "</IfVersion>" });
 225                         }
 226                 }
 227         elsif ($line =~ /^\s*<(\S+)\s*(.*)>/) {
 228                 # start of a container directive. The first member is a dummy
 229                 # directive at the same line as the container
 230                 local(%dir, @members);
 231                 %dir = ('line', $_[1],
 232                         'file', $_[2],
 233                         'type', 1,
 234                         'name', $1,
 235                         'value', $2);
 236                 $dir{'value'} =~ s/\s+$//g;
 237                 $dir{'words'} = &wsplit($dir{'value'});
 238                 $_[1]++;
 239                 @members = &parse_config_file($fh, $_[1], $_[2], $dir{'name'});
 240                 $dir{'members'} = \@members;
 241                 $dir{'eline'} = $_[1]-1;
 242                 push(@rv, \%dir);
 243                 }
 244         elsif ($line =~ /^\s*(\S+)\s*(.*)$/) {
 245                 # normal directive
 246                 local(%dir);
 247                 %dir = ('line', $_[1],
 248                         'eline', $_[1],
 249                         'file', $_[2],
 250                         'type', 0,
 251                         'name', $1,
 252                         'value', $2);
 253                 if ($dir{'value'} =~ s/\\$//g) {
 254                         # multi-line directive!
 255                         while($line = <$fh>) {
 256                                 chop($line);
 257                                 $cont = ($line =~ s/\\$//g);
 258                                 $dir{'value'} .= $line;
 259                                 $dir{'eline'} = ++$_[1];
 260                                 if (!$cont) { last; }
 261                                 }
 262                         }
 263                 $dir{'value'} =~ s/\s+$//g;
 264                 if ($dir{'value'} =~ /^(.*)\$\{([^\}]+)\}(.*)$/) {
 265                         # Contains a variable .. replace with define
 266                         local $v = $defs{$2};
 267                         if ($v) {
 268                                 $dir{'value'} = $1.$v.$3;
 269                                 }
 270                         }
 271                 $dir{'words'} = &wsplit($dir{'value'});
 272                 push(@rv, \%dir);
 273                 $_[1]++;
 274                 }
 275         else {
 276                 # blank or comment line
 277                 $_[1]++;
 278                 }
 279         }
 280 return @rv;
 281 }
 282
 283 # wsplit(string)
 284 # Splits a string like  foo "foo \"bar\"" bazzz  into an array of words
 285 sub wsplit
 286 {
 287 local($s, @rv); $s = $_[0];
 288 $s =~ s/\\\"/\0/g;
 289 while($s =~ /^"([^"]*)"\s*(.*)$/ || $s =~ /^(\S+)\s*(.*)$/) {
 290         $w = $1; $s = $2;
 291         $w =~ s/\0/"/g; push(@rv, $w);
 292         }
 293 return \@rv;
 294 }
 295
 296 # wjoin(word, word, ...)
 297 sub wjoin
 298 {
 299 local(@rv, $w);
 300 foreach $w (@_) {
 301         if ($w =~ /^\S+$/) { push(@rv, $w); }
 302         else { push(@rv, "\"$w\""); }
 303         }
 304 return join(' ', @rv);
 305 }
 306
 307 # find_directive(name, &directives, [1stword])
 308 # Returns the values of directives matching some name
 309 sub find_directive
 310 {
 311 local (@vals, $ref);
 312 foreach $ref (@{$_[1]}) {
 313         if (lc($ref->{'name'}) eq lc($_[0])) {
 314                 push(@vals, $_[2] ? $ref->{'words'}->[0] : $ref->{'value'});
 315                 }
 316         }
 317 return wantarray ? @vals : !@vals ? undef : $vals[$#vals];
 318 }
 319
 320 # find_directive_struct(name, &directives)
 321 # Returns references to directives maching some name
 322 sub find_directive_struct
 323 {
 324 local (@vals, $ref);
 325 foreach $ref (@{$_[1]}) {
 326         if (lc($ref->{'name'}) eq lc($_[0])) {
 327                 push(@vals, $ref);
 328                 }
 329         }
 330 return wantarray ? @vals : !@vals ? undef : $vals[$#vals];
 331 }
 332
 333 # find_vdirective(name, &virtualdirectives, &directives, [1stword])
 334 # Looks for some directive in a <VirtualHost> section, and then in the
 335 # main section
 336 sub find_vdirective
 337 {
 338 if ($_[1]) {
 339         $rv = &find_directive($_[0], $_[1], $_[3]);
 340         if ($rv) { return $rv; }
 341         }
 342 return &find_directive($_[0], $_[2], $_[3]);
 343 }
 344
 345 # get_config()
 346 # Returns the entire config structure
 347 sub get_config
 348 {
 349 local($acc, $res, $lnum, $conf, @virt, $v, $mref, $inc);
 350 if (@get_config_cache) {
 351         return \@get_config_cache;
 352         }
 353
 354 # read primary config file
 355 ($conf) = &find_httpd_conf();
 356 return undef if (!$conf);
 357 my %seenfiles;
 358 @get_config_cache = &get_config_file($conf, \%seenfiles);
 359
 360 # Read main resource and access config files
 361 $lnum = 0;
 362 $res = &find_directive("ResourceConfig", \@get_config_cache);
 363 if (!$res) { $res = $config{'srm_conf'}; }
 364 if (!$res) { $res = "$config{'httpd_dir'}/conf/srm.conf"; }
 365 if (!-r &translate_filename($res)) {
 366         $res = "$config{'httpd_dir'}/etc/srm.conf";
 367         }
 368 push(@get_config_cache, &get_config_file($res, \%seenfiles));
 369
 370 $lnum = 0;
 371 $acc = &find_directive("AccessConfig", \@get_config_cache);
 372 if (!$acc) { $acc = $config{'access_conf'}; }
 373 if (!$acc) { $acc = "$config{'httpd_dir'}/conf/access.conf"; }
 374 if (!-r &translate_filename($acc)) {
 375         $acc = "$config{'httpd_dir'}/etc/access.conf";
 376         }
 377 push(@get_config_cache, &get_config_file($acc, \%seenfiles));
 378
 379 # Read extra config files in VirtualHost sections
 380 @virt = &find_directive_struct("VirtualHost", \@get_config_cache);
 381 foreach $v (@virt) {
 382         my %seenfiles;
 383         $mref = $v->{'members'};
 384         foreach $idn ("ResourceConfig", "AccessConfig", "Include") {
 385                 foreach $inc (&find_directive_struct($idn, $mref)) {
 386                         local @incs = &expand_apache_include(
 387                                         $inc->{'words'}->[0]);
 388                         foreach my $ginc (@incs) {
 389                                 push(@$mref, &get_config_file($ginc,
 390                                                               \%seenfiles));
 391                                 }
 392                         }
 393                 }
 394         }
 395
 396 return \@get_config_cache;
 397 }
 398
 399 # get_config_file(filename, [&seen-files])
 400 # Returns a list of config hash refs from some file
 401 sub get_config_file
 402 {
 403 my ($file, $seen) = @_;
 404
 405 # Convert sites-enabled to real path in sites-available
 406 $file = &simplify_path(&resolve_links($file));
 407 return ( ) if ($seen && $seen->{$file}++);
 408 local @rv;
 409 if (opendir(DIR, $file)) {
 410         # Is a directory .. parse all files!
 411         local @files = readdir(DIR);
 412         closedir(DIR);
 413         foreach my $f (sort { $a cmp $b } @files) {
 414                 next if ($f =~ /^\./);
 415                 push(@rv, &get_config_file("$file/$f", $seen));
 416                 }
 417         }
 418 else {
 419         # Just a normal config file
 420         local $lnum = 0;
 421         &open_readfile(CONF, $file);
 422         @rv = &parse_config_file(CONF, $lnum, $file);
 423         close(CONF);
 424         }
 425
 426 # Expand Include directives
 427 foreach $inc (&find_directive_struct("Include", \@rv)) {
 428         local @incs = &expand_apache_include($inc->{'words'}->[0]);
 429         foreach my $ginc (@incs) {
 430                 push(@rv, &get_config_file($ginc, $seen));
 431                 }
 432         }
 433
 434 return @rv;
 435 }
 436
 437 # expand_apache_include(dir)
 438 # Given an include directive value, returns a list of matching files
 439 sub expand_apache_include
 440 {
 441 local ($incdir) = @_;
 442 if ($incdir !~ /^\//) { $incdir = "$config{'httpd_dir'}/$incdir"; }
 443 if ($incdir =~ /^(.*)\[\^([^\]]+)\](.*)$/) {
 444         # A glob like /etc/[^.#]*.conf , which cannot be handled
 445         # by Perl's glob function!
 446         local $before = $1;
 447         local $after = $3;
 448         local %reject = map { $_, 1 } split(//, $2);
 449         $reject{'*'} = $reject{'?'} = $reject{'['} = $reject{']'} =
 450           $reject{'/'} = $reject{'$'} = $reject{'('} = $reject{')'} =
 451           $reject{'!'} = 1;
 452         local $accept = join("", grep { !$reject{$_} } map { chr($_) } (32 .. 126));
 453         $incdir = $before."[".$accept."]".$after;
 454         }
 455 return sort { $a cmp $b } glob($incdir);
 456 }
 457
 458 # get_virtual_config(index)
 459 sub get_virtual_config
 460 {
 461 local($conf, $c, $v);
 462 $conf = &get_config();
 463 if (!$_[0]) { $c = $conf; $v = undef; }
 464 else {
 465         $c = $conf->[$_[0]]->{'members'};
 466         $v = $conf->[$_[0]];
 467         }
 468 return wantarray ? ($c, $v) : $c;
 469 }
 470
 471 # get_htaccess_config(file)
 472 sub get_htaccess_config
 473 {
 474 local($lnum, @conf);
 475 &open_readfile(HTACCESS, $_[0]);
 476 @conf = &parse_config_file(HTACCESS, $lnum, $_[0]);
 477 close(HTACCESS);
 478 return \@conf;
 479 }
 480
 481 # save_directive(name, &values, &parent-directives, &config, [always-at-end])
 482 # Updates the config file(s) and the directives structure with new values
 483 # for the given directives.
 484 # If a directive's value is merely being changed, then its value only needs
 485 # to be updated in the directives array and in the file.
 486 sub save_directive
 487 {
 488 local($i, @old, $lref, $change, $len, $v);
 489 @old = &find_directive_struct($_[0], $_[2]);
 490 local @files;
 491 for($i=0; $i<@old || $i<@{$_[1]}; $i++) {
 492         $v = ${$_[1]}[$i];
 493         if ($i >= @old) {
 494                 # a new directive is being added. If other directives of this
 495                 # type exist, add it after them. Otherwise, put it at the end of
 496                 # the first file in the section
 497                 if ($change && !$_[4]) {
 498                         # Have changed some old directive.. add this new one
 499                         # after it, and update change
 500                         local(%v, $j);
 501                         %v = (  "line", $change->{'line'}+1,
 502                                 "eline", $change->{'line'}+1,
 503                                 "file", $change->{'file'},
 504                                 "type", 0,
 505                                 "name", $_[0],
 506                                 "value", $v,
 507                                 "words", &wsplit($v) );
 508                         $j = &indexof($change, @{$_[2]})+1;
 509                         &renumber($_[3], $v{'line'}, $v{'file'}, 1);
 510                         splice(@{$_[2]}, $j, 0, \%v);
 511                         $lref = &read_file_lines($v{'file'});
 512                         push(@files, $v{'file'});
 513                         splice(@$lref, $v{'line'}, 0, "$_[0] $v");
 514                         $change = \%v;
 515                         }
 516                 else {
 517                         # Adding a new directive to the end of the list
 518                         # in this section
 519                         local($f, %v, $j);
 520                         $f = $_[2]->[0]->{'file'};
 521                         for($j=0; $_[2]->[$j]->{'file'} eq $f; $j++) { }
 522                         $l = $_[2]->[$j-1]->{'eline'}+1;
 523                         %v = (  "line", $l,
 524                                 "eline", $l,
 525                                 "file", $f,
 526                                 "type", 0,
 527                                 "name", $_[0],
 528                                 "value", $v,
 529                                 "words", &wsplit($v) );
 530                         &renumber($_[3], $l, $f, 1);
 531                         splice(@{$_[2]}, $j, 0, \%v);
 532                         $lref = &read_file_lines($f);
 533                         push(@files, $f);
 534                         splice(@$lref, $l, 0, "$_[0] $v");
 535                         }
 536                 }
 537         elsif ($i >= @{$_[1]}) {
 538                 # a directive was deleted
 539                 $lref = &read_file_lines($old[$i]->{'file'});
 540                 push(@files, $old[$i]->{'file'});
 541                 $idx = &indexof($old[$i], @{$_[2]});
 542                 splice(@{$_[2]}, $idx, 1);
 543                 $len = $old[$i]->{'eline'} - $old[$i]->{'line'} + 1;
 544                 splice(@$lref, $old[$i]->{'line'}, $len);
 545                 &renumber($_[3], $old[$i]->{'line'}, $old[$i]->{'file'}, -$len);
 546                 }
 547         else {
 548                 # just changing the value
 549                 $lref = &read_file_lines($old[$i]->{'file'});
 550                 push(@files, $old[$i]->{'file'});
 551                 $len = $old[$i]->{'eline'} - $old[$i]->{'line'} + 1;
 552                 &renumber($_[3], $old[$i]->{'eline'}+1,
 553                           $old[$i]->{'file'},1-$len);
 554                 $old[$i]->{'value'} = $v;
 555                 $old[$i]->{'words'} = &wsplit($v);
 556                 $old[$i]->{'eline'} = $old[$i]->{'line'};
 557                 splice(@$lref, $old[$i]->{'line'}, $len, "$_[0] $v");
 558                 $change = $old[$i];
 559                 }
 560         }
 561 return &unique(@files);
 562 }
 563
 564 # save_directive_struct(&old-directive, &directive, &parent-directives,
 565 #                       &config, [firstline-only])
 566 # Updates, creates or removes only multi-line directive like a <virtualhost>
 567 sub save_directive_struct
 568 {
 569 local ($olddir, $newdir, $pconf, $conf, $first) = @_;
 570 return if (!$olddir && !$newdir);       # Nothing to do
 571 local $file = $olddir ? $olddir->{'file'} :
 572               $newdir->{'file'} ? $newdir->{'file'} : $pconf->[0]->{'file'};
 573 local $lref = &read_file_lines($file);
 574 local $oldlen = $olddir ? $olddir->{'eline'}-$olddir->{'line'}+1 : undef;
 575 local @newlines = $newdir ? &directive_lines($newdir) : ( );
 576 if ($olddir && $newdir) {
 577         # Update in place
 578         if ($first) {
 579                 # Just changing first and last line, like virtualhost IP
 580                 $lref->[$olddir->{'line'}] = $newlines[0];
 581                 $lref->[$olddir->{'eline'}] = $newlines[$#newlines];
 582                 $olddir->{'name'} = $newdir->{'name'};
 583                 $olddir->{'value'} = $newdir->{'value'};
 584                 }
 585         else {
 586                 # Re-writing whole block
 587                 &renumber($conf, $olddir->{'eline'}+1, $file,
 588                           scalar(@newlines)-$oldlen);
 589                 local $idx = &indexof($olddir, @$pconf);
 590                 $pconf->[$idx] = $newdir if ($idx >= 0);
 591                 $newdir->{'file'} = $olddir->{'file'};
 592                 $newdir->{'line'} = $olddir->{'line'};
 593                 $newdir->{'eline'} = $olddir->{'line'}+scalar(@newlines)-1;
 594                 splice(@$lref, $olddir->{'line'}, $oldlen, @newlines);
 595
 596                 # Update sub-directive lines and files too
 597                 if ($newdir->{'type'}) {
 598                         &recursive_set_lines_files($newdir->{'members'},
 599                                                    $newdir->{'line'}+1,
 600                                                    $newdir->{'file'});
 601                         }
 602                 }
 603         }
 604 elsif ($olddir && !$newdir) {
 605         # Remove
 606         splice(@$lref, $olddir->{'line'}, $oldlen);
 607         local $idx = &indexof($olddir, @$pconf);
 608         splice(@$pconf, $idx, 1) if ($idx >= 0);
 609         &renumber($conf, $olddir->{'line'}, $olddir->{'file'}, -$oldlen);
 610         }
 611 elsif (!$olddir && $newdir) {
 612         # Add to file, at end of specific file or parent section
 613         local ($addline, $addpos);
 614         if ($newdir->{'file'}) {
 615                 $addline = scalar(@$lref);
 616                 $addpos = scalar(@$pconf);
 617                 }
 618         else {
 619                 for($addpos=0; $addpos < scalar(@$pconf) &&
 620                                $pconf->[$addpos]->{'file'} eq $file;
 621                     $addpos++) {
 622                         # Find last parent directive in same file
 623                         }
 624                 $addpos--;
 625                 $addline = $pconf->[$addpos]->{'eline'}+1;
 626                 }
 627         $newdir->{'file'} = $file;
 628         $newdir->{'line'} = $addline;
 629         $newdir->{'eline'} = $addline + scalar(@newlines) - 1;
 630         &renumber($conf, $addline, $file, scalar(@newlines));
 631         splice(@$pconf, $addpos, 0, $newdir);
 632         splice(@$lref, $addline, 0, @newlines);
 633
 634         # Update sub-directive lines and files too
 635         if ($newdir->{'type'}) {
 636                 &recursive_set_lines_files($newdir->{'members'},
 637                                            $newdir->{'line'}+1,
 638                                            $newdir->{'file'});
 639                 }
 640         }
 641 }
 642
 643 # recursive_set_lines_files(&directives, first-line, file)
 644 # Update the line numbers and filenames in a list of directives
 645 sub recursive_set_lines_files
 646 {
 647 local ($dirs, $line, $file) = @_;
 648 foreach my $d (@$dirs) {
 649         $dir->{'line'} = $line;
 650         $dir->{'file'} = $file;
 651         if ($dir->{'type'}) {
 652                 # Do sub-members too
 653                 &recursive_set_lines_files($dir->{'members'}, $line+1, $file);
 654                 $line += scalar(@{$dir->{'members'}})+1;
 655                 $dir->{'eline'} = $line;
 656                 }
 657         else {
 658                 $dir->{'eline'} = $line;
 659                 }
 660         $line++;
 661         }
 662 return $line;
 663 }
 664
 665 # delete_file_if_empty(file)
 666 # If a virtual host file is now empty, delete it (and any link to it)
 667 sub delete_file_if_empty
 668 {
 669 local ($file) = @_;
 670 local $lref = &read_file_lines($file, 1);
 671 foreach my $l (@$lref) {
 672         return 0 if ($l =~ /\S/);
 673         }
 674 &unflush_file_lines($file);
 675 unlink($file);
 676 &delete_webfile_link($file);
 677 }
 678
 679 # renumber(&config, line, file, offset)
 680 # Recursively changes the line number of all directives from some file
 681 # beyond the given line.
 682 sub renumber
 683 {
 684 local($d);
 685 if (!$_[3]) { return; }
 686 foreach $d (@{$_[0]}) {
 687         if ($d->{'file'} eq $_[2] && $d->{'line'} >= $_[1]) {
 688                 $d->{'line'} += $_[3];
 689                 }
 690         if ($d->{'file'} eq $_[2] && $d->{'eline'} >= $_[1]) {
 691                 $d->{'eline'} += $_[3];
 692                 }
 693         if ($d->{'type'}) {
 694                 &renumber($d->{'members'}, $_[1], $_[2], $_[3]);
 695                 }
 696         }
 697 }
 698
 699 # server_root(path, &directives)
 700 sub server_root
 701 {
 702 if (!$_[0]) { return undef; }
 703 elsif ($_[0] =~ /^\//) { return $_[0]; }
 704 else { return "$config{'httpd_dir'}/$_[0]"; }
 705 }
 706
 707 sub dump_config
 708 {
 709 local($c, $mref);
 710 print "<table border>\n";
 711 print "<tr> <td>Name</td> <td>Value</td> <td>File</td> <td>Line</td> </tr>\n";
 712 foreach $c (@_) {
 713         printf "<tr> <td>%s</td> <td>%s</td><td>%s</td><td>%s</td> </tr>\n",
 714                 $c->{'name'}, $c->{'value'}, $c->{'file'}, $c->{'line'};
 715         if ($c->{'type'}) {
 716                 print "<tr> <td colspan=4>\n";
 717                 $mref = $c->{'members'};
 718                 &dump_config(@$mref);
 719                 print "</td> </tr>\n";
 720                 }
 721         }
 722 print "</table>\n";
 723 }
 724
 725 sub def
 726 {
 727 return $_[0] ? $_[0] : $_[1];
 728 }
 729
 730 # make_directives(ref, version, module)
 731 sub make_directives
 732 {
 733 local(@rv, $aref);
 734 $aref = $_[0];
 735 local $ver = $_[1];
 736 if ($ver =~ /^(1)\.(3)(\d+)$/) {
 737         $ver = sprintf "%d.%d%2.2d", $1, $2, $3;
 738         }
 739 foreach $d (@$aref) {
 740         local(%dir);
 741         $dir{'name'} = $d->[0];
 742         $dir{'multiple'} = $d->[1];
 743         $dir{'type'} = int($d->[2]);
 744         $dir{'subtype'} = $d->[2] - $dir{'type'};
 745         $dir{'module'} = $_[2];
 746         $dir{'version'} = $ver;
 747         $dir{'priority'} = $d->[5];
 748         foreach $c (split(/\s+/, $d->[3])) { $dir{$c}++; }
 749         if (!$d->[4]) { push(@rv, \%dir); }
 750         elsif ($d->[4] =~ /^-([\d\.]+)$/ && $ver < $1) { push(@rv, \%dir); }
 751         elsif ($d->[4] =~ /^([\d\.]+)$/ && $ver >= $1) { push(@rv, \%dir); }
 752         elsif ($d->[4] =~ /^([\d\.]+)-([\d\.]+)$/ && $ver >= $1 && $ver < $2)
 753                 { push(@rv, \%dir); }
 754         }
 755 return @rv;
 756 }
 757
 758
 759 # editable_directives(type, context)
 760 # Returns an array of references to associative arrays, one for each
 761 # directive of the given type that can be used in the given context
 762 sub editable_directives
 763 {
 764 local($m, $func, @rv, %done);
 765 foreach $m (keys %httpd_modules) {
 766         $func = $m."_directives";
 767         push(@rv, &$func($httpd_modules{$m}));
 768         }
 769 @rv = grep { $_->{'type'} == $_[0] && $_->{$_[1]} &&
 770              !$done{$_->{'name'}}++ } @rv;
 771 @rv = grep { &can_edit_directive($_->{'name'}) } @rv;
 772 @rv = sort { local $td = $a->{'subtype'} <=> $b->{'subtype'};
 773              local $pd = $b->{'priority'} <=> $a->{'priority'};
 774              local $md = $a->{'module'} cmp $b->{'module'};
 775              $td ? $td : $pd ? $pd : $md ? $md : $a->{'name'} cmp $b->{'name'} }
 776                 @rv;
 777 return @rv;
 778 }
 779
 780 # can_edit_directive(name)
 781 # Returns 1 if the Apache directive named can be edited by the current user
 782 sub can_edit_directive
 783 {
 784 local ($name) = @_;
 785 if ($access{'dirsmode'} == 0) {
 786         return 1;
 787         }
 788 else {
 789         local %dirs = map { lc($_), 1 } split(/\s+/, $access{'dirs'});
 790         if ($access{'dirsmode'} == 1) {
 791                 return $dirs{lc($name)};
 792                 }
 793         else {
 794                 return !$dirs{lc($name)};
 795                 }
 796         }
 797 }
 798
 799 # generate_inputs(&editors, &directives)
 800 # Displays a 2-column list of options, for use inside a table
 801 sub generate_inputs
 802 {
 803 local($e, $sw, @args, @rv, $func, $lastsub);
 804 foreach $e (@{$_[0]}) {
 805         if (defined($lastsub) && $lastsub != $e->{'subtype'}) {
 806                 print &ui_table_hr();
 807                 }
 808         $lastsub = $e->{'subtype'};
 809
 810         # Build arg list for the editing function. Each arg can be a single
 811         # directive struct, or a reference to an array of structures.
 812         $func = "edit";
 813         undef(@args);
 814         foreach $ed (split(/\s+/, $e->{'name'})) {
 815                 local(@vals);
 816                 $func .= "_$ed";
 817                 @vals = &find_directive_struct($ed, $_[1]);
 818                 if ($e->{'multiple'}) { push(@args, \@vals); }
 819                 elsif (!@vals) { push(@args, undef); }
 820                 else { push(@args, $vals[$#vals]); }
 821                 }
 822         push(@args, $e);
 823
 824         # call the function
 825         @rv = &$func(@args);
 826         local $names;
 827         if ($config{'show_names'} || $userconfig{'show_names'}) {
 828                 $names = " (";
 829                 foreach $ed (split(/\s+/, $e->{'name'})) {
 830                         # nodo50 v0.1 - Change 000004 - Open new window for Help in Apache module and mod_apachessl Help from http://www.apache-ssl.org and
 831                         # nodo50 v0.1 - Change 000004 - Abre nueva ventana para Ayuda del módulo Apache y para mod_apachessl busca la Ayuda en http://www.apache-ssl.org and
 832                         $names .= "<tt><a href='".($e->{'module'} eq 'mod_apachessl' ? 'http://www.apache-ssl.org/docs.html#'.$ed : $apache_docbase."/".$e->{'module'}.".html#".lc($ed))."'>".$ed."</a></tt> ";
 833                         #$names .= "<tt><a href='".$apache_docbase."/".$e->{'module'}.".html#".lc($ed)."'>".$ed."</a></tt> ";
 834                         # nodo50 v0.1 - Change 000004 - End
 835                         }
 836                 $names .= ")";
 837                 }
 838         if ($rv[0] >= 2) {
 839                 # spans 2 columns..
 840                 if ($rv[0] == 3) {
 841                         # Takes up whole row
 842                         print &ui_table_row(undef, $rv[2], 4);
 843                         }
 844                 else {
 845                         # Has title on left
 846                         print &ui_table_row($rv[1], $rv[2], 3);
 847                         }
 848                 }
 849         else {
 850                 # only spans one column
 851                 print &ui_table_row($rv[1], $rv[2]);
 852                 }
 853         }
 854 }
 855
 856 # parse_inputs(&editors, &directives, &config)
 857 # Reads user choices from a form and update the directives and config files.
 858 sub parse_inputs
 859 {
 860 # First call editor functions to get new values. Each function returns
 861 # an array of references to arrays containing the new values for the directive.
 862 &before_changing();
 863 &lock_apache_files();
 864 foreach $e (@{$_[0]}) {
 865         @dirs = split(/\s+/, $e->{'name'});
 866         $func = "save_".join('_', @dirs);
 867         @rv = &$func($e);
 868         for($i=0; $i<@dirs; $i++) {
 869                 push(@chname, $dirs[$i]);
 870                 push(@chval, $rv[$i]);
 871                 }
 872         }
 873
 874 # Assuming everything went OK, update the configuration
 875 for($i=0; $i<@chname; $i++) {
 876         &save_directive($chname[$i], $chval[$i], $_[1], $_[2]);
 877         }
 878 &flush_file_lines();
 879 &unlock_apache_files();
 880 &after_changing();
 881 }
 882
 883 # opt_input(value, name, default, size)
 884 sub opt_input
 885 {
 886 return &ui_opt_textbox($_[1], $_[0], $_[3], $_[2]);
 887 }
 888
 889 # parse_opt(name, regexp, error, [noquotes])
 890 sub parse_opt
 891 {
 892 local($i, $re);
 893 local $v = $in{$_[0]};
 894 if ($in{"$_[0]_def"}) { return ( [ ] ); }
 895 for($i=1; $i<@_; $i+=2) {
 896         $re = $_[$i];
 897         if ($v !~ /$re/) { &error($_[$i+1]); }
 898         }
 899 return ( [ $v =~ /\s/ && !$_[3] ? "\"$v\"" : $v ] );
 900 }
 901
 902 # choice_input(value, name, default, [choice]+)
 903 # Each choice is a display,value pair
 904 sub choice_input
 905 {
 906 local($i, $rv);
 907 for($i=3; $i<@_; $i++) {
 908         $_[$i] =~ /^([^,]*),(.*)$/;
 909         $rv .= &ui_oneradio($_[1], $2, $1, lc($2) eq lc($_[0]) ||
 910                                 !defined($_[0]) && lc($2) eq lc($_[2]))."\n";
 911         }
 912 return $rv;
 913 }
 914
 915 # choice_input_vert(value, name, default, [choice]+)
 916 # Each choice is a display,value pair
 917 sub choice_input_vert
 918 {
 919 local($i, $rv);
 920 for($i=3; $i<@_; $i++) {
 921         $_[$i] =~ /^([^,]*),(.*)$/;
 922         $rv .= sprintf "<input type=radio name=$_[1] value=\"$2\" %s> $1<br>\n",
 923                 lc($2) eq lc($_[0]) || !defined($_[0]) &&
 924                                        lc($2) eq lc($_[2]) ? "checked" : "";
 925         }
 926 return $rv;
 927 }
 928
 929 # parse_choice(name, default)
 930 sub parse_choice
 931 {
 932 if (lc($in{$_[0]}) eq lc($_[1])) { return ( [ ] ); }
 933 else { return ( [ $in{$_[0]} ] ); }
 934 }
 935
 936 # select_input(value, name, default, [choice]+)
 937 sub select_input
 938 {
 939 local($i, $rv);
 940 $rv = "<select name=\"$_[1]\">\n";
 941 for($i=3; $i<@_; $i++) {
 942         $_[$i] =~ /^([^,]*),(.*)$/;
 943         $rv .= sprintf "<option value=\"$2\" %s> $1\n",
 944                 lc($2) eq lc($_[0]) || !defined($_[0]) && lc($2) eq lc($_[2]) ? "selected" : "";
 945         }
 946 $rv .= "</select>\n";
 947 return $rv;
 948 }
 949
 950 # parse_choice(name, default)
 951 sub parse_select
 952 {
 953 return &parse_choice(@_);
 954 }
 955
 956 # handler_input(value, name)
 957 sub handler_input
 958 {
 959 local($m, $func, @hl, $rv, $h);
 960 local $conf = &get_config();
 961 push(@hl, "");
 962 foreach $m (keys %httpd_modules) {
 963         $func = $m."_handlers";
 964         if (defined(&$func)) {
 965                 push(@hl, &$func($conf, $httpd_modules{$m}));
 966                 }
 967         }
 968 if (&indexof($_[0], @hl) < 0) { push(@hl, $_[0]); }
 969 $rv = "<select name=$_[1]>\n";
 970 foreach $h (&unique(@hl)) {
 971         $rv .= sprintf "<option value=\"$h\" %s>$h\n",
 972                 $h eq $_[0] ? "selected" : "";
 973         }
 974 $rv .= sprintf "<option value=\"None\" %s>&lt;$text{'core_none'}&gt;\n",
 975         $_[0] eq "None" ? "selected" : "";
 976 $rv .= "</select>\n";
 977 return $rv;
 978 }
 979
 980 # parse_handler(name)
 981 sub parse_handler
 982 {
 983 if ($in{$_[0]} eq "") { return ( [ ] ); }
 984 else { return ( [ $in{$_[0]} ] ); }
 985 }
 986
 987 # filters_input(&values, name)
 988 sub filters_input
 989 {
 990 local($m, $func, @fl, $rv, $f);
 991 local $conf = &get_config();
 992 foreach $m (keys %httpd_modules) {
 993         $func = $m."_filters";
 994         if (defined(&$func)) {
 995                 push(@fl, &$func($conf, $httpd_modules{$m}));
 996                 }
 997         }
 998 foreach $f (@{$_[0]}) {
 999         push(@fl, $f) if (&indexof($f, @fl) < 0);
1000         }
1001 foreach $f (&unique(@fl)) {
1002         $rv .= sprintf "<input type=checkbox name=$_[1] value='%s' %s> %s\n",
1003                         $f, &indexof($f, @{$_[0]}) < 0 ? "" : "checked", $f;
1004         }
1005 return $rv;
1006 }
1007
1008 # parse_filters(name)
1009 sub parse_filters
1010 {
1011 local @f = split(/\0/, $in{$_[0]});
1012 return @f ? ( [ join(";", @f) ] ) : ( [ ] );
1013 }
1014
1015
1016
1017 # virtual_name(struct, [forlog])
1018 sub virtual_name
1019 {
1020 if ($_[0]) {
1021         local $n = &find_directive("ServerName", $_[0]->{'members'});
1022         if ($n) {
1023                 return &html_escape($_[0]->{'value'} =~ /:(\d+)$/ ? "$n:$1"
1024                                                                   : $n);
1025                 }
1026         else {
1027                 return &html_escape(
1028                         $_[0]->{'value'} =~ /^\[(\S+)\]$/ ? $1 :
1029                         $_[0]->{'value'} =~ /^\[(\S+)\]:(\d+)$/ ? "$1:$2" :
1030                                 $_[0]->{'value'});
1031                 }
1032         }
1033 else { return $_[1] ? "*" : $text{'default_serv'}; }
1034 }
1035
1036 # dir_name(struct)
1037 # Given a <directory> or similar structure, return a human-readable description
1038 sub dir_name
1039 {
1040 $_[0]->{'name'} =~ /^(Directory|Files|Location|Proxy)(Match)?$/;
1041 my ($dfm, $mat) = ($1, $2);
1042 if ($dfm eq "Proxy" && !$mat && $_[0]->{'words'}->[0] eq "*") {
1043         # Proxy for all
1044         return $text{'dir_proxyall'};
1045         }
1046 elsif ($mat) {
1047         # Match-type directive
1048         return "$dfm regexp <tt>".&html_escape($_[0]->{'words'}->[0])."</tt>";
1049         }
1050 elsif ($_[0]->{'words'}->[0] eq "~") {
1051         # Regular expression
1052         return "$dfm regexp <tt>".&html_escape($_[0]->{'words'}->[1])."</tt>";
1053         }
1054 else {
1055         # Exact match
1056         return "$dfm <tt>".&html_escape($_[0]->{'words'}->[0])."</tt>";
1057         }
1058 }
1059
1060 # list_user_file(file, &user,  &pass)
1061 sub list_user_file
1062 {
1063 local($_);
1064 &open_readfile(USERS, $_[0]);
1065 while(<USERS>) {
1066         /^(\S+):(\S+)/;
1067         push(@{$_[1]}, $1); $_[2]->{$1} = $2;
1068         }
1069 close(USERS);
1070 }
1071
1072
1073 # config_icons(context, program)
1074 # Displays up to 18 icons, one for each type of configuration directive, for
1075 # some context (global, virtual, directory or htaccess)
1076 sub config_icons
1077 {
1078 local($m, $func, $e, %etype, $i, $c);
1079 foreach $m (sort { $a cmp $b } (keys %httpd_modules)) {
1080         $func = $m."_directives";
1081         foreach $e (&$func($httpd_modules{$m})) {
1082                 if ($e->{$_[0]}) { $etype{$e->{'type'}}++; }
1083                 }
1084         }
1085 local (@titles, @links, @icons);
1086 for($i=0; $text{"type_$i"}; $i++) {
1087         if ($etype{$i} && $access_types{$i}) {
1088                 push(@links, $_[1]."type=$i");
1089                 push(@titles, $text{"type_$i"});
1090                 push(@icons, "images/type_icon_$i.gif");
1091                 }
1092         }
1093 for($i=2; $i<@_; $i++) {
1094         if ($_[$i]) {
1095                 push(@links, $_[$i]->{'link'});
1096                 push(@titles, $_[$i]->{'name'});
1097                 push(@icons, $_[$i]->{'icon'});
1098                 }
1099         }
1100 &icons_table(\@links, \@titles, \@icons, 5);
1101 print "<p>\n";
1102 }
1103
1104 # restart_button()
1105 # Returns HTML for a link to put in the top-right corner of every page
1106 sub restart_button
1107 {
1108 local $rv;
1109 $args = "redir=".&urlize(&this_url());
1110 local @rv;
1111 if (&is_apache_running()) {
1112         if ($access{'apply'}) {
1113                 push(@rv, "<a href=\"restart.cgi?$args\">$text{'apache_apply'}</a>\n");
1114                 }
1115         if ($access{'stop'}) {
1116                 push(@rv, "<a href=\"stop.cgi?$args\">$text{'apache_stop'}</a>\n");
1117                 }
1118         }
1119 elsif ($access{'stop'}) {
1120         push(@rv, "<a href=\"start.cgi?$args\">$text{'apache_start'}</a>\n");
1121         }
1122 return join("<br>\n", @rv);
1123 }
1124
1125 # this_url()
1126 # Returns the URL in the apache directory of the current script
1127 sub this_url
1128 {
1129 local($url);
1130 $url = $ENV{'SCRIPT_NAME'};
1131 if ($ENV{'QUERY_STRING'} ne "") { $url .= "?$ENV{'QUERY_STRING'}"; }
1132 return $url;
1133 }
1134
1135 # find_all_directives(config, name)
1136 # Recursively finds all directives of some type
1137 sub find_all_directives
1138 {
1139 local(@rv, $d);
1140 foreach $d (@{$_[0]}) {
1141         if ($d->{'name'} eq $_[1]) { push(@rv, $d); }
1142         if ($d->{'type'} == 1) {
1143                 push(@rv, &find_all_directives($d->{'members'}, $_[1]));
1144                 }
1145         }
1146 return @rv;
1147 }
1148
1149 # httpd_info(executable)
1150 # Returns the httpd version and modules array
1151 sub httpd_info
1152 {
1153 local(@mods, $verstr, $ver, $minor);
1154 $verstr = &backquote_command("\"$_[0]\" -v 2>&1");
1155 if ($config{'httpd_version'}) {
1156         $config{'httpd_version'} =~ /(\d+)\.([\d\.]+)/;
1157         $ver = $1; $minor = $2; $minor =~ s/\.//g; $ver .= ".$minor";
1158         }
1159 elsif ($verstr =~ /Apache(\S*)\/(\d+)\.([\d\.]+)/) {
1160         # standard apache
1161         $ver = $2; $minor = $3; $minor =~ s/\.//g; $ver .= ".$minor";
1162         }
1163 elsif ($verstr =~ /HP\s*Apache-based\s*Web\s*Server(\S*)\/(\d+)\.([\d\.]+)/) {
1164         # HP's apache
1165         $ver = $2; $minor = $3; $minor =~ s/\.//g; $ver .= ".$minor";
1166         }
1167 elsif ($verstr =~ /Red\s*Hat\s+Secure\/2\.0/i) {
1168         # redhat secure server 2.0
1169         $ver = 1.31;
1170         }
1171 elsif ($verstr =~ /Red\s*Hat\s+Secure\/3\.0/i) {
1172         # redhat secure server 3.0
1173         $ver = 1.39;
1174         }
1175 elsif (&has_command("rpm") &&
1176        &backquote_command("rpm -q apache 2>&1") =~ /^apache-(\d+)\.([\d\.]+)/) {
1177         # got version from the RPM
1178         $ver = $1; $minor = $2; $minor =~ s/\.//g; $ver .= ".$minor";
1179         }
1180 else {
1181         # couldn't get version
1182         return (0, undef);
1183         }
1184 if ($ver < 1.2) {
1185         # apache 1.1 has no -l option! Use the standard list
1186         @mods = ("core", "mod_mime", "mod_access", "mod_auth", "mod_include",
1187                  "mod_negotiation", "mod_dir", "mod_cgi", "mod_userdir",
1188                  "mod_alias", "mod_env", "mod_log_common");
1189         }
1190 else {
1191         # ask apache for the module list
1192         @mods = ("core");
1193         &open_execute_command(APACHE, "\"$_[0]\" -l 2>/dev/null", 1);
1194         while(<APACHE>) {
1195                 if (/(\S+)\.c/) { push(@mods, $1); }
1196                 }
1197         close(APACHE);
1198         if ($?) {
1199                 # httpd crashed! Use last known good set of modules
1200                 local %oldsite;
1201                 &read_file($site_file, \%oldsite);
1202                 if ($oldsite{'modules'}) {
1203                         @mods = split(/\s+/, $oldsite{'modules'});
1204                         }
1205                 }
1206         @mods = &unique(@mods);
1207         }
1208 return ($ver, \@mods);
1209 }
1210
1211 # print_line(directive, text, indent, link)
1212 sub print_line
1213 {
1214 local $line = $_[0]->{'line'} + 1;
1215 local $lstr = "$_[0]->{'file'} ($line)";
1216 local $txt = join("", @{$_[1]});
1217 local $left = 85 - length($lstr) - $_[2];
1218 if (length($txt) > $left) {
1219         $txt = substr($txt, 0, $left)." ..";
1220         }
1221 local $txtlen = length($txt);
1222 $txt = &html_escape($txt);
1223 print " " x $_[2];
1224 if ($_[3]) {
1225         print "<a href=\"$_[3]\">",$txt,"</a>";
1226         }
1227 else { print $txt; }
1228 print " " x (90 - $txtlen - $_[2] - length($lstr));
1229 print $lstr,"\n";
1230 }
1231
1232 # can_edit_virt(struct)
1233 sub can_edit_virt
1234 {
1235 return 1 if ($access{'virts'} eq '*');
1236 local %vcan = map { $_, 1 } split(/\s+/, $access{'virts'});
1237 local ($can) = grep { $vcan{$_} } &virt_acl_name($_[0]);
1238 return $can ? 1 : 0;
1239 }
1240
1241 # virt_acl_name(struct)
1242 # Give a virtual host, returns a list of names that could be used in the ACL
1243 # to refer to it
1244 sub virt_acl_name
1245 {
1246 return ( "__default__" ) if (!$_[0]);
1247 local $n = &find_directive("ServerName", $_[0]->{'members'});
1248 local @rv;
1249 local $p;
1250 if ($_[0]->{'value'} =~ /(:\d+)/) { $p = $1; }
1251 if ($n) {
1252         push(@rv, $n.$p);
1253         }
1254 else {
1255         push(@rv, $_[0]->{'value'});
1256         }
1257 foreach $n (&find_directive_struct("ServerAlias", $_[0]->{'members'})) {
1258         local $a;
1259         foreach $a (@{$n->{'words'}}) {
1260                 push(@rv, $a.$p);
1261                 }
1262         }
1263 return @rv;
1264 }
1265
1266 # allowed_auth_file(file)
1267 sub allowed_auth_file
1268 {
1269 local $_;
1270 return 1 if ($access{'dir'} eq '/');
1271 return 0 if ($_[0] =~ /\.\./);
1272 local $f = &server_root($_[0], &get_config());
1273 return 0 if (-l $f && !&allowed_auth_file(readlink($f)));
1274 local $l = length($access{'dir'});
1275 return length($f) >= $l && substr($f, 0, $l) eq $access{'dir'};
1276 }
1277
1278 # directory_exists(file)
1279 # Returns 1 if the directory in some path exists
1280 sub directory_exists
1281 {
1282 local $path = &server_root($_[0], &get_config());
1283 if ($path =~ /^(\S*\/)([^\/]+)$/) {
1284         return -d $1;
1285         }
1286 else {
1287         return 0;
1288         }
1289 }
1290
1291 # allowed_doc_dir(dir)
1292 # Returns 1 if some directory is under the allowed root for alias targets
1293 sub allowed_doc_dir
1294 {
1295 return $access{'aliasdir'} eq '/' ||
1296        $_[0] !~ /^\// ||        # Relative path, like for <Files>
1297        &is_under_directory($access{'aliasdir'}, $_[0]);
1298 }
1299
1300 sub lock_apache_files
1301 {
1302 local $conf = &get_config();
1303 local $f;
1304 foreach $f (&unique(map { $_->{'file'} } @$conf)) {
1305         &lock_file($f);
1306         }
1307 }
1308
1309 sub unlock_apache_files
1310 {
1311 local $conf = &get_config();
1312 local $f;
1313 foreach $f (&unique(map { $_->{'file'} } @$conf)) {
1314         &unlock_file($f);
1315         }
1316 }
1317
1318 # directive_lines(directive, ...)
1319 sub directive_lines
1320 {
1321 local @rv;
1322 foreach $d (@_) {
1323         next if ($d->{'name'} eq 'dummy');
1324         if ($d->{'type'}) {
1325                 push(@rv, "<$d->{'name'} $d->{'value'}>");
1326                 push(@rv, &directive_lines(@{$d->{'members'}}));
1327                 push(@rv, "</$d->{'name'}>");
1328                 }
1329         else {
1330                 push(@rv, "$d->{'name'} $d->{'value'}");
1331                 }
1332         }
1333 return @rv;
1334 }
1335
1336 # test_config()
1337 # If possible, test the current configuration and return an error message,
1338 # or undef.
1339 sub test_config
1340 {
1341 if ($httpd_modules{'core'} >= 1.301) {
1342         # Test the configuration with the available command
1343         local $cmd;
1344         if ($config{'test_apachectl'} &&
1345             -x &translate_filename($config{'apachectl_path'})) {
1346                 # Test with apachectl
1347                 $cmd = "\"$config{'apachectl_path'}\" configtest";
1348                 }
1349         else {
1350                 # Test with httpd
1351                 local $httpd = &find_httpd();
1352                 $cmd = "\"$httpd\" -d \"$config{'httpd_dir'}\" -t";
1353                 if ($config{'httpd_conf'}) {
1354                         $cmd .= " -f \"$config{'httpd_conf'}\"";
1355                         }
1356                 foreach $d (&get_httpd_defines()) {
1357                         $cmd .= " -D$d";
1358                         }
1359                 }
1360         local $out = &backquote_command("$cmd 2>&1");
1361         if ($out && $out !~ /syntax\s+ok/i) {
1362                 return $out;
1363                 }
1364         }
1365 return undef;
1366 }
1367
1368 # before_changing()
1369 # If testing all changes, backup the config files so they can be reverted
1370 # if necessary.
1371 sub before_changing
1372 {
1373 if ($config{'test_always'} || $access{'test_always'}) {
1374         local $conf = &get_config();
1375         local @files = &unique(map { $_->{'file'} } @$conf);
1376         local $/ = undef;
1377         local $f;
1378         foreach $f (@files) {
1379                 if (&open_readfile(BEFORE, $f)) {
1380                         $before_changing{$f} = <BEFORE>;
1381                         close(BEFORE);
1382                         }
1383                 }
1384         }
1385 }
1386
1387 # after_changing()
1388 # If testing all changes, test now and revert the configs and show an error
1389 # message if a problem was found.
1390 sub after_changing
1391 {
1392 if ($config{'test_always'} || $access{'test_always'}) {
1393         local $err = &test_config();
1394         if ($err) {
1395                 # Something failed .. revert all files
1396                 &rollback_apache_config();
1397                 &error(&text('eafter', "<pre>$err</pre>"));
1398                 }
1399         }
1400 }
1401
1402 # rollback_apache_config()
1403 # Copy back all config files from their originals
1404 sub rollback_apache_config
1405 {
1406 local $f;
1407 foreach $f (keys %before_changing) {
1408         &open_tempfile(AFTER, ">$f");
1409         &print_tempfile(AFTER, $before_changing{$f});
1410         &close_tempfile(AFTER);
1411         }
1412 }
1413
1414 # find_httpd_conf()
1415 # Returns the path to the http.conf file, and the last place looked
1416 # (without any translation).
1417 sub find_httpd_conf
1418 {
1419 local $conf = $config{'httpd_conf'};
1420 return ( -f &translate_filename($conf) ? $conf : undef, $conf ) if ($conf);
1421 $conf = "$config{'httpd_dir'}/conf/httpd.conf";
1422 $conf = "$config{'httpd_dir'}/conf/httpd2.conf"
1423         if (!-f &translate_filename($conf));
1424 $conf = "$config{'httpd_dir'}/etc/httpd.conf"
1425         if (!-f &translate_filename($conf));
1426 $conf = "$config{'httpd_dir'}/etc/httpd2.conf"
1427         if (!-f &translate_filename($conf));
1428 $conf = undef if (!-f &translate_filename($conf));
1429 return ( $conf, "$config{'httpd_dir'}/conf/httpd.conf" );
1430 }
1431
1432 # find_httpd()
1433 # Returns the path to the httpd executable, by appending '2' if necessary
1434 sub find_httpd
1435 {
1436 return $config{'httpd_path'}
1437         if (-x &translate_filename($config{'httpd_path'}) &&
1438             !-d &translate_filename($config{'httpd_path'}));
1439 return $config{'httpd_path'}.'2'
1440         if (-x &translate_filename($config{'httpd_path'}.'2') &&
1441             !-d &translate_filename($config{'httpd_path'}.'2'));
1442 return undef;
1443 }
1444
1445 # get_pid_file()
1446 # Returns the path to the PID file (without any translation)
1447 sub get_pid_file
1448 {
1449 return $config{'pid_file'} if ($config{'pid_file'});
1450 local $conf = &get_config();
1451 local $pidfilestr = &find_directive_struct("PidFile", $conf);
1452 local $pidfile = $pidfilestr ? $pidfilestr->{'words'}->[0]
1453                              : "logs/httpd.pid";
1454 return &server_root($pidfile, $conf);
1455 }
1456
1457 # restart_apache()
1458 # Re-starts Apache, and returns undef on success or an error message on failure
1459 sub restart_apache
1460 {
1461 local $pidfile = &get_pid_file();
1462 if ($config{'apply_cmd'} eq 'restart') {
1463         # Call stop and start functions
1464         local $err = &stop_apache();
1465         return $err if ($err);
1466         local $stopped = &wait_for_apache_stop();
1467         local $err = &start_apache();
1468         return $err if ($err);
1469         }
1470 elsif ($config{'apply_cmd'}) {
1471         # Use the configured start command
1472         &clean_environment();
1473         local $out = &backquote_logged("$config{'apply_cmd'} 2>&1");
1474         &reset_environment();
1475         &wait_for_graceful() if ($config{'apply_cmd'} =~ /graceful/);
1476         if ($?) {
1477                 return "<pre>".&html_escape($out)."</pre>";
1478                 }
1479         }
1480 elsif (-x &translate_filename($config{'apachectl_path'})) {
1481         # Use apachectl to restart
1482         if ($httpd_modules{'core'} >= 2) {
1483                 # Do a graceful restart
1484                 &clean_environment();
1485                 local $out = &backquote_logged(
1486                         "$config{'apachectl_path'} graceful 2>&1");
1487                 &reset_environment();
1488                 &wait_for_graceful();
1489                 if ($?) {
1490                         return "<pre>".&html_escape($out)."</pre>";
1491                         }
1492                 }
1493         else {
1494                 &clean_environment();
1495                 local $out = &backquote_logged(
1496                         "$config{'apachectl_path'} restart 2>&1");
1497                 &reset_environment();
1498                 if ($out !~ /httpd restarted/) {
1499                         return "<pre>".&html_escape($out)."</pre>";
1500                         }
1501                 }
1502         }
1503 else {
1504         # send SIGHUP directly
1505         &open_readfile(PID, $pidfile) || return &text('restart_epid', $pidfile);
1506         <PID> =~ /(\d+)/ || return &text('restart_epid2', $pidfile);
1507         close(PID);
1508         &kill_logged('HUP', $1) || return &text('restart_esig', $1);
1509         &wait_for_graceful();
1510         }
1511 return undef;
1512 }
1513
1514 # wait_for_graceful([timeout])
1515 # Wait for some time for Apache to complete a graceful restart
1516 sub wait_for_graceful
1517 {
1518 local $timeout = $_[0] || 10;
1519 local $errorlog = &get_error_log();
1520 return -1 if (!$errorlog || !-r $errorlog);
1521 local @st = stat($errorlog);
1522 my $start = time();
1523 while(time() - $start < $timeout) {
1524         sleep(1);
1525         open(ERRORLOG, $errorlog);
1526         seek(ERRORLOG, $st[7], 0);
1527         local $/ = undef;
1528         local $rest = <ERRORLOG>;
1529         close(ERRORLOG);
1530         if ($rest =~ /resuming\s+normal\s+operations/i) {
1531                 return 1;
1532                 }
1533         }
1534 return 0;
1535 }
1536
1537 # stop_apache()
1538 # Attempts to stop the running Apache process, and returns undef on success or
1539 # an error message on failure
1540 sub stop_apache
1541 {
1542 local $out;
1543 if ($config{'stop_cmd'}) {
1544         # use the configured stop command
1545         $out = &backquote_logged("($config{'stop_cmd'}) 2>&1");
1546         if ($?) {
1547                 return "<pre>".&html_escape($out)."</pre>";
1548                 }
1549         }
1550 elsif (-x $config{'apachectl_path'}) {
1551         # use the apachectl program
1552         $out = &backquote_logged("($config{'apachectl_path'} stop) 2>&1");
1553         if ($httpd_modules{'core'} >= 2 ? $? : $out !~ /httpd stopped/) {
1554                 return "<pre>".&html_escape($out)."</pre>";
1555                 }
1556         }
1557 else {
1558         # kill the process
1559         $pidfile = &get_pid_file();
1560         open(PID, $pidfile) || return &text('stop_epid', $pidfile);
1561         <PID> =~ /(\d+)/ || return &text('stop_epid2', $pidfile);
1562         close(PID);
1563         &kill_logged('TERM', $1) || return &text('stop_esig', $1);
1564         }
1565 return undef;
1566 }
1567
1568 # start_apache()
1569 # Attempts to start Apache, and returns undef on success or an error message
1570 # upon failure.
1571 sub start_apache
1572 {
1573 local ($out, $cmd);
1574 &clean_environment();
1575 if ($config{'start_cmd'}) {
1576         # use the configured start command
1577         if ($config{'stop_cmd'}) {
1578                 # execute the stop command to clear lock files
1579                 &system_logged("($config{'stop_cmd'}) >/dev/null 2>&1");
1580                 }
1581         $out = &backquote_logged("($config{'start_cmd'}) 2>&1");
1582         &reset_environment();
1583         if ($?) {
1584                 return "<pre>".&html_escape($out)."</pre>";
1585                 }
1586         }
1587 elsif (-x $config{'apachectl_path'}) {
1588         # use the apachectl program
1589         $cmd = "$config{'apachectl_path'} start";
1590         $out = &backquote_logged("($cmd) 2>&1");
1591         &reset_environment();
1592         }
1593 else {
1594         # start manually
1595         local $httpd = &find_httpd();
1596         $cmd = "$httpd -d $config{'httpd_dir'}";
1597         if ($config{'httpd_conf'}) {
1598                 $cmd .= " -f $config{'httpd_conf'}";
1599                 }
1600         foreach $d (&get_httpd_defines()) {
1601                 $cmd .= " -D$d";
1602                 }
1603         local $temp = &transname();
1604         local $rv = &system_logged("( $cmd ) >$temp 2>&1 </dev/null");
1605         $out = &read_file_contents($temp);
1606         unlink($temp);
1607         &reset_environment();
1608         }
1609
1610 # Check if Apache may have failed to start
1611 local $slept;
1612 if ($out =~ /\S/ && $out !~ /httpd\s+started/i) {
1613         sleep(3);
1614         if (!&is_apache_running()) {
1615                 return "<pre>".&html_escape($cmd)." :\n".
1616                                &html_escape($out)."</pre>";
1617                 }
1618         $slept = 1;
1619         }
1620
1621 # check if startup was successful. Later apache version return no
1622 # error code, but instead fail to start and write the reason to
1623 # the error log file!
1624 sleep(3) if (!$slept);
1625 local $conf = &get_config();
1626 if (!&is_apache_running()) {
1627         # Not running..  find out why
1628         local $errorlogstr = &find_directive_struct("ErrorLog", $conf);
1629         local $errorlog = $errorlogstr ? $errorlogstr->{'words'}->[0]
1630                                        : "logs/error_log";
1631         if ($out =~ /\S/) {
1632                 return "$text{'start_eafter'} : <pre>$out</pre>";
1633                 }
1634         elsif ($errorlog eq 'syslog' || $errorlog =~ /^\|/) {
1635                 return $text{'start_eunknown'};
1636                 }
1637         else {
1638                 $errorlog = &server_root($errorlog, $conf);
1639                 $out = `tail -5 $errorlog`;
1640                 return "$text{'start_eafter'} : <pre>$out</pre>";
1641                 }
1642         }
1643 return undef;
1644 }
1645
1646 # get_error_log()
1647 # Returns the path to the global error log, if possible
1648 sub get_error_log
1649 {
1650 local $conf = &get_config();
1651 local $errorlogstr = &find_directive_struct("ErrorLog", $conf);
1652 local $errorlog = $errorlogstr ? $errorlogstr->{'words'}->[0]
1653                                : "logs/error_log";
1654 $errorlog = &server_root($errorlog, $conf);
1655 return $errorlog;
1656 }
1657
1658 sub is_apache_running
1659 {
1660 if ($gconfig{'os_type'} eq 'windows') {
1661         # No such thing as a PID file on Windows
1662         local ($pid) = &find_byname("Apache.exe");
1663         return $pid;
1664         }
1665 else {
1666         # Check PID file
1667         local $pidfile = &get_pid_file();
1668         return &check_pid_file($pidfile);
1669         }
1670 }
1671
1672 # wait_for_apache_stop([secs])
1673 # Wait 30 (by default) seconds for Apache to stop. Returns 1 if OK, 0 if not
1674 sub wait_for_apache_stop
1675 {
1676 local $secs = $_[0] || 30;
1677 for(my $i=0; $i<$secs; $i++) {
1678         return 1 if (!&is_apache_running());
1679         sleep(1);
1680         }
1681 return 0;
1682 }
1683
1684 # configurable_modules()
1685 # Returns a list of Apaches that are compiled in or dynamically loaded, and
1686 # supported by Webmin.
1687 sub configurable_modules
1688 {
1689 local ($ver, $mods) = &httpd_info(&find_httpd());
1690 local @rv;
1691 local $m;
1692
1693 # add compiled-in modules
1694 foreach $m (@$mods) {
1695         if (-r "$module_root_directory/$m.pl") {
1696                 push(@rv, $m);
1697                 }
1698         }
1699
1700 # add dynamically loaded modules
1701 local $conf = &get_config();
1702 foreach $l (&find_directive_struct("LoadModule", $conf)) {
1703         if ($l->{'words'}->[1] =~ /(mod_\S+)\.(so|dll)/ &&
1704             -r "$module_root_directory/$1.pl") {
1705                 push(@rv, $1);
1706                 }
1707         elsif ($l->{'words'}->[1] =~ /libssl\.so/ &&
1708                -r "$module_root_directory/mod_apachessl.pl") {
1709                 push(@rv, "mod_apachessl");
1710                 }
1711         elsif ($l->{'words'}->[1] =~ /lib([^\/\s]+)\.(so|dll)/ &&
1712                -r "$module_root_directory/mod_$1.pl") {
1713                 push(@rv, "mod_$1");
1714                 }
1715         }
1716 undef(@get_config_cache);       # Cache is no longer valid
1717
1718 return &unique(@rv);
1719 }
1720
1721 # get_httpd_defines(automatic-only)
1722 # Returns a list of defines that need to be passed to Apache
1723 sub get_httpd_defines
1724 {
1725 local ($auto) = @_;
1726 if (@get_httpd_defines_cache) {
1727         return @get_httpd_defines_cache;
1728         }
1729 local @rv;
1730 if (!$auto) {
1731         push(@rv, keys %httpd_defines);
1732         }
1733 if ($config{'defines_file'}) {
1734         # Add defines from an environment file, which can be in
1735         # the format :
1736         # OPTIONS='-Dfoo -Dbar'
1737         # or regular name=value format
1738         local %def;
1739         &read_env_file($config{'defines_file'}, \%def);
1740         if ($config{'defines_name'}) {
1741                 # Looking for var like OPTIONS='-Dfoo -Dbar'
1742                 local $var = $def{$config{'defines_name'}};
1743                 foreach my $v (split(/\s+/, $var)) {
1744                         if ($v =~ /^-[Dd](\S+)$/) {
1745                                 push(@rv, $1);
1746                                 }
1747                         else {
1748                                 push(@rv, $v);
1749                                 }
1750                         }
1751                 }
1752         else {
1753                 # Looking for regular name=value directives.
1754                 # Remove $SUFFIX variable seen on debian that is computed
1755                 # dynamically, but is usually empty.
1756                 foreach my $k (keys %def) {
1757                         $def{$k} =~ s/\$SUFFIX//g;
1758                         push(@rv, $k."=".$def{$k});
1759                         }
1760                 }
1761         }
1762 foreach my $md (split(/\t+/, $config{'defines_mods'})) {
1763         # Add HAVE_ defines from modules
1764         opendir(DIR, $md);
1765         while(my $m = readdir(DIR)) {
1766                 if ($m =~ /^(mod_|lib)(.*).so$/i) {
1767                         push(@rv, "HAVE_".uc($2));
1768                         }
1769                 }
1770         closedir(DIR);
1771         }
1772 foreach my $d (split(/\s+/, $config{'defines'})) {
1773         push(@rv, $d);
1774         }
1775 @get_httpd_defines_cache = @rv;
1776 return @rv;
1777 }
1778
1779 # create_webfile_link(file)
1780 # Creates a link in the debian-style link directory for a new website's file
1781 sub create_webfile_link
1782 {
1783 local ($file) = @_;
1784 if ($config{'link_dir'}) {
1785         local $short = $file;
1786         $short =~ s/^.*\///;
1787         local $linksrc = "$config{'link_dir'}/$short";
1788         &lock_file($linksrc);
1789         symlink($file, $linksrc);
1790         &unlock_file($linksrc);
1791         }
1792 }
1793
1794 # delete_webfile_link(file)
1795 # If the given path is in a directory like /etc/apache2/sites-available, delete
1796 # the link to it from /etc/apache2/sites-enabled
1797 sub delete_webfile_link
1798 {
1799 local ($file) = @_;
1800 if ($config{'link_dir'}) {
1801         local $short = $file;
1802         $short =~ s/^.*\///;
1803         opendir(LINKDIR, $config{'link_dir'});
1804         foreach my $f (readdir(LINKDIR)) {
1805                 if ($f ne "." && $f ne ".." &&
1806                     (&resolve_links($config{'link_dir'}."/".$f) eq $file ||
1807                      $short eq $f)) {
1808                         &unlink_logged($config{'link_dir'}."/".$f);
1809                         }
1810                 }
1811         closedir(LINKDIR);
1812         }
1813 }
1814
1815 # can_configure_apache_modules()
1816 # Returns 1 if the distro has a way of selecting enabled Apache modules
1817 sub can_configure_apache_modules
1818 {
1819 if ($gconfig{'os_type'} eq 'debian-linux') {
1820         # Debian and Ubuntu use an /etc/apacheN/mods-enabled dir
1821         return -d "$config{'httpd_dir'}/mods-enabled" &&
1822                -d "$config{'httpd_dir'}/mods-available";
1823         }
1824 else {
1825         return 0;
1826         }
1827 }
1828
1829 # list_configured_apache_modules()
1830 # Returns a list of all Apache modules. Each is a hash containing a mod and
1831 # enabled, disabled and available flags.
1832 sub list_configured_apache_modules
1833 {
1834 if ($gconfig{'os_type'} eq 'debian-linux') {
1835         # Find enabled modules
1836         local @rv;
1837         local $edir = "$config{'httpd_dir'}/mods-enabled";
1838         opendir(EDIR, $edir);
1839         foreach my $f (readdir(EDIR)) {
1840                 if ($f =~ /^(\S+)\.load$/) {
1841                         push(@rv, { 'mod' => $1, 'enabled' => 1 });
1842                         }
1843                 }
1844         closedir(EDIR);
1845
1846         # Add available modules
1847         local $adir = "$config{'httpd_dir'}/mods-available";
1848         opendir(ADIR, $adir);
1849         foreach my $f (readdir(ADIR)) {
1850                 if ($f =~ /^(\S+)\.load$/) {
1851                         local ($got) = grep { $_->{'mod'} eq $1 } @rv;
1852                         if (!$got) {
1853                                 push(@rv, { 'mod' => $1, 'disabled' => 1 });
1854                                 }
1855                         }
1856                 }
1857         closedir(ADIR);
1858
1859         # XXX modules from apt-get
1860
1861         return sort { $a->{'mod'} cmp $b->{'mod'} } @rv;
1862         }
1863 else {
1864         # Not supported
1865         return ( );
1866         }
1867 }
1868
1869 # add_configured_apache_module(module)
1870 # Updates the Apache configuration to use some module. Returns undef on success,
1871 # or an error message on failure.
1872 sub add_configured_apache_module
1873 {
1874 local ($mod) = @_;
1875 if ($gconfig{'os_type'} eq 'debian-linux') {
1876         # XXX download from apt-get ?
1877
1878         # Enable with a2enmod if installed
1879         if (&has_command("a2enmod")) {
1880                 local $out = &backquote_logged(
1881                                 "a2enmod ".quotemeta($mod)." 2>&1");
1882                 return $? ? $out : undef;
1883                 }
1884         else {
1885                 # Fall back to creating links
1886                 local $adir = "$config{'httpd_dir'}/mods-available";
1887                 local $edir = "$config{'httpd_dir'}/mods-enabled";
1888                 opendir(ADIR, $adir);
1889                 foreach my $f (readdir(ADIR)) {
1890                         if ($f =~ /^\Q$mod->{'mod'}\E\./) {
1891                                 &symlink_logged("$adir/$f", "$edir/$f") ||
1892                                         return $!;
1893                                 }
1894                         }
1895                 closedir(ADIR);
1896                 return undef;
1897                 }
1898         }
1899 else {
1900         return "Operating system does not support Apache modules";
1901         }
1902 }
1903
1904 # remove_configured_apache_module(module)
1905 # Updates the Apache configuration to stop using some module. Returns undef
1906 # on success, or an error message on failure.
1907 sub remove_configured_apache_module
1908 {
1909 local ($mod) = @_;
1910 if ($gconfig{'os_type'} eq 'debian-linux') {
1911         # Disable with a2dismod if installed
1912         if (&has_command("a2dismod")) {
1913                 local $out = &backquote_logged(
1914                                 "a2dismod ".quotemeta($mod)." 2>&1");
1915                 return $? ? $out : undef;
1916                 }
1917         else {
1918                 # Fall back to removing links
1919                 local $edir = "$config{'httpd_dir'}/mods-enabled";
1920                 opendir(EDIR, $edir);
1921                 foreach my $f (readdir(EDIR)) {
1922                         if ($f =~ /^\Q$mod->{'mod'}\E\./) {
1923                                 &unlink_logged("$edir/$f");
1924                                 }
1925                         }
1926                 closedir(EDIR);
1927                 return undef;
1928                 }
1929         }
1930 else {
1931         return "Operating system does not support Apache modules";
1932         }
1933 }
1934
1935 1;
1936