#!d:/cygwin/bin/perl.exe -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.
#
#usage example:
#
#
#C h a n g e
#
#</form>
#<form name="passwd" action="/%SCRIPTURLPATH%/passwd%SCRIPTSUFFIX%/%WEB%/">
#Username     <input type="text" name="username" value="" size="16" /> <br />
#Old password <input type="password" name="oldpassword" size="16" />
#New password <input type="password" name="password" size="16" />
#retype New password <input type="password" name="passwordA" size="16" />
#<input type="submit" name="passwd" />
#<input type="hidden" name="action" value="changePassword" />
#</form>
#

BEGIN {
    # Set default current working directory
    if( $ENV{"SCRIPT_FILENAME"} && $ENV{"SCRIPT_FILENAME"} =~ /^(.+)\/[^\/]+$/ ) {
        chdir $1;
    }
    # Set library paths in @INC at compile time
    unshift @INC, '.';
    require 'setlib.cfg';
}

use CGI::Carp qw( fatalsToBrowser );
use CGI;
use File::Copy;
use TWiki;
use TWiki::User;

use strict;

&main();

#=========================
sub main
{
    my $query = new CGI;
    my $action = $query->param( 'action' ) || "";

    if( $action eq "createweb" ) {
        createWeb( $query );

    } elsif( $action eq "changePassword" ) {
        changePassword($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 changePassword
{
    my( $query ) = @_;

    # get all parameters from the form
    my $wikiName = $query->param( 'username' );
    my $passwordA = $query->param( 'password' );
    my $passwordB = $query->param( 'passwordA' );
 
    #initialize
    my $topicName = $query->param( 'TopicName' );
    my $thePathInfo = $query->path_info();
    my $theUrl = $query->url;

    my ( $topic, $webName ) =
        &TWiki::initialize( $thePathInfo, $wikiName, $topicName, $theUrl, $query );
 
    my $text = "";
    my $url = "";

    # check if required fields are filled in
    if( ! $wikiName || ! $passwordA ) {
        $url = &TWiki::getOopsUrl( $webName, $topic, "oopsregrequ", );
        TWiki::redirect( $query, $url );
        return;
    }
 
    # check if user entry exists
    if(  ( $wikiName )  && (! TWiki::User::UserPasswordExists( $wikiName ) ) ) {
        # PTh 20 Jun 2000: changed to getOopsUrl
        $url = &TWiki::getOopsUrl( $webName, $topic, "oopsnotwikiuser", $wikiName );
        TWiki::redirect( $query, $url );
        return;
    }

    # check if passwords are identical
    if( $passwordA ne $passwordB ) {
        $url = &TWiki::getOopsUrl( $webName, $topic, "oopsregpasswd" );
        TWiki::redirect( $query, $url );
        return;
    }
 
     # c h a n g e
     my $oldpassword = $query->param( 'oldpassword' );

     # check if required fields are filled in
     if( ! $oldpassword ) {
         $url = &TWiki::getOopsUrl( $webName, $topic, "oopsregrequ" );
         TWiki::redirect( $query, $url );
         return;
     }

     my $pw = TWiki::User::CheckUserPasswd( $wikiName, $oldpassword );
     if( ! $pw ) {
         # NO - wrong old password
         $url = &TWiki::getOopsUrl( $webName, $topic, "oopswrongpassword");
         TWiki::redirect( $query, $url );
         return;
     }

     # OK - password may be changed
     TWiki::User::UpdateUserPassword($wikiName,  $oldpassword, $passwordA );

     # OK - password changed
     $url = &TWiki::getOopsUrl( $webName, $topic, "oopschangepasswd" );
     TWiki::redirect( $query, $url );
     return; 
}

#=========================
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";
    if( -e $from ) {
        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
