view release on metacpan or  search on metacpan

lib/Cvs/Cvsroot.pm  view on Meta::CPAN

    }

    return $self;
}

sub bind
{
    my($self, $cmd) = @_;

    my $debug = $cmd->cvs->debug();
    if($debug)
    {
        print STDERR "Binding CVSROOT handlers\n";
        print STDERR "CVSROOT access method is: $self->{method}\n";
    }
    my $init_context = $cmd->initial_context();

    if(defined $self->{'remote-shell'})
    {
        $ENV{CVS_RSH} = $self->{'remote-shell'};
    }

    if($self->{method} eq 'pserver')
    {
        $init_context->push_handler
        (
         qr/^cvs .*: used empty password; /, sub
         {
             if(defined $self->{password})
             {
                 if($cmd->cvs->login->success())
                 {
                     # The former command failed because it wasn't
                     # logged. So we need to relaunch it internally
                     $cmd->restart();
                 }
                 else
                 {
                     $cmd->err_result('pserver login failure');
                     return $init_context->finish();
                 }
             }
             else
             {
                 $cmd->err_result('you have to login.');
                 return $init_context->finish();
             }
         }
        );
    }
    elsif($self->{method} eq 'ssh')
    {
        # without pty, ssh call the ssh-askpass program to grab needed
        # informations from user. In batch mode it's not possible, so
        # we rewrite an ssh-askpass in a shell script stored in a
        # temporary file and we tell ssh to call it.
        my($fh, $file) = File::Temp::tmpnam()
          or die "can't create a temporary file";
        print STDERR "Creating askpass script `$file'\n"
          if $debug;
        chmod(0700, $file);
        $fh->print("#!/bin/sh\n");
        $fh->print("echo \$1|grep -iq password&&echo $self->{password}&&exit\n");
        $fh->print("echo \$1|grep -iq passphrase&&echo $self->{passphrase}&&exit\n");
        $fh->print("echo yes\n");
        $fh->close();
        $cmd->push_cleanup(sub
        {
            print STDERR "Deleting askpass script `$file'\n"
              if $debug;
            unlink $file
        });
        $ENV{SSH_ASKPASS} = $file;
        # ssh doesn't tell ssh-askpass until the DISPLAY environment
        # isn't set, so we have to set it to something (see ssh's
        # manual for more details).
        $ENV{DISPLAY} = '';

        my $ssh_context = $cmd->new_context();
        my $fingerprint;

        # building a combo pattern for all ssh error starting with the
        # string "ssh: "
        my $error_patterns = join
          ('|',
           '.*: Name or service not known',
           'connect to address [\d.]+ port \d+: Connection refused',
          );
        $init_context->push_handler
        (
         qr/^ssh: (?:$error_patterns)/, sub
         {
             $cmd->err_result(shift->[0]);
             return $init_context->finish();
         }
        );

        $init_context->push_handler
        (
         qr/Could not create directory/, sub
         {
             # Hint: this can happened where the home directory isn't writable
         }
        );
        $init_context->push_handler
        (
         qr/^Enter passphrase for key/, sub
         {
             $cmd->send($self->{passphrase});
         }
        );

        $init_context->push_handler
        (
         # maybe ssh version defendant...
         qr/'s password:/, sub
         {
             $cmd->send("$self->{password}\n");
         }
        );
        $init_context->push_handler