server.pl

   1 #!/usr/bin/perl
   2
   3 =head1 bak-git
   4
   5 Simpliest possible backup from remote host (with natcat as
   6 only depenency) to ad-hoc remote server
   7
   8 Install on client with:
   9
  10   echo install | nc 127.0.0.1 9001 > bak ; chmod 755 bak
  11
  12 Start server with:
  13
  14   ./server.pl /path/to/backup 127.0.0.1
  15
  16 You will want to add following to C<~/.ssh/config>
  17
  18   RemoteForward 9001 localhost:9001
  19
  20 =cut
  21
  22 use warnings;
  23 use strict;
  24 use autodie;
  25 use IO::Socket::INET;
  26 use File::Path;
  27
  28 my ( $dir, $server_ip ) = @ARGV;
  29 die "usage: $0 /backup/directory\n" unless $dir;
  30 $server_ip ||= '127.0.0.1';
  31
  32 my $shell_client = <<__SHELL_CLIENT__;
  33 #!/bin/sh
  34 echo `hostname -s` `pwd` \$* | nc $server_ip 9001
  35 __SHELL_CLIENT__
  36
  37 chdir $dir;
  38 system 'git init' unless -e '.git';
  39
  40 my $server = IO::Socket::INET->new(
  41         Proto     => 'tcp',
  42         LocalAddr => $server_ip,
  43         LocalPort => 9001,
  44         Listen    => SOMAXCONN,
  45         Reuse     => 1
  46 ) || die $!;
  47
  48
  49 warn "dir: $dir listen: $server_ip:9001\n"
  50         , "remote-host> echo install | nc $server_ip 9001 > bak ; chmod 755 bak\n"
  51         , $shell_client
  52 ;
  53
  54 while (my $client = $server->accept()) {
  55         my ($hostname,$pwd,$command,$path,$message) = split(/\s+/,<$client>,5);
  56
  57         if ( $pwd eq 'install' ) {
  58                 warn "install on $hostname\n";
  59                 print $client $shell_client;
  60                 close($client);
  61                 system 'ssh-copy-id', "root\@$hostname" if ! -d $hostname;
  62                 next;
  63         }
  64
  65         $message ||= '';
  66         $path = "$pwd/$path" unless $path =~ m{^/};
  67
  68         warn "$hostname [$command] $path | $message\n";
  69
  70
  71         my $dir = $path;
  72         $dir =~ s{/[^/]+$}{};
  73
  74         mkpath "$hostname/$dir" unless -e "$hostname/$dir";
  75
  76         if ( ! $command ) {
  77                 system "find $hostname -type f | sed 's,$hostname,,' > /tmp/$hostname.list";
  78                 system "rsync -avv --files-from /tmp/$hostname.list root\@$hostname:/ $hostname/"
  79         } elsif ( $command eq 'add' ) {
  80                 system 'rsync', '-avv', "root\@$hostname:$path", "$hostname/$path";
  81                 system 'git', 'add', "$hostname/$path";
  82         } elsif ( $command eq 'commit' ) {
  83                 system 'rsync', '-avv', "root\@$hostname:$path", "$hostname/$path" if $path;
  84                 $message ||= "$command $hostname $path";
  85                 system 'git', 'commit', '-m', $message, "$hostname/$path";
  86         } elsif ( $command =~ m{(diff|status|log)} ) {
  87                 my $opt = '--summary' if $command eq 'log';
  88                 print $client `git $command $opt $hostname`;
  89         } elsif ( $command eq 'revert' ) {
  90                 print $client `git checkout -- $hostname/$path`;
  91                 system 'rsync', '-avv', "$hostname/$path", "root\@$hostname:$path";
  92         } else {
  93                 print $client "Unknown command: $command\n";
  94         }
  95
  96 }
  97