#! /usr/bin/perl
# -*- Perl -*-
#                                                 Tomo.M(2006/05/20)
#
package W_con;

require Exporter;
@ISA = qw (Exporter);
@EXPORT = qw ( new
	       conn
	       check
	       );
use IO::Socket::INET;
use Crypt::RC4;
use Jcode;
use W_node;
use strict 'vars';
use vars qw ( $NVKEY $NXKEY
	      $debug
	      $timeout
	      $htph $htpp
	      );

$NVKEY = '98789asj';
$NXKEY = "\0999";

$debug = 1;
$timeout = 10;


my $enc_w_ver = "\x5f\x9c\x51\x44\x62\x17\xf4\x36\x58\x71\x1c\x5e"
    . "\xb7\x33\x20\x84\xe7\xbb\x9b\x5d";


sub new {
    my $this = shift;
    my $class = ref($this) || $this;
    my $self = {};
    bless $self => $class;

    if ($_[0]) {
	$self->set(@_);
	if (exists($self->{Hash})) {
	    $self->{Addr} = to_addr($self->{Hash});
	}
	if (exists($self->{Addr})) {
	    return $self->conn($self->{Addr});
	}
    }
    return($self);
}

sub set {
    my $this = shift;
    my %args;

    unless (@_ % 2) {
        %args = @_;
    } else {
        chomp($_[0]);
        if ($_[0] =~ /^\@/) {
            $args{Hash} = $_[0];
        } else {
            $args{Addr} = $_[0];
        }
    }

    foreach (keys %args) {
	$this->{$_} = $args{$_};
    }
    $this;
}

sub get {
    my $this = shift;
    my $key = shift;

    return($this->{$key});
}

sub conn {
    my $this = shift;

    my (%args, $sock, $host, $port);
 
    if (@_) {
	if (@_ % 2) {   # assume single arg
	    ($host, $port)  = split(/:/, $_[0]);
	} else {
	    %args = @_;
	    $host = $args{Host};
	    $port = $args{Port};
	}
    } else {
	($host, $port)  = split(/:/, $this->get('Addr'));
    }

    if ($host eq '' || $port eq '') {
	return undef;
    }

    $this->set('Host' => $host);
    $this->set('Port' => $port);

    eval {
	local $SIG{ALRM} = sub { die "alarm\n" };
	alarm $timeout;
	$sock = IO::Socket::INET->new( PeerAddr => $htph ? $htph : $host,
				       PeerPort => $htpp ? $htpp : $port,
				       Proto => 'tcp',
				       Timeout => $timeout);
	alarm 0;
    };
    if ($@) {
	#
	print STDERR "Can't connect to $host:$port\n";
    }
    return undef unless defined $sock;

    if ($htph && $htpp) {
	my $cmd = "CONNECT $host:$port HTTP/1.0\r\n\r\n";
	$sock->print($cmd);
	# suck proxy resp in.
	my $buf;
	my $nr = sread($sock, \$buf, length("HTTP/1.0 200"));
	return undef unless $buf =~ m%^HTTP/1.. 2%;
	while (1) {
	    $nr = sread($sock, \$buf, 1);
	    return undef if $nr < 1;
	    next unless $buf eq "\r";
	    $nr = sread($sock, \$buf, 1);
	    return undef if $nr < 1;
	    next unless $buf eq "\n";
	    $nr = sread($sock, \$buf, 1);
	    return undef if $nr < 1;
	    next unless $buf eq "\r";
	    $nr = sread($sock, \$buf, 1);
	    return undef if $nr < 1;
	    next unless $buf eq "\n";
	    last;
	} 
    }

    $this->set('Sock' => $sock);
    return $this;
}

sub check {
    my $this = shift;

    my ($buf, $dum, $key, $ctx, $nr, $str, $len, $cmd);
    my ($ini_key);

    $this->conn() unless defined $this->{Sock};

    if (defined $this->{Sock}) {
	$nr = sread($this->{Sock}, \$buf, 6); # dummy:2 + key:4
	if ($nr <= 0) {
	    print "cannot read: $!\n";
	    return;
	}
	hexdump($buf); # test
	($dum, $key) = unpack "a2a4", $buf;

	$ini_key = $key; # save ini_key;
	$ctx = Crypt::RC4->new($key);

	$nr = sread($this->{Sock}, \$buf, 5); # len:4 + cmd:1
	$str = $ctx->RC4($buf);
	($len, $cmd) = unpack "LC", $str;
	printf "block1: len=%d, cmd=%02x\n", $len, $cmd;
	if ($len != 1) {
	    hexdump($str);
	    print "-- peer seems to be a winnyp version --\n";
	    $nr = sread($this->{Sock}, \$buf, 256);
	    $str = $ctx->RC4($buf);
	    hexdump($str);
	    if ($str =~ /^[\x0-\x1]{4}/) {
		cmd_proc([13, $str]);
	    }
	    return;

	} else {
	    my @r = read_block($this->{Sock}, $ctx);
	    return unless defined $r[0];
	    ($cmd, $str) = (@r);
	    if ($cmd == 0) {
		my $ctx2 = Crypt::RC4->new($NVKEY);
		$str = $ctx2->RC4($str);
		my ($ver, $vstr) = unpack("La*", $str);
		print "intver=$ver, version==$vstr\n";
	    }
	}

	my $nkey = $ini_key ^ $NXKEY;
	print "New Key "; hexdump($nkey);
	$ctx = Crypt::RC4->new($nkey);
	loop($this->{Sock}, $ctx);
    }
}

#=-----------------------------------

# read ny's block 3,4,5 or any
#
sub loop {
    my ($s, $ctx) = @_;
    my ($cmd, $str);

    if (!defined($s)) {
	print "cannot access: $!\n";
	return;
    }

    while (1) {
	my @r = read_block($s, $ctx);
	return unless defined $r[0];
	cmd_proc(\@r);
	if ($r[0] = 0x03) {
	    reply1($s);
	}
    }

}

sub cmd_proc {
    my ($r) = @_;
    my ($cmd, $str) = @$r;

    if ($cmd == 0x01) {
	# block 3
	my $sp = unpack("f", $str);
	printf "block3: speed: %d\n", $sp;
    } elsif ($cmd == 0x02) {
	# block 4
	printf "block4: link type: %x%x%x%x\n", unpack("C4", $str);
    } elsif ($cmd == 0x03) {
	# block 5
	my ($a, $p, $dum ,$n) = unpack('a[L]SSa*', $str);
	printf "block5: ip=%s, port=%d\n", inet_ntoa($a), $p;
	#hexdump($n);
	my @dlen = unpack("C4a*", $n);
	my $dstr = pop(@dlen);
	
	for (my $i=0; $i<=$#dlen; $i++) {
	    if ($dlen[$i] > 0) {
		$dstr =~ /^(.{$dlen[$i]})(.*)$/s;
		($str, $dstr) = ($1, $2);
		if ( $str !~ /^[x00-0x1f]/) {
		    print "=($i)", jcode($str)->utf8, "\n";
		} else {
		    hexdump($str);
		}
	    }
	}

    } elsif ($cmd == 0x04) {
	# other node info
	my ($a, $p, $dum, $n) = unpack('a[L]SSa*', $str);
	printf "node info: ip=%s, port=%d\n", inet_ntoa($a), $p;
	$str = $n;
	my ($bp, $dum, $bn, $sp, @dlen) = unpack("SSCLC3a*", $str);
	printf "bbs port = %d, bbsflag = %d\n", $bp, $bn;
	printf "speed = %d\n", $sp;
	my $dstr = pop(@dlen);

	for (my $i=0; $i<=$#dlen; $i++) {
	    if ($dlen[$i] > 0) {
		$dstr =~ /^(.{$dlen[$i]})(.*)$/s;
		($str, $dstr) = ($1, $2);
		if ( $str !~ /^[x00-0x1f]/) {
		    print "=($i)", jcode($str)->utf8, "\n";
		} else {
		    hexdump($str);
		}
	    }
	}

    } elsif ($cmd == 0x0d) {
	# query
	printf "= cmd=query(%#02x)\n", $cmd;
	parse_query($str);

    } else {
	printf "= cmd=%02x\n", $cmd;
	hexdump($str);
    }

}


sub reply1 {
    my ($s) = @_;
    my ($ctx, $str, $key);

    srand time ^ $$;
    my @ikey = (rand 0x100, rand 0x10000);
    my $b1 = "\x01\x00\x00\x00\x61";
    my $b2 = "\x15\x00\x00\x00\x00";
    $b2 .=  $enc_w_ver;

    $ctx = Crypt::RC4->new($ikey[1]);
    $str = $ctx->RC4($b1);
    swrite($s, $str, length($str));
    $str = $ctx->RC4($b2);
    swrite($s, $str, length($str));

    my $b3 = "\x05\x00\x00\x00\x01";
    $b3 .= pack "f", 1000;
    my $b4 = "\x05\x00\x00\x00\x02";
#    $b4 .= pack("C4", (0,1,0,1));
#    $b4 .= pack("C4", (0,1,0,0));
    $b4 .= pack("C4", (0,0,0,0));
    my $b5 = "\x0d\x00\x00\x00\x03";
    $b5 .= "\xc0\xa8\x00\x01\x7f\x07\x00\x00\x00\x00\x00\x00";
    $key = $ikey[1] ^ $NXKEY;
    $ctx = Crypt::RC4->new($key);
    $str = $ctx->RC4($b3. $b4 . $b5);
    swrite($s, $str, length($str));

    my $bb = "\x01\x00\x00\x00\x0a";
    $str = $ctx->RC4($bb);
    swrite($s, $str, length($str));
}


sub parse_query {
    my ($str) = @_;
    my ($nstr, $flag, $id, $klen);
    my ($kwd, $trip, $nn);

    ($flag, $id, $klen, $nstr) = unpack 'a4LCa*', $str;
    printf "= f=%x%x%x%x\n", unpack "C4", $flag;
    printf "= id=%x\n", $id;
    printf "= keylen = %d\n", $klen;

    ($kwd, $trip, $nn, $nstr) = unpack "a[$klen]a[11]Ca*", $nstr;
    print "= ", jcode($kwd)->utf8, "\n";
    hexdump($trip);

    # indirect node info
    printf "= %d nodes\n", $nn;
    while ($nn-- > 0) {
	my ($a, $p);
	($a, $p, $nstr) = unpack 'a[4]Sa*', $nstr;
	printf "= ip: %s port: %d\n", inet_ntoa($a), $p;
    }

    # key info
    if (length($nstr)) {
	($nn, $nstr) = unpack "Sa*", $nstr;
	printf "- keys: %d\n", $nn;

	while ($nn-- > 0 && length($nstr)) {
	    (my($ip1, $p1, $ip2, $p2), $nstr)
		= unpack 'a[4]Sa[4]Sa*', $nstr;
	    printf "= ip: %s port: %d\n", inet_ntoa($ip1), $p1;
	    printf "= bbsip: %s port: %d\n", inet_ntoa($ip2), $p2;

	    (my ($fsz, $fha, $fnl, $fsum), $nstr)
		= unpack 'La16CSa*', $nstr;
	    printf "= fsize: %lu\n", $fsz;
	    printf "= fhash: %s\n", unpack "H32", $fha;

	    (my $fn, $trip, $nstr) = unpack "a[$fnl]a[11]a*", $nstr;
	    my $k = $fsum % 256;
	    my $ctxn = Crypt::RC4->new(pack("C", $k));
	    $fn = $ctxn->RC4($fn);
	    print "= fname: ", jcode($fn)->utf8, "\n";
	    hexdump($trip);

	    (my $len, $nstr) = unpack "Ca*", $nstr;
	    (my $btr, $nstr) = unpack "a[$len]a*", $nstr;
	    hexdump($btr);

	    (my ($ttl, $bref, $mtime, $igf, $v), $nstr)
		= unpack "SLLCCa*", $nstr;
	    printf "= ttl: %d\n", $ttl;
	    printf "= bref: %lu\n", $bref;
	    printf "= mtime: %lu\n", $mtime;
	    printf "= flag: %d\n", $igf;
	    printf "= ver: %d\n", $v;
	}
	print "=--\n";
    }
}

sub read_block {
    my ($s, $ctx) = @_;
    my ($len, $cmd, $str, $nr, $buf);

    # read length part
    $nr = sread($s, \$buf, 4);
    if ($nr <= 0) {
	print "cannot read: $!\n";
	return undef;
    }

    $len = unpack("L", $ctx->RC4($buf));

    if ($len > 0 && $len < 128*1024) {
	$nr = sread($s, \$buf, $len);
	if ($nr <= 0) {
	    print "cannot read: $!\n";
	    return undef;
	}
	$str = $ctx->RC4($buf);
	if ($str =~ s/^(.)(.+)/$2/s) {
	    $cmd = ord($1);
	    return($cmd, $str);
	}
    }
    return undef;
}



sub sread {
    my ($s, $buf, $len) = @_;
    my $nr;

    eval {
	local $SIG{ALRM} = sub { die "alarm\n" };
	alarm $timeout;
	$nr = $s->sysread($$buf, $len);
	alarm 0;
    };
    return($nr)
}

sub swrite {
    my ($s, $buf, $len) = @_;
    my $nw;

    eval {
	local $SIG{ALRM} = sub { die "alarm\n" };
	alarm $timeout;
	$nw = $s->syswrite($$buf, $len);
	alarm 0;
    };
    return($nw)
}


sub hexdump {
    my ($str) = @_;

    my @dat = unpack('C*', $str);
    my $len = $#dat;

    my ($i, $j) = (0, 0);
    while ($j <= $len) {
	print "=";
	for ($i=0; $i<16; $i++) {
	    last if ($j+$i > $len);
	    printf " %02x", $dat[$j+$i];
	}
	print "   " x (16-$i);
	print "  ";
	for ($i=0; $i<16; $i++) {
	    last if ($j+$i > $len);
	    my $c = $dat[$j+$i];
	    printf "%c", (($c<0x20||$c>0x7f) ? ord(".") : $c);
	}
	$j+=$i;
	print "\n";
    }
}

1;

__END__

=head1 NAME

W_con - connect to winny Node.

=head1 SYNOPSIS

    use W_con;

    $node = W_con->new( "127.0.0.1:12345" );
    if (defined($node)) {
        $node->check();
    }

=head1 DESCRIPTION

This module connect/check winny node at IP:PORT.

=head1 METHODS

=over 4

=item new ( IP:PORT )

connect to IP:PORT and return Node object.

=item check ( )

get various info from peer node.

=back

=head1 SEE ALSO


=head1 AUTHOR

Tomo.M <tomoyuki at pobox.com>

=head1 COPYRIGHT

Copyright (c) 2006 Tomo.M. All rights reserved.

=cut