#!/usr/bin/perl -wT
#
# TWiki Collaboration Platform, http://TWiki.org/
#
# Copyright (C) 2000-2003 Peter Thoeny, Peter@Thoeny.com
# Copyright (C) 2001 Klaus Wriessnegger, kw@sap.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.ai.mit.edu/copyleft/gpl.html
#

#usage example:
#
#R e s e t
#
#<form name="passwd" action="/%SCRIPTURLPATH%/passwd%SCRIPTSUFFIX%/%WEB%/">
#Username     <input type="text" name="username" value="" size="16" /> <br />
#New password <input type="password" name="password" size="16" />
#retype New password <input type="password" name="passwordA" size="16" />
#<input type="submit" name="passwd" />
#
#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="change" value="on" />
#</form>
#

# Set library paths in @INC, at compile time
BEGIN { unshift @INC, '.'; require 'setlib.cfg'; }

use CGI::Carp qw(fatalsToBrowser);
use CGI;
use TWiki;

if( $TWiki::OS eq "WINDOWS" ) {
    require MIME::Base64;
    require Digest::SHA1;
}

&main();
 
# =========================
sub main
{
    my $query = new CGI;
 
    # 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;

    ( $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 )  && (! htpasswdExistUser( $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;
    }

    my $theCryptPassword = &htpasswdGeneratePasswd( $wikiName,  $passwordA );
 
    my $change = $query->param( "change" ) || "";
 
    if( $change eq "on" ) {
 
        # 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;
        }

        # check password
        my $oldcrypt = htpasswdReadPasswd( $wikiName );
 
        my $pw = htpasswdCheckPasswd( $oldpassword, $oldcrypt );
        if( ! $pw ) {
            # NO - wrong old password
            $url = &TWiki::getOopsUrl( $webName, $topic, "oopswrongpassword");
            TWiki::redirect( $query, $url );
            return;
        }
 
        # OK - password may be changed
        my $oldCryptPassword = "$wikiName\:$oldcrypt";
        htpasswdAddUser( $oldCryptPassword, $theCryptPassword );
 
        # OK - password changed
        $url = &TWiki::getOopsUrl( $webName, $topic, "oopschangepasswd" );
        TWiki::redirect( $query, $url );
        return; 

    } else {
 
        # r e s e t
        # and finally display the reset password page
        $url = &TWiki::getOopsUrl( $webName, $wikiName, "oopsresetpasswd", $theCryptPassword );
        TWiki::redirect( $query, $url );
        return;
    }
 
}
 
# =========================
sub htpasswdCheckPasswd
{
    my ( $old, $oldcrypt ) = @_;
    my $pwd ;

    # check for Windows
    if ( $TWiki::OS eq "WINDOWS" ) {
        $pwd = '{SHA}' . MIME::Base64::encode_base64( Digest::SHA1::sha1( $old ) );
        # strip whitespace at end of line
        $pwd =~ /(.*)$/ ;
        $pwd = $1;

    } else {
        my $salt = substr( $oldcrypt, 0, 2 );
        $pwd = crypt( $old, $salt );
    }

    # OK
    if( $pwd eq $oldcrypt ) {
        return "1";
    }
    # NO
    return "";
}
 
# =========================
sub htpasswdReadPasswd
{
    my ( $user ) = @_;
 
    if( ! $user ) {
        return "";
    }
 
    my $text = &TWiki::Store::readFile( $TWiki::htpasswdFilename );
    if( $text =~ /$user\:(\S+)/ ) {
        return $1;
    }
    return "";
}
 
# =========================
sub htpasswdExistUser
{
    my ( $user ) = @_;
 
    if( ! $user ) {
        return "";
    }
 
    my $text = &TWiki::Store::readFile( $TWiki::htpasswdFilename );
    if( $text =~ /$user\:/go ) {
        return "1";
    }
    return "";
}
 
# =========================
sub htpasswdGeneratePasswd
{
    my ( $user, $passwd ) = @_;
    # by David Levy, Internet Channel, 1997
    # found at http://world.inch.com/Scripts/htpasswd.pl.html

    # check for Windows and use SHA1 digest instead of crypt()
    if( $TWiki::OS eq "WINDOWS" ) {
        my $pwd = $user . ':{SHA}' . MIME::Base64::encode_base64( Digest::SHA1::sha1( $passwd ) ); 
        $pwd =~ /(.*)$/;
        $pwd = $1;
        return $pwd
    }
    srand( $$|time );
    my @saltchars = ( 'a'..'z', 'A'..'Z', '0'..'9', '.', '/' );
    my $salt = $saltchars[ int( rand( $#saltchars+1 ) ) ];
    $salt .= $saltchars[ int( rand( $#saltchars+1 ) ) ];
    my $passwdcrypt = crypt( $passwd, $salt );
    return "$user\:$passwdcrypt";
}
 
# =========================
sub htpasswdAddUser
{
    my ( $oldUserEntry, $newUserEntry ) = @_;
 
    # can't use `htpasswd $wikiName` because htpasswd doesn't understand stdin
    # simply add name to file, but this is a security issue
    my $text = &TWiki::Store::readFile( $TWiki::htpasswdFilename );
    # escape + sign; SHA-passwords can have + signs
    $oldUserEntry =~ s/\+/\\\+/g;
    $text =~ s/$oldUserEntry/$newUserEntry/;
    &TWiki::Store::saveFile( $TWiki::htpasswdFilename, $text );
}

# EOF
