6 files changed, 699 insertions, 0 deletions
diff --git a/rt/etc/upgrade/3.8-branded-queues-extension b/rt/etc/upgrade/3.8-branded-queues-extension
new file mode 100755
index 000000000..5f6e38a42
--- /dev/null
+++ b/rt/etc/upgrade/3.8-branded-queues-extension
@@ -0,0 +1,95 @@
+#!/usr/bin/perl
+# BEGIN BPS TAGGED BLOCK {{{
+#
+# COPYRIGHT:
+#
+# This software is Copyright (c) 1996-2013 Best Practical Solutions, LLC
+#                                          <sales@bestpractical.com>
+#
+# (Except where explicitly superseded by other copyright notices)
+#
+#
+# LICENSE:
+#
+# This work is made available to you under the terms of Version 2 of
+# the GNU General Public License. A copy of that license should have
+# been provided with this software, but in any event can be snarfed
+# from www.gnu.org.
+#
+# This work 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.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+# 02110-1301 or visit their web page on the internet at
+# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
+#
+#
+# CONTRIBUTION SUBMISSION POLICY:
+#
+# (The following paragraph is not intended to limit the rights granted
+# to you to modify and distribute this software under the terms of
+# the GNU General Public License and is only of importance to you if
+# you choose to contribute your changes and enhancements to the
+# community by submitting them to Best Practical Solutions, LLC.)
+#
+# By intentionally submitting any modifications, corrections or
+# derivatives to this work, or any other work intended for use with
+# Request Tracker, to Best Practical Solutions, LLC, you confirm that
+# you are the copyright holder for those contributions and you grant
+# Best Practical Solutions,  LLC a nonexclusive, worldwide, irrevocable,
+# royalty-free, perpetual, license to use, copy, create derivative
+# works based on those contributions, and sublicense and distribute
+# those contributions and any derivatives thereof.
+#
+# END BPS TAGGED BLOCK }}}
+use strict;
+use warnings;
+
+use lib "/opt/rt3/local/lib";
+use lib "/opt/rt3/lib";
+
+
+use RT;
+RT::LoadConfig();
+RT::Init();
+
+use RT::Queues;
+
+my $queues = RT::Queues->new( RT->SystemUser );
+$queues->UnLimit();
+while ( my $queue = $queues->Next ) {
+    print "Processing queue ". ($queue->Name || $queue->id) ."...\n";
+    my $old_attr = $queue->FirstAttribute('BrandedSubjectTag');
+    unless ( $old_attr ) {
+        print "\thas no old-style subject tag. skipping\n";
+        next;
+    }
+    my $old_value = $old_attr->Content;
+    unless ( $old_value ) {
+        print "\thas empty old-style subject tag\n";
+    } else {
+        my ($status, $msg) = $queue->SetSubjectTag( $old_value );
+        unless ( $status ) {
+            print STDERR "\tERROR. Couldn't set tag: $msg\n";
+            next;
+        } else {
+            print "\thave set new-style subject tag to '$old_value'\n";
+        }
+    }
+
+    my ($status, $msg) = $queue->DeleteAttribute('BrandedSubjectTag');
+    unless ( $status ) {
+        print STDERR "\tERROR. Couldn't delete old-style tag: $msg\n";
+        next;
+    } else {
+        print "\tdeleted old-style tag entry\n";
+    }
+    print "\tDONE\n";
+}
+
+exit 0;
+
diff --git a/rt/etc/upgrade/3.8-ical-extension b/rt/etc/upgrade/3.8-ical-extension
new file mode 100755
index 000000000..10239dc4e
--- /dev/null
+++ b/rt/etc/upgrade/3.8-ical-extension
@@ -0,0 +1,96 @@
+#!/usr/bin/perl
+# BEGIN BPS TAGGED BLOCK {{{
+#
+# COPYRIGHT:
+#
+# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC
+#                                          <sales@bestpractical.com>
+#
+# (Except where explicitly superseded by other copyright notices)
+#
+#
+# LICENSE:
+#
+# This work is made available to you under the terms of Version 2 of
+# the GNU General Public License. A copy of that license should have
+# been provided with this software, but in any event can be snarfed
+# from www.gnu.org.
+#
+# This work 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.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+# 02110-1301 or visit their web page on the internet at
+# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
+#
+#
+# CONTRIBUTION SUBMISSION POLICY:
+#
+# (The following paragraph is not intended to limit the rights granted
+# to you to modify and distribute this software under the terms of
+# the GNU General Public License and is only of importance to you if
+# you choose to contribute your changes and enhancements to the
+# community by submitting them to Best Practical Solutions, LLC.)
+#
+# By intentionally submitting any modifications, corrections or
+# derivatives to this work, or any other work intended for use with
+# Request Tracker, to Best Practical Solutions, LLC, you confirm that
+# you are the copyright holder for those contributions and you grant
+# Best Practical Solutions,  LLC a nonexclusive, worldwide, irrevocable,
+# royalty-free, perpetual, license to use, copy, create derivative
+# works based on those contributions, and sublicense and distribute
+# those contributions and any derivatives thereof.
+#
+# END BPS TAGGED BLOCK }}}
+use strict;
+use warnings;
+
+use lib "/opt/rt3/local/lib";
+use lib "/opt/rt3/lib";
+
+
+use RT;
+RT::LoadConfig();
+RT::Init();
+
+use RT::Attributes;
+my $attrs = RT::Attributes->new( RT->SystemUser );
+$attrs->Limit(FIELD => 'ObjectType', OPERATOR=> '=', VALUE => 'RT::User');
+$attrs->Limit(FIELD => 'Name', OPERATOR=> '=', VALUE => 'ical-auth-token');
+while ( my $attr = $attrs->Next ) {
+    my $uid = $attr->ObjectId;
+    print "Processing auth token of user #". $uid ."...\n";
+
+    my $user = RT::User->new( RT->SystemUser );
+    $user->Load( $uid );
+    unless ( $user->id ) {
+        print STDERR "\tERROR. Couldn't load user record\n";
+        next;
+    }
+
+    my ($status, $msg);
+
+    ($status, $msg) = $user->DeleteAttribute('AuthToken')
+        if $user->FirstAttribute('AuthToken');
+    unless ( $status ) {
+        print STDERR "\tERROR. Couldn't delete duplicated attribute: $msg\n";
+        next;
+    } else {
+        print "\tdeleted duplicate attribute\n";
+    }
+
+    ($status, $msg) = $attr->SetName('AuthToken');
+    unless ( $status ) {
+        print STDERR "\tERROR. Couldn't rename attribute: $msg\n";
+        next;
+    } else {
+        print "\trenamed attribute\n";
+    }
+    print "\tDONE\n";
+}
+
+exit 0;
diff --git a/rt/etc/upgrade/4.0-customfield-checkbox-extension b/rt/etc/upgrade/4.0-customfield-checkbox-extension
new file mode 100755
index 000000000..a3db13cab
--- /dev/null
+++ b/rt/etc/upgrade/4.0-customfield-checkbox-extension
@@ -0,0 +1,86 @@
+#!/usr/bin/perl
+# BEGIN BPS TAGGED BLOCK {{{
+#
+# COPYRIGHT:
+#
+# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC
+#                                          <sales@bestpractical.com>
+#
+# (Except where explicitly superseded by other copyright notices)
+#
+#
+# LICENSE:
+#
+# This work is made available to you under the terms of Version 2 of
+# the GNU General Public License. A copy of that license should have
+# been provided with this software, but in any event can be snarfed
+# from www.gnu.org.
+#
+# This work 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.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+# 02110-1301 or visit their web page on the internet at
+# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
+#
+#
+# CONTRIBUTION SUBMISSION POLICY:
+#
+# (The following paragraph is not intended to limit the rights granted
+# to you to modify and distribute this software under the terms of
+# the GNU General Public License and is only of importance to you if
+# you choose to contribute your changes and enhancements to the
+# community by submitting them to Best Practical Solutions, LLC.)
+#
+# By intentionally submitting any modifications, corrections or
+# derivatives to this work, or any other work intended for use with
+# Request Tracker, to Best Practical Solutions, LLC, you confirm that
+# you are the copyright holder for those contributions and you grant
+# Best Practical Solutions,  LLC a nonexclusive, worldwide, irrevocable,
+# royalty-free, perpetual, license to use, copy, create derivative
+# works based on those contributions, and sublicense and distribute
+# those contributions and any derivatives thereof.
+#
+# END BPS TAGGED BLOCK }}}
+use strict;
+use warnings;
+
+use lib "/opt/rt3/local/lib";
+use lib "/opt/rt3/lib";
+
+use RT;
+RT::LoadConfig();
+RT::Init();
+
+use RT::CustomFields;
+my $cfs = RT::CustomFields->new( RT->SystemUser );
+$cfs->{find_disabled_rows} = 1;
+$cfs->Limit(
+    FIELD => 'Type',
+    VALUE => 'SelectCheckbox',
+);
+
+while ( my $cf = $cfs->Next ) {
+    print 'Processing custom field #' . $cf->id . "\n";
+    my ( $ret, $msg ) = $cf->SetType('Select');
+    unless ($ret) {
+        warn "Failed to set custom field #"
+          . $cf->id
+          . " Type to 'Select': $msg\n";
+    }
+
+    ( $ret, $msg ) = $cf->SetRenderType('List');
+    unless ($ret) {
+        warn "Failed to set custom field #"
+          . $cf->id
+          . " RenderType to 'List': $msg\n";
+    }
+}
+
+print "DONE\n";
+
+exit 0;
diff --git a/rt/etc/upgrade/generate-rtaddressregexp b/rt/etc/upgrade/generate-rtaddressregexp
new file mode 100755
index 000000000..729228a3a
--- /dev/null
+++ b/rt/etc/upgrade/generate-rtaddressregexp
@@ -0,0 +1,109 @@
+#!/usr/bin/perl
+# BEGIN BPS TAGGED BLOCK {{{
+#
+# COPYRIGHT:
+#
+# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC
+#                                          <sales@bestpractical.com>
+#
+# (Except where explicitly superseded by other copyright notices)
+#
+#
+# LICENSE:
+#
+# This work is made available to you under the terms of Version 2 of
+# the GNU General Public License. A copy of that license should have
+# been provided with this software, but in any event can be snarfed
+# from www.gnu.org.
+#
+# This work 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.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+# 02110-1301 or visit their web page on the internet at
+# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
+#
+#
+# CONTRIBUTION SUBMISSION POLICY:
+#
+# (The following paragraph is not intended to limit the rights granted
+# to you to modify and distribute this software under the terms of
+# the GNU General Public License and is only of importance to you if
+# you choose to contribute your changes and enhancements to the
+# community by submitting them to Best Practical Solutions, LLC.)
+#
+# By intentionally submitting any modifications, corrections or
+# derivatives to this work, or any other work intended for use with
+# Request Tracker, to Best Practical Solutions, LLC, you confirm that
+# you are the copyright holder for those contributions and you grant
+# Best Practical Solutions,  LLC a nonexclusive, worldwide, irrevocable,
+# royalty-free, perpetual, license to use, copy, create derivative
+# works based on those contributions, and sublicense and distribute
+# those contributions and any derivatives thereof.
+#
+# END BPS TAGGED BLOCK }}}
+use strict;
+use warnings;
+
+use lib "/opt/rt3/local/lib";
+use lib "/opt/rt3/lib";
+
+use RT;
+RT::LoadConfig();
+RT->Config->Set('LogToScreen' => 'debug');
+RT::Init();
+
+$| = 1;
+
+if (my $re = RT->Config->Get('RTAddressRegexp')) {
+    print "No need to use this script, you already have RTAddressRegexp set to $re\n";
+    exit;
+}
+
+use RT::Queues;
+my $queues = RT::Queues->new( RT->SystemUser );
+$queues->UnLimit;
+
+my %merged;
+merge(\%merged, RT->Config->Get('CorrespondAddress'), RT->Config->Get('CommentAddress'));
+while ( my $queue = $queues->Next ) {
+    merge(\%merged, $queue->CorrespondAddress, $queue->CommentAddress);
+}
+
+my @domains;
+for my $domain (sort keys %merged) {
+    my @addresses;
+    for my $base (sort keys %{$merged{$domain}}) {
+        my @subbits = keys(%{$merged{$domain}{$base}});
+        if (@subbits > 1) {
+            push @addresses, "\Q$base\E(?:".join("|",@subbits).")";
+        } else {
+            push @addresses, "\Q$base\E$subbits[0]";
+        }
+    }
+    if (@addresses > 1) {
+        push @domains, "(?:".join("|", @addresses).")\Q\@".$domain."\E";
+    } else {
+        push @domains, "$addresses[0]\Q\@$domain\E";
+    }
+}
+my $re = join "|", @domains;
+
+print <<ENDDESCRIPTION;
+You can add the following to RT_SiteConfig.pm, but may want to collapse it into a more efficient regexp.
+Keep in mind that this only contains the email addresses that RT knows about, you should also examine
+your mail system for aliases that reach RT but which RT doesn't know about.
+ENDDESCRIPTION
+print "Set(\$RTAddressRegexp,qr{^(?:${re})\$}i);\n";
+
+sub merge {
+    my $merged = shift;
+    for my $address (grep {defined and length} @_) {
+        $address =~ /^\s*(.*?)(-comments?)?\@(.*?)\s*$/;
+        $merged->{lc $3}{$1}{$2||''}++;
+    }
+}
diff --git a/rt/etc/upgrade/split-out-cf-categories b/rt/etc/upgrade/split-out-cf-categories
new file mode 100755
index 000000000..b61ade316
--- /dev/null
+++ b/rt/etc/upgrade/split-out-cf-categories
@@ -0,0 +1,171 @@
+#!/usr/bin/perl
+# BEGIN BPS TAGGED BLOCK {{{
+#
+# COPYRIGHT:
+#
+# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC
+#                                          <sales@bestpractical.com>
+#
+# (Except where explicitly superseded by other copyright notices)
+#
+#
+# LICENSE:
+#
+# This work is made available to you under the terms of Version 2 of
+# the GNU General Public License. A copy of that license should have
+# been provided with this software, but in any event can be snarfed
+# from www.gnu.org.
+#
+# This work 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.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+# 02110-1301 or visit their web page on the internet at
+# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
+#
+#
+# CONTRIBUTION SUBMISSION POLICY:
+#
+# (The following paragraph is not intended to limit the rights granted
+# to you to modify and distribute this software under the terms of
+# the GNU General Public License and is only of importance to you if
+# you choose to contribute your changes and enhancements to the
+# community by submitting them to Best Practical Solutions, LLC.)
+#
+# By intentionally submitting any modifications, corrections or
+# derivatives to this work, or any other work intended for use with
+# Request Tracker, to Best Practical Solutions, LLC, you confirm that
+# you are the copyright holder for those contributions and you grant
+# Best Practical Solutions,  LLC a nonexclusive, worldwide, irrevocable,
+# royalty-free, perpetual, license to use, copy, create derivative
+# works based on those contributions, and sublicense and distribute
+# those contributions and any derivatives thereof.
+#
+# END BPS TAGGED BLOCK }}}
+use strict;
+use warnings;
+
+use lib "/opt/rt3/local/lib";
+use lib "/opt/rt3/lib";
+
+use RT;
+RT::LoadConfig();
+RT->Config->Set('LogToScreen' => 'debug');
+RT::Init();
+
+$| = 1;
+
+$RT::Handle->BeginTransaction();
+
+use RT::CustomFields;
+my $CFs = RT::CustomFields->new( RT->SystemUser );
+$CFs->UnLimit;
+$CFs->Limit( FIELD => 'Type', VALUE => 'Select' );
+
+my $seen;
+while (my $cf  = $CFs->Next ) {
+    next if $cf->BasedOnObj->Id;
+    my @categories;
+    my %mapping;
+    my $values = $cf->Values;
+    while (my $value = $values->Next) {
+        next unless defined $value->Category and length $value->Category;
+        push @categories, $value->Category unless grep {$_ eq $value->Category} @categories;
+        $mapping{$value->Name} = $value->Category;
+    }
+    next unless @categories;
+
+    $seen++;
+    print "Found CF '@{[$cf->Name]}' with categories:\n";
+    print "  $_\n" for @categories;
+
+    print "Split this CF's categories into a hierarchical custom field (Y/n)? ";
+    my $dothis = <>;
+    next if $dothis =~ /n/i;
+
+    print "Enter name of CF to create as category ('@{[$cf->Name]} category'): ";
+    my $newname = <>;
+    chomp $newname;
+    $newname = $cf->Name . " category" unless length $newname;
+
+    # bump the CF's sort oder up by one
+    $cf->SetSortOrder( ($cf->SortOrder || 0) + 1 );
+
+    # ..and add a new CF before it
+    my $new = RT::CustomField->new( RT->SystemUser );
+    my ($id, $msg) = $new->Create(
+        Name => $newname,
+        Type => 'Select',
+        MaxValues => 1,
+        LookupType => $cf->LookupType,
+        SortOrder => $cf->SortOrder - 1,
+    );
+    die "Can't create custom field '$newname': $msg" unless $id;
+
+    # Set the CF to be based on what we just made
+    $cf->SetBasedOn( $new->Id );
+
+    # Apply it to all of the same things
+    {
+        my $ocfs = RT::ObjectCustomFields->new( RT->SystemUser );
+        $ocfs->LimitToCustomField( $cf->Id );
+        while (my $ocf = $ocfs->Next) {
+            my $newocf = RT::ObjectCustomField->new( RT->SystemUser );
+            ($id, $msg) = $newocf->Create(
+                SortOrder => $ocf->SortOrder,
+                CustomField => $new->Id,
+                ObjectId => $ocf->ObjectId,
+            );
+            die "Can't create ObjectCustomField: $msg" unless $id;
+        }
+    }
+
+    # Copy over all of the rights
+    {
+        my $acl = RT::ACL->new( RT->SystemUser );
+        $acl->LimitToObject( $cf );
+        while (my $ace = $acl->Next) {
+            my $newace = RT::ACE->new( RT->SystemUser );
+            ($id, $msg) = $newace->Create(
+                PrincipalId => $ace->PrincipalId,
+                PrincipalType => $ace->PrincipalType,
+                RightName => $ace->RightName,
+                Object => $new,
+            );
+            die "Can't assign rights: $msg" unless $id;
+        }
+    }
+
+    # Add values for all of the categories
+    for my $i (0..$#categories) {
+        ($id, $msg) = $new->AddValue(
+            Name => $categories[$i],
+            SortOrder => $i + 1,
+        );
+        die "Can't create custom field value: $msg" unless $id;
+    }
+
+    # Grovel through all ObjectCustomFieldValues, and add the
+    # appropriate category
+    {
+        my $ocfvs = RT::ObjectCustomFieldValues->new( RT->SystemUser );
+        $ocfvs->LimitToCustomField( $cf->Id );
+        while (my $ocfv = $ocfvs->Next) {
+            next unless exists $mapping{$ocfv->Content};
+            my $newocfv = RT::ObjectCustomFieldValue->new( RT->SystemUser );
+            ($id, $msg) = $newocfv->Create(
+                CustomField => $new->Id,
+                ObjectType => $ocfv->ObjectType,
+                ObjectId   => $ocfv->ObjectId,
+                Content    => $mapping{$ocfv->Content},
+            );
+        }
+    }
+}
+
+$RT::Handle->Commit;
+print "No custom fields with categories found\n" unless $seen;
diff --git a/rt/etc/upgrade/vulnerable-passwords b/rt/etc/upgrade/vulnerable-passwords
new file mode 100755
index 000000000..7f278a0a7
--- /dev/null
+++ b/rt/etc/upgrade/vulnerable-passwords
@@ -0,0 +1,142 @@
+#!/usr/bin/perl
+# BEGIN BPS TAGGED BLOCK {{{
+#
+# COPYRIGHT:
+#
+# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC
+#                                          <sales@bestpractical.com>
+#
+# (Except where explicitly superseded by other copyright notices)
+#
+#
+# LICENSE:
+#
+# This work is made available to you under the terms of Version 2 of
+# the GNU General Public License. A copy of that license should have
+# been provided with this software, but in any event can be snarfed
+# from www.gnu.org.
+#
+# This work 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.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+# 02110-1301 or visit their web page on the internet at
+# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
+#
+#
+# CONTRIBUTION SUBMISSION POLICY:
+#
+# (The following paragraph is not intended to limit the rights granted
+# to you to modify and distribute this software under the terms of
+# the GNU General Public License and is only of importance to you if
+# you choose to contribute your changes and enhancements to the
+# community by submitting them to Best Practical Solutions, LLC.)
+#
+# By intentionally submitting any modifications, corrections or
+# derivatives to this work, or any other work intended for use with
+# Request Tracker, to Best Practical Solutions, LLC, you confirm that
+# you are the copyright holder for those contributions and you grant
+# Best Practical Solutions,  LLC a nonexclusive, worldwide, irrevocable,
+# royalty-free, perpetual, license to use, copy, create derivative
+# works based on those contributions, and sublicense and distribute
+# those contributions and any derivatives thereof.
+#
+# END BPS TAGGED BLOCK }}}
+use strict;
+use warnings;
+
+use lib "/opt/rt3/local/lib";
+use lib "/opt/rt3/lib";
+
+use RT;
+RT::LoadConfig;
+RT::Init;
+
+$| = 1;
+
+use Getopt::Long;
+use Digest::SHA;
+my $fix;
+GetOptions("fix!" => \$fix);
+
+use RT::Users;
+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 = Digest::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;
+}