upgrade.pl

#!/usr/bin/perl

use v5.10;

use strict;
use warnings;

use Data::Dumper;
use LWP::Simple;
use File::Spec;
use File::Temp;
use Getopt::Long;
use List::Util qw(max);
use Term::ANSIColor;

$|++;

GetOptions(
  'otrs|o=s'    => \my $otrs_home,
  'version=s'   => \my $version,
  'db=s'        => \my $db_type,
  'dbu=s'       => \my $db_user,
  'otrsuser=s'  => \my $otrs_user,
  'otrsgroup=s' => \my $otrs_group,
  'webuser=s'   => \my $web_user,
  'webgroup=s'  => \my $web_group,
);

$db_type //= 'mysql';
$db_user //= 'otrs';

$web_user  //= 'www-data';
$web_group //= 'www-data';

$otrs_user  //= 'otrs';
$otrs_group //= 'otrs';

check_root();

if ( !$otrs_home || !-d $otrs_home ) {
    print colored( ["red"], "need --otrs parameter\n" );
    exit 1;
}

check_running_services();

my $current_release = $version // get_current_release( $otrs_home );
say colored( ["yellow"], "Current release: $current_release" );

my @releases = get_releases_for_upgrade( $current_release );
say colored( ["yellow"], "Versions for upgrade:" );
say "\t" . $_->{version} for @releases;

my @packages          = package_list( $otrs_home, $current_release );
my %package_locations = package_locations( $otrs_home, $current_release );

my $tmp_dir   = File::Temp->newdir;
my @parts     = split /\//, $otrs_home;
pop @parts;

my $base_dir  = File::Spec->catdir( @parts );

say "BASE_DIR: $base_dir";

my $old_release = move_current_release( $base_dir, $otrs_home, $current_release );

for my $release ( @releases ) {
    my $file = download_otrs( $release, $tmp_dir );
    unzip( $base_dir, $file, $release );

    say colored( ["yellow"], "handle $release->{version}..." );

    my $new_dir = File::Spec->catdir(
        $base_dir,
        'otrs-' . $release->{version},
    );

    copy_files_from_current( $old_release, $new_dir );

    copy_files_from_current( $old_release, $new_dir );
    set_permissions($otrs_home, $release, $otrs_user, $otrs_group, $web_user, $web_group);
    check_modules( $new_dir, $release );
    run_migration_scripts( $new_dir, $release, lc $db_type, $db_user );
    upgrade_packages( $new_dir, $release, \@packages, \%package_locations );

    say colored( ["blue"], "You might want to check if everything works in the browser!" );
    say colored( ["blue"], "You might want to copy the apache2 configuration!" );
    say colored( ["blue"], "Check if all customizations are ported!" );
    print colored( ["yellow"], "Continue with next version? (y/N) " );
    chomp ( my $continue = <STDIN> );

    last if lc $continue ne 'y';
}

say "done...";

# ==============================================================================

sub upgrade_packages {
    my ($dir, $release, $packages, $map) = @_;

    say colored( ["yellow"], "Upgrade packages..." );

    my ($major, $minor) = split /\./, $release->{version};

    my $command;

    if ( $major < 3 ) {
       say colored( ["red"], "This doesn't work for OTRS < 3" );
       return;
    }
    elsif ( $major < 5 ) {
       my $script = File::Spec->catfile( $dir, 'bin', 'otrs.PackageManager.pl' );
       my @opts   = qw/-a upgrade -p/;

       $command = qq~perl $script @opts \%s~;
    }
    else {
       my $script = File::Spec->catfile( $dir, 'bin', 'otrs.Console.pl' );
       my @opts   = qw/Admin::Package::Upgrade/;

       $command = qq~su -c "perl $script @opts \%s" -s /bin/bash otrs~;
    }

    my $key = "$major.$minor";

    for my $package ( @{ $packages || [] } ) {
        my $url = $map->{$package}->{$key};
        say colored( ["yellow"], "Upgrade $package... try $url" );
        system sprintf $command, $url;
    }
}

sub package_list {
    my ($dir, $release) = @_;

    say colored( ["yellow"], "Get package list..." );

    my ($major, $minor) = split /\./, $release;

    my $package_list;
    if ( $major < 3 ) {
       say colored( ["red"], "This doesn't work for OTRS < 3" );
       return;
    }
    elsif ( $major < 5 ) {
       my $command = File::Spec->catfile( $dir, 'bin', 'otrs.PackageManager.pl' );
       $package_list = qx{perl $command -a list};
    }
    else {
       my $command = File::Spec->catfile( $dir, 'bin', 'otrs.Console.pl' );
       $package_list = qx{su -c "perl $command Admin::Package::List" -s /bin/bash otrs};
    }

    my @packages = $package_list =~ m{^ \| \s+ Name: \s+ ([^\n]+)}xmsg;
    say colored( ["yellow"], "Found packages:" );
    say "\t$_" for @packages;

    return @packages;
}

sub package_locations {
    my ($dir, $release) = @_;

    say colored( ["yellow"], "Get package locations..." );

    my ($major, $minor) = split /\./, $release;

    my @locations;
    if ( $major < 3 ) {
       say colored( ["red"], "This doesn't work for OTRS < 3" );
       return;
    }
    elsif ( $major < 5 ) {
       my $command = File::Spec->catfile( $dir, 'bin', 'otrs.PackageManager.pl' );
       my $list    = qx{yes 'n' | perl $command -a list-repository};
       @locations  = $list =~ m{URL: \s+ ([^\n]+)}xmsg;
    }
    else {
       my $command = File::Spec->catfile( $dir, 'bin', 'otrs.Console.pl' );
       my $full    = qx{su -c "perl $command Admin::Package::List" -s /bin/bash otrs};
       my ($list)  = split /\n\n/, $full;

       @locations  = $list =~ m{URL: \s+ ([^\n]+)}xmsg;
    }

    say "Get repository index...";
    my %map;
    for my $repo ( @locations ) {
        my $index = get $repo . '/otrs.xml';

        my @packages = $index =~ m{<Package>(.*?)</Package>}xms;
        for my $package ( @packages ) {
            my ($name)     = $package =~ m{<Name>\s*(.*?)\s*</Name>}xms;
            my @frameworks = $package =~ m{<Framework>\s*(.*?)\s*</Framework>}xmsg;
            my ($file)     = $package =~ m{<File>\s*(.*?)\s*</File>}xmsg;

            for my $framework ( @frameworks ) {
                $framework =~ s{\.\*}{};
                $map{$name}->{$framework} = $repo . $file;
            }
        }
    }

    say colored( ["green"], "done" );

    return %map;
}

sub run_migration_scripts {
    my ($dir, $release, $db_type, $db_user) = @_;

    say colored( ["yellow"], "run migration scripts..." );

    my ($major, $minor) = split /\./, $release->{version};

    my $suffix = $major;
    $suffix .= '.' . $minor if $major < 4;

    # run .sql script
    say "Apply database changes...";
    if ( $db_type eq 'mysql' ) {
        system qq~mysql -p -u $db_user -h localhost otrs~ .
            ' < ' . File::Spec->catdir( $dir, 'scripts', 'DBUpdate-to-' . $suffix . '.' . $db_type . '.sql' );
    }
    elsif ( $db_type eq 'postgresql' ) {
        system qq~psql --set ON_ERROR_STOP=on --single-transaction $db_user otrs~ .
            ' < ' . File::Spec->catdir( $dir, 'scripts', 'DBUpdate-to-' . $suffix . '.' . $db_type . '.sql' );
    }
    else {
        say colored( ["red"], "Apply database changes (.sql) manually!" );
    }

    say colored( ["red"], "Continue with RETURN" );
    <STDIN>;

    # run DBUpdate script
    say "run DBUpdate script...";
    my $script = File::Spec->catdir( $dir, 'scripts', 'DBUpdate-to-' . $suffix . '.pl' );
    system 'perl', $script;
    say colored( ["green"], "done" );
}

sub check_modules {
    my ($dir, $release) = @_;

    print colored( ["yellow"], "Check modules..." );
    my ($major, $minor) = split /\./, $release->{version};

    my $script = 'otrs.CheckModules.pl';
    if ( $major < 3 ) {
        $script = 'otrs.checkModules';
    }

    my $bin_path = File::Spec->catfile( $dir, 'bin', $script );
    my @modules  = qx{perl $bin_path};

    my $installer;
    my @to_install;

    MODULE:
    for my $module ( @modules ) {
        next if $module =~ m{\.+ (\e\[32m)? ok}xms;

        my ($mod_name) = $module =~ m{ \s+ ([A-Za-z0-9:_]+) \.}xms;

        if ( !$mod_name ) {
            say colored( ["blue"], "Cannot determine module from line $module" );
            next MODULE;
        }

        print colored( ["yellow"], "Install $mod_name? (y/N) " );
        chomp (my $install = <STDIN>);

        if ( lc $install eq 'y' ) {
            my ($tmp_installer , $package) = $module =~ m{
                Use: \s '([^']+) \s+ ([A-Za-z0-9-]+)'
            }xmg;

            $installer = $tmp_installer if $tmp_installer;
            push @to_install, $package  if $package;
            push @to_install, $mod_name if !$package;
        }
    }

    if ( @to_install && !$installer ) {
        say colored( ["red"], "\nCannot determine installer. Please install modules manually..." );
        say colored( ["red"], "Press RETURN to continue OTRS upgrade..." );
        <STDIN>;

        return;
    }
    elsif ( @to_install ) {
        system $installer, @to_install;
    }

    say colored( ["green"], "done" );
}

sub download_otrs {
    my ($rel, $dir) = @_;

    print colored( ["yellow"], "download $rel->{version}..." );
    my $target = File::Spec->catfile( $tmp_dir, $rel->{file} );

    getstore( "http://ftp.otrs.org/pub/otrs/$rel->{file}", $target );

    say colored( ["green"], "done" );

    return $target;
}

sub unzip {
    my ($dir, $file, $release) = @_;

    print colored( ["yellow"], "unzip otrs archive..." );
    system "tar zxf $file -C $dir";
    system "rm $dir/otrs";

    my $version = $release->{version};
    system "ln -s $dir/otrs-$version $dir/otrs";
    say colored( ["green"], "done" );
}

sub move_current_release {
    my ($dir, $home, $current_release) = @_;

    my $target = File::Spec->catdir( $dir, 'otrs-' . $current_release );

    if ( -d $target ) {
        say colored( ["green"], "$target already exists... do not move" );
        return $target;
    }

    print colored( ["yellow"], "move old release to $target..." );
    system "mv $home $target";
    system "mkdir $home";
    say colored( ["green"], "done" );

    return $target;
}

sub copy_files_from_current {
    my ($old_dir, $new_dir) = @_;

    say colored( ["yellow"], "Copy files from old release ($old_dir // $new_dir)..." );

    # Copy Config.pm
    say "\tcopy Config.pm";
    system "cp", File::Spec->catfile( $old_dir, 'Kernel', 'Config.pm' ),
                 File::Spec->catfile( $new_dir, 'Kernel', 'Config.pm' );

    # Copy ZZZAuto.pm
    say "\tcopy ZZZAuto.pm";
    system "cp", File::Spec->catfile( $old_dir, 'Kernel', 'Config', 'Files', 'ZZZAuto.pm' ),
                 File::Spec->catfile( $new_dir, 'Kernel', 'Config', 'Files', 'ZZZAuto.pm' );

    # Copy TicketCounter.log
    say "\tcopy TicketCounter.log";
    system "cp", File::Spec->catfile( $old_dir, 'var', 'log', 'TicketCounter.log' ),
                 File::Spec->catfile( $new_dir, 'var', 'log', 'TicketCounter.log' );

    # Copy article data
    say "\tcopy article data";
    system "cp", "-R", File::Spec->catfile( $old_dir, 'var', 'article', '*' ),
                       File::Spec->catdir(  $new_dir, 'var', 'article' );

    # Copy cronjobs
    say "\tcopy cronjobs";
    my $cronjob_dir = File::Spec->catdir( $old_dir, 'var', 'cron' );
    opendir( my $dirh, $cronjob_dir );
    while ( my $entry = readdir $dirh ) {
        my $path = File::Spec->catfile( $cronjob_dir, $entry );

        next if -d $path;
        next if $entry =~ m{\.dist$};

        system "cp", $path, File::Spec->catfile( $new_dir, 'var', 'cron', $entry );
    }

    say colored( ["green"], "done" );
}

sub set_permissions {
    my ($dir, $release, $otrs_user, $otrs_group, $web_user, $web_group) = @_;

    say colored( ["yellow"], "Set permissions..." );

    my %opts = (
        '< 3'  => [
            $dir, $otrs_user, $otrs_group, $web_user, $web_group,
        ],
        '== 3' => [
            '--otrs-user'  => $otrs_user,
            '--otrs-group' => $otrs_group,
            '--web-user'   => $web_user,
            '--web-group'  => $web_group,
        ],
        '== 4' => [
            '--otrs-user'  => $otrs_user,
            '--web-group'  => $web_group,
        ],
        '>= 5' => [
            '--otrs-user'  => $otrs_user,
            '--web-group'  => $web_group,
        ],
    );

    my @opts;

    my ($major) = split /\./, $release->{version};
    for my $key ( keys %opts ) {
        if ( eval $major . $key ) {
            @opts = @{ $opts{$key} };
        }
    }

    if ( $major < 3 ) {
        system 'sh', File::Spec->catfile( $dir, 'bin', 'SetPermissions.sh' ), @opts;
        return;
    }

    system 'perl', File::Spec->catfile( $dir, 'bin', 'otrs.SetPermissions.pl' ), @opts, $dir;

    say colored( ["green"], "done" );
}

sub get_current_release {
    my ($dir) = @_;

    my $path    = File::Spec->catfile( $dir, 'RELEASE' );
    my $content = do{ local (@ARGV, $/) = $path; <> };

    my ($current_release) = $content =~ m{VERSION \s+ = \s+ ([^\s]+)}xms;
    return $current_release;
}

sub get_releases_for_upgrade {
    my ($current) = @_;

    my ($major, $minor, $patch) = split /\./, $current;

    my %version_groups;
    my %otrs_map;

    my $listing = get "http://ftp.otrs.org/pub/otrs/";
    while ( $listing =~ m{
        href="
            (?<file>
                otrs-
                (?<version> [0-9\.]+ )
                \.tar\.gz
            )
        " }xmsg ) {

        my $version = $-{version}->[0];
        my ($tmajor, $tminor, $tpatch) = split /\./, $version;

        next if $tmajor < $major;
        next if $tmajor == $major && $tminor <= $minor;

        my $group_key = sprintf "%03d.%03d",     $tmajor, $tminor;
        my $otrs_key  = sprintf "%03d.%03d%03d", $tmajor, $tminor, $tpatch;

        $otrs_map{$otrs_key} = {
            file    => $-{file}->[0],
            version => $version,
        };

        push @{ $version_groups{$group_key} }, $otrs_key;
    }

    my @otrs;

    for my $group_key ( sort keys %version_groups ) {
        my $max = max @{ $version_groups{$group_key} };
        push @otrs, $otrs_map{$max};
    }

    return @otrs;
}

sub check_root {
    if ( $< != 0 ) {
        say colored( ["red"], "Need to run this script as root/sudo user" );
        exit 1;
    }
}

sub check_running_services {
   # check apache

   # check crontab
}