Bitcoin Forum

#!/usr/bin/perl

use IO::Socket;use IO::Select;
use Digest::SHA;$|=1;

$btc=IO::Socket::INET->new(PeerAddr=>"localhost",PeerPort=>'8333',Proto=>'tcp') or die "Socket";
$sel=IO::Select->new();$sel->add($btc);

$p="\x2c\x7e\x00\x00"; # Version
$p.="\x01\x00\x00\x00\x00\x00\x00\x00"; # Services
$h=sprintf('%x',time());while(length($h)<16){$h="0".$h;}
$h=reverse($h);$p.=pack('h*',$h); # Unix Timestamp
$p.="\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xFF\xFF"; # To IP
$p.="\x7f\x00\x00\x01\x20\x8d"; # 127.0.0.1 - Port 8333
$p.="\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xFF\xFF"; # From IP
$p.="\x00\x00\x00\x00\x20\x8d"; # 0.0.0.0 - Port 8333
@chars=('a'..'f', 0..9);$rr=join '',map {$chars[rand @chars]} 1..16;
$p.=pack('H*',$rr); # Random Unique ID
$p.="\x00\x00\x00\x00\x00"; # No UA/Blocks

sendpacket('version',$p);
while($gotver==0){
  ($c,$p)=readpacket();
  if($c eq 'version'){$gotver=1;}
sleep(1);}
sendpacket('verack','');

while(1){
  ($c,$p)=readpacket();
  if($c eq 'inv'){
    sendpacket('getdata',$p);
  }
  if($c eq 'block'){
    $blk=unpack('H*',$p);print $blk."\n";
  }
sleep(1);}
close($btc);

sub sendpacket{my $c=shift(@_);my $p=shift(@_);
  my $o="\xf9\xbe\xb4\xd9"; # Magic for main network
  while(length($c)<12){$c.="\x00";}$o.=$c; #Command
  my $h=sprintf('%x',length($p));while(length($h)<8){$h="0".$h;}
  $h=reverse($h);$o.=pack('h*',$h); # Payload length
  $h=Digest::SHA::sha256(Digest::SHA::sha256($p));
  $h=unpack('H*',$h);$o.=pack('H*',substr($h,0,8)); # Checksum
  $o.=$p; # Payload
  print $btc $o;print STDERR "Sent $c (".length($p)." byte payload)\n";
}
sub readpacket{
  if(!$sel->can_read(1)){return 0;}
  my @x;my $x;while(1){read($btc,$x,1);$x=unpack('H*',$x);
    push(@x,$x);if($#x>3){shift(@x);}
    if(join('.',@x) eq "f9.be.b4.d9"){
      my $cmd;my $len;
      read($btc,$cmd,12);read($btc,$len,4);read($btc,$x,4);
      $x=unpack('h*',$len);$x=reverse($x);$len=hex($x);
      $x=chop($cmd);while($x eq "\x00"){$x=chop($cmd);}$cmd.=$x;
      print STDERR "Read $cmd ($len byte payload)\n";
      if($len>0){read($btc,$x,$len);return ($cmd,$x);}
      else{return ($cmd,'');}
    }
  }
}