Permalink
Cannot retrieve contributors at this time
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
547 lines (482 sloc)
11.9 KB
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
# Copyright (C) 2019 bw1 | |
# | |
# This program is free software: you can redistribute it and/or modify | |
# it under the terms of the GNU General Public License as published by | |
# the Free Software Foundation, either version 3 of the License, or | |
# (at your option) any later version. | |
# | |
# This program is distributed in the hope that it will be useful, | |
# but WITHOUT ANY WARRANTY; without even the implied warranty of | |
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
# GNU General Public License for more details. | |
# | |
# You should have received a copy of the GNU General Public License | |
# along with this program. If not, see <http://www.gnu.org/licenses/>. | |
use strict; | |
use vars qw($VERSION %IRSSI); | |
use Irssi; | |
use Irssi::TextUI; | |
use Time::Piece; | |
use Time::Seconds; | |
use Getopt::Long qw/GetOptionsFromString/; | |
use IPC::Open3; | |
use YAML qw/Dump DumpFile LoadFile/; | |
use Time::HiRes qw/sleep alarm/; | |
$VERSION = '0.1'; | |
%IRSSI = ( | |
authors => 'bw1', | |
contact => 'bw1@aol.at', | |
name => 'boinc', | |
description => 'interface to boinc', | |
license => 'gpl', | |
url => 'https://scripts.irssi.org/', | |
modules => 'Time::Piece Time::Seconds Getopt::Long IPC::Open3 YAML Time::HiRes', | |
changed => '2019-05-29', | |
); | |
my $help = <<'END'; | |
%9NAME%9 | |
boinc.pl - interface to boinc | |
%9SYNOPSIS%9 | |
/boinc {-all|-tasks|-credit|-old|-info|-update|-help|-h|-list} | |
/boinc <-host hostname> [-password password] [{-enable|-disable}] | |
%9DESCRIPTION%9 | |
interface to the boinc-client (https://boinc.berkeley.edu/) | |
add the statusbar item | |
/STATUSBAR window ADD boinc_credit | |
%9OPTIONS%9 | |
-all view all at once | |
-tasks view the actual tasks | |
-credit view the credits | |
-old view old tasks | |
-info print all internal data (debug) | |
-update update the statusbar item | |
-help|-h show a help message | |
-list list the configured hosts | |
-host add or modify a host entry | |
%9SETTINGS%9 | |
/set boinc_update_cycle 15 | |
update time in minutes of the statusbar item. | |
/set boinc_command boinccmd | |
command line interface of the BOINC client. | |
END | |
my ($a_host, $a_password, $a_disable, $a_enable); | |
my %options = ( | |
'all' => \&cmd_all, | |
'tasks' => \&cmd_tasks, | |
'credit' => \&cmd_credit, | |
'old' => \&cmd_old, | |
'info' => \&cmd_info, | |
'update' => \&cmd_update, | |
'help' => \&cmd_help, | |
'h' => \&cmd_help, | |
'host=s' => \$a_host, | |
'password=s' => \$a_password, | |
'disable' => sub {$a_disable =1}, | |
'enable' => sub {$a_disable =0}, | |
'list' => \&cmd_clist, | |
); | |
my $boinc_cmd; #='boinccmd'; | |
my $boinc_cmd_host='--host'; | |
my $boinc_cmd_passwd='--passwd'; | |
my $boinc_cmd_state='--get_state'; | |
my $boinc_cmd_old_task='--get_old_tasks'; | |
my %section= ( | |
'======== Tasks ========'=> 'tasks', | |
'======== Projects ========'=> 'proj', | |
'======== Applications ========'=> 'app', | |
'======== Application versions ========'=> 'app_ver', | |
'======== Workunits ========'=> 'units', | |
'======== Time stats ========'=> 'time', | |
'======== end ========'=> 'end', # help the last round | |
); | |
my $arry_start ='-----------'; | |
my ($args, $server, $witem); | |
my %config; | |
my %info; | |
my ($pid, %readex, $instr, $errstr); | |
my $total_credit; | |
my $expavg_credit; | |
my $run_tasks; | |
my ($time_tag, $time_cycle); | |
sub mytime { | |
my ($tstr) = @_; | |
#my $tstr='Sun May 5 18:40:48 2019'; | |
my $t= Time::Piece->strptime($tstr,'%a %b %d %H:%M:%S %Y'); | |
return $t->strftime('%Y-%m-%d %H:%M'); | |
} | |
sub mydifftime { | |
my ( $ts2) = @_; | |
#my $tstr='Sun May 5 18:40:48 2019'; | |
my $t1= localtime; | |
my $t2= Time::Piece->strptime($ts2,'%a %b %d %H:%M:%S %Y'); | |
my $td= $t2-$t1; | |
return $td->hours; | |
} | |
sub read_exec { | |
my ($cmd, $host, $rfunc) = @_; | |
my ($in, $out, $err); | |
use Symbol 'gensym'; $err = gensym; | |
$pid = open3($in, $out, $err, $cmd); | |
$readex{$pid}->{pid}=$pid; | |
$readex{$pid}->{cmd}=$cmd; | |
$readex{$pid}->{in}=$in; | |
$readex{$pid}->{out}=$out; | |
$readex{$pid}->{err}=$err; | |
$readex{$pid}->{host}=$host; | |
$readex{$pid}->{rfunc}=$rfunc; | |
Irssi::pidwait_add($pid); | |
} | |
sub sig_read_exec { | |
my ($pid, $status) = @_; | |
if (defined $readex{$pid} ) { | |
my $out =$readex{$pid}->{out}; | |
my $err =$readex{$pid}->{err}; | |
my $host =$readex{$pid}->{host}; | |
my $rfunc =$readex{$pid}->{rfunc}; | |
delete $readex{$pid}; | |
my $old = select $out; | |
local $/; | |
$instr = <$out>; | |
select $old; | |
my $old = select $err; | |
local $/; | |
$errstr = <$err>; | |
$errstr =~ s/[\n\r]//g; | |
select $old; | |
&$rfunc($host) if (defined $rfunc); | |
if ( scalar(keys(%readex)) == 1 && | |
exists $readex{job}) { | |
foreach my $j ( @{$readex{job}} ) { | |
if ( ref( $j) eq 'CODE' ) { | |
&$j(); | |
} else { | |
eval( $j ); | |
} | |
} | |
delete $readex{job}; | |
} | |
Irssi::signal_stop(); | |
} | |
} | |
sub read_host_old_task { | |
my ($host) = @_; | |
if ( $errstr ne '') { | |
$info{$host}->{error}=$errstr; | |
} | |
my @lines = split /\n/,$instr; | |
push @lines, 'task last:'; | |
my $count=0; | |
my $tl=[]; | |
my $task={}; | |
foreach my $l (@lines) { | |
if ($l =~ m/^task (.*):$/) { | |
if ( $count >0 ) { | |
push @{$tl}, $task; | |
$task={}; | |
} | |
$task->{taskname}=$1; | |
} else { | |
if ($l =~ m/^\s+(.*?):\s*(.*)$/ ) { | |
$task->{$1}=$2; | |
} | |
} | |
$count++; | |
} | |
$info{$host}->{old_tasks}=$tl; | |
} | |
sub read_host_state { | |
my ($host) = @_; | |
my $h; | |
if (!exists $info{$host}) { | |
my $h={}; | |
$info{$host}=$h; | |
} else { | |
$h=$info{$host}; | |
} | |
my $array=0; | |
if ( $errstr ne '') { | |
$info{$host}->{error}=$errstr; | |
} | |
my @lines = split /\n/,$instr; | |
push @lines, '======== end ========'; | |
my $sec=''; | |
my $sec_c=0; | |
my $sec_r=''; | |
my $arr_c=0; | |
my $arr_e=0; | |
my $arr_r=''; | |
my $par_r={}; | |
foreach my $line ( @lines) { | |
# section | |
if (exists $section{$line}) { | |
if ($sec_c >0) { | |
if ( $arr_c ==0) { | |
$h->{$sec}=$par_r; | |
$par_r={}; | |
} else { | |
$h->{$sec}=$arr_r; | |
} | |
} else { | |
} | |
$sec=$section{$line}; | |
$sec_c++; | |
$sec_r=''; | |
$arr_e=1; | |
} | |
# array | |
if ($line =~ m/$arry_start/ || $arr_e != 0 ) { | |
if ($arr_c >0) { | |
push @{$arr_r}, $par_r; | |
$par_r={}; | |
} else { | |
$arr_r=[]; | |
} | |
$arr_c++; | |
if ($arr_e != 0) { | |
$arr_e=0; | |
$arr_c=0; | |
} | |
} | |
# parameter | |
if ($line =~ m/^\s+(.*?):\s*(.*)$/ ) { | |
$par_r->{$1}=$2; | |
} | |
} | |
} | |
sub read_hosts { | |
my ( $jobs ) = @_; | |
if (!exists $readex{job}) { | |
$readex{job}=$jobs; | |
foreach my $host (keys %config) { | |
if ($config{$host}->{disable} != 1) { | |
$info{$host}={}; | |
my $cmd="$boinc_cmd $boinc_cmd_host $host"; | |
if ( defined $config{$host}->{password} ) { | |
$cmd = "$cmd $boinc_cmd_passwd $config{$host}->{password}"; | |
} | |
my $cmd1="$cmd $boinc_cmd_state"; | |
read_exec($cmd1, $host, \&read_host_state ); | |
my $cmd2="$cmd $boinc_cmd_old_task"; | |
read_exec($cmd2, $host, \&read_host_old_task ); | |
} else { | |
delete $info{$host}; | |
} | |
} | |
} | |
} | |
sub calc_credit { | |
$total_credit=0; | |
$expavg_credit; | |
$run_tasks=0; | |
foreach my $host (sort keys %info) { | |
my $h=$info{$host}; | |
my $utc=0; | |
my $uec=0; | |
foreach my $prj (@{$h->{proj}}) { | |
$utc += $prj->{user_total_credit}; | |
$uec += $prj->{user_expavg_credit}; | |
} | |
if ($utc > $total_credit) { | |
$total_credit=$utc; | |
$expavg_credit=$uec; | |
} | |
foreach my $t (@{$h->{tasks}}) { | |
if ($t->{active_task_state} eq 'EXECUTING') { | |
$run_tasks++; | |
} | |
} | |
} | |
} | |
sub print_tasks { | |
foreach my $host (sort keys %info) { | |
Irssi::printformat(MSGLEVEL_CLIENTCRAP,'myhl',$host); | |
foreach my $t ( @{$info{$host}->{tasks}} ) { | |
my $s=''; | |
$s .= sprintf " %s ", substr($t->{name},0,3); | |
$s .= sprintf "%5.1f ", $t->{'fraction done'}*100; | |
my $st='W'; | |
$st='%gR%N' if ($t->{active_task_state} eq 'EXECUTING'); | |
$st='%bD%N' if ($t->{'ready to report'} eq 'yes'); | |
$s .= sprintf "%s ", $st; | |
$s .= mytime($t->{received})." "; | |
$s .= mytime($t->{'report deadline'})." "; | |
$s .= sprintf "%8.1f", mydifftime($t->{'report deadline'}); | |
Irssi::print($s, MSGLEVEL_CLIENTCRAP); | |
} | |
} | |
Irssi::print('', MSGLEVEL_CLIENTCRAP); | |
} | |
sub print_old_tasks { | |
foreach my $host (sort keys %info) { | |
Irssi::printformat(MSGLEVEL_CLIENTCRAP,'myhl',$host); | |
foreach my $t ( @{$info{$host}->{old_tasks}} ) { | |
my $s=''; | |
$s .= sprintf " %-20s", $t->{taskname}; | |
$s .= sprintf " %3d", $t->{'exit status'}; | |
$s .= sprintf " %8.2fh", $t->{'elapsed time'} /60/60; | |
Irssi::print($s, MSGLEVEL_CLIENTCRAP); | |
} | |
} | |
Irssi::print('', MSGLEVEL_CLIENTCRAP); | |
} | |
sub print_credit { | |
my $total_credit=0; | |
my $expavg_credit; | |
my $he= sprintf "%-20s %10s %10s", 'host', 'avg', 'total'; | |
Irssi::printformat(MSGLEVEL_CLIENTCRAP,'myhl',$he); | |
foreach my $host (sort keys %info) { | |
my $h=$info{$host}; | |
my $hec=0; | |
my $htc=0; | |
my $utc=0; | |
my $uec=0; | |
foreach my $prj (@{$h->{proj}}) { | |
$hec += $prj->{host_expavg_credit}; | |
$htc += $prj->{host_total_credit}; | |
$utc += $prj->{user_total_credit}; | |
$uec += $prj->{user_expavg_credit}; | |
} | |
my $sh= sprintf ' %-19s',$host; | |
my $sa .= sprintf "%10.0f", $hec; | |
my $st .= sprintf "%10.0f", $htc; | |
Irssi::printformat(MSGLEVEL_CLIENTCRAP,'myhl', $sh, $sa, $st); | |
if ($utc > $total_credit) { | |
$total_credit=$utc; | |
$expavg_credit=$uec; | |
} | |
} | |
my $str= sprintf "%-20s %10.0f %10.0f",'sum', $expavg_credit, $total_credit; | |
Irssi::printformat(MSGLEVEL_CLIENTCRAP,'myhl',$str); | |
Irssi::print('', MSGLEVEL_CLIENTCRAP); | |
} | |
sub print_error { | |
foreach my $h (keys %info) { | |
if ( exists $info{$h}->{error} ) { | |
Irssi::print "Error: $info{$h}->{error}", MSGLEVEL_CLIENTCRAP; | |
} | |
} | |
} | |
sub sb_boinc_credit { | |
my ($sb_item, $get_size_only) = @_; | |
my $sb = | |
sprintf "run:%d avg:%d sum:%d", | |
$run_tasks, $expavg_credit, $total_credit; | |
$sb_item->default_handler($get_size_only, "{sb $sb}", '', 0); | |
} | |
sub cmd { | |
($args, $server, $witem)=@_; | |
my ($ret, $arg) = GetOptionsFromString($args, %options); | |
if (defined $a_host) { | |
$config{$a_host}->{host}=$a_host; | |
$config{$a_host}->{password}=$a_password | |
if (defined $a_password); | |
$config{$a_host}->{disable}=$a_disable | |
if (defined $a_disable); | |
$a_host=undef; | |
$a_password=undef; | |
$a_disable=undef; | |
$a_enable=undef; | |
} | |
} | |
sub cmd_clist { | |
my $s; | |
$s =sprintf '%-20s %-20s %-2s','host','password','disable'; | |
Irssi::print $s, MSGLEVEL_CLIENTCRAP; | |
foreach my $h (sort keys %config) { | |
$s =sprintf '%-20s %-20s %2d', | |
$config{$h}->{host}, | |
$config{$h}->{password}, | |
$config{$h}->{disable}; | |
Irssi::print $s, MSGLEVEL_CLIENTCRAP; | |
} | |
} | |
sub cmd_all { | |
read_hosts([ | |
\&print_tasks, | |
\&print_credit, | |
\&print_old_tasks, | |
\&print_error, | |
]); | |
} | |
sub cmd_tasks { | |
read_hosts([ | |
\&print_tasks, | |
\&print_error, | |
]); | |
} | |
sub cmd_credit { | |
read_hosts([ | |
\&print_credit, | |
\&print_error, | |
]); | |
} | |
sub cmd_old { | |
read_hosts([ | |
\&print_old_tasks, | |
\&print_error, | |
]); | |
} | |
sub cmd_info { | |
Irssi::print "%info", MSGLEVEL_CLIENTCRAP; | |
Irssi::print Dump(\%info), MSGLEVEL_CLIENTCRAP; | |
} | |
sub cmd_update { | |
read_hosts(); | |
$readex{job} = [ | |
\&calc_credit, | |
'Irssi::statusbar_items_redraw("boinc_credit");', | |
]; | |
} | |
sub cmd_help { | |
Irssi::print $help, MSGLEVEL_CLIENTCRAP; | |
} | |
sub write_config { | |
my $fn=Irssi::get_irssi_dir().'/boinc.yaml'; | |
DumpFile( $fn, \%config); | |
} | |
sub read_config { | |
my $fn=Irssi::get_irssi_dir().'/boinc.yaml'; | |
if (-e $fn) { | |
%config = %{ LoadFile($fn) }; | |
} | |
} | |
sub sig_setup_changed { | |
$boinc_cmd= Irssi::settings_get_str('boinc_command'); | |
my $new_time = Irssi::settings_get_int('boinc_update_cycle'); | |
if ( $time_cycle != $new_time ) { | |
if ( defined $time_tag) { | |
Irssi::timeout_remove($time_tag); | |
$time_tag= undef; | |
$time_cycle= 0; | |
} | |
if ($new_time !=0 ) { | |
$time_tag= | |
Irssi::timeout_add($new_time*60*1000, \&cmd_update, ''); | |
cmd_update(); | |
$time_cycle= $new_time; | |
} | |
} | |
} | |
sub UNLOAD { | |
write_config(); | |
} | |
Irssi::theme_register([ | |
'myhl', '{hilight $0} $1 $2', | |
]); | |
Irssi::command_bind('help', sub { | |
if ($_[0] =~ m/boinc/ ) { | |
cmd_help(); | |
Irssi::signal_stop; | |
} | |
} | |
); | |
Irssi::signal_add('pidwait', 'sig_read_exec'); | |
Irssi::signal_add('setup changed', 'sig_setup_changed'); | |
Irssi::statusbar_item_register ('boinc_credit', 0, 'sb_boinc_credit'); | |
Irssi::settings_add_int($IRSSI{'name'}, 'boinc_update_cycle', 15); | |
Irssi::settings_add_str($IRSSI{'name'}, 'boinc_command', 'boinccmd'); | |
Irssi::command_bind($IRSSI{name},\&cmd); | |
my @opt=map {$_ =~ s/=.*$//, $_ } keys %options; | |
Irssi::command_set_options($IRSSI{name}, join(" ", @opt)); | |
read_config(); | |
sig_setup_changed(); |