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