scripts/debian/ssh-move

   1 #! /usr/bin/perl -w
   2 use strict;
   3
   4 use IPC::Open2;
   5
   6 $ENV{LANG} = "C";
   7
   8 # The protocol consists of repeated exchanges of the following:
   9 #
  10 #   S: <filename>
  11 #   S: <each line of file, with dot-stuffing as in SMTP>
  12 #   S: .
  13 #   C: [writes file]
  14 #   C: <filename>
  15 #   S: [unlinks file]
  16
  17 my $server = 0;
  18 my $verbose = 0;
  19 my $nonint = 0;
  20 my $sshidentity;
  21 my $sshmovepath = 'ssh-move';
  22 my $fromdir;
  23 my $todir;
  24
  25 while (@ARGV) {
  26     local $_ = shift @ARGV;
  27     if (/^--server$/) {
  28         $server = 1;
  29     } elsif (/^--verbose$/) {
  30         $verbose = 1;
  31     } elsif (/^--ssh-identity$/) {
  32         $sshidentity = shift @ARGV;
  33     } elsif (/^--ssh-move-path$/) {
  34         $sshmovepath = shift @ARGV;
  35     } elsif (/^--from-directory$/) {
  36         $fromdir = shift @ARGV;
  37     } elsif (/^--to-directory$/) {
  38         $todir = shift @ARGV;
  39     } elsif (/^--non-interactive$/) {
  40         $nonint = 1;
  41     } else {
  42         unshift @ARGV, $_;
  43         last;
  44     }
  45 }
  46
  47 local $| = 1;
  48
  49
  50 my ($in, $out) = (*STDIN, *STDOUT);
  51
  52 unless ($nonint) {
  53     my $servername = shift @ARGV;
  54     local (*READER, *WRITER);
  55
  56     my @args = ('ssh');
  57     push @args, '-i', $sshidentity if defined $sshidentity;
  58
  59     push @args, $servername, $sshmovepath;
  60     push @args, '--server' unless ($server);
  61     push @args, '--to-directory', $todir if (defined $todir && $server);
  62     push @args, '--from-directory', $fromdir if (defined $fromdir && !$server);
  63     push @args, '--non-interactive';
  64     push @args, map quotemeta, @ARGV unless ($server);
  65
  66     my $pid = open2 (\*READER, \*WRITER, @args);
  67
  68     ($in, $out) = (*READER, *WRITER);
  69 }
  70
  71 sub server ()
  72 {
  73     chdir $fromdir if defined $fromdir;
  74
  75     my @files = map glob, @ARGV;
  76
  77     for my $file (@files) {
  78         print $out "$file\n" or die "can't print to client: $!";
  79         open FILE, "< $file" or die "can't open $file: $!\n";
  80         local $_;
  81         while (<FILE>) {
  82             chomp;
  83             $_ = ".$_" if /^\./;
  84             print $out "$_\n" or die "can't print to client: $!";
  85         }
  86         print $out ".\n" or die "can't print to client: $!";
  87
  88         my $confirm = <$in>;
  89         chomp $confirm if defined $confirm;
  90         unlink $file if defined $confirm and $confirm eq $file;
  91     }
  92 }
  93
  94 sub client ()
  95 {
  96     chdir $todir if defined $todir;
  97
  98     my $file;
  99     while (defined ($file = <$in>)) {
 100         chomp $file;
 101         print STDERR $file if $verbose;
 102         (my $tmpfile = $file) =~ s[.*/][];
 103         $tmpfile .= ".$$.tmp";
 104         # TODO: unlink $tmpfile if things go wrong
 105         open TMP, "> $tmpfile" or die "can't open $tmpfile: $!";
 106         local $_;
 107         while (<$in>) {
 108             chomp;
 109             if ($_ eq '.') {
 110                 close TMP or die "can't close $tmpfile: $!";
 111                 rename $tmpfile, $file
 112                     or die "can't rename $tmpfile to $file: $!";
 113                 print $out "$file\n" or die "can't print to server: $!";
 114                 last;
 115             } else {
 116                 s/^\.//;
 117                 print TMP "$_\n" or die "can't print to $tmpfile: $!";
 118             }
 119         }
 120         print STDERR " ok\n" if $verbose;
 121     }
 122 }
 123
 124 if ($server) {
 125     server ();
 126 } else {
 127     client ();
 128 }