The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl

# $Id$

#- Copyright (C) 2006-2010 Mandriva SA

use strict;

BEGIN {
    #- clean environment
    $ENV{PATH} = "/sbin:/usr/sbin:/bin:/usr/bin";
    delete @ENV{qw(ENV BASH_ENV IFS CDPATH)};
}

use urpm::args;
use urpm::msg;
use URPM;
use urpm;

our $MACROS = '/etc/rpm/macros.d/urpmi.recover.macros';
our $listdate;
our $do_checkpoint;
our $noclean;
our $rollback;
our $disable;

sub usage () {
    print urpm::args::copyright('urpmi.recover', [ '2006-2010', 'Mandriva' ])
   . N("  --help         - print this help message.
") . N("  --checkpoint   - set repackaging start now
") . N("  --noclean      - don't clean repackage directory on checkpoint
") . N("  --urpmi-root   - use another root for urpmi db & rpm installation.
") . N("  --list         - list transactions since provided date/duration argument
") . N("  --list-all     - list all transactions in rpmdb (long)
") . N("  --list-safe    - list transactions since checkpoint
") . N("  --rollback     - rollback until specified date,
                   or rollback the specified number of transactions
") . N("  --disable      - turn off repackaging
");
    exit(1);
}

sub fmt_tid {
    my ($tid) = @_;
    require POSIX; POSIX->import('strftime');
    strftime("%F %T", localtime($tid));
}

sub date_to_tid {
    my ($date) = @_;
    require Date::Manip; Date::Manip->import;
    my $d = ParseDate($date)
	or die N("Invalid date or duration [%s]\n", $date);
    UnixDate($d, '%s');
}

#- clean up repackage directory
sub clean_repackage_dir {
    my ($repackage_dir) = @_;
    if (!$repackage_dir || $repackage_dir eq '/') {
	die N("Repackage directory not defined\n");
    }
    -d $repackage_dir
	or die N("Can't write to repackage directory [%s]\n", $repackage_dir);
    unless ($noclean) {
	print N("Cleaning up repackage directory [%s]...\n", $repackage_dir);
	my $nb = unlink grep { ! -d $_ } glob("$repackage_dir/*");
	print P("%d file removed\n", "%d files removed\n", $nb, $nb);
    }
}

#- option parsing

@ARGV or usage();
my $command_line = "@ARGV"; #- for logging
urpm::args::parse_cmdline()
    or exit(1);
@ARGV and die N("Spurious command-line arguments [%s]\n", "@ARGV");
$do_checkpoint && $rollback
    and die N("You can't specify --checkpoint and --rollback at the same time\n");
$do_checkpoint && $listdate
    and die N("You can't specify --checkpoint and --list at the same time\n");
$rollback && $listdate
    and die N("You can't specify --rollback and --list at the same time\n");
$disable && ($listdate || $rollback || $do_checkpoint)
    and die N("You can't specify --disable along with another option");

#- --list <date> and --list-all

if ($listdate) {
    my $listtime = -1;
    if ($listdate eq 'checkpoint') {
	URPM::read_config_files();
	$listtime = URPM::expand("%_unsafe_rollbacks");
    } elsif ($listdate ne -1) {
	#- convert to timestamp
	$listtime = date_to_tid($listdate);
    }
    my %tids;

    my $db = URPM::DB::open() or die "Can't open RPM DB\n";
    $db->traverse(sub {
	my ($p) = @_;
	my $tid = $p->installtid;
	return if $tid < $listtime;
	exists $tids{$tid} or $tids{$tid} = [];
	push @{ $tids{$tid} }, scalar($p->fullname);
    });

    unless (scalar keys %tids) {
	die N("No transaction found since %s\n", $listdate);
    }
    print "Date                rpms\n";
    print "------------------- -------------------\n";
    foreach my $tid (sort { $a <=> $b } keys %tids) {
	my @p = @{$tids{$tid}};
	print fmt_tid($tid), " ", shift(@p), "\n";
	while (@p) {
	    print " " x 20, shift(@p), "\n";
	}
    }
    exit(0);
}

#- check we're running as root
$< == 0 or die N("You must be superuser to do this");

#- --checkpoint

if ($do_checkpoint) {

    URPM::read_config_files();
    my $repackage_dir = URPM::expand("%_repackage_dir");
    my $unsafe_rollbacks = time();

    clean_repackage_dir($repackage_dir);

    #- write rpm config file
    print N("Writing rpm macros file [%s]...\n", $MACROS);
    open my $fh, '>', $MACROS
	or die "Can't open $MACROS for writing: $!\n";
    print $fh <<MACROS;
# Generated by urpmi.recover

# Turn repackaging on
%_repackage_all_erasures 1

# Put repackaged rpms here (lots of space necessary)
%_repackage_dir $repackage_dir

# Don't erase on rollback before this date (seconds since epoch)
%_unsafe_rollbacks $unsafe_rollbacks

# Automate transaction rollbacks on upgrade failure
%_rollback_transaction_on_failure 0
MACROS
    close $fh;

    sys_log("checkpoint defined");
    exit(0);
}

#- --rollback

if ($rollback) {
    sys_log("called with: $command_line");

    my $tid;
    if ($rollback !~ /\D/) {
	#- $rollback contains a number of transactions to roll back
	#- get a date from there
	my %tids;
	my $db = URPM::DB::open() or die "Can't open RPM DB\n";
	$db->traverse(sub { ++$tids{ $_[0]->installtid } });
	my @tids = sort { $b <=> $a } keys %tids;
	$tid = $tids[$rollback - 1];
    } else {
	#- $rollback contains a date, convert it to tid
	$tid = date_to_tid($rollback);
    }
    $tid or die N("No rollback date found\n");

    my $rollbackdate = fmt_tid($tid);
    print N("Rollback until %s...\n", $rollbackdate), "\n";
    exec '/bin/rpm', '-Uvh', '--rollback', $rollbackdate;
}

#- --disable

if ($disable) {
    print N("Disabling repackaging\n");

    unless ($noclean) {
	URPM::read_config_files();
	my $repackage_dir = URPM::expand("%_repackage_dir");
	clean_repackage_dir($repackage_dir);
    }

    open my $fh, '<', $MACROS
	or die "Can't open $MACROS for reading: $!\n";
    my $macrosfile = join '', <$fh>;
    close $fh;
    #- turn off repackaging macro
    $macrosfile =~ s/_repackage_all_erasures\s+\w+/_repackage_all_erasures 0/g;
    print N("Writing rpm macros file [%s]...\n", $MACROS);
    open $fh, '>', $MACROS
	or die "Can't open $MACROS for writing: $!\n";
    print $fh $macrosfile;
    close $fh;

    sys_log("repackaging disabled");
    exit(0);
}