Ksplice.pm.in

   1 package Ksplice;
   2 use Cwd qw(abs_path getcwd);
   3 use Getopt::Long qw(:config bundling);
   4 use File::Basename;
   5 use File::Copy;
   6 use File::Path;
   7 use File::Spec::Functions qw(tmpdir);
   8 use File::Temp qw(tempfile tempdir);
   9 use Fatal qw(:void copy rename move chdir mkdir rmdir unlink rmtree);
  10 use IPC::Open2;
  11 use IPC::Open3;
  12 use Pod::Usage;
  13 use Text::ParseWords;
  14 use strict;
  15 use warnings;
  16 use Verbose qw(:2 copy rename move utime chdir mkdir mkpath unlink rmtree tempfile tempdir);
  17 require Exporter;
  18 our @ISA = qw(Exporter);
  19 our @EXPORT = qw(
  20         Verbose GetOptions pod2usage shellwords
  21         $datadir $libexecdir @common_options $help $raw_errors
  22         child_error runval runval_raw runstr runstr_err runval_in runval_infile runval_outfile
  23         unpack_update
  24         get_stage set_stage set_debug_level set_partial get_abort_cause get_patch update_loaded
  25         get_debug_output get_conflicts get_raw_conflicts get_short_description
  26         read_file write_file
  27         abs_path getcwd basename dirname tmpdir
  28         copy rename move utime chdir mkdir mkpath unlink rmtree tempfile tempdir
  29         print_abort_error print_abort_code
  30 );
  31
  32 our ($datadir, $libexecdir) = qw(KSPLICE_DATA_DIR KSPLICE_LIBEXEC_DIR);
  33
  34 our $help = 0;
  35 our $raw_errors = 0;
  36 our @common_options = (
  37         "help|?" => \$help,
  38         "raw-errors" => \$raw_errors,
  39         "version" => sub { print "Ksplice version PACKAGE_VERSION\n"; exit(0); },
  40         "api-version" => sub { print "KSPLICE_API_VERSION\n"; exit(0); },
  41         "verbose|v:+" => \$Verbose::level,
  42         "quiet|q:+" => sub { $Verbose::level -= $_[1]; },
  43 );
  44
  45 $SIG{__DIE__} = sub {
  46         die @_ if $^S || !$raw_errors;
  47         exit(-1);
  48 };
  49
  50 sub child_error {
  51         if($raw_errors) {
  52                 return ($? != 0);
  53         }
  54         if($? == -1) {
  55                 print STDERR "Failed to exec child\n";
  56         } elsif(($? & 127) != 0) {
  57                 print STDERR "Child exited with signal ", ($? & 127), ($? & 128) ? " (core dumped)\n" : "\n";
  58         } elsif($? >> 8 != 0) {
  59                 print STDERR "Child exited with status ", $? >> 8, "\n";
  60         } else {
  61                 return 0;
  62         }
  63         return 1;
  64 }
  65
  66 sub runval {
  67         my (@cmd) = @_;
  68         if(runval_raw(@cmd) != 0) {
  69                 child_error();
  70                 die "Failed during: @cmd\n";
  71         }
  72 }
  73
  74 sub runval_raw {
  75         my (@cmd) = @_;
  76         my ($out, $err);
  77         print "+ @cmd\n" if($Verbose::level >= 1);
  78         if($raw_errors) {
  79                 my $pid = open3(fileno STDIN, ">&STDOUT", ">/dev/null", @cmd);
  80                 waitpid($pid, 0);
  81                 return $?;
  82         } else {
  83                 return system(@cmd);
  84         }
  85 }
  86
  87 sub runstr {
  88         my @cmd = @_;
  89         print "+ @cmd\n" if($Verbose::level >= 1);
  90         local $/;
  91         local (*PIPE);
  92         if($raw_errors) {
  93                 open3(fileno STDIN, \*PIPE, ">/dev/null", @cmd);
  94         } else {
  95                 open PIPE, '-|', @cmd or die "Can't run @cmd: $!";
  96         }
  97         my $output = <PIPE>;
  98         close PIPE or $! == 0 or die "Can't run @cmd: $!";
  99         return $output;
 100 }
 101
 102 sub runstr_err {
 103         my @cmd = @_;
 104         print "+ @cmd\n" if($Verbose::level >= 1);
 105         local (*ERROR);
 106         my $pid = open3(fileno STDIN, '>&STDOUT', \*ERROR, @cmd);
 107         local $/;
 108         my $error = <ERROR>;
 109         waitpid($pid, 0);
 110         print STDERR $error unless $raw_errors;
 111         return $error;
 112 }
 113
 114 sub runval_in {
 115         my ($in, @cmd) = @_;
 116         print "+ @cmd <<'EOF'\n${in}EOF\n" if($Verbose::level >= 1);
 117         local (*WRITE);
 118         if($raw_errors) {
 119                 open3(\*WRITE, ">&STDOUT", ">/dev/null", @cmd);
 120         } else {
 121                 open(WRITE, '|-', @cmd) or die "Can't run @cmd: $!";
 122         }
 123         print WRITE $in;
 124         close(WRITE) or $! == 0 or die "Can't run @cmd: $!";
 125         if(child_error()) {
 126                 die "Failed during: @cmd";
 127         }
 128 }
 129
 130 sub runval_infile {
 131         my ($infile, @cmd) = @_;
 132         print "+ @cmd < $infile\n" if($Verbose::level >= 1);
 133         local (*INFILE);
 134         open(INFILE, '<', $infile) or die "Can't open $infile: $!";
 135         my $pid;
 136         if($raw_errors) {
 137                 $pid = open3('<&INFILE', '>&STDOUT', ">/dev/null", @cmd);
 138         } else {
 139                 $pid = open2('>&STDOUT', '<&INFILE', @cmd);
 140         }
 141         waitpid($pid, 0);
 142         if(child_error()) {
 143                 die "Failed during: @cmd";
 144         }
 145 }
 146
 147 sub runval_outfile {
 148         my ($outfile, @cmd) = @_;
 149         print "+ @cmd > $outfile\n" if($Verbose::level >= 1);
 150         local (*OUTFILE);
 151         open(OUTFILE, '>', $outfile) or die "Can't open $outfile: $!";
 152         my $pid;
 153         if($raw_errors) {
 154                 $pid = open3('</dev/null', '>&OUTFILE', ">/dev/null", @cmd);
 155         } else {
 156                 $pid = open2('>&OUTFILE', '</dev/null', @cmd);
 157         }
 158         waitpid($pid, 0);
 159         if(child_error()) {
 160                 die "Failed during: @cmd";
 161         }
 162 }
 163
 164 sub unpack_update {
 165         my ($file) = @_;
 166         runval("tar", "--force-local", "-zxf", $file);
 167         my ($ksplice) = glob('*/');
 168         chop($ksplice); # remove the trailing slash
 169         return $ksplice;
 170 }
 171
 172 sub get_sysfs {
 173         my ($kid) = @_;
 174         if(! -d "/sys/module") {
 175                 die "/sys not mounted?\n";
 176         }
 177         my $update = "ksplice_$kid";
 178         if (-d "/sys/kernel/ksplice/$kid") {
 179                 return "/sys/kernel/ksplice/$kid";
 180         }
 181         if (-d "/sys/module/$update/ksplice") {
 182                 return "/sys/module/$update/ksplice";
 183         }
 184         return undef;
 185 }
 186
 187 sub update_loaded {
 188         my ($kid) = @_;
 189         return defined(get_sysfs($kid));
 190 }
 191
 192 sub read_file {
 193         my ($file) = @_;
 194         local (*INPUT, $/);
 195         open(INPUT, "<", $file) or die $!;
 196         return <INPUT>;
 197 }
 198
 199 sub write_file {
 200         my ($file, $string) = @_;
 201         local *INPUT;
 202         open(INPUT, ">", $file) or die $!;
 203         print INPUT $string;
 204 }
 205
 206 sub read_sysfs {
 207         my ($kid, $attr) = @_;
 208         my $sysfs = get_sysfs($kid);
 209         return undef if (!defined($sysfs));
 210         return read_file("$sysfs/$attr");
 211 }
 212
 213 sub write_sysfs {
 214         my ($kid, $attr, $string) = @_;
 215         my $sysfs = get_sysfs($kid);
 216         return undef if (!defined($sysfs));
 217         write_file("$sysfs/$attr", $string);
 218 }
 219
 220 sub get_debug_output {
 221         my ($kid, $debugfs_out) = @_;
 222         my $update = "ksplice_$kid";
 223         if (!$debugfs_out) {
 224                 (undef, $debugfs_out) = tempfile('ksplice-debug-XXXXXX', DIR => tmpdir());
 225         }
 226         if (runval_raw("grep", "-qFx", "nodev\tdebugfs", "/proc/filesystems") == 0) {
 227                 my $debugfsdir = tempdir('ksplice-debugfs-XXXXXX', TMPDIR => 1);
 228                 runval(qw(mount -t debugfs debugfs), $debugfsdir);
 229                 if (-e "$debugfsdir/$update") {
 230                         copy("$debugfsdir/$update", $debugfs_out);
 231                 }
 232                 runval(qw(umount), $debugfsdir);
 233                 rmdir($debugfsdir);
 234                 return $debugfs_out;
 235         } elsif ($? >> 8 == 1) {
 236                 return ();
 237         } else {
 238                 child_error();
 239                 exit(-1);
 240         }
 241 }
 242
 243 sub get_stage {
 244         my ($kid) = @_;
 245         chomp(my $result = read_sysfs($kid, "stage"));
 246         return $result;
 247 }
 248
 249 sub get_abort_cause {
 250         my ($kid) = @_;
 251         chomp(my $result = read_sysfs($kid, "abort_cause"));
 252         return $result;
 253 }
 254
 255 sub get_conflicts {
 256         my ($kid) = @_;
 257         chomp(my $conflicts = read_sysfs($kid, "conflicts"));
 258         my @conflicts = split('\n', $conflicts);
 259         my $out = '';
 260         foreach my $conflict (@conflicts) {
 261                 my ($name, $pid, @symbols) = split(' ', $conflict);
 262                 next if (!@symbols);
 263                 $out .= "Process $name(pid $pid) is using the following symbols changed by update $kid:\n";
 264                 foreach my $symbol (@symbols) {
 265                         $out .= "  $symbol\n";
 266                 }
 267         }
 268         return $out;
 269 }
 270
 271 sub get_raw_conflicts {
 272         my ($kid) = @_;
 273         my $conflicts = read_sysfs($kid, "conflicts");
 274         return $conflicts;
 275 }
 276
 277 sub get_patch {
 278         my ($kid) = @_;
 279         my $result = read_file("/var/run/ksplice/updates/$kid/patch");
 280         return $result;
 281 }
 282
 283 sub get_short_description {
 284         my ($kid) = @_;
 285         open(INPUT, "<", "/var/run/ksplice/updates/$kid/description") or return undef;
 286         my $result = <INPUT>;
 287         close(INPUT);
 288         return $result;
 289 }
 290
 291 sub set_stage {
 292         my ($kid, $string) = @_;
 293         write_sysfs($kid, "stage", "$string\n");
 294 }
 295
 296 sub set_debug_level {
 297         my ($kid, $string) = @_;
 298         write_sysfs($kid, "debug", "$string\n");
 299 }
 300
 301 sub set_partial {
 302         my ($kid, $string) = @_;
 303         write_sysfs($kid, "partial", "$string\n");
 304 }
 305
 306 sub print_abort_error {
 307         my ($kid, %errors) = @_;
 308         my $error = get_abort_cause($kid);
 309
 310         print_abort_code($error, %errors);
 311         if ($error eq 'code_busy') {
 312                 if($raw_errors) {
 313                         print STDERR get_raw_conflicts($kid);
 314                 } else {
 315                         print STDERR get_conflicts($kid);
 316                 }
 317         }
 318 }
 319
 320 sub print_abort_code {
 321         my ($error, %errors) = @_;
 322         if($raw_errors) {
 323                 print STDERR "$error\n";
 324         } else {
 325                 $error = "UNKNOWN" if (!exists $errors{$error});
 326                 print STDERR "\n$errors{$error}\n";
 327         }
 328 }
 329
 330 END {
 331         $Verbose::level = 0;
 332         chdir("/");
 333 }
 334
 335 1;