# Author: Joe Krahn <krahn@niehs.nih.gov>
# File: $Conf{InstallDir}/lib/BackupPC/RsyncPExt.pm
# Version: initial draft
#
# This is not a normal Perl module, but instead a hack to override the
# File::RsyncP::serverConnect() module subroutine. When included by
# $conf(PerlModuleLoad}, these routines have priority because this file
# is loaded after the normal modules are included.
#
# To install, add "BackupPC:RsyuncPExt" to $Conf{PerlModuleLoad}, assuming that
# the file is named as suggested above, but it can be named anything as long
# as it is accessible in BackupPC's Perl library path.
#
# To use, set the port he shell command must be defined with $Conf{RsyncClientCmd}, which must
# start the remote rsync with arguments "--server --daemon --config==rsyncd.conf .".
# The CGI interface hides that option in 'rsyncd' mode, but it is easy (and safer)
# to override the actual command using the command= option in the authorized_keys file.
###########################################################################
# This is a hybridization of File::RsyncP subroutines remoteStart() and
# serverConnect(), to support rsync daemon connections over a shell. See
# "USING RSYNC-DAEMON FEATURES VIA A REMOTE-SHELL CONNECTION" in the rsync man page.
#############################################################################
package File::RsyncP;
sub serverConnect {
    use Socket;
    use Data::Dumper;
    my($rs, $host, $port) = @_;
    if (not defined $port or $port != 0) {
        #local(*FH);
        $port ||= 873;
        my $proto = getprotobyname('tcp');
        my $iaddr = inet_aton($host)     || return "unknown host $host";
        my $paddr = sockaddr_in($port, $iaddr);

        alarm($rs->{timeout}) if ( $rs->{timeout} );
        socket(FH, PF_INET, SOCK_STREAM, $proto)
				        || return "inet socket: $!";
        connect(FH, $paddr)             || return "inet connect: $!";
        $rs->{fh} = *FH;
        $rs->writeData("\@RSYNCD: $rs->{protocol_version}\n", 1);
        my $line = $rs->getLine;
        alarm(0) if ( $rs->{timeout} );
        if ( $line !~ /\@RSYNCD:\s*(\d+)/ ) {
	    return "unexpected response $line\n";
        }
        $rs->{remote_protocol} = $1;
        if ( $rs->{remote_protocol} < 20 || $rs->{remote_protocol} > 40 ) {
            return "Bad protocol version: $rs->{remote_protocol}\n";
        }
        $rs->log("Connected to $host:$port, remote version $rs->{remote_protocol}")
                            if ( $rs->{logLevel} >= 1 );

    } else {
# This section is from File::RsyncP::remoteStart
        local(*RSYNC);
        socketpair(RSYNC, FH, AF_UNIX, SOCK_STREAM, PF_UNSPEC)
                                          or die "socketpair: $!";

        $rs->{rsyncCmd} = [split(" ", $rs->{rsyncCmd})]
		        if ( ref($rs->{rsyncCmd}) ne 'ARRAY'
		          && ref($rs->{rsyncCmd}) ne 'CODE' );
        if ( $rs->{rsyncCmdType} eq "full" || ref($rs->{rsyncCmd}) ne 'ARRAY' ) {
            $cmd = $rs->{rsyncCmd};
        } else {
            $cmd = [@{$rs->{rsyncCmd}}, "--server", "--daemon", "."];
        }
        $rs->log("Running: " . join(" ", @$cmd))
		        if ( ref($cmd) eq 'ARRAY' && $rs->{logLevel} >= 1 );
        if ( !($pid = fork()) ) {
            #
            # The child execs rsync.
            #
            close(FH);
            close(STDIN);
            close(STDOUT);
            close(STDERR);
            open(STDIN, "<&RSYNC");
            open(STDOUT, ">&RSYNC");
            open(STDERR, ">&RSYNC");
            if ( ref($cmd) eq 'CODE' ) {
                &$cmd();
            } else {
                exec(@$cmd);
            }
            # not reached
            # $rs->log("Failed to exec rsync command $cmd[0]");
            # exit(0);
        }
        close(RSYNC);
        $rs->{fh} = *FH;
        $rs->{rsyncPID} = $pid;
        $rs->{pidHandler}->($rs->{rsyncPID}, $rs->{childPID})
                            if ( defined($rs->{pidHandler}) );

# This section is from File::RsyncP::serverConnect
# In case the remote system requires a tty, ssh can allocate a tty with "-t" or
# "-tt", which works here except that a tcgetattr() error message is seen before
# the RSYNCD handshake. The rsync executable will fail in this case, but it
# is allowed for here. For this situation, only one line must be skipped.
        my $max_skip = 1;
        my $response = "";
        $rs->writeData("\@RSYNCD: $rs->{protocol_version}\n", 1);
        for (my $try = 0;;$try++) {
            my $line = $rs->getLine;
            if ( $line =~ /\@RSYNCD:\s*(\d+)/ ) {
                 $rs->{remote_protocol} = $1;
                 last;
            }
            $response .= $line;
            return "remoteConnect(shell=\"$cmd\"): unexpected response: $response\n"
        		    if ($try>=$max_skip);
        }
        if ( $rs->{remote_protocol} < 20 || $rs->{remote_protocol} > 40 ) {
            return "Bad protocol version: $rs->{remote_protocol}\n";
        }
        $rs->log("Connected to rsyncd shell \"$cmd\", remote version $rs->{remote_protocol}")
                            if ( $rs->{logLevel} >= 1 );
    }
    $rs->{protocol_version} = $rs->{remote_protocol}
                        if ( $rs->{protocol_version} > $rs->{remote_protocol} );
    $rs->{fio}->protocol_version($rs->{protocol_version})
                        if ( $rs->{fio_version} >= 2 );
    $rs->log("Negotiated protocol version $rs->{protocol_version}")
                        if ( $rs->{logLevel} >= 1 );
    return;
};

1;