forked from onryo/siona
Extremely Private HUSH and HAC explorer
https://explorer.hush.is
You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
337 lines
10 KiB
337 lines
10 KiB
#!/usr/bin/env perl
|
|
use strict;
|
|
use warnings;
|
|
use JSON::Any;
|
|
use Data::Dumper;
|
|
use 5.014;
|
|
my $STATS = {};
|
|
$|=1;
|
|
|
|
my $ADDRS = {};
|
|
|
|
# While Siona swims, we pave with bricks on the road she will run on...
|
|
my $dir = shift || $ENV{HOME} . "/data";
|
|
my $cli = "/home/duke/git/hush3/src/hush-cli";
|
|
my $getinfo = readfile("$dir/getinfo.json");
|
|
my $template = readfile("/var/www/explorer.hush.is/address/template.html");
|
|
my $addrdir = "/var/www/explorer.hush.is/address/";
|
|
if($getinfo =~ m/"blocks": (\d+)/){ $STATS->{BLOCKS} ||= $1; }
|
|
if($getinfo =~ m/"tls_connections": (\d+)/){ $STATS->{TLS_CONNECTIONS} ||= $1; }
|
|
if($getinfo =~ m/"connections": (\d+)/){ $STATS->{CONNECTIONS} ||= $1; }
|
|
if($getinfo =~ m/"protocolversion": (\d+)/){ $STATS->{PROTOCOLVERSION} ||= $1; }
|
|
|
|
my @symbols = qw/
|
|
TX_TABLE ADDRESSES_TABLE TLS_CONNECTIONS CONNECTIONS PROTOCOLVERSION
|
|
/;
|
|
my @addresses;
|
|
my $height = $STATS->{BLOCKS};
|
|
$STATS->{ADDRESSES_TABLE} = "";
|
|
$STATS->{TX_TABLE} = "";
|
|
|
|
my $mineraddress = "";
|
|
for my $h ($height-50 .. $height) {
|
|
my $thisminer = "";
|
|
# TODO: fix this garbage
|
|
my $reward = $h > 340000 ? "3.125 HUSH" : "12.5 HUSH";
|
|
my $block = get_block($h);
|
|
#die Dumper $block;
|
|
my $time = localtime($block->{time}) . " UTC" || "";
|
|
my @txs = @{ $block->{tx} };
|
|
my $numtx = @txs;
|
|
# TODO: look on filesystem first? redis cache?
|
|
my $hash = qx!$cli getblockhash $h!;
|
|
chomp $hash;
|
|
|
|
my $root = "/var/www/explorer.hush.is";
|
|
my $blockdir = "$root/block/$hash";
|
|
if (!-e "$root/block/$h") {
|
|
# make /block/HEIGHT work
|
|
my $cmd = "ln -s $blockdir $root/block/$h";
|
|
qx{$cmd};
|
|
warn $cmd;
|
|
}
|
|
if (!-d $blockdir) {
|
|
# so explorer.hush.is/block/HASH works
|
|
my $cmd = "mkdir -p $blockdir";
|
|
qx{$cmd};
|
|
warn $cmd;
|
|
my $block_template_file = "$root/block/template.html";
|
|
my $new_block_file = "$root/block/$hash/index.html";
|
|
# TODO: process template with block details
|
|
my $block_template = readfile($block_template_file);
|
|
$block_template =~ s/#BLOCKS#/$h/g;
|
|
$block_template =~ s/#BLOCKHASH#/$hash/g;
|
|
$block_template =~ s/#PREVIOUSBLOCKHASH#/$block->{previousblockhash}/ge;
|
|
$block_template =~ s/#BLOCKTIME#/$time/g;
|
|
$block_template =~ s/#ANCHOR#/$block->{anchor}/ge;
|
|
$block_template =~ s/#VERSION#/$block->{version}/ge;
|
|
$block_template =~ s/#BITS#/$block->{bits}/ge;
|
|
$block_template =~ s/#BLOCKSIZE#/$block->{size}/ge;
|
|
$block_template =~ s/#CHAINWORK#/$block->{chainwork}/ge;
|
|
$block_template =~ s/#MERKLEROOT#/$block->{merkleroot}/ge;
|
|
$block_template =~ s/#FINALSAPLINGROOT#/$block->{finalsaplingroot}/ge;
|
|
# TODO
|
|
$block_template =~ s/#BLOCKREWARD#/3.125 HUSH/g;
|
|
$block_template =~ s/#BLOCKNONCE#/$block->{nonce}/ge;
|
|
$block_template =~ s/#DIFFICULTY#/$block->{difficulty}/ge;
|
|
$block_template =~ s/#NUM_TXS#/$numtx/g;
|
|
|
|
my $txtype = "";
|
|
# generate tx list table
|
|
$STATS->{TX_TABLE}=<<HTML;
|
|
<table border=1>
|
|
<tr><th>Transaction ID (txid)</th><th>Type</th><th>Inputs</th>
|
|
<th>Outputs</th><th>Shielded Inputs</th><th>Shielded Outputs</th>
|
|
<th>Addresses</th>
|
|
<th>Amount</th>
|
|
<th>Transaction Time</th>
|
|
<!--
|
|
<th>Expiry Height</th>
|
|
<th>Lock Time</th>
|
|
-->
|
|
</tr>
|
|
HTML
|
|
|
|
my $txi = 0;
|
|
for my $tx (@txs) {
|
|
my $json = qx!$cli getrawtransaction $tx 1!;
|
|
# "vout": 0,
|
|
# "address": "RBHHGTQoULWb8gPD6Nj4fix6ov46hzzQMj",
|
|
# address is duplicated in the JSON of getrawtransaction !! fuck.
|
|
# KMD or ZEC upstream bug?
|
|
$json =~ s/"vout": 0,\w*"address": "([a-z0-9]+)",/"vout": 0,/mg;
|
|
|
|
# Satoshi Forgive Me
|
|
$json =~ s/"address":\w+"([a-z0-9]+)"(.+)"address":\w+"\g1"(.+)/"address": "$1"$2/mg;
|
|
|
|
warn "decoding tx=$tx"; # with json=$json";
|
|
my $j = JSON::Any->new;
|
|
my $o = $j->decode($json);
|
|
$TX->{$tx} = $o;
|
|
my $tx_dir = "$root/tx/$tx";
|
|
my $tx_file = "$root/tx/$tx/index.html";
|
|
my $tx_template_file = "$root/tx/template.html";
|
|
my $tx_template = readfile($tx_template_file);
|
|
my $txtime = localtime($o->{time}) . " UTC ( " . $o->{time} . " )";
|
|
#my $txsize = $o->{size} . " bytes";
|
|
$tx_template =~ s/#TXID#/$tx/ge;
|
|
$tx_template =~ s/#TXTIME#/$txtime/ge;
|
|
#$tx_template =~ s/#TXSIZE#/$txsize/g;
|
|
$tx_template =~ s/#BLOCKHEIGHT#/$h/ge;
|
|
$tx_template =~ s/#BLOCKHASH#/$hash/ge;
|
|
my ($vin,$vout,$zin,$zout) = ($o->{vin},$o->{vout},$o->{vShieldedSpend},$o->{vShieldedOutput});
|
|
my $expiryheight = $o->{expiryheight} == 0 ? "Default" : $o->{expiryheight};
|
|
my $locktime = localtime($o->{locktime}) . " UTC ( " . $o->{locktime} . " )";
|
|
my $valueBalance = $o->{valueBalance} || "?";
|
|
|
|
my $vins = @$vin;
|
|
my $vouts = @$vout;
|
|
my $zins = @$zin;
|
|
my $zouts = @$zout;
|
|
my $coinbase = $vin->[0] ? $vin->[0]->{coinbase}." with sequence ".$vin->[0]->{sequence} : "False"; #($vin->[0] && $vin->[0]->{coinbase}) ? $vin->[0]{coinbase} . " with sequence " . $vin->{sequence} : "False";
|
|
|
|
# coinbase does not count as a transparent input
|
|
$vins-- if ($vin->[0] && $vin->[0]->{coinbase});
|
|
|
|
my $tx_data =<<DATA;
|
|
<table border=1>
|
|
<tr><th>Coinbase</th><td align=center>$coinbase</td></tr>
|
|
<tr><th>Expiry Height</th><td align=center>$expiryheight</td></tr>
|
|
<tr><th>Transparent Inputs</th><td align=center> $vins </td></tr>
|
|
<tr><th>Transparent Outputs</th><td align=center> $vouts </td></tr>
|
|
<tr><th>Shielded Inputs</th><td align=center> $zins </td></tr>
|
|
<tr><th>Shielded Outputs</th><td align=center> $zouts </td></tr>
|
|
<tr><th>Locktime</th><td align=center>$locktime</td></tr>
|
|
</table>
|
|
|
|
DATA
|
|
$tx_template =~ s/#TX_DATA#/$tx_data/g;
|
|
|
|
my $cmd = "mkdir -p $tx_dir";
|
|
warn $cmd;
|
|
## create tx dir + page
|
|
qx{$cmd};
|
|
|
|
open(my $fh, '>', $tx_file) or die "$tx_file: $!";
|
|
print $fh $tx_template;
|
|
close $fh or die $!;
|
|
|
|
## create tx view on block page
|
|
my $from = $o->{vin}->[0] ? $o->{vin}->[0]->{address} : "zs1???";
|
|
#my $to = $o->{vout}->[0] ? $o->{vout}->[0]->{scriptPubKey}->{addresses}->[0] : "zs1???";
|
|
my $to2 = "";
|
|
# only look at coinbase tx's
|
|
if($txi == 0) {
|
|
# LEXICAL SCOPING BUG, MAN!
|
|
$mineraddress = $o->{vout}->[0] ? $o->{vout}->[0]->{scriptPubKey}->{addresses}->[0] : "";
|
|
$thisminer = $mineraddress;
|
|
}
|
|
say "<!-- miner for $tx is $mineraddress -->";
|
|
my $to = $mineraddress ? $mineraddress : "zs1???";
|
|
if($o->{vout}->[1]) {
|
|
$to2 = $o->{vout}->[1]->{scriptPubKey}->{addresses}->[0];
|
|
}
|
|
$valueBalance = ($o->{vout}->[0]->{value} || 0) + ($o->{vout}->[1]->{value} || 0);
|
|
$valueBalance ||= "?";
|
|
$from ||= "";
|
|
|
|
$txtype = "Mining";
|
|
if($zins+$zouts>0) {
|
|
$txtype = "Shielded";
|
|
if($zins==0 && $zouts>0) { $txtype = "Shielding"; }
|
|
if($vins==0 && $vouts==0){ $txtype = "Fully Shielded" }
|
|
# this is prevented by consensus rule on HUSH mainnet
|
|
# but if we see it, ring the bell, lulz
|
|
if($zins>0 && $zouts==0) { $txtype = "De-Shielding!"; }
|
|
}
|
|
#if($vouts>0) { $txtype = "DPoW"; }
|
|
my $stuff;
|
|
|
|
if ($txtype eq "Mining") {
|
|
$stuff =<<STUFF;
|
|
<pre>
|
|
=> $to
|
|
=> $to2
|
|
</pre>
|
|
<br/>
|
|
STUFF
|
|
} else {
|
|
#TODO: fix this shite
|
|
$stuff =<<STUFF;
|
|
<pre>
|
|
$from => $to
|
|
$from => $to2
|
|
</pre>
|
|
<br/>
|
|
STUFF
|
|
}
|
|
|
|
my $tx_table = <<HTML;
|
|
<tr>
|
|
<td><a href="/tx/$tx">$tx</a></td>
|
|
<td>$txtype</td>
|
|
<td align=center>$vins</td>
|
|
<td align=center>$vouts</td>
|
|
<td align=center>$zins</td>
|
|
<td align=center>$zouts</td>
|
|
<td>$stuff</td>
|
|
<td>$valueBalance HUSH</td>
|
|
<td>$txtime</td>
|
|
<!--
|
|
<td>$expiryheight</td>
|
|
<td>$locktime</td>
|
|
-->
|
|
</tr>
|
|
HTML
|
|
$STATS->{TX_TABLE} .= $tx_table;
|
|
$txi++;
|
|
}
|
|
|
|
$STATS->{TX_TABLE} .= "</table>";
|
|
# $STATS->{TX_TABLE} .= "<pre>" . Dumper [ $vin ];''
|
|
|
|
$block_template =~ s/#TX_TABLE#/$STATS->{TX_TABLE}/ge;
|
|
|
|
# > ?
|
|
open(my $fh, '>>', $new_block_file) or die "$new_block_file: $!";
|
|
print $fh $block_template;
|
|
close $fh or die $!;
|
|
warn "wrote to $new_block_file ";
|
|
} else {
|
|
warn "block exists on disk, looking info up";
|
|
#TODO: error-checking for corrupt data
|
|
#warn Dumper $block;
|
|
my $lookuptx = $block->{tx}->[0];
|
|
my $o = get_raw($lookuptx);
|
|
$thisminer = $o->{vout}->[0]->{scriptPubKey}->{addresses}->[0];
|
|
warn "thisminer=$thisminer";
|
|
}
|
|
|
|
# give data to blocks after we have processed everything
|
|
my $b = [ $h, $hash, $reward,$time,$numtx,$thisminer,0 ];
|
|
#warn Dumper $b;
|
|
push @addresses, $b;
|
|
}
|
|
|
|
sub get_raw {
|
|
my $tx = shift;
|
|
my $cmd = "$cli getrawtransaction $tx 1";
|
|
warn $cmd;
|
|
my $json = qx!$cmd!;
|
|
# "vout": 0,
|
|
# "address": "RBHHGTQoULWb8gPD6Nj4fix6ov46hzzQMj",
|
|
# address is duplicated in the JSON of getrawtransaction !! fuck.
|
|
# KMD or ZEC upstream bug?
|
|
$json =~ s/"vout": 0,\w*"address": "([a-z0-9]+)",/"vout": 0,/mg;
|
|
# Satoshi Forgive Me
|
|
$json =~ s/"address":\w+"([a-z0-9]+)"(.+)"address":\w+"\g1"(.+)/"address": "$1"$2/mg;
|
|
warn "decoding tx=$tx"; # with json=$json";
|
|
my $j = JSON::Any->new;
|
|
my $o = $j->decode($json);
|
|
return $o;
|
|
}
|
|
|
|
# render data
|
|
for my $b (reverse @addresses) {
|
|
|
|
$STATS->{ADDRESSES_TABLE} .= <<"FUCK";
|
|
<tr>
|
|
<td align=center><a href="/block/$b->[0]">$b->[0]</a></td>
|
|
<td align=center><a href="/block/$b->[1]">$b->[1]</a></td>
|
|
<td align=center>$b->[2]</td>
|
|
<td align=center>$b->[3]</td>
|
|
<td align=center>$b->[4]</td>
|
|
<td align=center>$b->[5]</td>
|
|
</tr>
|
|
FUCK
|
|
}
|
|
|
|
|
|
|
|
for my $s (@symbols) {
|
|
if($s && $STATS->{$s}) { $template =~ s/#$s#/$STATS->{$s}/ge }
|
|
}
|
|
|
|
say $template;
|
|
|
|
###### functions
|
|
|
|
sub get_block {
|
|
my $height = shift;
|
|
my $dir = "/home/duke/data/blocks/";
|
|
my $file = "$dir/block-$height.json";
|
|
my $stats = {};
|
|
my $block;
|
|
|
|
# create data if it's not there
|
|
if( (!-e $file) || (-s $file == 0)) {
|
|
# logging?
|
|
my $cmd = "$cli getblock $height > /home/duke/data/blocks/block-$height.json";
|
|
warn $cmd;
|
|
qx/$cmd/;
|
|
# let the file sync to disk
|
|
sleep 1;
|
|
}
|
|
my $json = readfile($file);
|
|
if($json) {
|
|
my $j = JSON::Any->new;
|
|
$block = $j->decode($json);
|
|
} else {
|
|
warn "empty block $height!!" unless $json;
|
|
warn Dumper [$json];
|
|
}
|
|
|
|
return $block;
|
|
}
|
|
|
|
sub readfile {
|
|
my $file = shift;
|
|
my $data = "";
|
|
open(my $fh, '<', $file) or die "$file: $!";
|
|
my $txlist = 0;
|
|
while(<$fh>){
|
|
$data.=$_
|
|
}
|
|
close($fh);
|
|
return $data;
|
|
}
|
|
|