#! /usr/bin/perl

# usage: $0 /etc/rsnapshot.conf

# Copyright (C) 2009-2021 Arne Wichmann
#
# This little thing is distributed under the GNU General Public License,
# version 2. If you need the license, ask your distributor for it.

use strict;
use Time::Local;

# default args
my($rsyncargs)="-ax --stats --delete --numeric-ids --relative --delete-excluded";
my($root)="/var/cache/rsnapshot";
my($retry)='';
my($postcommand)='';

# search for lines beginning with backup in rsnapshots configfile and start
# an rsync adding the given options to the default args
# lines beginning with root contain the root directory for all backups
my(@backups);
my($yearly,$months,$weeks,$days) = ("all", 12, 4);
open(C,shift);
for (<C>) {
  if (s/^root\s+//) {
    chomp;
    $root=$_;
    next;
  } elsif (s/^precommand\s+//){
    chomp;
    my($return)=system($_);
    die "$_ returned $return (shift left by 8;)" if $return;
  } elsif (s/^postcommand\s+//){
    chomp;
    $postcommand=$_;
  } elsif (s/^backuptimes\s+//){
    chomp;
    my(@times)=split;
    for (@times) {
      /^(\d+)([ymwd])$/ || die "backuptimes $_ not supported";
      my($i,$ymwd)=($1,$2);
      if ($ymwd eq "y") {
        $i<1 or die "no yearly backup (0y) or one backup per year (no y".
	  " parameter) supported";
	$yearly=0;
      } elsif ($ymwd eq "m") {
        $months=$i;
      } elsif ($ymwd eq "w") {
        $weeks=$i;
      } elsif ($ymwd eq "d") {
        $days=$i;
      } else { die "$ymwd not supported (can not happen?)"; }
    }
  } elsif (s/^retry\s*$//){
    $retry='n';
  }
  next unless /^backup/;
  my ($rsa)=$rsyncargs;
  @_=split;
  for my $xc (split(",",$_[3])) { $rsa.=" --".$xc; }
  push(@backups,"rsync $rsa ".$_[1]." ".$_[2]);
}

# if there is a problem (even a non-fatal one) we set this to non-zero
my($exitcode)=0;

# find the name of todays backup and test if it already exists
chdir("$root") || die "oops?";
my(@time)=localtime(time);
my($backupname)=sprintf("backup.%04d%02d%02d",$time[5]+1900,$time[4]+1,$time[3]);
# my($backupname)=sprintf("backup.%04d%02d%02d",$time[5],$time[4],$time[3]);
if (-e "$backupname" and not $retry) {die "$backupname exists";}

# find all older backups 
my(@allbackups)=sort(glob("backup.????????"));

# take the newest existing backup and use it as starting point for todays
# backup. if there is none just create an empty dir.
# my($newestbackup)=$allbackups[$#allbackups];
# we want to keep the newest backup.
my($newestbackup)=pop(@allbackups);
if ($newestbackup eq $backupname) {$newestbackup=pop(@allbackups);}
if (-e $newestbackup) {
  my($return)=system("cp -al$retry $newestbackup/. $backupname");
  die "cp returned $return (shift left by 8;)" if $return;
  utime(time(),time(),$backupname) || warn "utime $backupname failed";
} else {
  print "Fullbackup!\n";
  mkdir "$root/$backupname" || die "oops?";
}

chdir("$root/$backupname") || die "oops?";

for (@backups) {
  my($return)=system($_);
  warn "rsync returned $return (shift left by 8;)" if $return;
  $exitcode=$return if $return;
}

chdir("$root") || die "oops?";

# $kunde will einen link auf den fileserver im backup haben
# symlink($backupname."/fileserver.local/home/fileserver",
#   sprintf("fileserver.%04d-%02d-%02d",$time[5]+1900,$time[4]+1,$time[3]));

# remove all backup which are more than 12 months old and on the 1st of a
# month or more than 4 weeks old and on a saturday or more than 7 days old
for (@allbackups) {
  # yearly - indefinite on 07-01
  /^backup.(....)0701$/ and next if $yearly;

  # monthly - 12 months 
  my($p)=sprintf("^backup.%04d(..)01\$",$time[5]+1899);
  if (/$p/) { next if 12+$time[4]+1-$1<$months; }
  $p=sprintf("^backup.%04d(..)01\$",$time[5]+1900);
  if (/$p/) { next if $time[4]+1-$1<$months; }

  # weekly - 4 weeks
  /^backup.(....)(..)(..)$/ or next;
  # TODO: timelocal buggily makes the program die if given invalid input
  my($btime)=timelocal(0,0,0,$3,$2-1,$1);
  my(@lbt)=localtime($btime);
  next if ($btime>time()-60*60*24*7*$weeks and $lbt[6]==6); # Samstags...

  # daily - 7 days
  next if ($btime>time()-60*60*24*$days);

  print "Test. Not removing $_\n";
  # system("rm -rf $_");

  # der baltech-link
  # /backup\.(....)(..)(..)/;
  # my($year,$mon)=($1+1900,$2+1);
  # s/backup\.(....)(..)(..)/fileserver.$year-$mon-$3/;
  # print "Unlinking $_\n";
  # unlink($_);
}

chdir('/') || die "oops?";

if ($postcommand) {
  my($return)=system($postcommand);
  die "$postcommand returned $return (shift left by 8;)" if $return;
}

exit $exitcode if $exitcode;