apache/mod_setenvif.pl

   1 # mod_setenvif.pl
   2 # Defines editors for directives to set environment variables
   3
   4 sub mod_setenvif_directives
   5 {
   6 local($rv);
   7 $rv = [ [ 'BrowserMatch BrowserMatchNoCase', 1, 11, 'global', '-1.313' ],
   8         [ 'BrowserMatch BrowserMatchNoCase', 1, 11, 'virtual directory htaccess', 1.313 ],
   9         [ 'SetEnvIf SetEnvIfNoCase', 1, 11, 'global', '1.3-1.313' ],
  10         [ 'SetEnvIf SetEnvIfNoCase', 1, 11, 'virtual directory htaccess', 1.313 ] ];
  11 return &make_directives($rv, $_[0], "mod_setenvif");
  12 }
  13
  14 require 'browsermatch.pl';
  15
  16 sub edit_SetEnvIf_SetEnvIfNoCase
  17 {
  18 local($d, @w, $i, @head, @regex, @var, @val, @case, $rv);
  19 foreach $d (@{$_[0]}, @{$_[1]}) {
  20         @w = @{$d->{'words'}};
  21         for($i=2; $i<@w; $i++) {
  22                 push(@head, $w[0]);
  23                 push(@regex, $w[1]);
  24                 if ($w[$i] =~ /^\!(\S+)$/)
  25                         { push(@var, $1); push(@val, undef); }
  26                 elsif ($w[$i] =~ /^(\S+)=(\S*)$/)
  27                         { push(@var, $1); push(@val, $2); }
  28                 else { push(@var, $w[$i]); push(@val, 1); }
  29                 if ($d->{'name'} eq "SetEnvIf") { push(@case, 1); }
  30                 else { push(@case, 0); }
  31                 }
  32         }
  33 push(@head, ""); push(@regex, ""); push(@var, ""); push(@val, ""); push(@case, 0);
  34 $rv = "<table border>\n".
  35       "<tr $tb> <td><b>$text{'mod_setenvif_header'}</b></td> <td><b>$text{'mod_setenvif_match'}</b></td>\n".
  36       "<td><b>$text{'mod_setenvif_case'}</b></td> <td><b>$text{'mod_setenvif_var'}</b></td>\n".
  37       "<td><b>$text{'mod_setenvif_value'}</b></td> </tr>\n";
  38 for($i=0; $i<@head; $i++) {
  39         $rv .= "<tr $cb>\n";
  40         $rv .= sprintf
  41                 "<td><input size=15 name=SetEnvIf_head_$i value=\"%s\"></td>\n",
  42                 $head[$i];
  43         $rv .= sprintf
  44                 "<td><input size=10 name=SetEnvIf_regex_$i value=\"%s\"></td>\n",
  45                 $regex[$i];
  46         $rv .= "<td>".&choice_input($case[$i], "SetEnvIf_case_$i", 1,
  47                "$text{'yes'},1", "$text{'no'},0")."</td>\n";
  48         $rv .= sprintf
  49                 "<td><input size=20 name=SetEnvIf_var_$i value=\"%s\"></td>\n",
  50                 $var[$i];
  51         $rv .= "<td>".&opt_input($val[$i], "SetEnvIf_val_$i",
  52                "$text{'mod_setenvif_clear'}", 10)."</td>\n";
  53         $rv .= "</tr>\n";
  54         }
  55 $rv .= "</table>\n";
  56 return (2, "$text{'mod_setenvif_txt'}", $rv);
  57 }
  58 sub save_SetEnvIf_SetEnvIfNoCase
  59 {
  60 local($i, $head, $regex, $case, $var, $val,
  61       $set, $lastsi, $lastsnc, @si, @sinc);
  62 for($i=0; defined($head = $in{"SetEnvIf_head_$i"}); $i++) {
  63         $regex = $in{"SetEnvIf_regex_$i"}; $case = $in{"SetEnvIf_case_$i"};
  64         $var = $in{"SetEnvIf_var_$i"};
  65         $val = $in{"SetEnvIf_val_${i}_def"} ? undef : $in{"SetEnvIf_val_$i"};
  66         if ($head !~ /\S/ && $regex !~ /\S/ && $var !~ /\S/) { next; }
  67         $head =~ /^\S+$/ || &error(&text('mod_setenvif_eheader', $head));
  68         $regex =~ /^\S+$/ || &error(&text('mod_setenvif_eregex', $regex));
  69         $var =~ /^\S+$/ || &error(&text('mod_setenvif_evar', $var));
  70         $set = !defined($val) ? "!$var" : $val eq "1" ? $var : "$var=$val";
  71         if ($case) {
  72                 if ("$head $regex" eq $lastsi) { $si[$#si] .= " $set"; }
  73                 else { push(@si, "$head $regex $set"); }
  74                 $lastsi = "$head $regex";
  75                 }
  76         else {
  77                 if ("$head $regex" eq $lastsinc) { $sinc[$#sinc] .= " $set"; }
  78                 else { push(@sinc, "$head $regex $set"); }
  79                 $lastsinc = "$head $regex";
  80                 }
  81         }
  82 return ( \@si, \@sinc );
  83 }
  84
  85 1;
  86