VCS::LibCVS::Client::Connection::Pserver - a connection to a cvs pserver

  my $conn = VCS::LibCVS::Client::Connection->new($root);

  VCS::LibCVS::Client::Connection

  VCS::LibCVS::Client
  VCS::LibCVS::Client::Connection

#
# Copyright (c) 2004,2005 Alexander Taler (dissent@0--0.org)
#
# All rights reserved. This program is free software; you can redistribute it
# and/or modify it under the same terms as Perl itself.
#

package VCS::LibCVS::Client::Connection::Pserver;

use strict;
use Carp;
use IO::Socket::INET;

###############################################################################
# Class constants
###############################################################################

use constant REVISION => '$Header: /cvsroot/libcvs-perl/libcvs-perl/VCS/LibCVS/Client/Connection/Pserver.pm,v 1.7 2005/10/10 12:52:11 dissent Exp $ ';

use vars ('@ISA');
@ISA = ("VCS::LibCVS::Client::Connection");

###############################################################################
# Initializer
###############################################################################

# register protocols supported by this connection, and authentication functions
sub BEGIN {
  my $class = "VCS::LibCVS::Client::Connection::Pserver";
  $VCS::LibCVS::Client::Connection::Protocol_map{"pserver"} = $class;

  push @VCS::LibCVS::Authentication_Functions, \&auth_cvspass;
}

###############################################################################
# Class variables
###############################################################################

use vars ('$Search_CvsPass', '$Prompt', '$Store_CvsPass');
$Search_CvsPass = 1;
$Prompt         = 1;
$Store_CvsPass  = 1;


###############################################################################
# Private variables
###############################################################################

# $self->{Root}    VCS::LibCVS::Datum::Root object for my repository.
# $self->{Socket}  IO::Socket::INET object for connection to repository.

###############################################################################
# Class routines
###############################################################################

sub new {
  my $class = shift;
  my $root = shift;

  my $that = bless {}, $class;
  $that->{Root} = $root;
  return $that;
}

sub auth_cvspass {
  my ($scheme, $needed, $info) = @_;
  return if ($scheme ne "pserver");

  my $scrambled;

  # Search the ~/.cvspass file if requested.
  if ($Search_CvsPass) {
    my $cvspass = VCS::LibCVS::Client::Connection::CvsPass->new();
    $scrambled = $cvspass->get_password($info->{CVSRoot});
  }

  # Prompt for the password if requested, necessary and on a tty.
  if ((! defined $scrambled) && ($Prompt) && (-t)) {
    my $password;
    print "CVS pserver is insecure, don't use it\n";
    print "CVS pserver password for " . $info->{CVSRoot}->as_string() . ":";
    system "stty -echo"; chomp($password = <STDIN>); system "stty echo";
    print "\n";
    $scrambled = pserver_scramble($password);

    # Write the newly acquired password to the ~/.cvspass file, if requested.
    if ($Search_CvsPass && $Store_CvsPass) {
      my $cvspass = VCS::LibCVS::Client::Connection::CvsPass->new();
      $cvspass->store_password($info->{CVSRoot}, $scrambled);
    }
  }

  my %ret = ("scrambled_password" => $scrambled);
  return \%ret;
}

###############################################################################
# Private routines
###############################################################################

# The pserver cipher, copied from cvsclient.info
use vars ('%pserver_cipher');
my %pserver_cipher =
(
                 '0' => 111,               'P' => 125,               'p' =>  58,
    '!' => 120,  '1' =>  52,  'A' =>  57,  'Q' =>  55,  'a' => 121,  'q' => 113,
    '"' =>  53,  '2' =>  75,  'B' =>  83,  'R' =>  54,  'b' => 117,  'r' =>  32,
                 '3' => 119,  'C' =>  43,  'S' =>  66,  'c' => 104,  's' =>  90,
                 '4' =>  49,  'D' =>  46,  'T' => 124,  'd' => 101,  't' =>  44,
    '%' => 109,  '5' =>  34,  'E' => 102,  'U' => 126,  'e' => 100,  'u' =>  98,
    '&' =>  72,  '6' =>  82,  'F' =>  40,  'V' =>  59,  'f' =>  69,  'v' =>  60,
    '\'' => 108, '7' =>  81,  'G' =>  89,  'W' =>  47,  'g' =>  73,  'w' =>  51,
    '(' =>  70,  '8' =>  95,  'H' =>  38,  'X' =>  92,  'h' =>  99,  'x' =>  33,
    ')' =>  64,  '9' =>  65,  'I' => 103,  'Y' =>  71,  'i' =>  63,  'y' =>  97,
    '*' =>  76,  ':' => 112,  'J' =>  45,  'Z' => 115,  'j' =>  94,  'z' =>  62,
    '+' =>  67,  ';' =>  86,  'K' =>  50,               'k' =>  93,
    ',' => 116,  '<' => 118,  'L' =>  42,               'l' =>  39,
    '-' =>  74,  '=' => 110,  'M' => 123,               'm' =>  37,
    '.' =>  68,  '>' => 122,  'N' =>  91,               'n' =>  61,
    '/' =>  87,  '?' => 105,  'O' =>  35,  '_' =>  56,  'o' =>  48,
);

# Scramble a password pserver style

sub pserver_scramble {
  # Reverse, since chop works from the end
  my $plain_r = reverse(shift);
  my $scrambled = "A";

  while ($plain_r) {
    $scrambled .= chr($pserver_cipher{chop($plain_r)});
  }

  return $scrambled;
}

###############################################################################
# Instance routines
###############################################################################

sub connect {
  my $self = shift;

  return if $self->connected();

  $self->SUPER::connect();

  # Ask the authentication callbacks for the pserver password
  my %info = ( "CVSRoot" => $self->{Root} );
  my @needed = ("scrambled_password");
  my $password;

  foreach my $auth_func (@VCS::LibCVS::Authentication_Functions) {
    my $result = &$auth_func("pserver", \@needed, \%info);
    if (defined $result && defined $result->{"scrambled_password"}) {
      $password =  $result->{"scrambled_password"};
      last;
    }
  }

  confess "No password for " . $self->{Root}->as_string if ! defined $password;

  # Open the connection to the pserver
  my $host = $self->{Root}->{HostName};
  my $port = $self->{Root}->{Port} || 2401;
  $self->{Socket} = IO::Socket::INET->new(PeerAddr => $host, PeerPort => $port);

  confess "Could not connect to " . $self->{Root}->as_string
    if ! defined $self->{Socket};

  # Do the pserver authentication
  $self->{Socket}->print("BEGIN AUTH REQUEST\n");
  $self->{Socket}->print($self->{Root}->{RootDir} . "\n");
  $self->{Socket}->print($self->{Root}->{UserName} . "\n");
  $self->{Socket}->print($password . "\n");
  $self->{Socket}->print("END AUTH REQUEST\n");

  # Check that the authentication succeeded
  my $result = $self->{Socket}->getline();
  if ($result !~ /^I LOVE YOU$/) {
    my $message = "";
    while ($result !~ /I HATE YOU|^error/) {
      $message .= $result;
      $result = $self->{Socket}->getline();
    }
    $message .= $result;
    confess("Pserver authentication failed: $message");
  }

  # Use the socket for both reading and writing.
  $self->{SubFromServer} = $self->{Socket};
  $self->{SubToServer} = $self->{Socket};
  $self->connect_fin();
}

sub disconnect {
  my $self = shift;

  return if ! $self->connected();
  $self->SUPER::disconnect();
  $self->{Socket}->shutdown(2);
}

###############################################################################
# Private routines
###############################################################################

1;