1# Module of TWiki Enterprise Collaboration Platform, http://TWiki.org/ 2# 3# Copyright (C) 2000-2018 Peter Thoeny, peter[at]thoeny.org 4# and TWiki Contributors. All Rights Reserved. TWiki Contributors 5# are listed in the AUTHORS file in the root of this distribution. 6# NOTE: Please extend that file, not this notice. 7# 8# Additional copyrights apply to some or all of the code in this 9# file as follows: 10# 11# This program is free software; you can redistribute it and/or 12# modify it under the terms of the GNU General Public License 13# as published by the Free Software Foundation; either version 3 14# of the License, or (at your option) any later version. For 15# more details read LICENSE in the root of this distribution. 16# 17# This program is distributed in the hope that it will be useful, 18# but WITHOUT ANY WARRANTY; without even the implied warranty of 19# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 20# 21# As per the GPL, removal of this notice is prohibited. 22# 23# This is a both parser for configuration declaration files, such as 24# TWikiCfg.spec, and a serialisation visitor for writing out changes 25# to LocalSite.cfg 26# 27# The supported syntax in declaration files is as follows: 28# 29# cfg ::= ( setting | section | extension )* ; 30# setting ::= BOL typespec EOL comment* BOL def ; 31# typespec ::= "# **" id options "**" ; 32# def ::= "$" ["TWiki::"] "cfg" keys "=" value ";" ; 33# keys ::= ( "{" id "}" )+ ; 34# value is any perl value not including ";" 35# comment ::= BOL "#" string EOL ; 36# section ::= BOL "#--++" string EOL comment* ; 37# extension ::= BOL " *" id "*" 38# EOL ::= end of line 39# BOL ::= beginning of line 40# id ::= a \w+ word (legal Perl bareword) 41# 42# * A *section* is simply a divider used to create foldable blocks. It can 43# have varying depth depending on the number of + signs 44# * A *setting* is the sugar required for the setting of a single 45# configuration value. 46# * An *extension* is a pluggable UI extension that supports some extra UI 47# functionality, such as the menu of languages or the menu of plugins. 48# 49# Each *setting* has a *typespec* and a *def*. 50# 51# The typespec consists of a type id and some options. Types are loaded by 52# type id from the TWiki::Configure::Types hierachy - for example, type 53# BOOLEAN is defined by TWiki::Configure::Types::BOOLEAN. Each type is a 54# subclass of TWiki::Configure::Type - see that class for more details of 55# what is supported. 56# 57# A *def* is a specification of a field in the $TWiki::cfg hash, together with 58# a perl value for that hash. Each field can have an associated *Checker* 59# which is loaded from the TWiki::Configure::Checkers hierarchy. Checkers 60# are responsible for specific checks on the value of that variable. For 61# example, the checker for $TWiki::cfg{Banana}{Republic} will be expected 62# to be found in TWiki::Configure::Checkers::Banana::Republic. 63# Checkers are subclasses of TWiki::Configure::Checker. See that class for 64# more details. 65# 66# An *extension* is a placeholder for a pluggable UI module. 67# 68package TWiki::Configure::TWikiCfg; 69 70use strict; 71use Data::Dumper; 72 73use TWiki::Configure::Section; 74use TWiki::Configure::Value; 75use TWiki::Configure::Pluggable; 76use TWiki::Configure::Item; 77 78# Used in saving, when we need a callback. Otherwise the methods here are 79# all static. 80sub new { 81 my $class = shift; 82 83 return bless({}, $class); 84} 85 86# Load the configuration declarations. The core set is defined in 87# TWiki.spec, which must be found on the @INC path and is always loaded 88# first. Then find all settings for extensions in their .spec files. 89# 90# This *only* reads type specifications, it *does not* read values. 91# 92# SEE ALSO TWiki::Configure::Load::readDefaults 93sub load { 94 my ($root, $haveLSC) = @_; 95 96 my $file = TWiki::findFileOnPath('TWiki.spec'); 97 if ($file) { 98 _parse($file, $root, $haveLSC); 99 } 100 if ($haveLSC) { 101 my %read; 102 foreach my $dir (@INC) { 103 _loadSpecsFrom("$dir/TWiki/Plugins", $root, \%read); 104 _loadSpecsFrom("$dir/TWiki/Contrib", $root, \%read); 105 } 106 } 107} 108 109sub _loadSpecsFrom { 110 my ($dir, $root, $read) = @_; 111 112 return unless opendir(D, $dir); 113 foreach my $extension ( grep { !/^\./ } readdir D) { 114 next if $read->{$extension}; 115 $extension =~ /(.*)/; $extension = $1; # untaint 116 my $file = "$dir/$extension/Config.spec"; 117 next unless -e $file; 118 _parse($file, $root, 1); 119 $read->{$extension} = $file; 120 } 121 closedir(D); 122} 123 124########################################################################### 125## INPUT 126########################################################################### 127{ 128 # Inner class that represents section headings temporarily during the 129 # parse. They are expanded to section blocks at the end. 130 package SectionMarker; 131 132 use base 'TWiki::Configure::Item'; 133 134 sub new { 135 my ($class, $depth, $head) = @_; 136 my $this = bless({}, $class); 137 $this->{depth} = $depth + 1; 138 $this->{head} = $head; 139 return $this; 140 } 141 142 sub getValueObject { return undef; } 143} 144 145# Process the config array and add section objects 146sub _extractSections { 147 my ($settings, $root) = @_; 148 149 my $section = $root; 150 my $depth = 0; 151 152 foreach my $item (@$settings) { 153 if ($item->isa('SectionMarker')) { 154 my $ns = $root->getSectionObject($item->{head}, $item->{depth}+1); 155 if ($ns) { 156 $depth = $item->{depth}; 157 } else { 158 while ($depth > $item->{depth} - 1) { 159 $section = $section->{parent}; 160 $depth--; 161 } 162 while ($depth < $item->{depth} - 1) { 163 my $ns = new TWiki::Configure::Section(''); 164 $section->addChild($ns); 165 $section = $ns; 166 $depth++; 167 } 168 $ns = new TWiki::Configure::Section($item->{head}); 169 $ns->{desc} = $item->{desc}; 170 $section->addChild($ns); 171 $depth++; 172 } 173 $section = $ns; 174 } elsif ($item->isa('TWiki::Configure::Value')) { 175 # Skip it if we already have a settings object for these 176 # keys (first loaded always takes precedence, irrespective 177 # of which section it is in) 178 my $vo = $root->getValueObject($item->getKeys()); 179 next if ($vo); 180 $section->addChild($item); 181 } else { 182 $section->addChild($item); 183 } 184 } 185} 186 187# See if we have already build a value object for these keys 188sub _getValueObject { 189 my ($keys, $settings) = @_; 190 foreach my $item (@$settings) { 191 my $i = $item->getValueObject($keys); 192 return $i if $i; 193 } 194 return undef; 195} 196 197# Parse the config declaration file and return a root node for the 198# configuration it describes 199sub _parse { 200 my ($file, $root, $haveLSC) = @_; 201 202 open(F, "<$file") || return ''; 203 local $/ = "\n"; 204 my $open = undef; 205 my @settings; 206 my $sectionNum = 0; 207 208 foreach my $l (<F>) { 209 if( $l =~ /^#\s*\*\*\s*([A-Z]+)\s*(.*?)\s*\*\*\s*$/ ) { 210 pusht(\@settings, $open) if $open; 211 $open = new TWiki::Configure::Value(typename=>$1, opts=>$2); 212 } 213 214 elsif ($l =~ /^#?\s*\$(TWiki::)?cfg([^=\s]*)\s*=(.*)$/) { 215 my $keys = $2; 216 my $tentativeVal = $3; 217 if ($open && $open->isa('SectionMarker')) { 218 pusht(\@settings, $open); 219 $open = undef; 220 } 221 # If there is already a UI object for 222 # these keys, we don't need to add another. But if there 223 # isn't, we do. 224 if (!$open) { 225 next if $root->getValueObject($keys); 226 next if (_getValueObject($keys, \@settings)); 227 # This is an untyped value 228 $open = new TWiki::Configure::Value(); 229 } 230 $open->set(keys => $keys); 231 pusht(\@settings, $open); 232 $open = undef; 233 } 234 235 elsif( $l =~ /^#\s*\*([A-Z]+)\*/ ) { 236 my $pluggable = $1; 237 my $p = TWiki::Configure::Pluggable::load($pluggable); 238 if ($p) { 239 pusht(\@settings, $open) if $open; 240 $open = $p; 241 } elsif ($open) { 242 $l =~ s/^#\s?//; 243 $open->addToDesc($l); 244 } 245 } 246 247 elsif( $l =~ /^#\s*---\+(\+*) *(.*?)$/ ) { 248 # Only load the first section if we don't have LocalSite.cfg 249 last if ($sectionNum && !$haveLSC); 250 $sectionNum++; 251 pusht(\@settings, $open) if $open; 252 $open = new SectionMarker(length($1), $2); 253 } 254 255 elsif( $l =~ /^#\s?(.*)$/ ) { 256 $open->addToDesc($1) if $open; 257 } 258 } 259 close(F); 260 pusht(\@settings, $open) if $open; 261 _extractSections(\@settings, $root); 262} 263 264sub pusht { 265 my ($a, $n) = @_; 266 foreach my $v (@$a) { 267 Carp::confess "$n" if $v eq $n; 268 } 269 push(@$a,$n); 270} 271 272########################################################################### 273## OUTPUT 274########################################################################### 275 276# Generate .cfg file format output 277sub save { 278 my ($root, $valuer, $logger) = @_; 279 280 # Object used to act as a visitor to hold the output 281 my $this = new TWiki::Configure::TWikiCfg(); 282 $this->{logger} = $logger; 283 $this->{valuer} = $valuer; 284 $this->{root} = $root; 285 $this->{content} = ''; 286 287 my $lsc = TWiki::findFileOnPath('LocalSite.cfg'); 288 unless ($lsc) { 289 # If not found on the path, park it beside TWiki.spec 290 $lsc = TWiki::findFileOnPath('TWiki.spec') || ''; 291 $lsc =~ s/TWiki\.spec/LocalSite.cfg/; 292 } 293 294 if (open(F, '<'.$lsc)) { 295 local $/ = undef; 296 $this->{content} = <F>; 297 close(F); 298 } else { 299 $this->{content} = <<'HERE'; 300# Local site settings for TWiki. This file is managed by the 'configure' 301# CGI script, though you can also make (careful!) manual changes with a 302# text editor. 303HERE 304 } 305 306 my $out = $this->_save(); 307 open(F, '>'.$lsc) || 308 die "Could not open $lsc for write: $!"; 309 print F $this->{content}; 310 close(F); 311 312 return ''; 313} 314 315sub _save { 316 my $this = shift; 317 318 $this->{content} =~ s/\s*1;\s*$/\n/sg; 319 $this->{root}->visit($this); 320 $this->{content} .= "1;\n"; 321} 322 323# Visitor method called by node traversal during save. Incrementally modify 324# values, unless a value is reverting to the default in which case remove it. 325sub startVisit { 326 my ($this, $visitee) = @_; 327 328 if ($visitee->isa('TWiki::Configure::Value')) { 329 my $keys = $visitee->getKeys(); 330 my $warble = $this->{valuer}->currentValue($visitee); 331 return 1 unless defined $warble; 332 # For some reason Data::Dumper ignores the second parameter sometimes 333 # when -T is enabled, so have to do a substitution 334 my $txt = Data::Dumper->Dump([$warble]); 335 $txt =~ s/VAR1/TWiki::cfg$keys/; 336 # Substitute any existing value, or append if not there 337 unless ($this->{content} =~ s/\$(TWiki::)?cfg\Q$keys\E\s*=.*?;\n/$txt/s) { 338 $this->{content} .= $txt; 339 } 340 if( $visitee->{typename} && $visitee->{typename} eq 'PASSWORD' ) { 341 $txt = ('*' x 15) . "\n"; 342 } 343 if ($this->{logger}) { 344 $this->{logger}->logChange($visitee->getKeys(), $txt); 345 } 346 } 347 return 1; 348} 349 350sub endVisit { 351 my ($this, $visitee) = @_; 352 353 return 1; 354} 355 3561; 357