forked from onryo/siona
Jonathan "Duke" Leto
2 years ago
10 changed files with 67 additions and 750 deletions
@ -0,0 +1 @@ |
|||
*sw? |
@ -1,7 +1,33 @@ |
|||
# explorer.hush.land |
|||
# Siona |
|||
|
|||
This is Siona, a maximum privacy block explorer designed for chains which support zaddrs |
|||
and which runs <a href="https://explorer.hush.is">explorer.hush.is</a> and <a href="https://explorer.hush.land">explorer.hush.land</a>. |
|||
|
|||
It is written in Perl 5 and generates static HTML with no Javascript and basic inline CSS for styling. It requires a Redis server |
|||
running on localhost, which is for caching and reduces disk i/o. |
|||
|
|||
# Installing dependencies |
|||
|
|||
Requires JSON::Any and Redis Perl modules and redis-server an Debian package. |
|||
|
|||
# Instructions |
|||
|
|||
Assume you put `update.sh` in /home/$USER and your Hush source code in ~/git/hush3 , add this to your $USER crontab with `crontab -e` : |
|||
|
|||
``` |
|||
crontab -l |
|||
# set env vars that Siona will use |
|||
SIONA_DOMAIN=explorer.some.poop |
|||
SIONA_TICKER=GAZOOTZ |
|||
SIONA_CLI=~/git/hush3/src/hush-cli -ac_NAME=$(SIONA_TICKER) |
|||
|
|||
# update explorer data every 5 minutes |
|||
*/5 * * * * ~/update.sh |
|||
``` |
|||
|
|||
# Copyright |
|||
|
|||
2016-2022 The Hush Developers |
|||
|
|||
# License |
|||
|
|||
*/5 * * * * cd /home/hush && ./update.sh |
|||
``` |
|||
GPLv3 |
|||
|
@ -1,337 +0,0 @@ |
|||
#!/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; |
|||
} |
@ -1,7 +0,0 @@ |
|||
#!/usr/bin/perl |
|||
use strict; |
|||
use warnings; |
|||
use Redis; |
|||
my $r = Redis->new; |
|||
|
|||
$r->set("test:123","fuck"); |
@ -1,375 +0,0 @@ |
|||
#!/usr/bin/env perl |
|||
use strict; |
|||
use warnings; |
|||
use JSON::Any; |
|||
use Data::Dumper; |
|||
use 5.014; |
|||
my $STATS = {}; |
|||
$|=1; |
|||
|
|||
my $TX = {}; |
|||
|
|||
#sleep 10; |
|||
|
|||
# While Siona swims, we pave with bricks on the road she will run on... |
|||
my $dir = shift || '/var/www/explorer.hush.is/api/'; |
|||
my $cli = "/home/duke/git/hush3/src/hush-cli"; |
|||
my $getinfo = readfile("$dir/getinfo.json"); |
|||
my $mining = readfile("$dir/getmininginfo.json"); |
|||
my $template = readfile("/var/www/explorer.hush.is/blocks/template.html"); |
|||
my $blocksdir = "/var/www/explorer.hush.is/blocks/"; |
|||
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 BLOCKS_TABLE TLS_CONNECTIONS CONNECTIONS PROTOCOLVERSION |
|||
/; |
|||
my @blocks = (); |
|||
my $height = $STATS->{BLOCKS}; |
|||
$STATS->{BLOCKS_TABLE} = ""; |
|||
$STATS->{TX_TABLE} = ""; |
|||
|
|||
my $NUM_BLOCKS = 50; |
|||
my $mineraddress = ""; |
|||
for my $h ($height-$NUM_BLOCKS .. $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 = $block->{time}; |
|||
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} || "?"; |
|||
# "vShieldedOutput": [ |
|||
# { |
|||
# "cv": "61e0fed3b97e08e442408c7efc4058a9116695e6e28a22c0fbf0987fdfbcdd27", |
|||
# "cmu": "25245041af3bbc5a03da1cd6d60665f7659cbb3bab1080a6e003f856d45998fc", |
|||
# "ephemeralKey": "bffefb4f55679610bbdbd43bfba64308842348ba70bb999fad00c67356eab998", |
|||
# "encCiphertext": "b685c9d4f6164102999e88e3e30fcca37d9c402fc72533185d495a9d64f1fca277ead03aefe960eeaf102c0c92686a75c792ae8662f40601287ff19635581279d9c9940ba3c29af36166620422c6 |
|||
#49c4a7ca938734ceecb93a3abc8753ff3535950662ef46d8ed3a0608a61c65be5d0bdb1c262bd63fde759040eef74d4d81619ee154bbabe4fc0e27d82b19c6ed0d4cd806d5bc75ebbb13370ff3f19979ab3b74e859d9b88d3802 |
|||
#bc7a2ce7ae4305c6beec2146b374bda7234395d0aa390337e69ef5d04eddef0087244292f358b46eeb3c2a5a6d3bd1c89aaa4ebfd8bab58d2d4771b1d106db1a5dcead3b09cfc9fc38b972ce98c53d3cd658b02e58b087c7c73e |
|||
#0bd7cb093f2b15ab397094be5bc98f5865045d1845e548249fc811545db1645beb2f044366ba9ae584074e6fa5c03d786757c88ed8eff2d81570d15e64f192707d7393ce40b0f2f767cfbeaa5f05a634fe527da982241c92c4c2 |
|||
#9642f633115d34fe6791f00c8867e2242485de5f0bb87a8d4e6b375f557db6968f5ecc4f07b838b2dd85dd54e4e9ae2a28e9305bd1a6ae71adf75335d5f44cc046194fdbc91fb80202f06af9431716dc6627b2aa4723b0b8e4bb |
|||
#504649b6350ba9f020106d71248227ed8d7a10e2fbcbf64824c8923149822970b3c574614a8c32602106132c1209917974566b2990cf106666f985a2fa1f1409efdc457404700da210906b0f19be61c70d70eddc2f1cbffd94bb |
|||
#4c154a332fdd345ad06bd2ac86a339a93eae25db5eb3b4c6090d8483a8e5dd642231d17f3011b2f4b629ef72c08df1eeb6e7d06e", |
|||
# "outCiphertext": "53e3865f52101faf3218b60b7d58b9c426dc7c6cff009a8ceddd58031afe9802cae0f423a1085c2b36c776db29b57db8041e9bac42d6b445a0d69eb5a2f0ef61b4790595a68750c60889ff811dce |
|||
#8fbb", |
|||
# "proof": "82eda0f7de0936f6ca8208e63bda8db9970feb232ae64635e5bea67f16fdbe1b5e5e3a6bb7b7d2f0127c0d17de494834a82e899e8eecdfc71a59de8d1808a53df2989762bd54a855dadc535f2c5107d7b6da |
|||
#a732153c4dda4ac965be79ba2ecc030bd58e4c05d5ac7be283b3dc68af8a39231a31cccb54eae65c676760182bd22965f2e1c3685de44c0b93d84519bf138c7942222795dfdd0f683474b7c75221c9355109258805cc038ca43b |
|||
#26d5770bf25882326f4f508731b36a8632bc0012" |
|||
# } |
|||
# ], |
|||
|
|||
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"; |
|||
} |
|||
|
|||
my $blockduration = 0; |
|||
if($#blocks >= 0) { |
|||
$blockduration = $time - $blocks[$#blocks]->[3]; |
|||
} |
|||
# give data to blocks after we have processed everything |
|||
my $b = [ $h, $hash, $reward,$time,$numtx,$thisminer, $blockduration ]; |
|||
#warn Dumper $b; |
|||
push @blocks, $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 @blocks) { |
|||
my ($height,$hash,$reward,$time,$txs,$miner,$duration) = @$b; |
|||
|
|||
$time = localtime($time); |
|||
|
|||
# we can't calc the duration of the first block we look at, yet |
|||
$duration = "--" unless $duration; |
|||
|
|||
$STATS->{BLOCKS_TABLE} .= <<"FUCK"; |
|||
<tr> |
|||
<td align=center><a href="/block/$height">$height</a></td> |
|||
<td align=center><a href="/block/$hash">$hash</a></td> |
|||
<td align=center>$time UTC</td> |
|||
<td align=center>$duration s</td> |
|||
<td align=center>$miner</td> |
|||
<td align=center>$reward</td> |
|||
<td align=center>$txs</td> |
|||
</tr> |
|||
FUCK |
|||
} |
|||
|
|||
|
|||
|
|||
for my $s (@symbols) { |
|||
if($s && $STATS->{$s}) { $template =~ s/#$s#/$STATS->{$s}/ge } |
|||
} |
|||
|
|||
# derived stat |
|||
#my $zpct = sprintf "%.3f", $STATS->{SUPPLY} > 0 ? 100*($STATS->{ZFUNDS}/$STATS->{SUPPLY}) : "0.000"; |
|||
#$template =~ s/#ZFUNDS_PERCENT#/$zpct/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; |
|||
} |
@ -1,13 +1,19 @@ |
|||
#!/usr/bin/env bash |
|||
DIR=/var/www/explorer.hush.land/var/www/explorer.hush.land/api |
|||
# Copyright 2016-2022 The Hush Developers |
|||
|
|||
DOMAIN=$(SIONA_DOMAIN) |
|||
CLI=$(SIONA_CLI) |
|||
# this is optional and not used yet here |
|||
ACNAME=$(SIONA_ACNAME) |
|||
DIR=/var/www/$DOMAIN/var/www/$DOMAIN/api |
|||
|
|||
# TODO: remove IP info from getpeerinfo |
|||
#~/git/hush3/src/hush-cli getpeerinfo > $DIR/getpeerinfo.json |
|||
~/git/hush3/src/hush-cli getinfo &> $DIR/getinfo.json |
|||
~/git/hush3/src/hush-cli getmininginfo &> $DIR/getmininginfo.json |
|||
~/git/hush3/src/hush-cli getblockchaininfo &> $DIR/getblockchain.json |
|||
~/git/hush3/src/hush-cli getchaintxstats &> $DIR/getchaintxstats.json |
|||
~/git/hush3/src/hush-cli gettxoutsetinfo &> $DIR/gettxoutsetinfo.json |
|||
~/git/hush3/src/hush-cli coinsupply &> $DIR/coinsupply.json |
|||
~/git/hush3/src/hush-cli getchaintips &> $DIR/getchaintips.json |
|||
~/git/hush3/src/hush-cli getchaintxstats &> $DIR/getchaintxstats.json |
|||
#$CLI getpeerinfo > $DIR/getpeerinfo.json |
|||
$CLI getinfo &> $DIR/getinfo.json |
|||
$CLI getmininginfo &> $DIR/getmininginfo.json |
|||
$CLI getblockchaininfo &> $DIR/getblockchain.json |
|||
$CLI getchaintxstats &> $DIR/getchaintxstats.json |
|||
$CLI gettxoutsetinfo &> $DIR/gettxoutsetinfo.json |
|||
$CLI coinsupply &> $DIR/coinsupply.json |
|||
$CLI getchaintips &> $DIR/getchaintips.json |
|||
$CLI getchaintxstats &> $DIR/getchaintxstats.json |
|||
|
@ -1,18 +1,17 @@ |
|||
#!/usr/bin/env bash |
|||
|
|||
cli=~/git/hush3/src/hush-cli |
|||
cli=$(SIONA_CLI) |
|||
|
|||
# only ask for data if we don't have it |
|||
#if [ -s ~/data/blocks/block-$HEIGHT.json ]; then |
|||
# HEIGHT=$($cli getblockcount); $cli getblock $HEIGHT > ~/data/blocks/block-$HEIGHT.json |
|||
#fi |
|||
|
|||
NEWFILE=/var/www/explorer.hush.land/var/www/explorer.hush.land/blocks/index.new.html |
|||
INDEXFILE=/var/www/explorer.hush.land/var/www/explorer.hush.land/blocks/index.html |
|||
NEWFILE=/var/www/$domain/var/www/$domain/blocks/index.new.html |
|||
INDEXFILE=/var/www/$domain/var/www/$domain/blocks/index.html |
|||
|
|||
# reads data from /var/www/explorer.hush.is/api |
|||
#~/git/explorer.hush.is/bin/update_blocks.pl > $NEWFILE |
|||
/var/www/explorer.hush.land/bin/update_blocks_redis.pl > $NEWFILE |
|||
# reads data from /var/www/$domain/api |
|||
/var/www/$domain/bin/update_blocks_redis.pl > $NEWFILE |
|||
if [ -s $NEWFILE ]; then |
|||
cp $NEWFILE $INDEXFILE |
|||
fi |
|||
|
Loading…
Reference in new issue