1#!/bin/sh -
2#@ Simple updater, places backup and metadata files in $(REPO_)?OUTPUT_DIR.
3#@ default: (tar -rpf) backup.tar files changed since (timestamp of) last run
4#@ -r/--reset: do not take care about timestamps, do create xy.dateTtime.tar.XY
5#@ -c/--complete: other input (@COMPLETE_INPUT), always xy.dateTtime.tar.XY
6#@ -t/--timestamp: don't backup, but set the timestamp to the current time
7#@ -b/--basename: only with -r/-c: not xy.dateTtime.tar.XY but backup.tar.XY
8#@ With either of -r and -c $ADDONS, if existent, is removed.
9#@ 2015-10-09: add -b/--basename option, add $COMPRESSOR variable, start
10#@       via shell and $PERL5OPT clear to avoid multibyte problems
11#@ 2015-09-02: no longer following symbolic links
12#@ 2015-12-25: excluding symbolic links from archives; change $SYMLINK_INCLUDE
13#@       in the script header to change this.
14#@ 2016-08-27: s-it-mode;  FIX faulty xarg/tar -c invocations (Ralph Corderoy)
15#@ 2016-10-19: Renamed from backup.pl "now" that we start via sh(1).
16#@ 2016-10-19: Removed support for Mercurial: not tested in years.
17#@ ..2017-06-12: Various little fixes still due to the xarg/tar stuff.
18#@ 2017-06-13,14: Add $HOOK mechanism.
19#@ 2018-10-12: Fix $HOOK mechanism for filenames with spaces as shown by
20#@       POSIX, assuming no newlines are in a name:
21#@          sed −e 's/"/"\\""/g' −e 's/.*/"&"/'
22#@ 2018-11-12: add -p option to tar.
23#@ 2018-11-13: change builtin path set.
24#@ 2020-09-03, 2021-02-23: change builtin path set.
25#@ 2021-03-03: silence $COMPRESSOR
26#
27# 2010 - 2021 Steffen Nurpmeso <steffen@sdaoden.eu>.
28# Public Domain.
29
30# Now start perl(1) without PERL5OPT set to avoid multibyte sequence errors
31PERL5OPT= PERL5LIB= exec perl -x "${0}" "${@}"
32exit
33# Thanks to perl(5) and it's -x / #! perl / __END__ mechanism!
34# Why can env(1) not be used for such easy things in #!?
35#!perl
36
37## Note: all _absolute_ directories and _not_ globs ##
38
39# Home directory of user
40my $HOME = $ENV{'HOME'};
41# EMail address to send result to
42my $EMAIL = defined($ENV{'EMAIL'}) ? $ENV{'EMAIL'} : 'postmaster@localhost';
43
44# Where to store backup(s) and metadata
45my $OUTPUT_DIR = '/var/tmp/' . (getpwuid($<))[0] . '/backups';
46
47# We are also able to create backup bundles for git(1).
48# They are stored in the directory given here; note that these are *not*
49# automatically backed up, so place them in @XY_INPUT so that they end up in
50# the actual backup archive ...
51# Simply comment this variable out if you don't want this.
52my $REPO_OUTPUT_DIR = "$HOME/sec.arena/backups";
53
54# What actually happens is that $REPO_SRC_DIR is walked.
55# For git(1) this is xy.git (plus xy.git/.git).  Here we simply use the git(1)
56# "bundle" command with all possible flags to create the backup for everything
57# that is not found in --remotes, which thus automatically includes stashes
58# etc. (for the latter .git/logs/refs/stash is also backed up)
59my $REPO_SRC_DIR = "$HOME/src";
60
61# Our metadata storage file
62my $TSTAMP = "$OUTPUT_DIR/.-backup.dat";
63
64# Sometimes there is temporarily a directory which also should be backed up,
65# but adjusting the backup script is too blown for this.
66# If this file here exists, each line is treated as the specification of such
67# a directory (again: absolute paths, please).
68# $ADDONS will be removed in complete/reset mode, if it exists.
69my $ADDONS = "$OUTPUT_DIR/.backup-addons.txt";
70
71# A hook can be registered for archive creation, it will read the file to be
72# backup-up from standard input.
73# It takes two arguments: a boolean that indicates whether complete/reset
74# mode was used, and the perl $^O string (again: absolute paths, please).
75my $HOOK = "$OUTPUT_DIR/.backup-hook.sh";
76
77# A fileglob (may really be a glob) and a list of directories to always exclude
78my $EXGLOB = '._* *~ %* *.swp .encfs*.xml';
79my @EXLIST = qw(.DS_Store .localized .Trash);
80
81# List of input directories for normal mode/--complete mode, respectively.
82# @NORMAL_INPUT is regulary extended by all directories found in $ADDONS, iff
83my @NORMAL_INPUT = (
84   "$HOME/arena",
85   "$HOME/.secweb-mozilla",
86   "$HOME/.sec.arena",
87   "$HOME/.sic",
88   "/x/doc"
89);
90my @COMPLETE_INPUT = (
91   "$HOME/arena",
92   "$HOME/.secweb-mozilla",
93   "$HOME/.sec.arena",
94   "$HOME/.sic"
95);
96
97# Symbolic links will be skipped actively if this is true.
98# Otherwise they will be added to the backup as symbolic links!
99my $SYMLINK_INCLUDE = 0;
100
101# Compressor for --complete and --reset.  It must compress its filename
102# argument to FILENAME${COMPRESSOR_EXT}.  If it does not remove the original
103# file, we will do
104my $COMPRESSOR = 'zstd -19 -T0 -q';
105my $COMPRESSOR_EXT = '.zst';
106
107###  --  >8  --  8<  --  ###
108
109#use diagnostics -verbose;
110use warnings;
111#use strict;
112use sigtrap qw(die normal-signals);
113use File::Temp;
114use Getopt::Long;
115use IO::Handle;
116
117my ($COMPLETE, $RESET, $TIMESTAMP, $BASENAME, $VERBOSE) = (0, 0, 0, 0, 0);
118my $FS_TIME_ANDOFF = 3; # Filesystem precision adjust (must be mask) ...
119my $INPUT; # References to above syms
120
121# Messages also go into this finally mail(1)ed file
122my ($MFFH,$MFFN) = File::Temp::tempfile(UNLINK => 1);
123
124jMAIN:{
125   msg(0, "Parsing command line");
126   Getopt::Long::Configure('bundling');
127   GetOptions('c|complete' => \$COMPLETE, 'r|reset' => \$RESET,
128         't|timestamp' => \$TIMESTAMP, 'b|basename' => \$BASENAME,
129         'v|verbose' => \$VERBOSE);
130   if($COMPLETE){
131      msg(1, 'Using "complete" backup configuration');
132      $INPUT = \@COMPLETE_INPUT
133   }else{
134      $INPUT = \@NORMAL_INPUT
135   }
136   $RESET = 1 if $TIMESTAMP;
137   msg(1, 'Ignoring old timestamps due to "--reset"') if $RESET;
138   msg(1, 'Only updating the timestamp due to "--timestamp"') if $TIMESTAMP;
139   err(1, '-b/--basename only meaningful with "--complete" or "--reset"')
140      if $BASENAME && !($COMPLETE || $RESET);
141
142   Timestamp::query();
143   unless($TIMESTAMP){
144      Addons::manage($COMPLETE || $RESET);
145
146      GitBundles::create();
147
148      Filelist::create();
149      unless(Filelist::is_any()){
150         Timestamp::save();
151         do_exit(0)
152      }
153
154      if(Hook::exists()){
155         Hook::call()
156      }else{
157         Archive::create()
158      }
159   }
160   Timestamp::save();
161
162   exit(0) if $TIMESTAMP;
163   do_exit(0)
164}
165
166sub msg{
167   my $args = \@_;
168   my $lvl = shift @$args;
169   foreach my $a (@$args){
170      my $m = '- ' . ('  ' x $lvl) . $a . "\n";
171      print STDOUT $m;
172      print $MFFH $m
173   }
174   $MFFH->flush()
175}
176
177sub err{
178   my $args = \@_;
179   my $lvl = shift @$args;
180   foreach my $a (@$args){
181      my $m = '! ' . ('  ' x $lvl) . $a . "\n";
182      print STDERR $m;
183      print $MFFH $m
184   }
185   $MFFH->flush()
186}
187
188sub do_exit{
189   my $estat = $_[0];
190   if($estat == 0){ msg(0, 'mail(1)ing report and exit success') }
191   else{ err(0, 'mail(1)ing report and exit FAILURE') }
192   $| = 1;
193   system("mail -s 'Backup report (" . Filelist::count() . # XXX use sendmail
194         " file(s))' $EMAIL < $MFFN >/dev/null 2>&1");
195   $| = 0;
196   exit $estat
197}
198
199{package Timestamp;
200   $CURRENT = 0;
201   $CURRENT_DATE = '';
202   $LAST = 916053068;
203   $LAST_DATE = '1999-01-11T11:11:08 GMT';
204
205   sub query{
206      $CURRENT = time;
207      $CURRENT &= ~$FS_TIME_ANDOFF;
208      $CURRENT_DATE = _format_epoch($CURRENT);
209      ::msg(0, "Current timestamp: $CURRENT ($CURRENT_DATE)");
210      _read() unless $RESET
211   }
212
213   sub save{
214      ::msg(0, "Writing current timestamp to <$TSTAMP>");
215      unless(open TSTAMP, '>', $TSTAMP){
216         ::err(1, "Failed to open for writing: $^E",
217               'Ensure writeability and re-run!');
218         ::do_exit(1)
219      }
220      print TSTAMP "$CURRENT\n(That's $CURRENT_DATE)\n";
221      close TSTAMP
222   }
223
224   sub _read{
225      ::msg(0, "Reading old timestamp from <$TSTAMP>");
226      unless(open TSTAMP, '<', $TSTAMP){
227         ::err(1, 'Timestamp file cannot be read - setting --reset option');
228         $RESET = 1
229      }else{
230         my $l = <TSTAMP>;
231         close TSTAMP;
232         chomp $l;
233         if($l !~ /^\d+$/){
234            ::err(1, 'Timestamp corrupted - setting --reset option');
235            $RESET = 1;
236            return
237         }
238         $l = int $l;
239
240         $l &= ~$FS_TIME_ANDOFF;
241         if($l >= $CURRENT){
242            ::err(1, 'Timestamp corrupted - setting --reset option');
243            $RESET = 1
244         }else{
245            $LAST = $l;
246            $LAST_DATE = _format_epoch($LAST);
247            ::msg(1, "Got $LAST ($LAST_DATE)")
248         }
249      }
250   }
251
252   sub _format_epoch{
253      my @e = gmtime $_[0];
254      return sprintf('%04d-%02d-%02dT%02d:%02d:%02d GMT',
255            ($e[5] + 1900), ($e[4] + 1), $e[3], $e[2], $e[1], $e[0])
256   }
257}
258
259{package Addons;
260   sub manage{
261      unless(-f $ADDONS){
262         ::msg(0, "Addons: \"$ADDONS\" does not exist, skip");
263         return
264      }
265      (shift != 0) ? _drop() : _load()
266   }
267
268   sub _load{
269      ::msg(0, "Addons: reading \"$ADDONS\"");
270      unless(open AO, '<', $ADDONS){
271         ::err(1, 'Addons file cannot be read');
272         ::do_exit(1)
273      }
274      foreach my $l (<AO>){
275         chomp $l;
276         unless(-d $l){
277            ::err(1, "Addon \"$l\" is not accessible");
278            ::do_exit(1)
279         }
280         ::msg(1, "Adding-on \"$l\"");
281         unshift @$INPUT, $l
282      }
283      close AO
284   }
285
286   sub _drop{
287      ::msg(0, "Addons: removing \"$ADDONS\"");
288      unless(unlink $ADDONS){
289         ::err(1, "Addons file cannot be deleted: $^E");
290         ::do_exit(1)
291      }
292   }
293}
294
295{package GitBundles;
296   my @Git_Dirs;
297
298   sub create{
299      return unless defined $REPO_OUTPUT_DIR;
300      _create_list();
301      _create_backups() if @Git_Dirs
302   }
303
304   sub _create_list{
305      ::msg(0, 'Collecting git(1) repo information');
306      unless(-d $REPO_OUTPUT_DIR){
307         ::err(0, 'FAILURE: no Git backup-bundle dir found');
308         ::do_exit(1)
309      }
310
311      unless(opendir DIR, $REPO_SRC_DIR){
312         ::err(1, "opendir($REPO_SRC_DIR) failed: $^E");
313         ::do_exit(1)
314      }
315      my @dents = readdir DIR;
316      closedir DIR;
317
318      foreach my $dent (@dents){
319         next if $dent eq '.' || $dent eq '..';
320         my $abs = $REPO_SRC_DIR . '/' . $dent;
321         next unless -d $abs;
322         next unless $abs =~ /\.git$/;
323         next unless -d "$abs/.git";
324         push @Git_Dirs, $dent;
325         ::msg(1, "added <$dent>")
326      }
327   }
328
329   sub _create_backups{
330      ::msg(0, "Creating Git bundle backups");
331      foreach my $e (@Git_Dirs){
332         ::msg(1, "Processing $e");
333         my $src = $REPO_SRC_DIR . '/' . $e;
334         unless(chdir $src){
335            ::err(2, "GitBundles: cannot chdir($src): $^E");
336            ::do_exit(1)
337         }
338
339         _do_bundle($e)
340      }
341   }
342
343   sub _do_bundle{
344      my $repo = shift;
345      my ($target, $flag, $pop_stash, $omodt);
346      ::msg(2, 'Checking for new bundle') if $VERBOSE;
347
348      $target = "$REPO_OUTPUT_DIR/$repo";
349      $target = $1 if $target =~ /(.+)\..+$/;
350      $target .= '.bundle';
351      $flag = '--all --not --remotes --tags';
352      ::msg(3, "... target: $target") if $VERBOSE;
353
354      $pop_stash = system('git update-index -q --refresh; ' .
355            'git diff-index --quiet --cached HEAD ' .
356               '--ignore-submodules -- && ' .
357            'git diff-files --quiet --ignore-submodules && ' .
358            'test -z "$(git ls-files -o -z)"');
359      $pop_stash >>= 8;
360      if($pop_stash != 0){
361         ::msg(3, 'Locale modifications exist, stashing them away')
362            if $VERBOSE;
363         $pop_stash = system('git stash --all >/dev/null 2>&1');
364         $pop_stash >>= 8;
365         if($pop_stash++ != 0){
366            ::err(3, '"git(1) stash --all" away local modifications ' .
367               "failed in $repo");
368            ::do_exit(1)
369         }
370      }
371
372      $flag = system("git bundle create $target $flag >> $MFFN 2>&1");
373      seek $MFFH, 0, 2;
374      # Does not create an empty bundle: 128
375      if($flag >> 8 == 128){
376         ::msg(3, 'No updates available, dropping outdated bundles, if any')
377            if $VERBOSE;
378         ::err(3, "Failed to unlink outdated bundle $target: $^E")
379            if (-f $target && unlink($target) != 1);
380         ::err(3, "Failed to unlink outdated $target.stashlog: $^E")
381            if (-f "$target.stashlog" && unlink("$target.stashlog") != 1)
382      }elsif($flag >> 8 != 0){
383         ::err(3, "git(1) bundle failed for $repo ($target)");
384         ::do_exit(1)
385      }
386      # Unfortunately stashes in bundles are rather useless without the
387      # additional log file (AFAIK)!
388      elsif(-f ".git/logs/refs/stash"){
389         ::msg(3, ".git/logs/refs/stash exists, creating $target.stashlog")
390            if $VERBOSE;
391         unless(open SI, '<', '.git/logs/refs/stash'){
392            ::err(4, 'Failed to read .git/logs/refs/stash');
393            ::do_exit(1)
394         }
395         unless(open SO, '>', "$target.stashlog"){
396            ::err(4, "Failed to write $target.stashlog");
397            ::do_exit(1)
398         }
399         print SO "# Place this in .git/logs/refs/stash\n" ||
400            ::do_exit("Failed to write $target.stashlog");
401         print SO $_ || ::do_exit("Failed to write $target.stashlog")
402            foreach(<SI>);
403         close SO;
404         close SI
405      }
406      # And then, there may be a bundle but no (more) stash
407      elsif(-f "$target.stashlog" && unlink("$target.stashlog") != 1){
408         ::err(3, "Failed to unlink outdated $target.stashlog: $^E")
409      }
410
411      if($pop_stash != 0){
412         ::msg(3, 'Locale modifications existed, popping the stash')
413            if $VERBOSE;
414         $pop_stash = system('git stash pop >/dev/null 2>&1');
415         ::err(3, '"git(1) stash pop" the local modifications ' .
416               "failed in $repo") if ($pop_stash >> 8 != 0)
417      }
418   }
419}
420
421{package Filelist;
422   my @List;
423
424   sub create{
425      ::msg(0, 'Checking input directories');
426      for(my $i = 0; $i < @$INPUT;){
427         my $dir = $$INPUT[$i++];
428         if(! -d $dir){
429            splice @$INPUT, --$i, 1;
430            ::err(1,  "DROPPED <$dir>")
431         }else{
432            ::msg(1, "added <$dir>")
433         }
434      }
435      if(@$INPUT == 0){
436         ::err(0, 'FAILURE: no (accessible) directories found');
437         ::do_exit(1)
438      }
439
440      ::msg(0, 'Creating backup filelist');
441      _parse_dir($_) foreach @$INPUT;
442      ::msg(0, '... scheduled ' .@List. ' files for backup')
443   }
444
445   sub is_any{ return @List > 0 }
446   sub count{ return scalar @List }
447   sub get_listref{ return \@List }
448
449   sub _parse_dir{
450      my ($abspath) = @_;
451      # Need to chdir() due to glob(@EXGLOB) ...
452      ::msg(1, ".. checking <$abspath>") if $VERBOSE;
453      unless(chdir $abspath){
454         ::err(1, "Cannot chdir($abspath): $^E");
455         return
456      }
457      unless(opendir DIR, '.'){
458         ::err(1, "opendir($abspath) failed: $^E");
459         return
460      }
461      my @dents = readdir DIR;
462      closedir DIR;
463      my @exglob = glob $EXGLOB;
464
465      my @subdirs;
466jOUTER:
467      foreach my $dentry (@dents){
468         next if $dentry eq '.' || $dentry eq '..';
469         foreach(@exglob){
470            if($dentry eq $_){
471               ::msg(2, "<$dentry> glob-excluded") if $VERBOSE;
472               next jOUTER
473            }
474         }
475         foreach(@EXLIST){
476            if($dentry eq $_){
477               ::msg(2, "<$dentry> list-excluded") if $VERBOSE;
478               next jOUTER
479            }
480         }
481
482         my $path = "$abspath/$dentry";
483         if(-d $dentry){
484            push(@subdirs, $path);
485            ::msg(2, "<$dentry> dir-traversal enqueued") if $VERBOSE
486         }elsif(-f _){
487            if(!-r _){
488               ::err(2, "<$path> not readable");
489               next jOUTER
490            }
491            if(!$SYMLINK_INCLUDE){
492               lstat $dentry;
493               if(-l _){
494                  ::msg(2, "excluded symbolic link <$dentry>")
495                     if $VERBOSE;
496                  next jOUTER
497               }
498            }
499
500            my $mtime = (stat _)[9] & ~$FS_TIME_ANDOFF;
501            if($RESET || $mtime >= $Timestamp::LAST){
502               push @List, $path;
503               if($VERBOSE){ ::msg(2, "added <$dentry>") }
504               else{ ::msg(1, "a <$path>") }
505            }elsif($VERBOSE){
506               ::msg(2, "time-miss <$dentry>")
507            }
508         }
509      }
510      foreach(@subdirs){ _parse_dir($_) }
511   }
512}
513
514{package Archive;
515   sub create{
516      my $backup = 'backup'; #$COMPLETE ? 'complete-backup' : 'backup';
517
518      my ($ar, $far);
519      if($RESET || $COMPLETE){
520         if(!$BASENAME){
521            $ar = $Timestamp::CURRENT_DATE;
522            $ar =~ s/:/_/g;
523            $ar =~ s/^(.*?)[[:space:]]+[[:alpha:]]+[[:space:]]*$/$1/;
524            $ar = "$OUTPUT_DIR/monthly-$backup-$ar.tar"
525         }else{
526            $ar = "$OUTPUT_DIR/$backup.tar"
527         }
528         $far = $ar . $COMPRESSOR_EXT;
529         ::msg(0, "Creating complete archive <$far>");
530         if(-e $far){
531            ::err(3, "Archive <$far> already exists");
532            ::do_exit(1)
533         }
534         if(-e $ar && !unlink $ar){
535            ::err(1, "Old archive <$ar> exists but cannot be deleted: $^E");
536            ::do_exit(1)
537         }
538      }else{
539         $ar = "$OUTPUT_DIR/$backup.tar";
540         ::msg(0, "Creating/Updating archive <$ar>")
541      }
542
543      unless(open XARGS, "| xargs -0 tar -r -p -f $ar >>$MFFN 2>&1"){
544         ::err(1, "Failed to create pipe: $^E");
545         ::do_exit(1)
546      }
547      my $listref = Filelist::get_listref();
548      foreach my $p (@$listref){ print XARGS $p, "\x00" }
549      close XARGS;
550
551      if($RESET || $COMPLETE){
552         system("</dev/null $COMPRESSOR $ar >>$MFFN 2>&1");
553         unless(! -f $ar || unlink $ar){
554            ::err(1, "Temporary archive $ar cannot be deleted: $^E");
555            ::do_exit(1)
556         }
557      }
558
559      seek $MFFH, 0, 2
560   }
561}
562
563{package Hook;
564   sub exists{
565      -x $HOOK
566   }
567
568   sub call{
569      unless(open HOOK, "| $HOOK " . ($COMPLETE || $RESET) .
570            " $^O >>$MFFN 2>&1"){
571         ::err(1, "Failed to create hook pipe: $^E");
572         ::do_exit(1)
573      }else{
574         my ($stop, $listref) = (0, Filelist::get_listref());
575         local *hdl = sub{ $stop = 1 };
576         local $SIG{PIPE} = \&hdl;
577         foreach my $p (@$listref){
578            last if $stop;
579            $p =~ s/\"/\"\\\"\"/g;
580            $p = '"' . $p . '"';
581            print HOOK $p, "\n"
582         }
583      }
584      close HOOK;
585
586      seek $MFFH, 0, 2
587   }
588}
589
590# vim:set ft=perl:s-it-mode
591