#!/usr/bin/perl
use strict; use warnings;

# rv, the ssh local editor
# written by Sam Watkins, 2009
# this program is public domain

my $ssh_config =
 "Add near top of workstation ~/.ssh/config: RemoteForward 1337 127.0.0.1:1337";

use IO::Socket;
use IO::File;
use File::Basename;
use File::Copy;
use File::Spec::Functions;
use POSIX ":sys_wait_h";

sub REAPER {
	while ((my $child = waitpid(-1, WNOHANG)) > 0) {
		# $Kid_Status{$child} = $?;
	}
	$SIG{CHLD} = \&REAPER;  # still loathe sysV
};
$SIG{CHLD} = \&REAPER;

our $port = $ENV{RV_PORT} || 1337;
our $pass = $ENV{RV_PASS} || "ger0n1mo";
our $block_size = 4096;
our $tmpdir = $ENV{RV_TMP} || "$ENV{HOME}/.rv-tmp";
our $xterm = $ENV{RV_XTERM} || "xterm -e";
our $quiet = $ENV{RV_QUIET} || 0;

our $noxterm = {
	gvim => 1,
	emacs => 1,
	gimp => 1,
	qiv => 1,
};

our $map = {
	gvim => 'gvim -f',
};

our $wrappers = {
	hold => 1,
	thensh => 1,
	lessit => 1,
};

mkdir $tmpdir;

our @xterm = split / /, $xterm;

if (@ARGV && $ARGV[0] =~ /^(-h|--help)$/) {
	help();
	exit 0;
}

if (@ARGV == 0) {
	rv_server();
} else {
	rv_client(@ARGV);
}

exit;


sub help {
	print qi(qq{
		usage: rv
		       rv editor [options] [--] file ...
		  - $ssh_config
		  - run `rv` on the local workstation
		  - ssh to a remote host and run `rv vi -o *.c` or something.
		  - if you edit your remote .ssh/config too, you can ssh from one remote
		    host to another and rv will still work
		  - rv will not lose any of your work
		configuration settings:
		  - RV_PORT=$port
		  - RV_PASS=$pass
		  - RV_TMP=$tmpdir
		  - RV_XTERM=$xterm
		  - RV_QUIET=$quiet
	});
}

sub rv_server {
	# runs on the local workstation
	warn "starting rv server\n";
	chdir $tmpdir or die "cannot chdir to $tmpdir\n";
    my $listener = IO::Socket::INET->new(Proto => "tcp",
	  LocalAddr => "localhost", LocalPort => $port, Listen => 1, Reuse => 1)
		or die "can't serve on TCP port $port: $!\n";

	while (1) {
		my $sock = $listener->accept
			or next;
		if (fork() == 0) {
			rv_server_1($sock);
			exit(0);
		}
		$sock->close();
	}
}

sub rv_server_1 {
	local $SIG{CHLD} = 'DEFAULT';
	my ($sock) = @_;
	my @files;
	eval {
		my $pass1 = $sock->getln;
		$pass1 eq $pass or die "password incorrect\n";
		my $editor = $sock->getln;
		my $editor1 = $editor;
		if ($map->{$editor}) {
			$editor1 = $map->{$editor};
		}
		my @editor = split / /, $editor1;
		if (!$noxterm->{$editor}) {
			unshift @editor, @xterm;
		}
		my $options = $sock->getln;
		my @options = split / /, $options;
		while (1) {
			my $pathname = $sock->getln;
			last if $pathname eq ".";
			my $size = $sock->getln;
			warn "downloading $pathname size $size\n"
				if !$quiet;
			my $base = basename($pathname);
			my ($temp_fh, $temp_file) =
			  mytempfile($base);
			defined $temp_file or die "mytempfile for $pathname failed\n";
			push @files, $temp_file;
			copyn($sock, $temp_fh, $size);
			$temp_fh->close or die "close failed: $temp_file\n";
		}
		my $start_edit_time = time();

		my $ret = system @editor, @options, @files;
		if ($ret) { die "editor failed: @editor @options @files -> $ret\n"; }

		for my $file (@files) {
			my $mtime = (stat($file))[9];
			if ($mtime <= $start_edit_time) {
				warn "file unchanged: $file\n"
					if !$quiet;
				$sock->sayln(-1);
			} else {
				my $temp_fh = IO::File->new($file)
				  or die "open failed: $file\n";
				my $size = -s $file;
				warn "uploading $file size $size\n"
					if !$quiet;
				$sock->sayln($size);
				copyn($temp_fh, $sock, $size);
				$temp_fh->close or die "close failed: $file\n";
			}
		}
		die "did not receive ack - keeping temp files: @files\n"
		  if $sock->getln ne ".";
		$sock->close;
		unlink @files;
	};
	if ($@) {
		warn "$@";
		if (@files) {
			warn "temp files still exist:\n";
			for my $file (@files) {
				warn "  $file\n";
			}
		}
	}
	$sock->close;
}

sub mytempfile {
	my ($base, $dir) = @_;
	my ($fh, $file);
	my $count = "";
	my $base1 = $base;
	while(1) {
		if (defined $dir) {
			$file = catfile($dir, $base1);
		} else {
			$file = $base1;
		}
		$fh = IO::File->new($file, O_RDWR|O_CREAT|O_TRUNC|O_EXCL);
		last if $fh;
		$base1 = (++$count) . "_$base";
	}
	return ($fh, $file);
}

sub backup {
	my ($file) = @_;
	my $dir = dirname($file);
	my $base = basename($file);
	my ($fh, $bak) = mytempfile($base, $dir);
	copy($file, $bak) or die "backup failed: $file\n";
	return $bak;
}

sub rv_client {
	# runs on the remote host
	my @args = @_;

	my $options_done = 0;
	my @editor;
	my @options;
	my @files;
	my $editor = shift @args;
	defined $editor
		or die "no editor specified\n";
	if ($wrappers->{$editor} && @args) {
		$editor .= " ".shift(@args);
	}
	for (@args) {
		if ($_ eq "--") {
			$options_done = 1;
		} elsif (!$options_done && $_ =~ /^-/) {
			push @options, $_;
		} else {
			push @files, $_;
		}
	}

	my $sock = IO::Socket::INET->new(PeerAddr => "localhost", PeerPort => $port)
		or die "cannot connect to rv socket on port $port\n$ssh_config\n";

	$sock->sayln($pass);
	$sock->sayln($editor);
	$sock->sayln("@options");
	for my $file (@files) {
		$sock->sayln($file);
		if (-f $file) {
			my $size = -s $file;
			$sock->sayln($size);
			my $fh = IO::File->new($file) or die "open failed: $file\n";
			copyn($fh, $sock, $size);
			$fh->close or die "close failed: $file\n";
		} else {
			$sock->sayln(0);
		}
	}
	$sock->sayln(".");

	# the editor runs here...

	my $count = 0;
	eval {
		for my $file (@files) {
			my $size = $sock->getln;
			if ($size < 0) {
				warn "file unchanged: $file\n"
					if !$quiet;
			} else {
				my $fh = IO::File->new($file, "w") or die "open w failed: $file\n";
				my $bak;
				$bak = backup($file) if -f $file;
				eval {
					copyn($sock, $fh, $size);
				};
				if ($@) {
					if ($bak) {
						rename $bak, $file
						  or warn "could not restore backup $bak to $file\n";
					}
					die "$@\n";
				}
				if ($bak) {
					unlink $bak or die "could not unlink backup $bak for $file\n";
				}
			}
			++$count;
		}
	};
	if ($@) {
		warn "$@";
		if ($count < @files-1) {
			warn "some (other) files were not saved:";
			warn "  $_\n" for splice(@files, $count+1);
			warn "temp files still exist on the workstation\n";
		}
		$sock->close;
		exit 1;
	}
	$sock->sayln(".");
	$sock->close;
}

sub qi {
	my ($s) = @_;
	$s =~ s/^\n//;
	$s =~ s/\n\s*\z/\n/;
	my ($i) = $s =~ /^(\s*)/;
	$s =~ s/^$i//gm;
	return $s;
}

sub IO::Handle::getln {
	my ($fh) = @_;
	my $line = $fh->getline;
	die "getln: EOF / error\n" if !defined $line;
	chomp($line);
	return $line;
}

sub IO::Handle::sayln {
	my ($fh, @text) = @_;
	$fh->print(@text, "\n") or die "sayln failed\n";
}

sub min {
	my ($x, $y) = @_;
	return $x < $y ? $x : $y;
}

sub copyn {
	my ($in, $out, $size) = @_;
	my $buf;
	while ($size) {
		my $to_read = min($block_size, $size);
		my $count = $in->read($buf, $to_read);
		die "copyn: EOF / error" if !$count;
		$out->write($buf, $count) or die "copyn: write failed\n";
		$size -= $count;
	}
}