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 `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 ($pwd,$command,$path,$message) = split(/\s+/,<$client>,4);
  56         my $ip = $client->peerhost;
  57
  58         if ( $pwd eq 'install' ) {
  59                 warn "install on $ip\n";
  60                 print $client $shell_client;
  61                 close($client);
  62                 next;
  63         }
  64
  65         $message ||= '';
  66         $path = "$pwd/$path" unless $path =~ m{^/};
  67
  68         warn "$ip [$command] $path | $message\n";
  69
  70         if ( ! -d $ip ) {
  71                 system 'ssh-copy-id', "root\@$ip";
  72         }
  73
  74
  75         my $dir = $path;
  76         $dir =~ s{/[^/]+$}{};
  77
  78         mkpath "$ip/$dir" unless -e "$ip/$dir";
  79
  80         if ( ! $command ) {
  81                 system "find $ip -type f | sed 's,$ip,,' > /tmp/$ip.list";
  82                 system "rsync -avv --files-from /tmp/$ip.list root\@$ip:/ $ip/"
  83         } elsif ( $command eq 'add' ) {
  84                 system 'rsync', '-avv', "root\@$ip:$path", "$ip/$path";
  85                 system 'git', 'add', "$ip/$path";
  86         } elsif ( $command eq 'commit' ) {
  87                 system 'rsync', '-avv', "root\@$ip:$path", "$ip/$path";
  88                 $message ||= "$command $ip $path";
  89                 system 'git', 'commit', '-m', $message, "$ip/$path";
  90         } elsif ( $command =~ m{(diff|status|log)} ) {
  91                 print $client `git $command $ip`;
  92         } else {
  93                 print $client "Unknown command: $command\n";
  94         }
  95
  96 }
  97