File Coverage

blib/lib/urpm/parallel_ka_run.pm
Criterion Covered Total %
statement 7 9 77.7
branch n/a
condition n/a
subroutine 3 3 100.0
pod n/a
total 10 12 83.3


line stmt bran cond sub pod time code
1             package urpm::parallel_ka_run;
2              
3              
4             #- Copyright (C) 2002, 2003, 2004, 2005 MandrakeSoft SA
5             #- Copyright (C) 2005-2010 Mandriva SA
6             #- Copyright (C) 2011-2017 Mageia
7              
8 1     1   2586 use strict;
  1         3  
  1         41  
9 1     1   9 use urpm::util 'find';
  1         27  
  1         64  
10 1     1   46 use urpm::msg;
  0            
  0            
11             use urpm::parallel;
12              
13             our @ISA = 'urpm::parallel';
14              
15             our $mput_command = $ENV{URPMI_MPUT_COMMAND};
16             our $rshp_command = $ENV{URPMI_RSHP_COMMAND};
17              
18             if (!$mput_command) {
19             ($mput_command) = find { -x $_ } qw(/usr/bin/mput2 /usr/bin/mput);
20             }
21             $mput_command ||= 'mput';
22             if (!$rshp_command) {
23             ($rshp_command) = find { -x $_ } qw(/usr/bin/rshp2 /usr/bin/rshp);
24             }
25             $rshp_command ||= 'rshp';
26              
27             sub _rshp_urpm {
28             my ($parallel, $urpm, $rshp_option, $cmd, $para) = @_;
29              
30             # it doesn't matter for urpmq, and previous version of urpmq didn't handle it:
31             $cmd ne 'urpmq' and $para = "--no-locales $para";
32              
33             my $command = "$rshp_command $rshp_option $parallel->{options} -- $cmd $para";
34             $urpm->{log}("parallel_ka_run: $command");
35             $command;
36             }
37             sub _rshp_urpm_popen {
38             my ($parallel, $urpm, $cmd, $para) = @_;
39              
40             my $command = _rshp_urpm($parallel, $urpm, '-v', $cmd, $para);
41             open(my $fh, "$command |") or $urpm->{fatal}(1, "Can't fork $rshp_command: $!");
42             $fh;
43             }
44              
45             sub urpm_popen {
46             my ($parallel, $urpm, $cmd, $para, $do) = @_;
47              
48             my $fh = _rshp_urpm_popen($parallel, $urpm, $cmd, $para);
49              
50             while (my $s = <$fh>) {
51             chomp $s;
52             my ($node, $s_) = _parse_rshp_output($s) or next;
53              
54             $urpm->{debug}("parallel_ka_run: $node: received: $s_") if $urpm->{debug};
55             $do->($node, $s_) and last;
56             }
57             close $fh or $urpm->{fatal}(1, N("rshp failed, maybe a node is unreacheable"));
58             ();
59             }
60              
61             sub run_urpm_command {
62             my ($parallel, $urpm, $cmd, $para) = @_;
63             system(_rshp_urpm($parallel, $urpm, '', $cmd, $para)) == 0;
64             }
65              
66             sub copy_to_dir { &_run_mput }
67              
68             sub propagate_file {
69             my ($parallel, $urpm, $file) = @_;
70             _run_mput($parallel, $urpm, $file, $file);
71             }
72              
73             sub _run_mput {
74             my ($parallel, $urpm, @para) = @_;
75              
76             my @l = (split(' ', $parallel->{options}), '--', @para);
77             $urpm->{log}("parallel_ka_run: $mput_command " . join(' ', @l));
78             system $mput_command, @l;
79             $? == 0 || $? == 256 or $urpm->{fatal}(1, N("mput failed, maybe a node is unreacheable"));
80             }
81              
82             sub _parse_rshp_output {
83             my ($s) = @_;
84             #- eg of output of rshp2: [rank:2]:@removing@mpich-1.2.5.2-10mlcs4.x86_64
85              
86             if ($s =~ /<([^>]*)>.*:->:(.*)/ || $s =~ /<([^>]*)>\s*\[[^]]*\]:(.*)/) {
87             ($1, $2);
88             } else {
89             warn "bad rshp output $s\n";
90             ();
91             }
92             }
93              
94             #- allow to bootstrap from urpmi code directly (namespace is urpm).
95              
96             package urpm;
97              
98             no warnings 'redefine';
99              
100             sub handle_parallel_options {
101             my (undef, $options) = @_;
102             my ($media, $ka_run_options) = $options =~ /ka-run(?:\(([^\)]*)\))?:(.*)/;
103             if ($ka_run_options) {
104             my ($flush_nodes, %nodes);
105             foreach (split ' ', $ka_run_options) {
106             if ($_ eq '-m') {
107             $flush_nodes = 1;
108             } else {
109             $flush_nodes and $nodes{/host=([^,]*)/ ? $1 : $_} = undef;
110             undef $flush_nodes;
111             }
112             }
113             return bless {
114             media => $media,
115             options => $ka_run_options,
116             nodes => \%nodes,
117             }, "urpm::parallel_ka_run";
118             }
119             return undef;
120             }
121              
122             1;