gistfile1.txt

# uses https://github.com/mtve/bitcoin-pl for base58.pm, ecdsa.pm
# doesn't work.  ecdsa.pm is flakey and usually doesn't create the same signature as the reference implementation.

use strict;
use warnings;

use Carp;
use Data::Dumper;

use Socket;
use POSIX;

use lib '/home/scott/projects/bitcoin/bitcoin-pl';

use base58;
use ecdsa;
use ripemd160;
use util;
use script;

#
# args
#

my $balance = 450000;   # 0.0045 * 10e7;
my $fee = 10000;        # 0.0001 * 10e7;   # fee in bitcoins converted at satoshies
my $amount_to_send = $balance - $fee;

#
# constants
#

my $magic = 0xd9b4bef9;

#
# inputs
#

my $privateKey = '...';                                 # ask me
my $privateKeyCompressed = 0;                                                                        # set if we detect that the $privateKey is flagged to have been used with compressed public keys
my $prevTransactionHash = 'b097384c42a3be2730db3e3720a1806c76172b6b62b2b5ee007c2c6fd295cadf';        # txid of the transaction we want to spend money from; "tx_hash_big_endian" from https://blockchain.info/unspent?active=1LouWrNVMifzN9zpzrEtLmiJZuXwP2w7Bw; the other byte ordering results in "unable to find all input txes"
my $fromAddress = '1LouWrNVMifzN9zpzrEtLmiJZuXwP2w7Bw';                                              # in Electrum
my $outputs = [ [  $amount_to_send, "1BxzF8rgXtuiPuSN8azdMJgryzQSWt4Uoj", ], ];                      # satoshis:  0.00101234 - 0.0001 = 0.00091234 * 10e7

# makeSignedTransaction() calls makeRawTransaction() twice, hashing it to compute the signature the first time,
# and actually signing it the second time

my $signed_txn = makeSignedTransaction(
    $privateKey,                                                                        # private key
    $prevTransactionHash,                                                               # output (prev) transaction hash
    1,                                                                                  # sourceIndex of which output of that transaction to spend
    $fromAddress,                                                                       # from address; becomes "scriptPubKey"
    $outputs,                                                                           # outputs:  amount and destination address
);

warn "signed transaction: $signed_txn";

sub makeSignedTransaction {
    my $privateKey = shift;                   # base58
    my $outputTransactionHash = shift;        # ascii hex
    my $sourceIndex = shift;                  # numeric
    my $fromAddress = shift;                  # base58  XXX redundant with $privateKey
    my $outputs = shift;                      # arrayref of number and base58

    # private key from WIF

    $privateKey = wifToPrivateKey( $privateKey );
    $privateKey = Math::BigInt->from_hex( '0x' . to_hex( $privateKey ) );

    # temporary scriptSig based on the previous TX's scriptPubKey for the sake of hashing and signing this TX

    my $scriptPubKey = addrHashToScriptPubKey( $fromAddress );

    my $myTxn_forSig = makeRawTransaction( $outputTransactionHash, $sourceIndex, $scriptPubKey, $outputs ) . "01000000"; 

    warn "txn_for_sig: $myTxn_forSig";

    my $s256 = base58::sha256( base58::sha256( from_hex( $myTxn_forSig ) ) );
    # $s256 = Math::BigInt->from_hex( '0x' . to_hex( $s256 ) );   # no... don't do this.  this is what was keeping it from working.  it was in binary (scalar string buffer full of characters) and needs to be in binary.

    # sign the first draft of this TX

    my $sig = ecdsa::Sign( { priv => $privateKey, compressed => $privateKeyCompressed, }, $s256 );
    $sig .= chr(0x01);  # "01 is hashtype"

    warn "sig: " . to_hex($sig);

    # get the pubkey

    my $pubKey = ecdsa::pub_from_priv( $privateKey );
    $pubKey = $privateKeyCompressed ? ecdsa::pub_encode_compressed( $pubKey ) : ecdsa::pub_encode( $pubKey );

    warn "pubKey: " . to_hex($pubKey);

    do {

        # XXXX impractical sanity for dev:  check our pubKey against the sig on the tx we're drawing from

        my $computed_address = to_hex( ripemd160::hash(base58::sha256($pubKey)));   # 40 bytes of hex data
        my $tx_address = 'd9495c762aed3dba15eec648beb55a8a43b8d1bd';  # from https://blockchain.info/tx/b097384c42a3be2730db3e3720a1806c76172b6b62b2b5ee007c2c6fd295cadf?show_adv=true output #2
        $computed_address eq $tx_address or die "sha256-ripe160 of our pubKey doesn't match the address this TX was sent to:\n$computed_address\nvs\n$tx_address\n";
        
    };

    do {
        # sanity check -- make sure that our public key hashes to the same thing as our from address
        my $b58_hex = to_hex( base58::DecodeBase58Check( $fromAddress ) );
        $b58_hex =~ s{^00}{} if length($b58_hex) > 40;  # not sure why it's coming back like that but it has one byte worth of hex 0s at the front of it
        to_hex( ripemd160::hash(base58::sha256($pubKey))) eq $b58_hex or die;
    };

    do {
        # more sanity checking
        my $sig = $sig;
        substr $sig, -1, 1, '';  # take off the 0x01 hash type indicator
        ecdsa::Verify({ pub => $pubKey }, $s256, $sig) or die;
        warn "okay!\n";
    };

    my $scriptSig = to_hex( _varstr( $sig ) ) . to_hex( _varstr( $pubKey ) );

    script::Parse(from_hex($scriptSig)); # XXX

    # makeRawTransaction() again, this time with our own scriptSig and no version word on the end
    # scriptSig replaces scriptPubKey

    my $signed_txn = makeRawTransaction( $outputTransactionHash, $sourceIndex, $scriptSig, $outputs );

    return $signed_txn;

}

sub makeRawTransaction {
    my $outputTransactionHash = shift;    # ascii hex
    my $sourceIndex = shift;              # numeric
    my $scriptSig = shift;                # ascii hex
    my $outputs = shift;                  # arrayref of destination address and amount

    # returns hex
    # used by makeSignedTranaction()

    my $makeOutput = sub {
        # this is the "TxOut" structure in https://en.bitcoin.it/wiki/Protocol_documentation
        my $redemptionSatoshis = $_[0]->[0] or die;                     # integer number of satoshies
        my $outputAddress = $_[0]->[1] or die;                          # base58check encoded
        my $outputScript = addrHashToScriptPubKey( $outputAddress );    # this is the signature script which verifies future attempts to spend money from this output
        # scriptPubKey: OP_DUP OP_HASH160 <pubKeyHash> OP_EQUALVERIFY OP_CHECKSIG
        # return to_hex( pack("L<L<", $redemptionSatoshis, 0x00 ) ) . sprintf( '%02x', length( from_hex( $outputScript ) ) ) . $outputScript; # XXX no Q in this build; not sure how this affects what amounts we can transmit; little endian; least significant byte goes first; that means that this won't work for larger transfers
        return to_hex( pack("VV", $redemptionSatoshis, 0x00 ) ) . sprintf( '%02x', length( from_hex( $outputScript ) ) ) . $outputScript; 
    };

    my $formattedOutputs = join '', map $makeOutput->($_), @$outputs;

    return 
        "01000000" .                                                # 4 bytes version
        "01" .                                                      # varint for number of inputs
        to_hex( scalar reverse( from_hex( $outputTransactionHash ) ) ) .   # bytewise reverse $outputTransactionHash; start of "tx_in[]" structure
        to_hex( pack('L<', $sourceIndex ) ) .                       # number of which output from the sending transaction to use
        sprintf( '%02x', length( from_hex( $scriptSig ) ) ) .       # length of the scriptSig
        $scriptSig .                                                # and the scriptSig, which has is "script" which puts signature hashes on the stack to sign this transaction
        "ffffffff" .                                                # sequence; end of "tx_in[]" structure
        to_hex( _varint( scalar @$outputs ) ) .                     # was: sprintf( "%02x", scalar @$outputs ) .   # number of outputs; varint
        $formattedOutputs .                                         # and the actual outputs, which include script for verifying signature hashes of a subsequent transaction
        "00000000"                                                  # lockTime:  none
    ;
}

#
# utilities
#

sub addrHashToScriptPubKey {
    my $b58str = shift;
    length($b58str) == 34 or die;    # 34 character base58 string

    # 76     A9      14 (20 bytes)                                 88             AC

    my $b58_hex = to_hex( base58::DecodeBase58Check( $b58str ) );

    $b58_hex =~ s{^00}{} if length($b58_hex) > 40;  # remove version (?)

    length($b58_hex) == 40 or die;  # 160 bit public key hash after it has gone through sha256, ripem160

    # 0x14 pushes 20 bytes onto the stack, which jives with $b58_hex's actual size

    my $script = '76a914' . $b58_hex .  '88ac';

    script::Parse(from_hex($script)); # XXX

    return $script;
}

sub wifToPrivateKey {
    my $wif = shift;

    # decode a WIF formatted private key:  https://en.bitcoin.it/wiki/Wallet_import_format
    # returns bytes

    my $private_key = base58::DecodeBase58Check( $wif );
    substr( $private_key, 0, 1, '' ) eq chr(0x80) or die; 
    if( length( $private_key ) == 33 and substr( $private_key, 32, 1 ) eq chr(0x01) ) {
        # just make a note; and take off the flag indicating compressed keys
        substr $private_key, 32, 1, '';
        $privateKeyCompressed = 1;
    }
    length( $private_key ) == 32 or die;
    return $private_key;
}

sub _varstr {
    my $s = shift;
    # generate a variable length string which itself has a variable length length indicating value on the front of it
    # used by makeSignedTransaction()
    # takes bytes and returns bytes
    # creepily enough, for items of length 1-75, the numeric prefix is also the Script opcode for pushing that many bytes of data onto the stack, 
    # meaning that BER encoded strings are valid Script bytecode, in those cases.
    return _varint(length($s)) . $s;
}

sub _varint {
    my $n = shift;
    # used by _varstr()
    if( $n < 0xfd ) {
        return pack 'C', $n;                  # B in Python
    } elsif( $n < 0xffff ) {
        return pack 'CS<', chr(0xfd), $n;     # XXX c should probably be C
    } elsif( $n < 0xffffffff ) {
        return pack 'CL<', chr(0xfe), $n;
    } else {
        return pack 'CQ<', chr(0xff), $n; 
    }
}

sub _unvarstr {
    # chews the bytes off of the beginning of its string argument that it has decoded
    my $length = _unvarint($_[0]);
    return substr $_[0], 0, $length, '';
}

sub _unvarint {
    # modifies its string argument to chew off bytes it has decoded
    my $v = ord( substr( $_[0], 0, 1, '') );
    if( $v < 0xfd ) {
        return $v;
    } elsif( $v == 0xfd ) {
        return unpack 'S<', substr $_[0], 0, 2, '';
    } elsif( $v == 0xfe ) {
        return unpack 'L<', substr $_[0], 0, 4, '';
    }
}

sub to_hex {
    unpack( "H*", $_[0] );
}

sub from_hex {
    pack( "H*", $_[0] );
}