packdir.pl

#!/usr/bin/env perl
use strict;
use warnings;
use File::Find;
use File::Spec;
use File::Basename;
use File::Path qw(make_path);
use MIME::Base64;

my $srcdir = shift or die "Usage: $0 /path/to/dir\n";
my $outfile = shift || 'self_extracting.pl';
die "outfile $outfile exists" if -e $outfile;
my @files;

find(sub {
  return if -d;
  my $path = $File::Find::name;
  my $rel = File::Spec->abs2rel($path, $srcdir);
  my ($mode, $uid, $gid) = (stat($path))[2, 4, 5];
  open my $fh, '<', $path or die "Can't open $path: $!";
  binmode $fh;
  my $data = do { local $/; <$fh> };
  close $fh;
  push @files, [$rel, $mode & 07777, $uid, $gid, encode_base64($data, '')];
}, $srcdir);

open my $out, '>', $outfile or die "Can't write $outfile: $!";
print $out "#!/usr/bin/env perl\n";
print $out <<'__EXTRACTOR__';
use strict;
use warnings;
use File::Path qw(make_path);
use File::Basename;
use MIME::Base64;

my $payload;
my $in_payload;

my $path = $file->{path};
my $dir  = dirname($path);
make_path($dir) unless -d $dir;
open my $fh, '>', $path or die "Can't write $path: $!";
binmode $fh;
print $fh decode_base64($file->{data});
close $fh;
chmod $file->{mode}, $path;
chown $file->{uid}, $file->{gid}, $path;
print "Extracted $path\n";
}
exit;
__DATA__
__EXTRACTOR__

print $out "\n__DATA__\n";
printf $out "%s\t%s\t%s\t%s\t%s\n", @$_ for @files;
close $out;
chmod 0755, $outfile;

print "Packed ", scalar(@files), " files into $outfile\n";

syn_aft.pl

#!/usr/bin/perl

package Digest::SHA::PurePerl;


package main;
use 5.008;
use strict;
use warnings;

# $ sync-aft dot-file-name verification-code

my ($aft_name, $exp_code) = @ARGV;
die "usage: $0 aft_name expected_code\n" unless $aft_name && $exp_code;

my $cachedir = $ENV{CACHEDIR} || '/mnt/media';
die "$cachedir does not exist" unless -d $cachedir;
my $aft_file = "$cachedir/.$aft_name.aft";
die "$aft_file does not exist" unless -f $aft_file;
my $remote = $ENV{REMOTE} || 'host:';
my $tmpdir = join '/', ($ENV{TMPDIR} || '/tmp'), $aft_name;
mkdir $tmpdir;
die "cannot create $tmpdir" unless -d $tmpdir;
END { @_ = glob("$tmpdir/.* $tmpdir/*"); unlink @_ and rmdir "$tmpdir" if scalar @_ && -d $tmpdir; }
# warn join "\n", $aft_name, $exp_code, $cachedir, $aft_file, $remote, $tmpdir;

my @shas = ();
open AFT, $aft_file;
my @aft = sort { $a->[1] cmp $b->[1] } map { [split /\t/] } <AFT>;
close AFT;
my $sha_aft = Digest::SHA::PurePerl->new(256);
foreach my $aft (@aft) {
  my ($exp_sha, $filename, $comment) = @$aft;
  my $sha_file = Digest::SHA::PurePerl->new(256);
  open FILENAME, ">$tmpdir/.$filename";
  binmode FILENAME, ':raw';
  foreach (sort glob("$cachedir/$exp_sha.*")) {
    open FILE, $_;
    my $offset = 0;
    my $buffer;
    while (my $read = sysread FILE, $buffer, $ENV{READ_LENGTH} || 128_000, $offset) {
      print FILENAME $buffer or last;
      $offset += $read;
      $sha_file->add($buffer);
      $sha_aft->add($buffer);
    }
    close FILE;
  }
  close FILENAME;
  my $act_sha = $sha_file->hexdigest;
  if ($act_sha eq $exp_sha) {
    print STDERR "good file $filename\n";
    rename "$tmpdir/.$filename", "$tmpdir/$filename";
    push @shas, [$act_sha, $filename];
  }
  else {
    print STDERR "bad file $filename ($act_sha != $exp_sha)\n";
    warn "$tmpdir/.$filename";
  }
}
my $act_code = substr $sha_aft->hexdigest, 0, length $exp_code;
if ($act_code eq $exp_code) {
  print "good aft $aft_name\n";
  print qx(rsync -vazi -e ssh $tmpdir $remote) unless $ENV{DRY_RUN};
}
else {
  print "bad aft $aft_name ($act_code != $exp_code)\n";
}