#!/usr/bin/perl -w
#

use strict;
use lib "/opt/zimbra/common/lib/perl5";
use Getopt::Long;
use File::Basename;
use File::Path;
use Time::Local;
use Time::HiRes qw (gettimeofday);
use Date::Calc qw (:all);
use POSIX;
use IO::Compress::Gzip qw (gzip $GzipError);

my %LC;

sub getLocalConfig(;@) {
	my @vars = @_;
	my $dir = dirname(dirname($0));  # /opt/zimbra/libexec/zmbackupldap --> /opt/zimbra
	my $cmd = "$dir/bin/zmlocalconfig -q -x";
	if (scalar(@vars) > 0) {
		$cmd .= ' ' . join(' ', @vars);
	}
	open(LCH, "$cmd |") or die "Unable to invoke $cmd: $!";
	my $line;
	while (defined($line = <LCH>)) {
		$line =~ s/[\r\n]*$//;  # Remove trailing CR/LFs.
		my @fields = split(/\s*=\s*/, $line, 2);
		$LC{$fields[0]} = $fields[1];
	}
	close(LCH);
}

sub userCheck() {
	my $loggedIn = qx(id -un);
	chomp($loggedIn) if (defined($loggedIn));
	my $expected = $LC{zimbra_user};
	if ($loggedIn ne $expected) {
		print STDERR "Must be user $expected to run this command\n";
		exit(1);
	}
}

getLocalConfig('zimbra_user');
userCheck();

sub getLabel() {
    my ($seconds, $microseconds) = gettimeofday;
    my $ms = sprintf("%03d",$microseconds/1000);
    my ($sec, $min, $hour, $mday, $mon, $year) = gmtime($seconds);
    $year += 1900;
    $mon++;
    my $label = sprintf("full-%04d%02d%02d.%02d%02d%02d.%03d",
    					 $year, $mon, $mday, $hour, $min, $sec, $ms);
    return $label;
}

sub zmslapcat($;$) {
	my ($outdir, $zip) = @_;
	if (! -e $outdir) {
		mkpath($outdir) || die "Unable to create directory $outdir: $!";
	}
	my $cmd = "/opt/zimbra/libexec/zmslapcat $outdir";
	my $rc = system($cmd);
	$rc >>= 8;
	if ($rc != 0) {
		print STDERR "Unable to invoke $cmd: exit code = $rc";
		exit($rc);
	}
	system("rm -f $outdir/ldap.bak.*");
	$cmd = "/opt/zimbra/libexec/zmslapcat -c $outdir";
	$rc = system($cmd);
	$rc >>= 8;
	if ($rc != 0) {
		print STDERR "Unable to invoke $cmd: exit code = $rc";
		exit($rc);
	}
	system("rm -f $outdir/ldap-config.bak.*");
        if(defined($zip)) {
          my $input="$outdir/ldap.bak";
          my $status = gzip $input => "$input.gz"
            or die "gzip failed: $GzipError\n";

          $input="$outdir/ldap-config.bak";
          $status = gzip $input => "$input.gz"
            or die "gzip failed: $GzipError\n";

          unlink("$outdir/ldap.bak");
          unlink("$outdir/ldap-config.bak");
        }
}

sub getLabelTime($) {
    my $label = shift;
    if ($label =~ /-(\d\d\d\d)(\d\d)(\d\d)\.(\d\d)(\d\d)(\d\d)\.(\d\d\d)$/) {
        my ($year, $mon, $day, $hour, $min, $sec, $ms) = ($1, $2, $3, $4, $5, $6, $7);
        my $t = Time::Local::timegm($sec, $min, $hour, $day, $mon - 1, $year);
        return ($t, $ms);
    }
    return (0, 0);
}

sub listLabels($) {
    my $backupTarget = shift;
    my $sessionsDir = "$backupTarget/sessions";
    opendir(DIR, $sessionsDir) or die "Unable to open directory $sessionsDir: $!";
    my @labels = grep { /^[^\.]/ } readdir(DIR);
    closedir(DIR);
    return @labels;
}

sub parseDeleteThreshold($;$) {
    my ($val, $backupTarget) = @_;
    if ($val =~ /^full-/ || $val =~ /^incr-/) {
        # It's a label.
        my $labelDir = "$backupTarget/sessions/$val";
        if (-e $labelDir) {
            my ($t, $t_ms) = getLabelTime($val);
            if ($t == 0) {
                print STDERR "Invalid backup label: $val\n";
                return (0, 0);
            }
            return ($t, $t_ms);
        } else {
            print STDERR "No such backup label: $val\n";
            return (0, 0);
        }
    } elsif ($val =~ /^(\d+)([dmy])$/) {
        # It's a period.
        my ($now, $microseconds) = gettimeofday;
        my $ms = sprintf("%03d",$microseconds/1000);
        my ($n, $unit) = ($1, $2);
        if ($unit eq 'd') {
            my $delta = $n * 24 * 60 * 60;
            return $now - $delta;
        } elsif ($unit eq 'm') {
            my ($sec, $min, $hour, $mday, $mon, $year) = localtime($now);
            $mon -= $n;
            while ($mon < 0) {
                $year--;
                $mon += 12;
            }
            my $mdays = Days_in_Month($year+1900,$mon+1);
            if ($mday > $mdays) {
                $mday = $mdays;
            }
            my $t = Time::Local::timelocal($sec, $min, $hour, $mday, $mon, $year);
            return ($t, $ms);
        } elsif ($unit eq 'y') {
            my ($sec, $min, $hour, $mday, $mon, $year) = localtime($now);
            $year -= $n;
            my $t = Time::Local::timelocal($sec, $min, $hour, $mday, $mon, $year);
            return ($t, $ms);
        } else {
            print STDERR "Invalid period: $val\n";
            return (0, 0);
        }
    } elsif ($val =~ /^(\d\d\d\d)\/(\d\d)\/(\d\d)/) {
        # It's a timestamp. (in local time, not GMT)
        my ($year, $mon, $mday, $hour, $min, $sec) = ($1, $2, $3, 0, 0, 0);
        if ($val =~ /-(\d\d):(\d\d):(\d\d)$/) {
            ($hour, $min, $sec) = ($1, $2, $3);
        }
        my $t = Time::Local::timelocal($sec, $min, $hour, $mday, $mon - 1, $year);
        return ($t, 0);
    } else {
        print STDERR "Invalid threshold: $val\n";
        return (0, 0);
    }
}

sub toLocalTimestamp($;$) {
    my ($time, $ms) = @_;
    $ms |= 0;
    $ms = sprintf("%03d", $ms);
    my ($sec, $min, $hour, $mday, $mon, $year) = localtime($time);
    return POSIX::strftime("%a, %Y/%m/%d %H:%M:%S.$ms %Z", $sec, $min, $hour, $mday, $mon, $year);
}

sub deleteBackups($$$) {
    my ($threshold, $t_ms, $backupTarget) = @_;
    my $thresholdStr = toLocalTimestamp($threshold, $t_ms);
    print "Deleting backups on or older than $thresholdStr\n";
    my @labels = listLabels($backupTarget);
    foreach my $label (@labels) {
        my ($time, $millis) = getLabelTime($label);
        next if ($time == 0);  # not a backup label directory; leave it alone
        if ($time < $threshold || ($time == $threshold && $millis <= $t_ms)) {
            File::Path::rmtree("$backupTarget/sessions/$label");
            print "Deleting $label\n";
        }
    }
}

sub usage(;$) {
	my $rc = shift;
	if (!defined($rc)) {
		$rc = 1;
	}
	print <<_USAGE_;
Usage: zmbackupldap [--target <backup target directory>] [--zip]
       zmbackupldap --outdir <output directory> [--zip]
       zmbackupldap -del <label/date/period>

 -t,--target <arg>    backup target directory (default = /opt/zimbra/backup)
 -o,--outdir <arg>    full path to output directory
 --del <arg>          delete backups including and prior to the specified
                      label, date (YYYY/MM/DD[-hh:mm:ss]) or period (nn{d|m|y}).
 -z,--zip             gzip the finished backup

Back up LDAP data by calling zmslapcat.

If invoked using the first form, data is saved to <target>/tmp/<label>/ldap and
then moved to <target>/sessions/<label>/ldap.  <target> defaults to
/opt/zimbra/backup.  This form is used on a server that is running ldap but
not mailbox service.

The second form is used by the mailbox server when backing up a mailbox server
that is also running ldap.  Data is saved in --outdir directory and is not moved
anywhere.  This form should not be used when invoking this script directly.

The third form is used for purging old backups.
_USAGE_
	exit($rc);
}


# main

my $help;
my ($target, $outdir, $del, $zip) = ("/opt/zimbra/backup", undef, undef, undef);
my $opts_good = GetOptions(
	'help' => \$help,
	'target=s' => \$target,
	'outdir=s' => \$outdir,
	'del=s' => \$del,
	'zip' => \$zip,
);
if (!$opts_good) {
	print STDERR "\n";
	usage();
}
if ($help) {
	usage(0);
}

if (defined($del)) {
    if (defined($outdir)) {
        usage();
    }
    my ($t, $t_ms) = parseDeleteThreshold($del, $target);
    if ($t == 0) {
        usage();
    }
    deleteBackups($t, $t_ms, $target);
} elsif (defined($outdir)) {
	zmslapcat($outdir,$zip);
	print "$outdir\n";
} else {
	# ldap-only host
	my $label = getLabel();
	my $tmproot = "$target/tmp/$label";
	my $tmpdir = "$tmproot/ldap";
	mkpath($tmpdir) || die "Unable to create directory $tmpdir: $!";
	zmslapcat($tmpdir,$zip);
	my $dest = "$target/sessions/$label";
  if (! -e "$target/sessions") {
	  mkpath("$target/sessions") || die "Unable to create directory $target/sessions: $!";
  }
	rename($tmproot, $dest) || die "Unable to move $tmproot to $dest: $!";
	print "$label\n";
}
