#!/usr/bin/perl

# tmbmgr.pl v1.35 (c) 2014 Jeremy Kister
# Released under Perl's Artistic License
# http://jeremy.kister.net/code/tmbmgr.pl
#
# BTC: 1EmQKDC5PchvfxByReWsetaR6Et3ar6vLp
# Cryptsy: cee57e7aecb36ad8b85231108a1e7ac1d95d2f0d
#
# continuously make calls to trademybit's "bestalgo" api method.
# use sgminer v5's API to adjust pool priority to match bestalgo.
# this makes us mine the most profitable x algorithm.
# also can specify minimum rate (normalized b/m/d) to mine for.
#
# this code can be ran on the miner itself or a third party machine
# that has access to your miner(s) API port. adjust api-groups.
#
# add to sgminer config:
#  "api-allow" :  "P:10.0.0.0/24,R:127.0.0.1/32",
#  "api-groups" : "P:poolpriority:enablepool:disablepool:*",
#  "api-listen" : true,
#  "api-network" : true,
#
# add in pools for each algorithm you want to mine (x11/x13/x15/nist5/neo).
# order of pools is irrelevant as far as this code is concerned.
# DONT add the "switcher" ports - use the main 4440/5550/6660/7770/8880
#
# then set up your /etc/tmbmgr.conf file.
# key    your key found at: https://pool.trademybit.com/account/profile
# miners a space separated list of miners to control.
#        ip addresses are okay.
#        you may annex a :<port> to assign a per-miner API port. e.g.,
#        miner1:4028 miner2:4029 miner3:3028
# min    minimum score/price that you'll mine for (otherwise the
#        protocol is disabled).  min can either be set to a single
#        value (to be used globally) or it can be specified per miner:
#        miner1:0.01 miner2:0.009
# adjust change score by this percent
#        some protocols cost more electricity to run than others.
#        e.g., neoscrypt is 9% more than x11 (and is much slower on older cards)
#        to level out the profit, we lower neoscrypt's score by 9%.
#        or, when Wolf0's x11 kernel leaked, we bump x11 priority by 140%
#        * global-- adjust: neoscrypt:91 nist5:88 x11:140
#        * per miner--  adjust: miner1:neoscrypt:91,nist5:88,x11:140 miner2:<...>
# delay  rounds a protocol has to be more profitable than what we're
#        currently mining before we switch.  too short (or no) delay will cause
#        constant flips between the most profitable protocols - sgminer wastes
#        time initializing the new kernel for each flip.
#        delay is automatically x1.5 when the profit difference is < 6% and 
#        x3 when the profit difference is < 2%.
#        DEFAULT: 3
#        
#
# echo "key: your_tmb_api_key" > /etc/tmbmgr.conf
# echo "miners: miner1 miner2 miner3 miner-foo" >> /etc/tmbmgr.conf
# echo "min: 0.0015" >> /etc/tmbmgr.conf
# echo "adjust: neoscrypt:91 nist5:88 x11:140" >> /etc/tmbmgr.conf
# echo "delay: 3" >> /etc/tmbmgr.conf
#
# i like running the code like:
#  screen -mS tmbmgr perl tmbmgr.pl -D
# ymmv.

use strict;
use JSON;
use Getopt::Std;
use HTTP::Cookies;
use LWP::UserAgent;
use IO::Socket::INET;

$SIG{PIPE} = sub { debug( "caught SIGPIPE!" ) };

my %PORTMAP = ( 8880 => 'neoscrypt',
                7770 => 'nist5',
                6660 => 'x15',
                5550 => 'x13',
                4440 => 'x11',
              );

my %opt;
getopts('Dc:', \%opt);
# Debug
# config file

$opt{c} ||= '/etc/tmbmgr.conf';

my $UA  = "Mozilla/4.0 (compatible; tmbmgr/1.35; LWP/$LWP::UserAgent::VERSION; Perl/$^V)";
my $URL = 'https://pool.trademybit.com/api/';

my $time = time();
my $conf = getconfig();
my $json = JSON->new();
my $jar  = HTTP::Cookies->new(hide_cookie2 => 1);
my $ua   = LWP::UserAgent->new(agent   => $UA,
                               timeout => 2,
                               cookie_jar => $jar);

my %lopts = @LWP::Protocol::http::EXTRA_SOCK_OPTS;
$lopts{SendTE} = 0;
@LWP::Protocol::http::EXTRA_SOCK_OPTS = %lopts;

my $poolq = '{"command":"pools"}' . "\r\n";

my (%miners,%tmb);
while( 1 ){
    debug( "getting data." );

    $time = time();
    my $nextrun = ($time+60);

    # has config file updated ?
    my $mtime = (stat($opt{c}))[9];
    if( $mtime > $conf->{mtime} ){
        $conf = getconfig();
    }

    # ask TMB what the scores are for which protocols
    my $bestref = bestalgo();

    # adjust each miner's pool settings appropriately
    MINER: for my $miner ( @{$conf->{miners}} ){
        debug( " *** $miner ***" );
 
        # get adjusted scores per miner
        my $adjusted = $conf->{adjust}{$miner} ? adjust($miner,$bestref) : $bestref;
        my @order;
        for my $href (@{$adjusted}){
            push @order, $href->{algo};
        }

        # get this miner's pool config
        unless( $miners{$miner}{pools} ){
            my $res = getpools( $miner );
            next unless $res;
        }
      
        # create custom order of protocols based on miner's pool config 
        my @morder;
        for my $proto ( @order ) {
            push @morder, $proto if( $miners{$miner}{algo}{$proto} );
        }

        # deal with protocols miner has + NOT being returned by bestalgo
        for my $proto (keys %{ $miners{$miner}{algo} }){
            next if defined($tmb{$proto});
            next if $miners{$miner}{extra}{$proto};
            $miners{$miner}{extra}{$proto} = 1;
            push @morder, $proto;
        }

        $miners{$miner}{idle} = 1; # prove otherwise
        for my $proto (@morder){
            if( ($tmb{$proto} < $conf->{$miner}{min}) || (! $tmb{$proto}) ){
                # too worthless to mine || not being returned by bestalgo.  disable the pool.
                next if $miners{$miner}{proto}{$proto} eq 0;
                debug( "  * disabling $proto on $miner" );
                for my $pool ( @{ $miners{$miner}{pools}{$proto} } ){
                    my $sock = sock($miner);
                    next MINER unless $sock;
                    $sock->send( "disablepool|$pool\r\n" );
                }
                $miners{$miner}{proto}{$proto} = 0;
            }else{
                $miners{$miner}{idle} = 0;

                next if $miners{$miner}{proto}{$proto} eq 1;
                debug( "  * enabling $proto on $miner" );
                for my $pool ( @{ $miners{$miner}{pools}{$proto} } ){
                    my $sock = sock($miner);
                    next MINER unless $sock;
                    $sock->send( "enablepool|$pool\r\n" );
                }
                $miners{$miner}{proto}{$proto} = 1;
            }
        }

        # are all protocols disabled (due to price) ?
        if( $miners{$miner}{idle} ){
            unless( $miners{$miner}{last}{idle} ){
                $miners{$miner}{time} = $time;
                $miners{$miner}{last}{idle} = 1;
            }
            goto SUMM;
        }else{
            if( $miners{$miner}{last}{idle} ){
                $miners{$miner}{last}{idle} = 0;
                $miners{$miner}{time} = $time;
            }
        }

        my @aorder; #for stats
        
        # what is the new score vs the score of the protocol the miner is running currently
        if( $miners{$miner}{last}{order}->[0] eq $morder[0] ){
            # if we're mining x11, 
            # round1 x13 is best, round2 x11 is best, round3 x13 is best,
            # otherwise we'd switch to x13 on round3
            delete $miners{$miner}{delay};

            if( @{$miners{$miner}{last}{order}} ~~ @morder ){
                @aorder = @{$miners{$miner}{last}{order}};
                goto SUMM;
            }
        }else{
	        my $current;
	        for my $href (@{$adjusted}){
	            next unless $href->{algo} eq $miners{$miner}{last}{order}[0];
	            $current = $href;
	            last;
	        }
	        if( ref($current) ){ # not first round
	            my %round = ( score => $adjusted->[0]->{score},
                              algo  => $adjusted->[0]->{algo},
                            );
	            my $diff = abs($round{score} - $current->{score});
	            my $avg = (($round{score} + $current->{score}) / 2);
	            my $percent = sprintf('%.2f', (($diff/$avg) * 100));
	
	            debug( "  * $current->{algo} @ $current->{score} < $round{algo} @ $round{score} by ${percent}%" );
	
                $miners{$miner}{delay}{$morder[0]}++;

                # if round1 x11 is best, round2 x13 is best, round3 x11 is best,
                # we want x11 = 1, not = 2 (we want concurrent rounds before switching)
                for my $protocol (keys %{$miners{$miner}{delay}}){
                    next if $protocol eq $morder[0];
                    delete $miners{$miner}{delay}{$protocol};
                }

	            # make sure it stays higher than current for X rounds before switching
                my $want = ($percent < 2) ?
                           int($conf->{delay} * 3.0 + 0.5) :
                           ($percent < 6) ?
                           int($conf->{delay} * 1.5 + 0.5) :
                           $conf->{delay};
                my $rounds = $miners{$miner}{delay}{$morder[0]};
                unless( $rounds >= $want ){
                    debug( "  * delay on protocol switch ${rounds}/${want}" );
                    @aorder = @{$miners{$miner}{last}{order}};
                    goto SUMM;
	            }
	        }
        }
        
        my $data = 'poolpriority|';
        for my $proto (@morder){
            $data .= join(',', @{ $miners{$miner}{pools}{$proto} } ) . ',';
        }
        chop( $data ); # trailing comma

        debug( "  * sending new priority data to $miner" );

        my $sock = sock($miner);
        next MINER unless $sock;
        $sock->send($data);

        $miners{$miner}{last}{order} = \@morder;
        delete $miners{$miner}{delay};

        @aorder = @morder;

        # only reset the counter if the 'best' changed
        unless( $miners{$miner}{last}{best} eq $morder[0] ){
            $miners{$miner}{time} = $time;
            $miners{$miner}{last}{best} = $morder[0];
        }

        SUMM:
            if( $opt{D} ){
                my $lot = getlot($miner);
                my $state = $miners{$miner}{idle} ? 'idle' : "mining $aorder[0]";
                verbose( "$miner $state for $lot" );

                my @prio;
                for (@aorder){
                    next unless $miners{$miner}{proto}{$_};
                    push @prio, $_;
                }
                my $pstr = join(' -> ', @prio);
                verbose( "  * $pstr" );
            }

    }

    $time=time();

    my $diff = ($nextrun - $time);
    if( $diff > 0 ){
        debug( "sleeping $diff seconds." );
        sleep $diff;
    }
}

sub sock {
    my $miner = shift;

    my $sock = IO::Socket::INET->new( PeerAddr => $miner,
                                      PeerPort => $conf->{$miner}{port},
                                      Proto => 'tcp',
                                      Timeout => 2,
                                    );
    unless( $sock ){
        delete $miners{$miner};
        verbose( " could not set up socket to ${miner}!" );
    }
    
    return $sock;
}

sub getpools {
    my $miner = shift || die "getpools must specify miner\n";

    # find out how the miner's pools are set up.
	
    my $sock = sock($miner);
    return 0 unless $sock;
	
    $sock->send( $poolq );
	    
    my $reply;
    $sock->read( $reply, 16384 );
    my $res = un_json( $reply );
    
    my $num = 0;
    for my $pool (@{ $res->{POOLS} }){
        my ($port) = $pool->{URL} =~ /:(\d{3}0)$/;
        if( my $name = $PORTMAP{$port} ){
            push @{ $miners{$miner}{pools}{$name} }, $num;
            $miners{$miner}{algo}{$name} = 1;
        }else{
            verbose( "will not manage $miner/pool URL: $pool->{URL}" );
        }
        $num++;
    }
	
    return 1 unless $opt{D};

    my $dstring = "detected miner has ";
    for my $pool (values %PORTMAP){
        $dstring .= eval{ @{$miners{$miner}{pools}{$pool}} } || 0;
        $dstring .= " $pool, "
    }
    chop($dstring); # trailing space
    chop($dstring); # trailing comma
    $dstring .= ' pools';

    verbose( $dstring );

    return 1;
}

sub bestalgo {
    my $url = $URL . 'bestalgo?key=' . $conf->{key};

    while(1){
        my $r = $ua->get($url);
	    until( $r->is_success ){
	        #QQQ config for stop mining during bestalgo outage?
	        verbose( " tmb/bestalgo failed: ", $r->status_line );
	        $r = $ua->get($url);
	        sleep 10;
	    }
	
	    my $data = un_json( $r->decoded_content );
	
	    # ignore scrypt + scrypt-n
	    my @clean;
	    for my $href (@{ $data }){
	        if( $href->{algo} =~ /^(?:x1(?:1|3|5)|nist5|neoscrypt)/ ){
	            debug( sprintf(' -> %9s @ %s',$href->{algo},$href->{score}) );
	            push @clean, $href;
	            $tmb{ $href->{algo} } = $href->{score};
	        }
        }

        # in case tmb returns 200 on api but no data.
        if( @clean ){
            return \@clean;
        }

        verbose( " tmb/bestalgo returned success but came back empty!" );
        sleep 10;
    }
}

sub adjust {
    my $miner = shift;
    my $aref = shift || die "must specify order aref\n";
 
    my @nref;   
    for my $obj (@{ $aref }){
        if( my $percent = $conf->{adjust}{$miner}{$obj->{algo}} ){
            my $ns = (($percent/100) * $obj->{score});
            debug( "  * adjust: ", $obj->{algo}, " ", $obj->{score}, " * ${percent}% = ", $ns );
            push @nref, { algo => $obj->{algo}, score => $ns };
        }else{
            push @nref, { algo => $obj->{algo}, score => $obj->{score} };
        }
    }

    my @sorted = map { $_->[0] }
                 sort { $b->[1] <=> $a->[1] }
                 map { [ $_, $_->{score} ] } @nref;
    return \@sorted;
}

sub un_json {
    my $input = shift;

    my $x = eval {
        $json->decode( $input );
    };
    return $x;
}

sub getlot {
    my $miner = shift;

    # get length of time we've been mining this algorithm
    my $s = ($time - $miners{$miner}{time});

    my $h = my $m = 0;
    while( $s >= 3600 ){
        $h++;
        $s -= 3600;
    }
    while( $s >= 60 ){
        $m++;
        $s -= 60;
    }

    return ( sprintf('%02d:%02d:%02d',$h,$m,$s) );
}

sub getconfig {

    debug( "reading config file" );

    my %conf;
    open(my $fh, $opt{c}) || die "cannot open $opt{c}: $!\n";
    while(<$fh>){
        chomp;
        s/[#;].*//g;
        next if( /^\s*$/ );
    
        if( /^miners?\s*:\s*(.+)\s*/ ){
            my $string = $1;
            for my $obj ( split /\s+/, $string ){
                my ($miner,$port) = split /:/, $obj;
                push @{ $conf{miners} }, $miner;
                $conf{$miner}{port} = $port || 4028;
            }
        }elsif( /^min\s*:\s*(.+)\s*/ ){
            my $string = $1;
            if( $string =~ /:/ ){
                for my $obj ( split /\s+/, $string ){
                    my ($miner,$min) = split /:/, $obj;
                    $conf{$miner}{min} = $min;
                }
            }else{
                $conf{min} = $string;
            }
        }elsif( /^adjust\s*:\s*(.+)\s*/ ){
            my $string = $1;

            if( $string =~ /[^\s:]+:[^\s:]+:\d{1,2}/ ){
                for my $block ( split /\s+/, $string ){
                    if( $block =~ /^([^:]+):(.+)/ ){
                        my ($miner,$data) = ($1,$2);
                        for my $kv (split /,/, $data){
                            my ($proto,$percent) = split /:/, $kv;
                            $conf{adjust}{$miner}{$proto} = $percent;
                            debug( " * will adjust $miner/$proto by ${percent}%" );
                        }
                    }else{
                        die "unknown config: $string\n";
                    }
                }
            }else{
                for my $obj ( split /\s+/, $string ){
                    my ($proto,$percent) = split /:/, $obj;
                    $conf{_adjust}{$proto} = $percent;
                    debug( " * will adjust all $proto by ${percent}%" );
                }
            }
        }elsif( /^(key|delay)\s*:\s*(\S+)/ ){
            $conf{$1} = $2;
        }else{
            verbose( "ignoring line in config: $_" );
        }
    }
    close $fh;

    $conf{delay} ||= 3;

    die "no key found in $opt{c}\n" unless $conf{key};
    die "no miners found in $opt{c}\n" unless $conf{miners}[0];
    die "invalid delay in $opt{c}\n" unless( int($conf{delay}) eq $conf{delay} );

    for my $miner (@{ $conf{miners} }){
        unless( $conf{$miner}{min} ){
            $conf{$miner}{min} = $conf{min} || 0;
        }
        if( ref($conf{_adjust}) && ! ref($conf{adjust}{$miner}) ){
            $conf{adjust}{$miner} = $conf{_adjust};
        }
    }
    $conf{mtime} = $time;
    return( \%conf );
}

sub verbose {
    my ($msg) = join('', @_);

    warn "$msg\n";
}

sub debug {
    verbose @_ if $opt{D};
}