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