From 8090ee69cac319409670fa4644094f1bbcadf229 Mon Sep 17 00:00:00 2001 From: CrawfordCurrie Date: Wed, 29 May 2013 18:07:07 +0000 Subject: [PATCH] Item12515: RPC interface to 'configure' - first step in a new, simpler, client-based UI git-svn-id: http://svn.foswiki.org/trunk/ConfigurePlugin@16760 0b4bb1d4-4e5a-0410-9cc4-b2b747904278 --- TIDY | 0 data/Sandbox/PluginTestConfigurePlugin.txt | 7 + data/System/ConfigurePlugin.txt | 100 +++ lib/Foswiki/Plugins/ConfigurePlugin.pm | 371 +++++++++++ .../Plugins/ConfigurePlugin/Config.spec | 2 + .../Plugins/ConfigurePlugin/DEPENDENCIES | 2 + lib/Foswiki/Plugins/ConfigurePlugin/MANIFEST | 6 + .../Plugins/ConfigurePlugin/SpecEntry.pm | 593 ++++++++++++++++++ lib/Foswiki/Plugins/ConfigurePlugin/build.pl | 76 +++ .../ConfigurePlugin/ConfigurePluginSuite.pm | 34 + .../ConfigurePlugin/ConfigurePluginTests.pm | 221 +++++++ 11 files changed, 1412 insertions(+) create mode 100644 TIDY create mode 100644 data/Sandbox/PluginTestConfigurePlugin.txt create mode 100644 data/System/ConfigurePlugin.txt create mode 100644 lib/Foswiki/Plugins/ConfigurePlugin.pm create mode 100644 lib/Foswiki/Plugins/ConfigurePlugin/Config.spec create mode 100644 lib/Foswiki/Plugins/ConfigurePlugin/DEPENDENCIES create mode 100644 lib/Foswiki/Plugins/ConfigurePlugin/MANIFEST create mode 100644 lib/Foswiki/Plugins/ConfigurePlugin/SpecEntry.pm create mode 100644 lib/Foswiki/Plugins/ConfigurePlugin/build.pl create mode 100644 test/unit/ConfigurePlugin/ConfigurePluginSuite.pm create mode 100644 test/unit/ConfigurePlugin/ConfigurePluginTests.pm diff --git a/TIDY b/TIDY new file mode 100644 index 0000000..e69de29 diff --git a/data/Sandbox/PluginTestConfigurePlugin.txt b/data/Sandbox/PluginTestConfigurePlugin.txt new file mode 100644 index 0000000..7e8115d --- /dev/null +++ b/data/Sandbox/PluginTestConfigurePlugin.txt @@ -0,0 +1,7 @@ +%META:TOPICINFO{author="ProjectContributor" date="1297286796" format="1.1" version="1"}% +%META:TOPICPARENT{name="ConfigurePlugin"}% +---+!! Testing !ConfigurePlugin + +SOME EXAMPLES OF THE PLUGIN + +__Related:__ %SYSTEMWEB%.ConfigurePlugin diff --git a/data/System/ConfigurePlugin.txt b/data/System/ConfigurePlugin.txt new file mode 100644 index 0000000..d9e7fb4 --- /dev/null +++ b/data/System/ConfigurePlugin.txt @@ -0,0 +1,100 @@ +%META:TOPICPARENT{name="Plugins"}% + +---+!! Empty Plugin + +%SHORTDESCRIPTION% + +RPC interface to Foswiki configuration data. This plugin provides +access to all Foswiki configuration data, supports running +server-side checkers, and allows you to save modifications. + +Callers must authenticate as admins, or the request will be rejected with +a 403 status. + +Note that this interface does not do everything that =configure= does. +The intent is to provide an interface to support those who want to +build their own configuration interface in Javascript. Most relevant is +that this interface will *fail* unless Foswiki has been minimally +configured (LocalSite.cfg exists). + +---++ Remote Procedure Call (RPC) interface +RPC calls are handled via either of the =JsonRpcContrib= or the =XmlRPCContrib=. +The following procedures are supported: + * =getspec= - Retrieve the first .spec entry that exactly matches the + parameters passed in. For example, =title=Store= will retrieve the + entire spec subtree for the section called 'Store'. + =keys:"{Store}{Implementation}"= will retrieve the spec for that one entry. the structure passed here is a search; it is a template for the single .spec entry for which the spec is required. You cannot pass a list; if you require the spec for a subsection, retrieve the section title. + See below for information on how specs are represented. + * =getcfg= - Retrieve the current setting value of one or more keys. + The =keys= parameter can be used to pass in a list of key names + (e.g. =keys:["{Store}{Implementation}","{DataDir}"]= ) + to get values for. If there isn't at least one =key= parameter, + returns the entire configuration hash. All keys must be found, or + an error will be thrown. Results are returned in a has mapping + key name to current value. + * =check= - Runs the server-side checkers on the data passed in the + =config= parameter, which must be a configuration hash. For example, + the ={Mail}{Server}= entry would be checked by passing in the JSON + ={"Mail":{"Server":"newvalue"}}=. You can pass as many configuration + items as you want. The results of the check are reported in an array + where each entry is a hash with fields =keys=, =level= (e.g. =warnings, =errors=) and =message=. + * =changecfg= - Lets you change configuration values and clear them. Changes will be saved. + *Does not check the configuration*. Takes two parameters: + * =clear= - array of keys to clear from the configuration. Keys will be cleared even if they have a .spec entry. + * =set= - hash mapping key names to new values. Clears are done *before* sets. + Result is a string reporting the outcome. + +---++ Invocation examples + +---+++ json-rpc +Call using a URL of the format: + +=%SCRIPTURL{"jsonrpc"}%/configure= + +while POSTing a request encoded according to the JSON-RPC 2.0 specification: + + +{ + jsonrpc: "2.0", + method: "getspec", + params: { + keys: [ "{DataDir}", "{Store}{Implementation}" ] + }, + id: "caller's id" +} + + +---+++ xml-rpc + +---++ .spec format +All .spec entries have a =type= (which is =SECTION= for sections). They also may +have =description= and =children=. + +SECTIONs have: + * =title= + +Configuration entries (such as ={DataDir}=) have: + * =keys= + * =options= + * =optional= + * =defined= + +---++ Installation +%$INSTALL_INSTRUCTIONS% +The plugin uses two other extensions, the =JsonRpcContrib= and the =XmlRpcContrib=, to provide support for these two different calling methods. Install the extension appropriate to the calling method you intend to use. + +---++ Info + +| Author: | CrawfordCurrie | +| Copyright: | 2013, CrawfordCurrie http://c-dot.co.uk, All Rights Reserved | +| License: | GPL ([[http://www.gnu.org/copyleft/gpl.html][GNU General Public License]]) | +| Dependencies: | %$DEPENDENCIES% | +| Version: | %$VERSION% | +| Release: | %$RELEASE% | +| Change History: |   | +| 1.0.0 (29 May 2013): | Initial version | +| Home: | http://foswiki.org/Extensions/%TOPIC% | +| Support: | http://foswiki.org/Support/%TOPIC% | diff --git a/lib/Foswiki/Plugins/ConfigurePlugin.pm b/lib/Foswiki/Plugins/ConfigurePlugin.pm new file mode 100644 index 0000000..f3ba553 --- /dev/null +++ b/lib/Foswiki/Plugins/ConfigurePlugin.pm @@ -0,0 +1,371 @@ +# See bottom of file for default license and copyright information + +=begin TML + +---+ package Foswiki::Plugins::ConfigurePlugin + +TODO: + +Implement check +Implement save + +=cut + +package Foswiki::Plugins::ConfigurePlugin; + +use strict; +use warnings; +use version; our $VERSION = version->declare("v1.0.0_001"); +use Assert; + +use Foswiki::Plugins::ConfigurePlugin::SpecEntry (); + +our $RELEASE = '29 May 2013'; +our $SHORTDESCRIPTION = '=configure= done using json-rpc or xml-rpc calls'; + +our $NO_PREFS_IN_TOPIC = 1; + +sub initPlugin { + my ( $topic, $web, $user, $installWeb ) = @_; + my $ok = 0; + if ( eval 'require Foswiki::Contrib::JsonRpcContrib' ) { + foreach my $method (qw(getcfg getspec check changecfg deletecfg)) { + Foswiki::Contrib::JsonRpcContrib::registerMethod( 'configure', + $method, JSONwrap($method) ); + } + $ok = 1; + } + else { die $@ } + if ( eval 'require Foswiki::Contrib::XmlRpcContrib' ) { + foreach my $method (qw(getcfg getspec check changecfg deletecfg)) { + Foswiki::Contrib::XmlRpcContrib::registerRPCHandler( $method, + \&$method ); + } + $ok = 1; + } + + return $ok; +} + +sub JSONwrap { + my $method = shift; + return sub { + my ( $session, $request ) = @_; + no strict 'refs'; + return &$method( $session, $request->{data}->{params} ); + use strict 'refs'; + } +} + +sub configure { + my ( $session, $params ) = @_; + my ( $status, $data ) = ( 0, '' ); + + if ( Foswiki::Func::isAnAdmin() ) { + my $verb = $params->{verb}; + if ( defined $verb && defined &$verb ) { + ( $status, $data ) = &$verb( $params->{params} ); + } + else { + $verb = 'UNDEFINED' unless defined $verb; + ( $status, $data ) = ( 400, "Bad verb '$verb'" ); + } + } + else { + ( $status, $data ) = ( 403, "We wants our rights, precious!" ); + } + + return ( $status, $status >= 400 ? $data : undef, $data ); +} + +# Look for the value of one or more keys. +# params: 'keys' - list of key names to recover values for +# If there isn't at least one 'key' parameter, returns the +# entire configuration hash. +sub getcfg { + my ( $session, $params ) = @_; + + # Reload Foswiki::cfg without expansions + $Foswiki::cfg{ConfigurationFinished} = 0; + Foswiki::Configure::Load::readConfig( 1, 1 ); + + my $keys = $params->{keys}; # expect a list + my $what; + if ( defined $keys ) { + $what = {}; + foreach my $key (@$keys) { + if ( $key !~ +/^($Foswiki::Plugins::ConfigurePlugin::SpecEntry::configItemRegex)$/ + ) + { + return ( 400, "Bad key '$key'" ); + } + else { + $key = $1; # Implicit untaint + } + my $val = eval "exists \$Foswiki::cfg$key"; + if ( !$val ) { + return ( 404, "$key not defined" ); + } + eval "\$what->$key=\$Foswiki::cfg$key"; + if ($@) { + return ( 500, $@ ); + } + } + } + else { + $what = \%Foswiki::cfg; + } + return ( 200, undef, $what ); +} + +# use a search to find a configuration item spec +sub getspec { + my ( $session, $params ) = @_; + my $search; + + while ( my ( $k, $e ) = each %$params ) { + if ( $k =~ /^(.*)$/ ) { + $search ||= {}; + $search->{$k} = $e; + } + } + my $root = Foswiki::Plugins::ConfigurePlugin::SpecEntry::loadSpecFiles(); + my $what; + if ($search) { + $what = $root->findSpecEntry(%$search); + if ( !$what ) { + require Data::Dumper; + return ( 404, Data::Dumper->Dump( [$search], ["Not_found"] ) ); + } + } + else { + $what = $root; + } + return ( 200, undef, $what ); +} + +sub check { + my ( $session, $params ) = @_; + unless ( scalar keys %$params ) { + $params = \%Foswiki::cfg; # debug; force full check of old config + } + + # Load the spec files so we can find the type checker + my $root = Foswiki::Plugins::ConfigurePlugin::SpecEntry::loadSpecFiles(); + + # Set the new values, based on finding points where there is a + # spec entry with keys. + $root->set($params); + + # now check them + my @report = $root->check($params); + return ( 200, \@report ); +} + +sub changecfg { + my ( $session, $params ) = @_; + my $changes = $params->{set}; # expect a hash + my $deletions = $params->{clear}; # expect an array of keys + my $added = 0; + my $changed = 0; + my $cleared = 0; + + # Reload Foswiki::cfg without expansions + $Foswiki::cfg{ConfigurationFinished} = 0; + Foswiki::Configure::Load::readConfig( 1, 1 ); + + if ( defined $deletions ) { + foreach my $key (@$deletions) { + if ( $key !~ +/^($Foswiki::Plugins::ConfigurePlugin::SpecEntry::configItemRegex)$/ + ) + { + + # Abort + return ( 400, "Bad key '$key'" ); + } + else { + $key = + Foswiki::Plugins::ConfigurePlugin::SpecEntry::safeKeys($1) + ; # Implicit untaint + } + $cleared += eval "exists \$Foswiki::cfg$key" ? 1 : 0; + eval "delete \$Foswiki::cfg$key"; + } + } + if ( defined $changes ) { + while ( my ( $key, $value ) = each %$changes ) { + if ( $key !~ +/^($Foswiki::Plugins::ConfigurePlugin::SpecEntry::configItemRegex)$/ + ) + { + + # Abort + return ( 400, "Bad key '$key'" ); + } + else { + $key = + Foswiki::Plugins::ConfigurePlugin::SpecEntry::safeKeys($1) + ; # Implicit untaint + } + if ( eval "exists \$Foswiki::cfg$key" ) { + my $oval = eval "\$Foswiki::cfg$key"; + if ( ref($oval) || $oval =~ /^[0-9]+$/ ) { + $changed++ if $oval != $value; + } + else { + $changed++ if $oval ne $value; + } + } + else { + $added++; + } + eval "\$Foswiki::cfg$key=\$value"; + } + } + if ( $changed || $added || $cleared ) { + _save(); + } + + $Foswiki::cfg{ConfigurationFinished} = 0; + Foswiki::Configure::Load::readConfig( 0, 1 ); + + return ( 200, undef, + "Added: $added; Changed: $changed; Cleared: $cleared" ); +} + +sub _save { + my $lsc = Foswiki::Plugins::ConfigurePlugin::SpecEntry::findFileOnPath( + 'Foswiki.spec') + || ''; + $lsc =~ s/Foswiki\.spec/LocalSite.cfg/; + + my $content; + my ( @backups, $backup ); + while ( -f $lsc ) { + + if ( open( F, '<', $lsc ) ) { + local $/ = undef; + $content = ; + close(F); + } + else { + last if ( $!{ENOENT} ); # Race: file disappeared + die "Unable to read $lsc: $!\n"; # Serious error + } + + $Foswiki::cfg{MaxLSCBackups} ||= 0; + + last unless ( $Foswiki::cfg{MaxLSCBackups} ); + + # Save backup copy of current configuration (even if insane) + + require Errno; + require Fcntl; + Fcntl->import(qw/:DEFAULT/); + require File::Spec; + + my ( $mode, $uid, $gid, $atime, $mtime ) = ( stat(_) )[ 2, 4, 5, 8, 9 ]; + + # Find a reasonable starting point for the new backup's name + + my $n = 0; + my ( $vol, $dir, $file ) = File::Spec->splitpath($lsc); + $dir = File::Spec->catpath( $vol, $dir, 'x' ); + chop $dir; + if ( opendir( my $d, $dir ) ) { + @backups = + sort { $b <=> $a } + map { /^$file\.(\d+)$/ ? ($1) : () } readdir($d); + my $last = $backups[0]; + $n = $last if ( defined $last ); + $n++; + closedir($d); + } + else { + $n = 1; + unshift @backups, $n++ while ( -e "$lsc.$n" ); + } + + # Find the actual filename and open for write + + my $open; + my $um = umask(0); + unshift @backups, $n++ + while ( + !( + $open = sysopen( F, "$lsc.$n", + O_WRONLY() | O_CREAT() | O_EXCL(), $mode & 07777 + ) + ) + && $!{EEXIST} + ); + if ($open) { + $backup = "$lsc.$n"; + unshift @backups, $n; + print F $content; + close(F); + utime $atime, $mtime, $backup; + chown $uid, $gid, $backup; + } + else { + die "Unable to open $lsc.$n for write: $!\n"; + } + umask($um); + last; + } + my $oldContent = $content || ''; + + $content = <<'HERE'; +# Local site settings for Foswiki. This file is managed by the system, +# though you can also make (careful!) manual changes with a text editor. +# See the Foswiki.spec file in this directory for documentation +# Extensions are documented in the Config.spec file in the Plugins/ +# or Contrib/ directories (Do not remove the following blank line.) + +HERE + my $root = Foswiki::Plugins::ConfigurePlugin::SpecEntry::loadSpecFiles(); + my ( $lines, $requires ) = $root->lscify( \%Foswiki::cfg ); + if ($requires) { + $content .= join( '', map { "require $_;\n" } keys %$requires ); + } + $content .= join( '', @$lines ) . "1;\n"; + + my $um = umask(007); # Contains passwords, no world access to new file + open( F, '>', $lsc ) + || die "Could not open $lsc for write: $!\n"; + print F $content; + close(F) or die "Close failed for $lsc: $!\n"; + umask($um); + if ( $backup && ( my $max = $Foswiki::cfg{MaxLSCBackups} ) >= 0 ) { + while ( @backups > $max ) { + my $n = pop @backups; + unlink "$lsc.$n"; + } + } +} + +1; + +__END__ + +Author: Crawford Currie http://c-dot.co.uk + +Foswiki - The Free and Open Source Wiki, http://foswiki.org/ + +Copyright (C) 2013-2013 Foswiki Contributors. Foswiki Contributors +are listed in the AUTHORS file in the root of this distribution. +NOTE: Please extend that file, not this notice. + +This program is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public License +as published by the Free Software Foundation; either version 2 +of the License, or (at your option) any later version. For +more details read LICENSE in the root of this distribution. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + +As per the GPL, removal of this notice is prohibited. diff --git a/lib/Foswiki/Plugins/ConfigurePlugin/Config.spec b/lib/Foswiki/Plugins/ConfigurePlugin/Config.spec new file mode 100644 index 0000000..962338e --- /dev/null +++ b/lib/Foswiki/Plugins/ConfigurePlugin/Config.spec @@ -0,0 +1,2 @@ +# ---+ Extensions +# ---++ ConfigurePlugin diff --git a/lib/Foswiki/Plugins/ConfigurePlugin/DEPENDENCIES b/lib/Foswiki/Plugins/ConfigurePlugin/DEPENDENCIES new file mode 100644 index 0000000..cd3fb5c --- /dev/null +++ b/lib/Foswiki/Plugins/ConfigurePlugin/DEPENDENCIES @@ -0,0 +1,2 @@ +Foswiki::Plugins::JsonRpcContrib,>=0,perl,JSON interface +Foswiki::Plugins::XmlRpcContrib,>=0,perl,XML interface diff --git a/lib/Foswiki/Plugins/ConfigurePlugin/MANIFEST b/lib/Foswiki/Plugins/ConfigurePlugin/MANIFEST new file mode 100644 index 0000000..5a18ce8 --- /dev/null +++ b/lib/Foswiki/Plugins/ConfigurePlugin/MANIFEST @@ -0,0 +1,6 @@ +!noci +data/System/ConfigurePlugin.txt 0644 Documentation page +data/Sandbox/PluginTestConfigurePlugin.txt 0644 Examples +lib/Foswiki/Plugins/ConfigurePlugin.pm 0444 Perl module +lib/Foswiki/Plugins/ConfigurePlugin/Config.spec 0444 Configuration +lib/Foswiki/Plugins/ConfigurePlugin/SpecEntry.pm 0444 Perl module diff --git a/lib/Foswiki/Plugins/ConfigurePlugin/SpecEntry.pm b/lib/Foswiki/Plugins/ConfigurePlugin/SpecEntry.pm new file mode 100644 index 0000000..8cfaddc --- /dev/null +++ b/lib/Foswiki/Plugins/ConfigurePlugin/SpecEntry.pm @@ -0,0 +1,593 @@ +# See bottom of file for license and copyright information +package Foswiki::Plugins::ConfigurePlugin::SpecEntry; + +# A SpecEntry represents a single entry in a .spec file - either a +# section, an individual keyed value, or a special layout marker like +# *FINDEXTENSIONS*. It also behaves as a Value object for use with +# checkers. +use strict; +use warnings; +use Data::Structure::Util; + +our $configItemRegex = qr/(?:\{(?:'[^']+'|"[^"]+"|[-:\w]+)\})+/o; + +sub new { + my $class = shift; + + return bless( {@_}, $class ); +} + +sub createSpecEntry { + my $this = shift; + return new Foswiki::Plugins::ConfigurePlugin::SpecEntry(@_); +} + +sub findSpecEntry { + my $this = shift; + my %search = @_; + my $mismatch = 0; + my $match = 1; + while ( my ( $k, $e ) = each %search ) { + $match = 0 unless ( defined $this->{$k} && $this->{$k} eq $e ); + } + + # there was no search, or the search matched all terms + return $this if $match; + + # Search pending + if ( 0 && $this->{_pending} ) { + foreach my $child ( @{ $this->{_pending} } ) { + my $cvo = $child->findSpecEntry(@_); + return $cvo if $cvo; + } + } + + # Search children + foreach my $child ( @{ $this->{children} } ) { + my $cvo = $child->findSpecEntry(@_); + return $cvo if $cvo; + } + return undef; +} + +sub _appendDescription { + my ( $this, $desc ) = @_; + $this->{description} ||= ''; + $this->{description} .= $desc; +} + +# Add a new entry to the queue for adding to the tree. +# Must only call on the root. +sub _addPendingEntry { + my ( $this, $n ) = @_; + die "Cannot add undef" unless defined $n; + foreach my $v ( @{ $this->{_pending} } ) { + + # Don't push the same entry twice + return if ( $v eq $n ); + } + push( @{ $this->{_pending} }, $n ); +} + +# Add a child to this node. +sub addChild { + my ( $this, $child ) = @_; + foreach my $kid ( @{ $this->{children} } ) { + Carp::confess if $child eq $kid; + } + $child->{parent} = $this; + + push( @{ $this->{children} }, $child ); + +} + +# So the JSON module can serialise blessed objects +sub TO_JSON { + my $d = { %{ $_[0] } }; + delete $d->{parent}; + return $d; +} + +sub findFileOnPath { + my $file = shift; + + $file =~ s(::)(/)g; + + foreach my $dir (@INC) { + if ( -e "$dir/$file" ) { + return "$dir/$file"; + } + } + return; +} + +# Load all spec files into a tree structure +sub loadSpecFiles { + my $this = new Foswiki::Plugins::ConfigurePlugin::SpecEntry; + + my $file = findFileOnPath('Foswiki.spec'); + if ($file) { + $this->_parse($file); + } + + my %read; + foreach my $dir (@INC) { + $this->_loadSpecsFrom( "$dir/Foswiki/Plugins", \%read ); + $this->_loadSpecsFrom( "$dir/Foswiki/Contrib", \%read ); + } + + return $this; +} + +# Load all Config.spec files from the given type directory +sub _loadSpecsFrom { + my ( $this, $dir, $read ) = @_; + + return unless opendir( D, $dir ); + foreach my $extension ( grep { $_ !~ /^\./ } readdir D ) { + next if $extension =~ /^Empty/; # Skip Empty* + next if $read->{$extension}; + $extension =~ /(.*)/; + $extension = $1; # untaint + my $file = "$dir/$extension/Config.spec"; + next unless -e $file; + $this->_parse($file); + $read->{$extension} = $file; + } + closedir(D); +} + +# Merge the pending entries into the tree, creating the section +# hierarchy as we go. +sub _mergePendingEntries { + my $this = shift; + + my $section = $this; + my $depth = 0; + + foreach my $item ( @{ $this->{_pending} } ) { + if ( $item->{type} && $item->{type} eq 'SECTION' ) { + my $ns = $this->findSpecEntry( + title => $item->{title}, + depth => $item->{depth} + ); + if ($ns) { + + # the section is already there + $depth = $item->{depth}; + $section = $ns; + } + else { + while ( $depth > $item->{depth} - 1 ) { + $section = $section->{parent} if $section->{parent}; + $depth--; + } + while ( $depth < $item->{depth} - 1 ) { + my $ns = createSpecEntry( + $this, + type => 'SECTION', + title => '', + depth => $depth + ); + $section->addChild($ns); + $section = $ns; + $depth++; + } + $section->addChild($item); + $section = $item; + $depth++; + } + next; + } + + # Skip it if we already have a settings object for these + # keys (first loaded always takes precedence, irrespective + # of which section it is in) + if ( defined $item->{keys} ) { + my $vo = $this->findSpecEntry( keys => $item->{keys} ); + + # SMELL: warning? + next if $vo; + } + + $section->addChild($item); + } + delete $this->{_pending}; +} + +# The parse is a two-pass process. First we load all configuration items +# in a flat array, with SectionMarker objects marking where section +# headings were found. Then we process that array to find the section +# markers and create the hierarchy. +sub _parse { + my ( $this, $file ) = @_; + + open( F, '<', $file ) || return ''; + local $/ = "\n"; + my $open = undef; # current setting or section + my $sectionNum = 0; + + while ( my $l = ) { + $l =~ s/\r//g; + + # Continuation lines + + while ( $l =~ /\\$/ && !eof F ) { + my $cont = ; + $cont =~ s/\r//g; + $cont =~ s/^#// if ( $l =~ /^#/ ); + $cont =~ s/^\s*//; + chomp $l; + unless ( $cont =~ /^#/ ) { + chop $l; + $l .= $cont; + } + } + if ( $l =~ /\\$/ ) { + die "Reached end-of-file at $file:$., continuation expected"; + } + + last if ( $l =~ /^1;|^__\w+__/ ); + next if ( $l =~ /^\s*$/ || $l =~ /^\s*#!/ ); + + if ( $l =~ /^#\s*\*\*\s*([A-Z]+)\s*(.*?)\s*\*\*\s*$/ ) { + + # **STRING 30 EXPERT** + $this->_addPendingEntry($open) if $open; + if ( $1 eq 'ENHANCE' ) { + + # Enhance the description of an existing value + $open = $this->findSpecEntry( keys => $2 ); + } + else { + $open = $this->createSpecEntry( + type => $1, + options => _expandOptions( $1, $2 ) + ); + } + } + + elsif ( $l =~ /^(#)?\s*\$(?:Foswiki::)?cfg([^=\s]*)\s*=(.*)$/ ) { + + # $Foswiki::cfg{Rice}{Brown} = + my $optional = $1; + my $keys = safeKeys($2); + unless ( $keys =~ /^$configItemRegex$/ ) { + die "Invalid item specifier $keys at $file:$."; + } + + # my $tentativeVal = $3; # Possibly line 1 of many + if ( $open && $open->{type} eq 'SECTION' ) { + $this->_addPendingEntry($open); + $open = undef; + } + + # If there is already an object for + # these keys, we don't need to add another. But if there + # isn't, we do. + if ( !$open ) { + $open = $this->findSpecEntry( keys => $keys ); + + # Create an untyped value if the keys are not already known + $open = $this->createSpecEntry( type => 'UNKNOWN' ) + unless $open; + } + $open->{optional} = 1 if $optional; + $open->{defined} = [ $file, 0 + $. ]; + $open->{keys} = $keys; + $this->_addPendingEntry($open); + $open = undef; + } + + elsif ( $l =~ /^#\s*\*([A-Z]+)\*/ ) { + + # *FINDEXTENSIONS* etc + my $name = $1; + if ($open) { + $this->_addPendingEntry($open); + } + $open = $this->createSpecEntry( + type => 'PLUGGABLE', + title => $name + ); + } + + elsif ( $l =~ /^#\s*---\+(\+*) *(.*?)$/ ) { + + # ---++ Section + my ( $d, $t ) = ( $1, $2 ); + my $opts; + $sectionNum++; + $this->_addPendingEntry($open) if $open; + if ( $t =~ s/^(.*?)\s*--\s*(.*?)\s*$/$1/ ) { + $opts = $2; + } + $open = $this->createSpecEntry( + type => 'SECTION', + title => $t, + depth => length($d) + 1 + ); + $open->{options} = $opts if defined $opts; + } + + elsif ( $l =~ /^#\s?(.*)$/ ) { + + # Bog standard comment + $open->_appendDescription($1) if $open; + } + } + close(F); + $this->_addPendingEntry($open) if $open; + $this->_mergePendingEntries(); +} + +sub _expandOptions { + my ( $type, $options ) = @_; + if ( $type eq 'SELECTCLASS' ) { + return [ _findClasses($options) ]; + } + return $options; +} + +# $pattern is a wildcard expression that matches classes e.g. +# Foswiki::Plugins::*Plugin +# * is the only wildcard supported +# Finds all classes that match in @INC +sub _findClasses { + my ($pattern) = @_; + + $pattern =~ s/\*/.*/g; + my @path = split( /::/, $pattern ); + + my $places = \@INC; + + while ( scalar(@path) > 1 && @$places ) { + my $pathel = shift(@path); + eval "\$pathel = qr/^($pathel)\$/"; # () to untaint + my @newplaces; + + foreach my $place (@$places) { + if ( opendir( DIR, $place ) ) { + + #next if ($place =~ /^\..*/); + foreach my $subplace ( readdir DIR ) { + next unless $subplace =~ $pathel; + + #next if ($subplace =~ /^\..*/); + push( @newplaces, $place . '/' . $1 ); + } + closedir DIR; + } + } + $places = \@newplaces; + } + + my @list; + my $leaf = shift(@path); + eval "\$leaf = qr/$leaf\.pm\$/"; + my %known; + foreach my $place (@$places) { + if ( opendir( DIR, $place ) ) { + foreach my $file ( readdir DIR ) { + next unless $file =~ $leaf; + next if ( $file =~ /^\..*/ ); + next unless ( $file =~ /^(.*)\.pm$/ ); + my $module = "$place/$1"; + $module =~ s./.::.g; + if ( $module =~ /($pattern)$/ ) { + push( @list, $1 ) unless $known{$1}; + $known{$1} = 1; + } + } + closedir DIR; + } + } + + return @list; +} + +# Canonicalise a key string +sub safeKeys { + my $k = shift; + $k =~ s/^{(.*)}$/$1/; + return '{' + . join( '}{', + map { $_ =~ s/^(['"])(.*)\1$/$2/; safeKey($_) } + split( /}{/, $k ) ) + . '}'; +} + +# Make a single key safe for use in a canonical key string +sub safeKey { + my $k = shift; + return $k if ( $k =~ /^[a-z_][a-z0-9_]*$/i ); + $k =~ s/'/\\'/g; + return "'$k'"; +} + +our $next_level; # localised in sub check(), set in sub inc() + +# Set new values for the entries in the data structure passed. +# note: the spec is used to determine *where* to set values. +sub set { + my ( $this, $data, @path ) = @_; + my @report; + local $next_level; + + if ( scalar(@path) ) { + my $keypath = '{' . join( '}{', @path ) . '}'; + my $spec = $this->findSpecEntry( keys => $keypath ); + if ( $spec && defined $spec->{keys} ) { # not a SECTION! + # This is a specced level; we will take the entire data + # under this point as the new value. + # Stomp Foswiki::cfg with our new value for checking + # and return + eval "\$Foswiki::cfg$keypath=\$data"; + die $@ if $@; + return; # don't recurse any deeper + } + } + if ( ref($data) eq 'HASH' ) { + while ( my ( $sk, $se ) = each %$data ) { + $this->set( $se, ( @path, safeKey($sk) ) ); + } + } +} + +# Check the configuration settings given in the $data against the +# checkers for the corresponding type. +sub check { + my ( $this, $data, @path ) = @_; + my @report; + local $next_level; + + if ( scalar(@path) ) { + my $keypath = '{' . join( '}{', @path ) . '}'; + my $spec = $this->findSpecEntry( keys => $keypath ); + if ($spec) { + my $checkerClass = + 'Foswiki::Configure::Checkers::' . join( '::', @path ); + my @checkers = _findClasses($checkerClass); + foreach my $chcl (@checkers) { + + # Load the checker + eval "require $chcl"; + die $@ if $@; + + # Invoke the checker + my $checker = $chcl->new($spec); + my $message = $checker->check($spec); + if ($message) { + push( + @report, + { + level => $next_level, + keys => $keypath, + message => $message + } + ); + } + } + } + } + if ( ref($data) eq 'HASH' ) { + while ( my ( $sk, $se ) = each %$data ) { + push( @report, $this->check( $se, ( @path, safeKey($sk) ) ) ); + } + } + + return @report; +} + +# Load current LSC *without* expanding embedded $Foswiki::cfg references +sub _loadRawLSC { + my $fh; + open( + $fh, '<', + Foswiki::Plugins::ConfigurePlugin::SpecEntry::findFileOnPath( + 'LocalSite.cfg') + ) || die $@; + local $/ = undef; + my $c = <$fh>; + close $fh; + $c =~ s/^\$Foswiki::cfg/\$Foswikicfg/gm; + my %Foswikicfg; + eval $c; + die $@ if $@; + return \%Foswikicfg; +} + +# Traverse LSC generating LSC format output +sub lscify { + my ( $this, $data,, @path ) = @_; + + my @content; + my %requires; + if ( scalar(@path) ) { + my $keypath = '{' . join( '}{', @path ) . '}'; + my $spec = $this->findSpecEntry( keys => $keypath ); + if ($spec) { + if ( defined $spec->{keys} ) { + + # This is a specced level; we will take the entire data + # under this point as the new value. + # Stomp Foswiki::cfg with our new value for checking + # and return + my $type = "Foswiki::Configure::Types::$spec->{type}"; + eval "require $type"; + unless ($@) { + my $nval = eval "\$Foswiki::cfg$keypath"; + die $@ if $@; + my ( $string, $require ) = + $type->new->value2string( $keypath, $nval ); + push( @content, $string ); + $requires{$require} = 1 if $require; + return ( \@content, \%requires ); + } + } + else { + push( @content, "# $spec->{title}" ); + } + } + } + if ( ref($data) eq 'HASH' ) { + foreach my $sk ( sort keys %$data ) { + my ( $c, $r ) = + $this->lscify( $data->{$sk}, ( @path, safeKey($sk) ) ); + push( @content, @$c ); + map { $requires{$_} = 1 } keys %$r; + } + } + else { + + # Something else; unspecced and not a hash. + require Foswiki::Configure::Type; + my $keypath = '{' . join( '}{', @path ) . '}'; + my $val = eval "\$Foswiki::cfg$keypath"; + my ( $var, $require ) = + Foswiki::Configure::Type->new->value2string( $keypath, $val ); + $requires{$require} = 1 if $require; + push( @content, $var ); + } + return ( \@content, \%requires ); +} + +######### CRUFT TO SUPPORT CHECKERS ############### +# Done this clumsy way to avoid changing the checker code. +sub inc { + my ( $this, $level ) = @_; + $next_level = $level; +} + +sub getKeys { + return shift->{keys}; +} + +sub getCheckerOptions { + return shift->{checkerOpts}; +} + +sub feedback { + return ''; +} + +1; +1; +__END__ +Foswiki - The Free and Open Source Wiki, http://foswiki.org/ + +Copyright (C) 2013 Foswiki Contributors. Foswiki Contributors +are listed in the AUTHORS file in the root of this distribution. +NOTE: Please extend that file, not this notice. + +This program is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public License +as published by the Free Software Foundation; either version 2 +of the License, or (at your option) any later version. For +more details read LICENSE in the root of this distribution. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + +As per the GPL, removal of this notice is prohibited. diff --git a/lib/Foswiki/Plugins/ConfigurePlugin/build.pl b/lib/Foswiki/Plugins/ConfigurePlugin/build.pl new file mode 100644 index 0000000..9c6fc9f --- /dev/null +++ b/lib/Foswiki/Plugins/ConfigurePlugin/build.pl @@ -0,0 +1,76 @@ +#!/usr/bin/perl -w +# +# Example build class. Copy this file to the equivalent place in your +# plugin or contrib and edit. +# +# Read the comments at the top of lib/Foswiki/Contrib/Build.pm for +# details of how the build process works, and what files you +# have to provide and where. +# +# Requires the environment variable FOSWIKI_LIBS (a colon-separated path +# list) to be set to point at the build system and any required dependencies. +# Usage: ./build.pl [-n] [-v] [target] +# where [target] is the optional build target (build, test, +# install, release, uninstall), test is the default. +# Two command-line options are supported: +# -n Don't actually do anything, just print commands +# -v Be verbose +# + +# Standard preamble +use strict; +use warnings; + +BEGIN { unshift @INC, split( /:/, $ENV{FOSWIKI_LIBS} ); } + +use Foswiki::Contrib::Build; + +# Create the build object +my $build = new Foswiki::Contrib::Build('ConfigurePlugin'); + +# Build the target on the command line, or the default target +$build->build( $build->{target} ); + +=begin TML + +You can do a lot more with the build system if you want; for example, to add +a new target, you could do this: + + +{ + package MyModuleBuild; + our @ISA = qw( Foswiki::Contrib::Build ); + + sub new { + my $class = shift; + return bless( $class->SUPER::new( "MyModule" ), $class ); + } + + sub target_mytarget { + my $this = shift; + # Do other build stuff here + } +} + +# Create the build object +my $build = new MyModuleBuild(); + + +You can also specify a different default target server for uploads. +This can be any web on any accessible Foswiki installation. +These defaults will be used when expanding tokens in .txt +files, but be warned, they can be overridden at upload time! + + +# name of web to upload to +$build->{UPLOADTARGETWEB} = 'Extensions'; +# Full URL of pub directory +$build->{UPLOADTARGETPUB} = 'http://foswiki.org/pub'; +# Full URL of bin directory +$build->{UPLOADTARGETSCRIPT} = 'http://foswiki.org/bin'; +# Script extension +$build->{UPLOADTARGETSUFFIX} = ''; + + +=cut + diff --git a/test/unit/ConfigurePlugin/ConfigurePluginSuite.pm b/test/unit/ConfigurePlugin/ConfigurePluginSuite.pm new file mode 100644 index 0000000..ed77a72 --- /dev/null +++ b/test/unit/ConfigurePlugin/ConfigurePluginSuite.pm @@ -0,0 +1,34 @@ +# See bottom of file for license and copyright information +package ConfigurePluginSuite; + +use strict; +use warnings; + +use Unit::TestSuite; +our @ISA = 'Unit::TestSuite'; + +sub name { 'ConfigurePluginSuite' } + +# List the modules that contain the extension-specific tests you +# want to run. These tests are run when you 'perl build.pl test' +sub include_tests { qw(ConfigurePluginTests) } + +1; +__END__ +Foswiki - The Free and Open Source Wiki, http://foswiki.org/ + +Copyright (C) 2008-%$CREATEDYEAR% Foswiki Contributors. Foswiki Contributors +are listed in the AUTHORS file in the root of this distribution. +NOTE: Please extend that file, not this notice. + +This program is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public License +as published by the Free Software Foundation; either version 2 +of the License, or (at your option) any later version. For +more details read LICENSE in the root of this distribution. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + +As per the GPL, removal of this notice is prohibited. diff --git a/test/unit/ConfigurePlugin/ConfigurePluginTests.pm b/test/unit/ConfigurePlugin/ConfigurePluginTests.pm new file mode 100644 index 0000000..95804cf --- /dev/null +++ b/test/unit/ConfigurePlugin/ConfigurePluginTests.pm @@ -0,0 +1,221 @@ +# See bottom of file for license and copyright information +use strict; +use warnings; + +package ConfigurePluginTests; + +use FoswikiTestCase; +our @ISA = qw( FoswikiTestCase ); + +use strict; +use warnings; +use Foswiki; +use CGI; + +use Foswiki::Plugins::ConfigurePlugin; + +sub new { + my $self = shift()->SUPER::new(@_); + return $self; +} + +# Set up the test fixture +sub set_up { + my $this = shift; + + $this->SUPER::set_up(); + $this->{test_work_dir} = $Foswiki::cfg{WorkingDir}; + open( F, '<', + Foswiki::Plugins::ConfigurePlugin::SpecEntry::findFileOnPath( + 'LocalSite.cfg') + ) || die $@; + local $/ = undef; + my $c = ; + close F; + $this->{safe_lsc} = $c; +} + +sub tear_down { + my $this = shift; + + # make sure the correct config comes back + $Foswiki::cfg{ConfigurationFinished} = 0; + Foswiki::Configure::Load::readConfig( 0, 0 ); + + # Got to restore this, otherwise SUPER::tear_down will eat + # the one restored from LSC + $Foswiki::cfg{WorkingDir} = $this->{test_work_dir}; + open( F, '>', + Foswiki::Plugins::ConfigurePlugin::SpecEntry::findFileOnPath( + 'LocalSite.cfg') + ) || die $@; + print F $this->{safe_lsc}; + close(F); + $this->SUPER::tear_down(); +} + +sub test_getcfg { + my $this = shift; + my $params = { "keys" => [ "{DataDir}", "{Store}{Implementation}" ] }; + my @result = + Foswiki::Plugins::ConfigurePlugin::getcfg( $this->{session}, $params ); + $this->assert_num_equals( 200, $result[0] ); + $this->assert_null( $result[1] ); + $this->assert_deep_equals( + { + Store => { Implementation => $Foswiki::cfg{Store}{Implementation} }, + DataDir => $Foswiki::cfg{DataDir} + }, + $result[2] + ); +} + +sub test_getcfg_all { + my $this = shift; + my $params = {}; + my @result = + Foswiki::Plugins::ConfigurePlugin::getcfg( $this->{session}, $params ); + $this->assert_num_equals( 200, $result[0] ); + $this->assert_null( $result[1] ); + $this->assert_deep_equals( \%Foswiki::cfg, $result[2] ); +} + +sub test_getcfg_badkey { + my $this = shift; + my $params = { "keys" => ["Not a key"] }; + my @result = + Foswiki::Plugins::ConfigurePlugin::getcfg( $this->{session}, $params ); + $this->assert_num_equals( 400, $result[0] ); + $this->assert_str_equals( "Bad key 'Not a key'", $result[1] ); + $this->assert_null( $result[2] ); +} + +sub test_getcfg_nokey { + my $this = shift; + my $params = { "keys" => ["{Peed}{Skills}"] }; + my @result = + Foswiki::Plugins::ConfigurePlugin::getcfg( $this->{session}, $params ); + $this->assert_num_equals( 404, $result[0] ); + $this->assert_str_equals( "{Peed}{Skills} not defined", $result[1] ); + $this->assert_null( $result[2] ); +} + +# For stripping parents in the spec tree if needed for print debug +sub unparent { + my $what = shift; + my $type = ref($what); + return unless $type; + if ( $type eq 'ARRAY' ) { + foreach my $vv (@$what) { + unparent($vv); + } + } + else { + delete $what->{parent}; + foreach my $v ( values %$what ) { + unparent($v); + } + } + return $what; +} + +sub test_getspec { + my $this = shift; + my $params = { "keys" => "{DataDir}" }; + my @result = + Foswiki::Plugins::ConfigurePlugin::getspec( $this->{session}, $params ); + $this->assert_num_equals( 200, $result[0] ); + $this->assert_null( $result[1] ); + my $spec = $result[2]; + $this->assert_str_equals( 'PATH', $spec->{type} ); + $this->assert_str_equals( '{DataDir}', $spec->{keys} ); +} + +sub test_getspec_badkey { + my $this = shift; + my $params = { "keys" => "{BadKey}" }; + my @result = + Foswiki::Plugins::ConfigurePlugin::getspec( $this->{session}, $params ); + $this->assert_num_equals( 404, $result[0] ); + $this->assert_matches( qr/^\$Not_found = {\s*\'keys\' => \'{BadKey}\'\s*};/, + $result[1] ); +} + +sub test_check { + my $this = shift; + my $params = { Log => { Implementation => 'Foswiki::Logger::PlainFile' } }; + my @result = + Foswiki::Plugins::ConfigurePlugin::check( $this->{session}, $params ); + $this->assert_num_equals( 200, $result[0] ); + my $report = $result[1]; + $this->assert_num_equals( 1, scalar @$report ); + $report = $report->[0]; + $this->assert_str_equals( '{Log}{Implementation}', $report->{keys} ); + $this->assert_str_equals( 'warnings', $report->{level} ); + $this->assert_matches( qr/On busy systems/, $report->{message} ); +} + +sub test_changecfg { + my $this = shift; + $Foswiki::cfg{Test}{Key} = 'value1'; + $Foswiki::cfg{'Test-Key'} = 'value2'; + $Foswiki::cfg{'TestKey'} = 'value3'; + delete $Foswiki::cfg{TestA}; + delete $Foswiki::cfg{TestB}{Ruin}; + my $params = { + clear => [ '{Test-Key}', '{Test}{Key}', '{TestDontCountMe}' ], + set => { + '{TestA}' => 'Shingle', + '{TestB}{Ruin}' => 'Ribbed', + '{Test-Key}' => 'newtestkey', + '{TestKey}' => 'newval' + } + }; + my @result = + Foswiki::Plugins::ConfigurePlugin::changecfg( $this->{session}, $params ); + $this->assert( 200, $result[0] ); + $this->assert_null( $result[1] ); + $this->assert_str_equals( 'Added: 3; Changed: 1; Cleared: 2', $result[2] ); + $this->assert_str_equals( 'newtestkey', $Foswiki::cfg{'Test-Key'} ); + $this->assert( !exists $Foswiki::cfg{Test}{Key} ); + $this->assert( !exists $Foswiki::cfg{TestDontCountMe} ); + $this->assert_str_equals( "Shingle", $Foswiki::cfg{TestA} ); + $this->assert_str_equals( "Ribbed", $Foswiki::cfg{TestB}{Ruin} ); + + # Check it was written correctly + delete $Foswiki::cfg{Test}; + open( F, '<', + Foswiki::Plugins::ConfigurePlugin::SpecEntry::findFileOnPath( + 'LocalSite.cfg') + ) || die $@; + local $/ = undef; + my $c = ; + close F; + $c =~ s/^\$Foswiki::cfg/\$blah/gm; + my %blah; + eval $c; + die $@ if $@; + $Foswiki::cfg{ConfigurationFinished} = 0; + Foswiki::Configure::Load::readConfig( 1, 1 ); + $this->assert_deep_equals( \%Foswiki::cfg, \%blah ); +} + +1; +__END__ +Foswiki - The Free and Open Source Wiki, http://foswiki.org/ + +Copyright (C) 2008-2013 Foswiki Contributors. Foswiki Contributors +are listed in the AUTHORS file in the root of this distribution. +NOTE: Please extend that file, not this notice. + +This program is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public License +as published by the Free Software Foundation; either version 2 +of the License, or (at your option) any later version. For +more details read LICENSE in the root of this distribution. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + +As per the GPL, removal of this notice is prohibited.