#!/usr/bin/env perl

# Copyright (c) 2000
#      Tanaka Akira. All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
# 1. Redistributions of source code must retain the above copyright notice, this
#    list of conditions and the following disclaimer.
# 2. Redistributions in binary form must reproduce the above copyright notice,
#    this list of conditions and the following disclaimer in the documentation
#    and/or other materials provided with the distribution.
# 3. The name of the author may not be used to endorse or promote products
#    derived from this software without specific prior written permission.
#
# THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
# SUCH DAMAGE.

###

# usage: cvs-client [-p] [-r] [cvsroot]

# option:
# -r : send `Root' request.
# -p : print path component of cvsroot and exit.

use IO::Socket;

$send_root = 0;
$print_path = 0;
if (@ARGV && $ARGV[0] eq '-r') {
  $send_root = 1;
  shift;
}
elsif (@ARGV && $ARGV[0] eq '-p') {
  $print_path = 1;
  shift;
}

if (@ARGV) {
  $cvsroot = shift;
}
elsif (-f 'CVS/Root') {
  $cvsroot = `cat CVS/Root`;
}
elsif (defined $ENV{'CVSROOT'}) {
  $cvsroot = $ENV{'CVSROOT'};
}
else {
  die "no CVSROOT specified.\n";
}

$| = 1;
%buffer = (); %eof = ();

if ($cvsroot =~ /^\//) {
  &fork($cvsroot);
}
elsif ($cvsroot =~ /^:(fork|local):/) {
  &fork($');
}
elsif ($cvsroot =~ /^:(ext|server):/) {
  &ext($');
}
elsif ($cvsroot =~ /^:pserver:/) {
  &pserver($');
}
else {
  die "unspported method: $cvsroot\n";
}

sub fork {
  my $path = shift;
  if ($print_path) { print $path, "\n"; exit 0; }

  open(STDOUT, "|cvs server") or die "cannot run cvs server: $!\n";
  print "Root $path\n" if $send_root;
  exec "/bin/cat";
  die "cannot exec cat: $!\n";
}

sub ext {
  my $rest = shift;
  my $rsh = $ENV{'CVS_RSH'} || 'rsh';
  my $server = $ENV{'CVS_SERVER'} || 'cvs';

  die "invalid ext cvsroot: $cvsroot\n" unless $rest =~ /^(?:([^\@]*)\@)?([^:\/]*):?\//;
  my $user = $1 || $ENV{'USER'} ;
  my $host = $2;
  my $path = "/$'";
  if ($print_path) { print $path, "\n"; exit 0; }

  my @argv;
  push(@argv, $rsh);
  push(@argv, '-l', $user) if defined $user;
  push(@argv, $host, $server, 'server');
    
  open(STDOUT, '|-') or do {
    exec @argv;
    die "cannot exec @argv: $!\n";
  };
  print "Root $path\n" if $send_root;
  exec "/bin/cat";
  die "cannot exec cat: $!\n";
}

sub pserver {
  my $rest = shift;

  die "invalid pserver cvsroot: $cvsroot\n" unless $rest =~ /^(?:([^\@:]*)(?::([^\@:]))?\@)?([^:\/]*)(?::([0-9]+)?)?\//;
  my $user = $1 || $ENV{'USER'};
  my $pass = $2;
  my $host = $3;
  my $port = $4 || "2401";
  my $path = "/$'";
  if ($print_path) { print $path, "\n"; exit 0; }

  if (defined $pass) {
    $pass = &enscramble($pass);
  }
  else {
    my $cvsroot_canonical = ":pserver:$user\@$host:$port$path";
    $pass = &read_cvspass($cvsroot_canonical) || &read_cvspass($cvsroot);
    defined($pass) or die "cannot find password for $cvsroot\n";
  }

  my $sock = IO::Socket::INET->new(
    PeerAddr => $host,
    PeerPort => $port,
    Proto    => 'tcp') or die "cvs-client cannot connect to $host:$port: $!\n";

  select($sock); $| = 1; select(STDOUT);

  &pserver_send_auth_request($sock, $path, $user, $pass);
  &pserver_recv_auth_request($sock);

  print $buffer{$sock}; $buffer{$sock} = '';
  print $sock "Root $path\n" if $send_root;

  my $rin, $rout, $nfound, $timeleft, $resp, $buffer;

  $rin = '';
  my $request_fileno = fileno(STDIN);
  my $response_fileno = fileno($sock);
  vec($rin,$request_fileno,1) = 1;
  vec($rin,$response_fileno,1) = 1;

  while (1) {
    ($nfound, $timeleft) = select($rout=$rin, undef, undef, undef);
    if (vec($rout,$response_fileno,1)) {
      $resp = sysread($sock, $buffer, 8192);
      die "sysread failed: $!\n" unless defined $resp;
      if (0 < $resp) {
       print $buffer;
      }
      else {
        vec($rin,$response_fileno,1) = 0;
      }
    }
    if (vec($rout,$request_fileno,1)) {
      $resp = sysread(STDIN, $buffer, 8192);
      die "sysread failed: $!\n" unless defined $resp;
      last if $resp == 0;
      print $sock $buffer;
    }
  }
  close($sock);
}

sub pserver_send_auth_request {
  my $sock = shift;
  my $path = shift;
  my $user = shift;
  my $pass = shift;

  print $sock <<"End";
BEGIN AUTH REQUEST
$path
$user
$pass
END AUTH REQUEST
End
}

sub pserver_recv_auth_request {
  my $sock = shift;
  my $resp = &getline($sock);

  if ($resp eq "I LOVE YOU\n") {
  }
  elsif ($resp eq "I HATE YOU\n") {
    print STDERR $resp;
    exit 1;
  }
  elsif ($resp =~ /^E /) {
    print STDERR $_;
    while (($resp = &getline($sock)) =~ /^E /) {
      print STDERR $resp;
    }
    if ($resp =~ /^error /) {
      print STDERR $_;
      exit 1;
    }
    print STDERR "unexpected response: $resp";
    exit 2;
  }
  elsif ($resp =~ /^error /) {
    print STDERR $resp;
    exit 1;
  }
  else {
    print STDERR "unexpected response: $resp";
    exit 2;
  }
}

sub read_cvspass {
  my $cvsroot = shift;
  my $cvspass = $ENV{'CVS_PASSFILE'} || "$ENV{'HOME'}/.cvspass";
  my $pass;

  open(PASS, $cvspass) or die "cannot open $cvspass: $!\n";
  while(<PASS>) {
    chomp;
    ($r, $p) = split(/ /, $_, 2);
    if ($r eq $cvsroot) {
      $pass = $p;
      last;
    }
  }
  close(PASS);
  return $pass;
}

BEGIN {
  $shifts = join '', map { sprintf("\\x%02x", $_) } 
    0,  1,  2,  3,  4,  5,  6,  7,  8,  9, 10, 11, 12, 13, 14, 15,
    16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31,
    114,120, 53, 79, 96,109, 72,108, 70, 64, 76, 67,116, 74, 68, 87,
    111, 52, 75,119, 49, 34, 82, 81, 95, 65,112, 86,118,110,122,105,
    41, 57, 83, 43, 46,102, 40, 89, 38,103, 45, 50, 42,123, 91, 35,
    125, 55, 54, 66,124,126, 59, 47, 92, 71,115, 78, 88,107,106, 56,
    36,121,117,104,101,100, 69, 73, 99, 63, 94, 93, 39, 37, 61, 48,
    58,113, 32, 90, 44, 98, 60, 51, 33, 97, 62, 77, 84, 80, 85,223,
    225,216,187,166,229,189,222,188,141,249,148,200,184,136,248,190,
    199,170,181,204,138,232,218,183,255,234,220,247,213,203,226,193,
    174,172,228,252,217,201,131,230,197,211,145,238,161,179,160,212,
    207,221,254,173,202,146,224,151,140,196,205,130,135,133,143,246,
    192,159,244,239,185,168,215,144,139,165,180,157,147,186,214,176,
    227,231,219,169,175,156,206,198,129,164,150,210,154,177,134,127,
    182,128,158,208,162,132,167,209,149,241,153,251,237,236,171,195,
    243,233,253,240,194,250,191,155,142,137,245,235,163,242,178,152;

  eval "sub scramble { my \$tmp = shift; \$tmp =~ tr/\\0-\\377/$shifts/; \$tmp }";
}

sub enscramble {
  "A" . &scramble(shift);
}

sub descramble {
  my $tmp = shift;
  die "descramble: unknown scrambling method\n" if $tmp !~ /^A/;
  substr($tmp, 0, 1) = '';
  &scramble($tmp);
}

sub getline
{
  my $fh = shift;
  return '' if $eof{$fh};

  my $buffer = $buffer{$fh};

  while ($buffer !~ /\n/) {
    if (sysread($fh, $buffer, 8192, length($buffer)) == 0) {
      $eof{$fh} = 1;
      break;
    }
  }
  if ($buffer =~ /\n/) {
    $buffer{$fh} = $';
    return "$`\n";
  }
  else {
    $buffer{$fh} = '';
    return $buffer;
  }
}
