Statystyki BOINC, cz. I

6 październik 2008 | Kategorie: BOINC, Perl

Przy robieniu swoich własnych statystyk BOINC, wykorzystywałem pliki ze statystykami generowanymi przez BOINC Manager, wymagało to jednak instalacji BOINC na danym komputerze. Po dyskusji na forum BOINC@Poland powstał skrypt (odbiegający trochę od pierwowzoru), który pobiera sam statystyki, bezpośrednio z schedulera danego projektu.

Konfiguracja skryptu znajduje się pliku xml, domyślnie config.xml w katalogu bieżącym. Gdy dany projekt wymaga alternatywnych parametrów konta, można je sprecyzować osobno dla każdego z projektów. Gdy poda się bezpośrednio klucz do danego projektu, skrypt pomija procedurę sprawdzania konta w danym projekcie. W tym przypadku pomijany jest adres e-mail i hasło do konta. W przypadku projektu World Community Grid w miejsce adresu e-mail wpisujemy nazwę użytkownika.

Pobierz config.xml
<config>
  <account_email>główny@adres.email</account_email>
  <account_passwd>głównehasło</account_passwd>
  <projects>
    <project>
      <account_email>alternatywny@adres.email</account_email>
      <account_passwd>alternatywnehasło</account_passwd>
      <project_url>http://www.ufluids.net/</project_url>
    </project>
    <project>
      <project_url>http://boinc.fzk.de/poem/</project_url>
    </project>
    <project>
      <project_url>http://milkyway.cs.rpi.edu/milkyway/</project_url>
      <!-- przykładowy klucz -->
      <account_key>a0a0a0a0a0a0a0a0a0a0a0a0a0a0a0a0</account_key>
    </project>
  </projects>
</config>

W wyniku działania skryptu, otrzymujemy plik xml, domyślnie stats.xml w katalogu bieżącym. Gdy w danym momencie dany projekt jest niedostępny, w statystykach podawane są dane z ostatniego udanego ich pobrania. Podczas testów okazało się, że każde zapytanie do schedulera powoduje wygenerowanie nowego hostid w danym projekcie, a tym samym powstanie w bazach projektu “komputerów duchów” i zaśmiecanie bazy schedulera. Aby temu zapobiec, konieczne okazało się generowanie osobnego hostid dla każdego z projektów osobno. Następuje to przy pierwszym uruchomieniu skryptu. Dodatkowo generowany jest także host_cpid wykorzystywany przy generowaniu w/w hostid. Parametry te są przechowywane w pliku ze statystykami i nie należy ich usuwać.

Pobierz stats.xml
<stats>
  <host_cpid>01010101010101010101010101010101</host_cpid><!-- przykładowy -->
  <projects>
    <project>
      <project_name>uFluids</project_name>
      <project_url>http://www.ufluids.net/</project_url>
      <user_total_credit>128.281442</user_total_credit>
      <user_expavg_credit>3.607507</user_expavg_credit>
      <last_update>1224747609</last_update>
      <hostid>11</hostid><!-- przykładowy -->
    </project>
    <project>
      <project_name>Poem@Home</project_name>
      <project_url>http://boinc.fzk.de/poem/</project_url>
      <user_total_credit>573731.146552</user_total_credit>
      <user_expavg_credit>3152.617978</user_expavg_credit>
      <last_update>1224747610</last_update>
      <hostid>12</hostid><!-- przykładowy -->
    </project>
    <project>
      <project_name>Milkyway@home</project_name>
      <project_url>http://milkyway.cs.rpi.edu/milkyway/</project_url>
      <user_total_credit>2085998.570040</user_total_credit>
      <user_expavg_credit>21861.985225</user_expavg_credit>
      <last_update>1224747046</last_update>
      <hostid>13</hostid><!-- przykładowy -->
    </project>
  </projects>
</stats>

Skrypt można uruchomić z parametrami wskazującymi alternatywny plik konfiguracyjny i/lub alternatywny plik ze statystykami. Uruchomiony bez parametrów, przyjmuje wartości domyślne.

Pobierz get-stats.pl
#!/usr/bin/perl -w
 
use strict;
use Digest::MD5 qw(md5_hex);
use XML::Simple;
use Time::HiRes qw(gettimeofday);
use Data::Dumper;
use LWP::UserAgent;
use Getopt::Long qw(:config bundling pass_through);
use Carp;
$|++;
 
# defaults
my $config_file = './config.xml',
my $stats_file = './stats.xml',
my $debug = 0;
 
my $ua = LWP::UserAgent->new;
$ua->timeout(20);
 
my $host_cpid = '';
my $stats = {};
my $stats_tmp = {};
my $config = {};
 
GetOptions(
    "c|config=s" => \$config_file,
    "o|output=s" => \$stats_file,
    "d|debug" => \$debug,
    "h|help|usage" => \&usage,
);
 
usage() if $ARGV[0];
 
# wymagany plik konfiguracyjny
if ( -r $config_file ) {
    $config = XMLin(
        $config_file,
        KeyAttr => '',
        GroupTags => { projects => 'project' },
        ForceArray => [ 'project' ],
        );
    print Dumper $config if $debug;
}
else {
    croak "$config_file $!\n";
}
 
# odczytanie wcześniej zpaisanych danych
if ( -r $stats_file ) {
    $stats = XMLin(
        $stats_file,
        KeyAttr => '',
        GroupTags => { projects => 'project' },
        ForceArray => [ 'project' ],
        );
    print Dumper $stats if $debug;
 
    if ( $host_cpid = $stats->{host_cpid} ) {
        print "using `$host_cpid' as host_cpid\n";
    } else {
        $host_cpid = md5_hex(gettimeofday());
        print "new host_cpid generated: `$host_cpid'\n";
    }
 
    foreach my $project ( @{$stats->{projects}} ) {
        if ( $project->{project_url} ne '' ) {
            $stats_tmp->{$project->{project_url}} = {
                total_credit => $project->{user_total_credit},
                expavg_credit => $project->{user_expavg_credit},
                project_url => $project->{project_url},
                project_name => $project->{project_name},
                last_update => $project->{last_update},
                hostid => $project->{hostid},
            };
        }
    }
}
else {
    carp "$stats_file $!\n";
}
 
print Dumper $stats_tmp if $debug;
 
# główna pętla
MAIN: foreach my $project ( @{$config->{projects}} ) {
    my $prj_url = $project->{project_url};
    my $prj_email = $project->{account_email} || $config->{account_email};
    my $prj_passwd = $project->{account_passwd} || $config->{account_passwd};
    my $hostid = $stats_tmp->{$prj_url}{hostid} || '';
    my $prj_key;
    my $sch_url;
 
    if ( $prj_email && $prj_passwd ) {
        print "getting stats from `$prj_url' for `@{[ $project->{account_key} || $prj_email ]}' using `$hostid' as hostid\n";
        unless ( $prj_key = ($project->{account_key} || lookup_account($prj_url,$prj_email,$prj_passwd)) ) {
            carp "account key not found\n";
            next MAIN;
        }
    }
    else {
        carp "project email or password not found, skipping...";
        next MAIN;
    }
 
    unless ( $sch_url = get_scheduler_url($prj_url) ) {
        carp "scheduler url not found, skipping...";
        next MAIN;
    }
 
    if ( $sch_url && $prj_key ) {
        if ( my $st = get_stats($sch_url,$prj_key,$hostid,$host_cpid) ) {
            $stats_tmp->{$prj_url}{project_name} = $st->{project_name};
            $stats_tmp->{$prj_url}{total_credit} = $st->{user_total_credit};
            $stats_tmp->{$prj_url}{expavg_credit} = $st->{user_expavg_credit};
            $stats_tmp->{$prj_url}{hostid} = $st->{hostid} if defined $st->{hostid};
            $stats_tmp->{$prj_url}{project_url} = $prj_url;
            $stats_tmp->{$prj_url}{last_update} = time;
        }
        else {
            carp "cannot get statistics, skipping...";
            next MAIN;
        }
    }
}
 
print Dumper $stats_tmp if $debug;
 
# wyjście
my $out = "<stats>\n";
$out .= "  <host_cpid>$host_cpid</host_cpid>\n";
$out .= "  <projects>\n";
 
foreach ( sort { uc $stats_tmp->{$a}{project_name} cmp uc $stats_tmp->{$b}{project_name} } keys %$stats_tmp ) {
    if ( defined $stats_tmp->{$_}{project_url} ) {
        $out .= "    <project>\n";
        $out .= "      <project_name>@{[$stats_tmp->{$_}{project_name}]}</project_name>\n";
        $out .= "      <project_url>@{[$stats_tmp->{$_}{project_url}]}</project_url>\n";
        $out .= "      <user_total_credit>@{[$stats_tmp->{$_}{total_credit}]}</user_total_credit>\n";
        $out .= "      <user_expavg_credit>@{[$stats_tmp->{$_}{expavg_credit}]}</user_expavg_credit>\n";
        $out .= "      <last_update>@{[$stats_tmp->{$_}{last_update}]}</last_update>\n";
        $out .= "      <hostid>@{[$stats_tmp->{$_}{hostid}]}</hostid>\n";
        $out .= "    </project>\n";
    }
}
 
$out .= "  </projects>\n";
$out .= "</stats>\n";
 
open my $fh,'>',$stats_file;
print $fh $out;
close $fh;
 
exit;
 
sub get_stats {
    my ($url,$key,$hostid,$host_cpid) = @_;
    $url =~ s!https://secure!http://www!; # obejście przy World Community Grid
 
    # wysyłamy zapytanie do schedulera
    # w większości projektów nie trzeba podawać wersji klienta
    # ale POEM wymagał tego
 
    my $req = HTTP::Request->new(POST => $url );
    $req->content_type('application/x-www-form-urlencoded');
    $req->content("<scheduler_request>
            <authenticator>$key</authenticator>
            <core_client_major_version>6</core_client_major_version>
            <core_client_minor_version>2</core_client_minor_version>
            <core_client_release>18</core_client_release>
            <hostid>$hostid</hostid>
            <host_info>
                <host_cpid>$host_cpid</host_cpid>
                <domain_name>perl script for personal stats</domain_name>
                <os_name>Ghost Host</os_name>
                <os_version>[safe to delete]</os_version>
                <p_vendor>Ghost Host</p_vendor>
                <p_model>[safe to delete]</p_model>
            </host_info>
            </scheduler_request>
            ");
 
    my $res = $ua->request($req);
 
    if ( $res->is_success ) {
        my $tmp = $res->content;
        $tmp =~ s!<<!<!g; # obejście przy uFluids
        $tmp =~ s!</scheduler_reply>.*!</scheduler_reply>!s; # obejście przy World Community Grid
        my $cnt;
        eval {
            $cnt = XMLin($tmp);
        };
 
        if ( $@ ) {
            carp $@;
            return 0;
        }
 
        if ( exists($cnt->{project_is_down}) ) {
            carp "$cnt->{message}{content}\n";
            return 0;
        }
        else {
            return $cnt;
        }
 
    }
    else {
        carp $res->status_line;
        return 0;
    }
}
 
sub lookup_account {
    my ($url,$email,$passwd) = @_;
    $url =~ s!/$!!;
 
    # pobieramy uid
    my $res = $ua->get(
        "$url/lookup_account.php?email_addr=$email&passwd_hash=@{[md5_hex($passwd.$email)]}"
        );
 
    if ( $res->is_success ) {
        my $tmp = $res->content;
        my $cnt;
        eval {
            $cnt = XMLin($tmp);
        };
 
        if ( $@ ) {
            carp $@;
            return 0;
        }
 
        # sprawdzamy czy nie było jakiegoś błędu przy identyfikacji
        if ( exists($cnt->{error_msg})) {
            carp $cnt->{error_msg};
            return 0;
        }
        else {
            return $cnt->{authenticator};
        }
 
    }
    else {
        carp $res->status_line;
        return 0;
    }
}
 
sub get_scheduler_url {
    my $url = shift;
    my $scheduler_url;
    my $res = $ua->get($url);
 
    if ( $res->is_success ) {
        # szukanie na głównej stronie projektu adresu schedulera
        ($scheduler_url) = $res->content =~ m'<scheduler>\s*(.*?)\s*</scheduler>';
        return $scheduler_url;
    }
    else {
        carp $res->status_line;
        return 0
    }
}
 
sub usage {
    print "$0 [-c|--config=FILE] [-o|--output=FILE] [-d] [-h|--help|--usage]\n\n";
    exit(1);
}
Nie ma jeszcze komentarzy.