nsbin/manage
Nico Schottelius df2daf524d init
Signed-off-by: Nico Schottelius <nico@manager.schottelius.org>
2017-07-19 17:15:41 +02:00

266 lines
8 KiB
Perl
Executable file

#!/usr/bin/perl -wT
#
# TWiki Collaboration Platform, http://TWiki.org/
#
# Copyright (C) 2002-2003 Peter Thoeny, peter@thoeny.com
#
# For licensing info read license.txt file in the TWiki root.
# 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.
#
# 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. See the
# GNU General Public License for more details, published at
# http://www.gnu.org/copyleft/gpl.html
#
# The manage script is used to manage some actions like creating
# a new web.
# Set library paths in @INC, at compile time
BEGIN { unshift @INC, '.'; require 'setlib.cfg'; }
use CGI::Carp qw( fatalsToBrowser );
use CGI;
use File::Copy;
use TWiki;
use strict;
&main();
#=========================
sub main
{
my $query = new CGI;
my $action = $query->param( 'action' ) || "";
if( $action eq "createweb" ) {
createWeb( $query );
# } elsif( $action eq "othercommand" ) {
} elsif( $action ) {
oopsRedirectMsg( $query, "", "", "", "msg_unrecognized_action", $action );
} else {
oopsRedirectMsg( $query, "", "", "", "msg_missing_action" );
}
}
#=========================
sub oopsRedirectMsg
{
my( $theQuery, $theWeb, $theTopic, $theOopsTmpl, $theTmplVar, $theMsg2, $theMsg3, $theMsg4 ) = @_;
$theWeb = $TWiki::mainWebname unless( $theWeb );
$theTopic = $TWiki::mainTopicname unless( $theTopic );
$theOopsTmpl = "oopsmanage" unless( $theOopsTmpl );
my $url = &TWiki::getOopsUrl( $theWeb, $theTopic, $theOopsTmpl,
"%TMPL:P{\"$theTmplVar\"}%", $theMsg2, $theMsg3, $theMsg4 );
TWiki::redirect( $theQuery, $url );
}
#=========================
sub createWeb
{
my( $query ) = @_;
my $thePathInfo = $query->path_info();
my $theRemoteUser = $query->remote_user();
my $theTopic = $query->param( 'topic' );
my $newWeb = $query->param( 'newweb' ) || "";
my $newTopic = $query->param( 'newtopic' ) || "";
my $baseWeb = $query->param( 'baseweb' ) || "";
my $webBgColor = $query->param( 'webbgcolor' ) || "";
my $siteMapWhat = $query->param( 'sitemapwhat' ) || "";
my $siteMapUseTo = $query->param( 'sitemapuseto' ) || "";
my $noSearchAll = $query->param( 'nosearchall' ) || "";
my $theUrl = $query->url;
my $oopsTmpl = "oopsmngcreateweb";
# initialize TWiki
my( $topicName, $webName, $dummy, $userName ) =
&TWiki::initialize( $thePathInfo, $theRemoteUser, $theTopic, $theUrl, $query );
$dummy = ""; # avoid warning
# check permission, user authorized to create webs?
my $wikiUserName = &TWiki::userToWikiName( $userName );
unless( &TWiki::Access::checkAccessPermission( "manage", $wikiUserName, "",
$topicName, $webName ) ) {
# user has not permission to change the topic
my $url = &TWiki::getOopsUrl( $webName, $topicName, "oopsaccesscreateweb" );
TWiki::redirect( $query, $url );
return;
}
if( $newWeb =~ /^_[a-zA-Z0-9_]+$/ ) {
# valid template web name, untaint
$newWeb =~ /(.*)/;
$newWeb = $1;
} elsif( TWiki::isWebName( $newWeb ) ) {
# valid web name, untaint
$newWeb =~ /(.*)/;
$newWeb = $1;
} elsif( $newWeb ) {
oopsRedirectMsg( $query, "", "", $oopsTmpl, "msg_web_name" );
return;
} else {
oopsRedirectMsg( $query, "", "", $oopsTmpl, "msg_web_missing" );
return;
}
if( TWiki::Store::topicExists( $newWeb, $TWiki::mainTopicname ) ) {
oopsRedirectMsg( $query, "", "", $oopsTmpl, "msg_web_exist", $newWeb );
return;
}
$baseWeb =~ s/$TWiki::securityFilter//go;
$baseWeb =~ /(.*)/;
$baseWeb = $1;
unless( TWiki::Store::topicExists( $baseWeb, $TWiki::mainTopicname ) ) {
oopsRedirectMsg( $query, "", "", $oopsTmpl, "msg_base_web", $baseWeb );
return;
}
unless( $webBgColor =~ /\#[0-9a-f]{6}/i ) {
oopsRedirectMsg( $query, "", "", $oopsTmpl, "msg_web_color" );
return;
}
# create the empty web
my $err = createEmptyWeb( $newWeb );
if( $err ) {
oopsRedirectMsg( $query, "", "", $oopsTmpl, "msg_web_create", $err );
return;
}
# copy needed topics from base web
$err = copyWebTopics( $baseWeb, $newWeb );
if( $err ) {
oopsRedirectMsg( $query, $newWeb, "", $oopsTmpl, "msg_web_copy_topics", $err );
return;
}
# patch WebPreferences
$err = patchWebPreferences( $newWeb, $TWiki::webPrefsTopicname, $webBgColor,
$siteMapWhat, $siteMapUseTo, $noSearchAll );
if( $err ) {
oopsRedirectMsg( $query, $newWeb, $TWiki::webPrefsTopicname, $oopsTmpl, "msg_patch_webpreferences", $err );
return;
}
# everything OK, redirect to last message
$newTopic = $TWiki::mainTopicname unless( $newTopic );
oopsRedirectMsg( $query, $newWeb, $newTopic, $oopsTmpl, "msg_create_web_ok" );
return;
}
#=========================
sub createEmptyWeb
{
my ( $theWeb ) = @_;
my $dir = "$TWiki::dataDir/$theWeb";
umask( 0 );
unless( mkdir( $dir, 0775 ) ) {
return( "Could not create $dir, error: $!" );
}
if ( $TWiki::useRcsDir ) {
unless( mkdir( "$dir/RCS", 0775 ) ) {
return( "Could not create $dir/RCS, error: $!" );
}
}
unless( open( FILE, ">$dir/.changes" ) ) {
return( "Could not create changes file $dir/.changes, error: $!" );
}
print FILE ""; # empty file
close( FILE );
unless( open( FILE, ">$dir/.mailnotify" ) ) {
return( "Could not create mailnotify timestamp file $dir/.mailnotify, error: $!" );
}
print FILE ""; # empty file
close( FILE );
return "";
}
#=========================
sub copyWebTopics
{
my ( $theBaseWeb, $theNewWeb ) = @_;
my $err = "";
my @topicList = &TWiki::Store::getTopicNames( $theBaseWeb );
unless( $theBaseWeb =~ /^_/ ) {
# not a template web, so filter for only Web* topics
@topicList = grep { /^Web/ } @topicList;
}
foreach my $topic ( @topicList ) {
$topic =~ s/$TWiki::securityFilter//go;
$topic =~ /(.*)/;
$topic = $1;
$err = copyOneTopic( $theBaseWeb, $topic, $theNewWeb );
return( $err ) if( $err );
}
return "";
}
#=========================
sub copyOneTopic
{
my ( $theFromWeb, $theTopic, $theToWeb ) = @_;
# FIXME: This should go into TWiki::Store
# copy topic file
my $from = "$TWiki::dataDir/$theFromWeb/$theTopic.txt";
my $to = "$TWiki::dataDir/$theToWeb/$theTopic.txt";
unless( copy( $from, $to ) ) {
return( "Copy file ( $from, $to ) failed, error: $!" );
}
umask( 002 );
chmod( 0644, $to );
# copy repository file
# FIXME: Hack, no support for RCS subdirectory
$from .= ",v";
$to .= ",v";
unless( copy( $from, $to ) ) {
return( "Copy file ( $from, $to ) failed, error: $!" );
}
umask( 002 );
chmod( 0644, $to );
# FIXME: Copy also attachments if present
return "";
}
#=========================
sub patchWebPreferences
{
my ( $theWeb, $theTopic, $theWebBgColor, $theSiteMapWhat, $theSiteMapUseTo, $doNoSearchAll ) = @_;
my( $meta, $text ) = &TWiki::Store::readTopic( $theWeb, $theTopic );
my $siteMapList = "";
$siteMapList = "on" if( $theSiteMapWhat );
$text =~ s/(\s\* Set WEBBGCOLOR =)[^\n\r]*/$1 $theWebBgColor/os;
$text =~ s/(\s\* Set SITEMAPLIST =)[^\n\r]*/$1 $siteMapList/os;
$text =~ s/(\s\* Set SITEMAPWHAT =)[^\n\r]*/$1 $theSiteMapWhat/os;
$text =~ s/(\s\* Set SITEMAPUSETO =)[^\n\r]*/$1 $theSiteMapUseTo/os;
$text =~ s/(\s\* Set NOSEARCHALL =)[^\n\r]*/$1 $doNoSearchAll/os;
my $err = &TWiki::Store::saveTopic( $theWeb, $theTopic, $text, $meta );
return $err;
}
#=========================
# EOF