source: trollforge/unsorted/vncscan.pl @ 624 Tweet

#!/usr/bin/perl
use strict;

my $target = shift;
die "Usage: $0 host\n" unless $target;

my $scanner = VNCScanner->new;
$scanner->scan($target);

package VNCScanner;
use IO::Socket::INET;

sub new {
    my ($class) = @_;

    my $self = {};
    return bless $self, $class;
}

*socket = \&sock;
sub sock { $_[0]->{sock} }

sub scan {
    my ($self, $host) = @_;

    my $socket = IO::Socket::INET->new(
                                       PeerAddr => $host,
                                       PeerPort => '5900',
                                       Proto    => 'tcp',
                                       ) or warn "Error connecting to $host: $!\n";

    if ($socket && $socket->connected) {
        $self->{sock} = $socket;
        $self->connect;
    }
}

sub connect {
    my $self = shift;

    my $socket = $self->sock;

    # read protocol version
    my $proto_v;
    $socket->read($proto_v, 12);
    $proto_v ||= '';
    chomp $proto_v;

    my ($maj_v, $min_v) = $proto_v =~ /RFB (\d+)\.(\d+)/;
    $self->{maj_v} = $maj_v;
    $self->{min_v} = $min_v;

    $self->log("Found RFB server ($maj_v.$min_v)");

    if ($maj_v == 3) {
        $self->auth;
    } elsif ($maj_v) {
        $self->log("Unknown RFB version $maj_v");
    } else {
        $self->log("Unknown RFB version response: $proto_v");
    }
}

sub auth {
    my $self = shift;
    my $sock = $self->sock;

    if ($self->{min_v} >= 7) {
        # do v. 7 auth
        $sock->print("RFB 003.007\n");

        # should receive 1 byte count of auth types
        my $sec_t_cnt;
        $sock->read($sec_t_cnt, 1);

        if ($sec_t_cnt) {
            # read array of auth types
            my $sec_t_array;
            $sock->read($sec_t_array, int($sec_t_cnt));

            # try auth bypass
            $sock->print(pack('C', 0x01)); # auth type none
            $self->check_auth_resp;
        } else {
            my $err_str_len;
            $sock->read($err_str_len, 4);
            $err_str_len = unpack('N', $err_str_len) + 0;

            my $err_str;
            $sock->read($err_str, $err_str_len);
            $self->log("Got authentication error: $err_str");
        }
    } else {
        # request version 3.3 auth
        $sock->print("RFB 003.003\n");

        # should get a type back
        my $sec_t;
        $sock->read($sec_t, 4);
        $sec_t = unpack('N', $sec_t);

        unless ($sec_t) {
            $self->log("Auth rejected");
            return;
        }

        if ($sec_t == 1) {
            # no auth, yay
            $self->log("No auth required!");
        } else {
            $self->log("Auth type $sec_t requested. Giving up.");
        }
    }
}

sub check_auth_resp {
    my $self = shift;
    my $sock = $self->sock;

    # read securityresult
    my $sec_res;
    $sock->read($sec_res, 4);
    $sec_res = unpack('N', $sec_res);

    if ($sec_res == 0) {
        # we're in!
        $self->log("Connected successfully!");
    } else {
        # read reason
        my $err_str_len;
        $sock->read($err_str_len, 4);
        $err_str_len = unpack('N*', $err_str_len) + 0;

        my $err_str;
        $sock->read($err_str, $err_str_len);
        $self->log("Error in authentication: $err_str");

        # server will disconnect
        $sock->close;
    }
}

sub log {
    my ($self, ,$msg) = @_;
    my $sock = $self->sock;
    my $addr = $sock ? $sock->peerhost : '';
    print "[$addr] $msg\n";
}