X-Git-Url: https://git.sesse.net/?p=remoteglot;a=blobdiff_plain;f=remoteglot.pl;h=55464e6e2716abafc287d427ad85d8d3daab58a9;hp=5a5d4c556ad4d6607111f12a8012ed79cf37eccc;hb=98f725bb9ae4f20645362bf829368367dc4f34ee;hpb=b643b81793e1457b373cd9f24635ae0757621ab7 diff --git a/remoteglot.pl b/remoteglot.pl index 5a5d4c5..55464e6 100755 --- a/remoteglot.pl +++ b/remoteglot.pl @@ -5,7 +5,7 @@ # analysis, or for live analysis of relayed games. (Do not use for # cheating! Cheating is bad for your karma, and your abuser flag.) # -# Copyright 2007 Steinar H. Gunderson +# Copyright 2007 Steinar H. Gunderson # Licensed under the GNU General Public License, version 2. # @@ -67,6 +67,7 @@ select(TBLOG); $| = 1; select(STDOUT); +umask 0022; # open the chess engine my $engine = open_engine($remoteglotconf::engine_cmdline, 'E1', sub { handle_uci(@_, 1); }); @@ -219,7 +220,7 @@ sub handle_fics { for my $pos ($pos_waiting, $pos_calculating) { next if (!defined($pos)); if ($pos->fen() eq $pos_for_movelist->fen()) { - $pos->{'pretty_history'} = \@pretty_movelist; + $pos->{'history'} = \@pretty_movelist; } } $getting_movelist = 0; @@ -275,8 +276,12 @@ sub handle_pgn { } my $pgn = Chess::PGN::Parse->new(undef, $body); - if (!defined($pgn) || !$pgn->read_game() || $body !~ /^\[/) { - warn "Error in parsing PGN from $url\n"; + if (!defined($pgn)) { + warn "Error in parsing PGN from $url [body='$body']\n"; + } elsif (!$pgn->read_game()) { + warn "Error in reading PGN game from $url [body='$body']\n"; + } elsif ($body !~ /^\[/) { + warn "Malformed PGN from $url [body='$body']\n"; } else { eval { # Skip to the right game. @@ -286,16 +291,28 @@ sub handle_pgn { } $pgn->parse_game({ save_comments => 'yes' }); - my $pos = Position->start_pos($pgn->white, $pgn->black); + my $white = $pgn->white; + my $black = $pgn->black; + $white =~ s/,.*//; # Remove first name. + $black =~ s/,.*//; # Remove first name. + my $pos = Position->start_pos($white, $black); my $moves = $pgn->moves; my @uci_moves = (); + my @repretty_moves = (); for my $move (@$moves) { - my $uci_move; - ($pos, $uci_move) = $pos->make_pretty_move($move); + my ($npos, $uci_move) = $pos->make_pretty_move($move); push @uci_moves, $uci_move; + + # Re-prettyprint the move. + my ($from_row, $from_col, $to_row, $to_col, $promo) = parse_uci_move($uci_move); + my ($pretty, undef) = $pos->{'board'}->prettyprint_move($from_row, $from_col, $to_row, $to_col, $promo); + push @repretty_moves, $pretty; + $pos = $npos; + } + if ($pgn->result eq '1-0' || $pgn->result eq '1/2-1/2' || $pgn->result eq '0-1') { + $pos->{'result'} = $pgn->result; } - $pos->{'result'} = $pgn->result; - $pos->{'pretty_history'} = $moves; + $pos->{'history'} = \@repretty_moves; extract_clock($pgn, $pos); @@ -482,10 +499,9 @@ sub parse_ids { my ($engine, @x) = @_; while (scalar @x > 0) { - if ($x[0] =~ /^(name|author)$/) { - my $key = shift @x; + if ($x[0] eq 'name') { my $value = join(' ', @x); - $engine->{'id'}{$key} = $value; + $engine->{'id'}{'author'} = $value; last; } @@ -502,7 +518,7 @@ sub prettyprint_pv_no_cache { } my $pv = shift @pvs; - my ($from_col, $from_row, $to_col, $to_row, $promo) = parse_uci_move($pv); + my ($from_row, $from_col, $to_row, $to_col, $promo) = parse_uci_move($pv); my ($pretty, $nb) = $board->prettyprint_move($from_row, $from_col, $to_row, $to_col, $promo); return ( $pretty, prettyprint_pv_no_cache($nb, @pvs) ); } @@ -520,6 +536,72 @@ sub prettyprint_pv { } } +my %tbprobe_cache = (); + +sub complete_using_tbprobe { + my ($pos, $info, $mpv) = @_; + + # We need Fathom installed to do standalone TB probes. + return if (!defined($remoteglotconf::fathom_cmdline)); + + # If we already have a mate, don't bother; in some cases, it would even be + # better than a tablebase score. + return if defined($info->{'score_mate' . $mpv}); + + # If we have a draw or near-draw score, there's also not much interesting + # we could add from a tablebase. We only really want mates. + return if ($info->{'score_cp' . $mpv} >= -12250 && $info->{'score_cp' . $mpv} <= 12250); + + # Run through the PV until we are at a 6-man position. + # TODO: We could in theory only have 5-man data. + my @pv = @{$info->{'pv' . $mpv}}; + my $key = $pos->fen() . " " . join('', @pv); + my @moves = (); + if (exists($tbprobe_cache{$key})) { + @moves = @{$tbprobe_cache{$key}}; + } else { + if ($mpv ne '') { + # Force doing at least one move of the PV. + my $move = shift @pv; + push @moves, $move; + $pos = $pos->make_move(parse_uci_move($move)); + } + + while ($pos->num_pieces() > 6 && $#pv > -1) { + my $move = shift @pv; + push @moves, $move; + $pos = $pos->make_move(parse_uci_move($move)); + } + + return if ($pos->num_pieces() > 6); + + my $fen = $pos->fen(); + my $pgn_text = `fathom --path=/srv/syzygy "$fen"`; + my $pgn = Chess::PGN::Parse->new(undef, $pgn_text); + return if (!defined($pgn) || !$pgn->read_game() || ($pgn->result ne '0-1' && $pgn->result ne '1-0')); + $pgn->quick_parse_game; + $info->{'pv' . $mpv} = \@moves; + + # Splice the PV from the tablebase onto what we have so far. + for my $move (@{$pgn->moves}) { + my $uci_move; + ($pos, $uci_move) = $pos->make_pretty_move($move); + push @moves, $uci_move; + } + + $tbprobe_cache{$key} = \@moves; + } + + $info->{'pv' . $mpv} = \@moves; + + my $matelen = int((1 + scalar @moves) / 2); + if ((scalar @moves) % 2 == 0) { + $info->{'score_mate' . $mpv} = -$matelen; + } else { + $info->{'score_mate' . $mpv} = $matelen; + } +} + sub output { #return; @@ -584,6 +666,8 @@ sub output { for my $key (qw(pv score_cp score_mate nodes nps depth seldepth tbhits)) { if (exists($info->{$key . '1'})) { $info->{$key} = $info->{$key . '1'}; + } else { + delete $info->{$key}; } } } @@ -610,6 +694,17 @@ sub output { return; } + # Now do our own Syzygy tablebase probes to convert scores like +123.45 to mate. + if (exists($info->{'pv'})) { + complete_using_tbprobe($pos_calculating, $info, ''); + } + + my $mpv = 1; + while (exists($info->{'pv' . $mpv})) { + complete_using_tbprobe($pos_calculating, $info, $mpv); + ++$mpv; + } + output_screen(); output_json(0); $latest_update = [Time::HiRes::gettimeofday]; @@ -698,8 +793,8 @@ sub output_screen { my $info = $engine2->{'info'}; last if (!exists($info->{'pv' . $mpv})); eval { + complete_using_tbprobe($pos_calculating_second_engine, $info, $mpv); my $pv = $info->{'pv' . $mpv}; - my $pretty_move = join('', prettyprint_pv($pos_calculating_second_engine, $pv->[0])); my @pretty_pv = prettyprint_pv($pos_calculating_second_engine, @$pv); if (scalar @pretty_pv > 5) { @@ -738,10 +833,21 @@ sub output_json { my $json = {}; $json->{'position'} = $pos_calculating->to_json_hash(); - $json->{'id'} = $engine->{'id'}; - $json->{'score'} = long_score($info, $pos_calculating, ''); - $json->{'short_score'} = short_score($info, $pos_calculating, ''); - $json->{'plot_score'} = plot_score($info, $pos_calculating, ''); + $json->{'engine'} = $engine->{'id'}; + if (defined($remoteglotconf::engine_url)) { + $json->{'engine'}{'url'} = $remoteglotconf::engine_url; + } + if (defined($remoteglotconf::engine_details)) { + $json->{'engine'}{'details'} = $remoteglotconf::engine_details; + } + if (defined($remoteglotconf::move_source)) { + $json->{'move_source'} = $remoteglotconf::move_source; + } + if (defined($remoteglotconf::move_source_url)) { + $json->{'move_source_url'} = $remoteglotconf::move_source_url; + } + $json->{'score'} = score_digest($info, $pos_calculating, ''); + $json->{'using_lomonosov'} = defined($remoteglotconf::tb_serial_key); $json->{'nodes'} = $info->{'nodes'}; $json->{'nps'} = $info->{'nps'}; @@ -749,9 +855,7 @@ sub output_json { $json->{'tbhits'} = $info->{'tbhits'}; $json->{'seldepth'} = $info->{'seldepth'}; $json->{'tablebase'} = $info->{'tablebase'}; - - $json->{'pv_uci'} = $info->{'pv'}; # Still needs to be there for the JS to calculate arrows; only for the primary PV, though! - $json->{'pv_pretty'} = [ prettyprint_pv($pos_calculating, @{$info->{'pv'}}) ]; + $json->{'pv'} = [ prettyprint_pv($pos_calculating, @{$info->{'pv'}}) ]; my %refutation_lines = (); my @refutation_lines = (); @@ -763,16 +867,15 @@ sub output_json { last if (!exists($info->{'pv' . $mpv})); eval { + complete_using_tbprobe($pos_calculating, $info, $mpv); my $pv = $info->{'pv' . $mpv}; my $pretty_move = join('', prettyprint_pv($pos_calculating, $pv->[0])); my @pretty_pv = prettyprint_pv($pos_calculating, @$pv); - $refutation_lines{$pv->[0]} = { - sort_key => $pretty_move, + $refutation_lines{$pretty_move} = { depth => $info->{'depth' . $mpv}, - score_sort_key => score_sort_key($info, $pos_calculating, $mpv, 0), - pretty_score => short_score($info, $pos_calculating, $mpv), - pretty_move => $pretty_move, - pv_pretty => \@pretty_pv, + score => score_digest($info, $pos_calculating, $mpv), + move => $pretty_move, + pv => \@pretty_pv, }; }; } @@ -780,19 +883,19 @@ sub output_json { $json->{'refutation_lines'} = \%refutation_lines; # Piece together historic score information, to the degree we have it. - if (!$historic_json_only && exists($pos_calculating->{'pretty_history'})) { + if (!$historic_json_only && exists($pos_calculating->{'history'})) { my %score_history = (); my $q = $dbh->prepare('SELECT * FROM scores WHERE id=?'); my $pos = Position->start_pos('white', 'black'); my $halfmove_num = 0; - for my $move (@{$pos_calculating->{'pretty_history'}}) { + for my $move (@{$pos_calculating->{'history'}}) { my $id = id_for_pos($pos, $halfmove_num); my $ref = $dbh->selectrow_hashref($q, undef, $id); if (defined($ref)) { $score_history{$halfmove_num} = [ - $ref->{'plot_score'}, - $ref->{'short_score'} + $ref->{'score_type'}, + $ref->{'score_value'} ]; } ++$halfmove_num; @@ -823,6 +926,7 @@ sub output_json { } # Give out a list of other games going on. (Empty is fine.) + # TODO: Don't bother reading our own file, the data will be stale anyway. if (!$historic_json_only) { my @games = (); @@ -837,11 +941,18 @@ sub output_json { my $white = $other_game_json->{'position'}{'player_w'} // die 'Missing white'; my $black = $other_game_json->{'position'}{'player_b'} // die 'Missing black'; - push @games, { + my $game = { id => $ref->{'id'}, name => "$white–$black", - url => $ref->{'url'} + url => $ref->{'url'}, + hashurl => $ref->{'hash_url'}, }; + if (defined($other_game_json->{'position'}{'result'})) { + $game->{'result'} = $other_game_json->{'position'}{'result'}; + } else { + $game->{'score'} = $other_game_json->{'score'}; + } + push @games, $game; }; if ($@) { warn "Could not add external game " . $ref->{'json_path'} . ": $@"; @@ -862,7 +973,7 @@ sub output_json { $last_written_json = $encoded; } - if (exists($pos_calculating->{'pretty_history'}) && + if (exists($pos_calculating->{'history'}) && defined($remoteglotconf::json_history_dir)) { my $id = id_for_pos($pos_calculating); my $filename = $remoteglotconf::json_history_dir . "/" . $id . ".json"; @@ -875,17 +986,21 @@ sub output_json { my $new_depth = $json->{'depth'} // 0; my $new_nodes = $json->{'nodes'} // 0; if (!defined($old_engine) || - $old_engine ne $json->{'id'}{'name'} || + $old_engine ne $json->{'engine'}{'name'} || $new_depth > $old_depth || ($new_depth == $old_depth && $new_nodes >= $old_nodes)) { atomic_set_contents($filename, $encoded); - if (defined($json->{'plot_score'})) { - local $dbh->{AutoCommit} = 0; - $dbh->do('DELETE FROM scores WHERE id=?', undef, $id); - $dbh->do('INSERT INTO scores (id, plot_score, short_score, engine, depth, nodes) VALUES (?,?,?,?,?,?)', undef, - $id, $json->{'plot_score'}, $json->{'short_score'}, - $json->{'id'}{'name'}, $new_depth, $new_nodes); - $dbh->commit; + if (defined($json->{'score'})) { + $dbh->do('INSERT INTO scores (id, score_type, score_value, engine, depth, nodes) VALUES (?,?,?,?,?,?) ' . + ' ON CONFLICT (id) DO UPDATE SET ' . + ' score_type=EXCLUDED.score_type, ' . + ' score_value=EXCLUDED.score_value, ' . + ' engine=EXCLUDED.engine, ' . + ' depth=EXCLUDED.depth, ' . + ' nodes=EXCLUDED.nodes', + undef, + $id, $json->{'score'}[0], $json->{'score'}[1], + $json->{'engine'}{'name'}, $new_depth, $new_nodes); } } } @@ -904,7 +1019,7 @@ sub atomic_set_contents { sub id_for_pos { my ($pos, $halfmove_num) = @_; - $halfmove_num //= scalar @{$pos->{'pretty_history'}}; + $halfmove_num //= scalar @{$pos->{'history'}}; (my $fen = $pos->fen()) =~ tr,/ ,-_,; return "move$halfmove_num-$fen"; } @@ -955,30 +1070,28 @@ sub short_score { return undef; } -sub score_sort_key { - my ($info, $pos, $mpv, $invert) = @_; +# Sufficient for computing long_score, short_score, plot_score and +# (with side-to-play information) score_sort_key. +sub score_digest { + my ($info, $pos, $mpv) = @_; if (defined($info->{'score_mate' . $mpv})) { my $mate = $info->{'score_mate' . $mpv}; - my $score; - if ($mate > 0) { - # Side to move mates - $score = 99999 - $mate; - } else { - # Side to move is getting mated (note the double negative for $mate) - $score = -99999 - $mate; - } - if ($invert) { - $score = -$score; + if ($pos->{'toplay'} eq 'B') { + $mate = -$mate; } - return $score; + return ['m', $mate]; } else { if (exists($info->{'score_cp' . $mpv})) { my $score = $info->{'score_cp' . $mpv}; - if ($invert) { + if ($pos->{'toplay'} eq 'B') { $score = -$score; } - return $score; + if ($score == 0 && $info->{'tablebase'}) { + return ['d', undef]; + } else { + return ['cp', $score]; + } } } @@ -1163,7 +1276,7 @@ sub find_clock_start { # TODO(sesse): Maybe we can get the number of moves somehow else for FICS games. # The history is needed for id_for_pos. - if (!exists($pos->{'pretty_history'})) { + if (!exists($pos->{'history'})) { return; } @@ -1317,5 +1430,5 @@ sub parse_uci_move { my $to_col = col_letter_to_num(substr($move, 2, 1)); my $to_row = row_letter_to_num(substr($move, 3, 1)); my $promo = substr($move, 4, 1); - return ($from_col, $from_row, $to_col, $to_row, $promo); + return ($from_row, $from_col, $to_row, $to_col, $promo); }