squid/parser-lib.pl

   1 # parser-lib.pl
   2 # Functions for reading and writing the squid config file
   3
   4 # get_config()
   5 # Parses squid.conf into an array of data structures
   6 sub get_config
   7 {
   8 local($lnum, $_);
   9 if (!@get_config_cache) {
  10         open(CONF, $config{'squid_conf'});
  11         $lnum = 0;
  12         while(<CONF>) {
  13                 s/\r|\n//g;     # strip newlines and comments
  14                 if (/^\s*(\#?\s*|\#\s+TAG:\s+)(\S+)\s*(.*)$/) {
  15                         local(%dir);
  16                         $dir{'name'} = $2;
  17                         $dir{'value'} = $3;
  18                         $dir{'enabled'} = !$1;
  19                         $dir{'comment'} = $1;
  20                         local $str = $3;
  21                         while($str =~ /^\s*("[^"]*")(.*)$/ ||
  22                               $str =~ /^\s*(\S+)(.*)$/) {
  23                                 local $v = $1;
  24                                 $str = $2;
  25                                 if ($v !~ /^"/ && $v =~ /^(.*)#/ &&
  26                                     !$dir{'comment'}) {
  27                                         # A comment .. end of values
  28                                         $v = $1;
  29                                         $dir{'postcomment'} = $str;
  30                                         $str = undef;
  31                                         last if ($v eq '');
  32                                         }
  33                                 push(@{$dir{'values'}}, $v);
  34                                 }
  35                         $dir{'line'} = $lnum;
  36                         $dir{'index'} = scalar(@get_config_cache);
  37                         if ($dir{'comment'} =~ /TAG/) {
  38                                 $dir{'tag'} = 1;
  39                                 }
  40                         push(@get_config_cache, \%dir);
  41                         }
  42                 $lnum++;
  43                 }
  44         close(CONF);
  45         }
  46 return \@get_config_cache;
  47 }
  48
  49 # find_config(name, &config, [disabled-mode])
  50 # Returns the structure(s) with some name
  51 # disabled mode 0 = only enabled, 1 = both, 2 = only disabled,
  52 # 3 = disabled and tags
  53 sub find_config
  54 {
  55 local($c, @rv);
  56 foreach $c (@{$_[1]}) {
  57         if ($c->{'name'} eq $_[0]) {
  58                 push(@rv, $c);
  59                 }
  60         }
  61 if ($_[2] == 0) {
  62         @rv = grep { $_->{'enabled'} && !$_->{'tag'} } @rv;
  63         }
  64 elsif ($_[2] == 1) {
  65         @rv = grep { !$_->{'tag'} } @rv;
  66         }
  67 elsif ($_[2] == 2) {
  68         @rv = grep { !$_->{'enabled'} && !$_->{'tag'} } @rv;
  69         }
  70 elsif ($_[2] == 3) {
  71         @rv = grep { !$_->{'enabled'} } @rv;
  72         }
  73 return @rv ? wantarray ? @rv : $rv[0]
  74            : wantarray ? () : undef;
  75 }
  76
  77 # find_value(name, &config, [disabled-mode])
  78 # Returns the value of some directive
  79 sub find_value
  80 {
  81 local $rv = &find_config(@_);
  82 return $rv ? $rv->{'value'} : undef;
  83 }
  84
  85 # find_values(name, &config, [disabled-mode])
  86 # Returns the value of some directive
  87 sub find_values
  88 {
  89 local $rv = &find_config(@_);
  90 return $rv ? $rv->{'values'} : undef;
  91 }
  92
  93 # save_value(&config, name, value*)
  94 sub save_value
  95 {
  96 local @v = map { { 'name' => $_[1],
  97                    'values' => [ $_ ] } } @_[2..@_-1];
  98 &save_directive($_[0], $_[1], \@v);
  99 }
 100
 101 # save_directive(&config, name, &values, [after])
 102 # Given a structure containing a directive name, type, values and members
 103 # add, update or remove that directive in config structure and data files.
 104 sub save_directive
 105 {
 106 local(@oldv, @newv, $i, $o, $n, $lref, $nl, $change);
 107 @oldv = &find_config($_[1], $_[0]);
 108 @newv = map { local %n = %$_; \%n } @{$_[2]};
 109 $lref = &read_file_lines($config{'squid_conf'});
 110 for($i=0; $i<@oldv || $i<@newv; $i++) {
 111         if ($i >= @oldv) {
 112                 # a new directive is being added..
 113                 $nl = &directive_line($newv[$i]);
 114                 local @after = ref($_[3]) ? ( $_[3] ) :
 115                                $_[3] ? &find_config($_[3], $_[0]) : ( );
 116                 local $after = @after ? @after[$#after] : undef;
 117                 local @comment = &find_config($_[1], $_[0], 3);
 118                 local $comment = @comment ? $comment[$#comment] : undef;
 119                 if ($change &&
 120                     (!$after || $after->{'line'} < $change->{'line'})) {
 121                         # put it after any directives of the same type
 122                         $newv[$i]->{'line'} = $change->{'line'}+1;
 123                         splice(@$lref, $newv[$i]->{'line'}, 0, $nl);
 124                         &renumber($_[0], $change->{'line'}, 1);
 125                         splice(@{$_[0]}, &indexof($change, @{$_[0]}),
 126                                0, $newv[$i]);
 127                         $change = $newv[$i];
 128                         }
 129                 elsif ($comment) {
 130                         # put it after commented line
 131                         $newv[$i]->{'line'} = $comment->{'line'}+1;
 132                         splice(@$lref, $newv[$i]->{'line'}, 0, $nl);
 133                         &renumber($_[0], $comment->{'line'}, 1);
 134                         splice(@{$_[0]}, &indexof($comment, @{$_[0]}),
 135                                0, $newv[$i]);
 136                         }
 137                 else {
 138                         # put it at the end of the file
 139                         $newv[$i]->{'line'} = scalar(@$lref);
 140                         push(@$lref, $nl);
 141                         push(@{$_[0]}, $newv[$i]);
 142                         }
 143                 }
 144         elsif ($i >= @newv) {
 145                 # a directive was deleted
 146                 splice(@$lref, $oldv[$i]->{'line'}, 1);
 147                 &renumber($_[0], $oldv[$i]->{'line'}, -1);
 148                 splice(@{$_[0]}, &indexof($oldv[$i], @{$_[0]}), 1);
 149                 }
 150         else {
 151                 # updating some directive
 152                 $newv[$i]->{'postcomment'} = $oldv[$i]->{'postcomment'};
 153                 $nl = &directive_line($newv[$i]);
 154                 local @after = $change && $_[3] ? ( $change ) :
 155                                                         # After last one updated
 156                                ref($_[3]) ? ( $_[3] ) : # After specific
 157                                $_[3] ? &find_config($_[3], $_[0]) : ( );
 158                 local $after = @after ? @after[$#after] : undef;
 159                 if ($after && $oldv[$i]->{'line'} < $after->{'line'}) {
 160                         # Need to move it after some directive
 161                         splice(@$lref, $oldv[$i]->{'line'}, 1);
 162                         splice(@{$_[0]}, &indexof($oldv[$i], @{$_[0]}), 1);
 163                         &renumber($_[0], $oldv[$i]->{'line'}, -1);
 164
 165                         splice(@$lref, $after->{'line'}+1, 0, $nl);
 166                         $newv[$i]->{'line'} = $after->{'line'}+1;
 167                         splice(@{$_[0]}, &indexof($after, @{$_[0]})+1, 0,
 168                                $newv[$i]);
 169                         &renumber($_[0], $newv[$i]->{'line'}, 1);
 170                         $change = $newv[$i];
 171                         }
 172                 else {
 173                         # Can just update at the same line
 174                         splice(@$lref, $oldv[$i]->{'line'}, 1, $nl);
 175                         $newv[$i]->{'line'} = $oldv[$i]->{'line'};
 176                         $_[0]->[&indexof($oldv[$i], @{$_[0]})] = $newv[$i];
 177                         $change = $newv[$i];
 178                         }
 179                 }
 180         }
 181 }
 182
 183 # directive_line(&details)
 184 sub directive_line
 185 {
 186 local @v = @{$_[0]->{'values'}};
 187 return $_[0]->{'name'}.(@v ? " ".join(' ',@v) : "").
 188        ($_[0]->{'postcomment'} ? " #".$_[0]->{'postcomment'} : "");
 189 }
 190
 191 # renumber(&directives, line, count, [end])
 192 # Runs through the given array of directives and increases the line numbers
 193 # of all those greater than some line by the given count
 194 sub renumber
 195 {
 196 local($d);
 197 foreach $d (@{$_[0]}) {
 198         if ($d->{'line'} > $_[1] && (!$_[3] || $d->{'line'} < $_[3])) {
 199                 $d->{'line'} += $_[2];
 200                 }
 201         }
 202 }
 203
 204 1;
 205