#!/usr/bin/env perl
use strict;
use warnings;

# Determine where RT is installed
if ($ENV{RTHOME}) {
    die "Invalid RTHOME $ENV{RTHOME}\n"
        unless -d $ENV{RTHOME} and -e "$ENV{RTHOME}/lib/RT.pm";
} elsif (-d "/opt/rt4" and -e "/opt/rt4/lib/RT.pm") {
    warn "Found RT in /opt/rt4\n";
    $ENV{RTHOME} = "/opt/rt4";
} elsif (-d "/opt/rt3" and -e "/opt/rt3/lib/RT.pm") {
    warn "Found RT in /opt/rt3\n";
    $ENV{RTHOME} = "/opt/rt3";
} else {
    die "Can't determine where RT is installed into; set the RTHOME environment variable\n" .
        "to the location of the base of your RT install.\n";
}

# The perl currently running is probably whatever was first in the path,
# which may not be what the installed RT uses.  Peek at the installed
# shebang lines to find out what we should re-exec ourselves with.
my $perl = find_perl();
if (not defined $perl) {
    warn "Can't determine perl binary that RT uses; assuming $^X\n";
} elsif (($ENV{PERL} || $^X) ne $perl) {
    warn "Using $perl to load RT...\n";
    $ENV{PERL} = $perl;
    exec($ENV{PERL}, $0, @ARGV) or die "Failed to run $perl: $!";
}


# Load RT
unshift @INC, "$ENV{RTHOME}/lib";
unshift @INC, "$ENV{RTHOME}/local/lib";

eval { require RT };
die "Failed to load RT: $@\n" if $@;

RT::LoadConfig();
RT::Init();


$| = 1;
require Getopt::Long;
my $fix;
Getopt::Long::GetOptions("fix!" => \$fix);

if ( $RT::VERSION =~ /^3\.8\.[0-8]\b/) {
    # This versions of RT needs RT::Extension::SaltedPasswords
    if ( eval {require RT::Extension::SaltedPasswords; 1} and not $@ ) {
        # Great, the extension is installed
        *sha256 = \&RT::Extension::SaltedPasswords::sha256;
    } else {
        die <<EOT;
This script upgrades users' passwords to a more secure hashing algorithm, but requires that RT::Extension::SaltedPasswords be installed, or you be running RT 3.8.9 or higher.  RT::Extension::SaltedPasswords can be downloaded from http://download.bestpractical.com/pub/rt/release/RT-Extension-SaltedPasswords.tar.gz
EOT
    }
} elsif ( eval {require Digest::SHA; 1} and not $@) {
    # Great, we have the module that we expect (on >= 3.8.9)
    *sha256 = \&Digest::SHA::sha256;
} else {
    die "Too early a version of RT (< 3.8) or Digest::SHA dependency not installed";
}

require RT::Users;
no warnings 'once';
my $users = RT::Users->new( $RT::SystemUser );
$users->Limit(
    FIELD => 'Password',
    OPERATOR => 'IS NOT',
    VALUE => 'NULL',
    ENTRYAGGREGATOR => 'AND',
);
$users->Limit(
    FIELD => 'Password',
    OPERATOR => '!=',
    VALUE => '*NO-PASSWORD*',
    ENTRYAGGREGATOR => 'AND',
);
$users->Limit(
    FIELD => 'Password',
    OPERATOR => 'NOT STARTSWITH',
    VALUE => '!',
    ENTRYAGGREGATOR => 'AND',
);
push @{$users->{'restrictions'}{ "main.Password" }}, "AND", {
    field => 'LENGTH(main.Password)',
    op => '<',
    value => '40',
};

# we want to update passwords on disabled users
$users->{'find_disabled_rows'} = 1;

my $count = $users->Count;
if ($count == 0) {
    print "No users with unsalted or weak cryptography found.\n";
    exit 0;
}

if ($fix) {
    print "Upgrading $count users...\n";
    while (my $u = $users->Next) {
        my $stored = $u->__Value("Password");
        my $raw;
        if (length $stored == 32) {
            $raw = pack("H*",$stored);
        } elsif (length $stored == 22) {
            $raw = MIME::Base64::decode_base64($stored);
        } elsif (length $stored == 13) {
            printf "%20s => Old crypt() format, cannot upgrade\n", $u->Name;
        } else {
            printf "%20s => Unknown password format!\n", $u->Name;
        }
        next unless $raw;

        my $salt = pack("C4",map{int rand(256)} 1..4);
        my $sha = sha256(
            $salt . $raw
        );
        $u->_Set(
            Field => "Password",
            Value => MIME::Base64::encode_base64(
                $salt . substr($sha,0,26), ""),
        );
    }
    print "Done.\n";
    exit 0;
} else {
    if ($count < 20) {
        print "$count users found with unsalted or weak-cryptography passwords:\n";
        print "      Id | Name\n", "-"x9, "+", "-"x9, "\n";
        while (my $u = $users->Next) {
            printf "%8d | %s\n", $u->Id, $u->Name;
        }
    } else {
        print "$count users found with unsalted or weak-cryptography passwords\n";
    }

    print "\n", "Run again with --fix to upgrade.\n";
    exit 1;
}


sub find_perl {
    my @files = qw|bin/rt bin/standalone_httpd sbin/standalone_httpd|;
    my ($file) = grep {-e $_} map {"$ENV{RTHOME}/$_"} @files;
    return undef unless $file;

    open(my $fh, "<", $file) or return;
    my ($shebang) = <$fh>;
    $shebang =~ /^#!(\S+)/ or return;

    return undef unless -x $1;
    return $1;
}
