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