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         runval("tar", "--force-local", "-zxf", $file);
 173         my ($ksplice) = glob('*/');
 174         chop($ksplice); # remove the trailing slash
 175         return $ksplice;
 176 }
 177
 178 sub get_sysfs {
 179         my ($kid) = @_;
 180         if(! -d "/sys/module") {
 181                 die "/sys not mounted?\n";
 182         }
 183         my $update = "ksplice_$kid";
 184         if (-d "/sys/kernel/ksplice/$kid") {
 185                 return "/sys/kernel/ksplice/$kid";
 186         }
 187         if (-d "/sys/module/$update/ksplice") {
 188                 return "/sys/module/$update/ksplice";
 189         }
 190         return undef;
 191 }
 192
 193 sub update_loaded {
 194         my ($kid) = @_;
 195         return defined(get_sysfs($kid));
 196 }
 197
 198 sub read_file {
 199         my ($file) = @_;
 200         local (*INPUT, $/);
 201         open(INPUT, "<", $file) or die $!;
 202         return <INPUT>;
 203 }
 204
 205 sub write_file {
 206         my ($file, $string) = @_;
 207         local *INPUT;
 208         open(INPUT, ">", $file) or die $!;
 209         print INPUT $string;
 210 }
 211
 212 sub read_sysfs {
 213         my ($kid, $attr) = @_;
 214         my $sysfs = get_sysfs($kid);
 215         return undef if (!defined($sysfs));
 216         return read_file("$sysfs/$attr");
 217 }
 218
 219 sub write_sysfs {
 220         my ($kid, $attr, $string) = @_;
 221         my $sysfs = get_sysfs($kid);
 222         return undef if (!defined($sysfs));
 223         write_file("$sysfs/$attr", $string);
 224 }
 225
 226 sub get_debug_output {
 227         my ($kid, $debugfs_out) = @_;
 228         my $update = "ksplice_$kid";
 229         if (!$debugfs_out) {
 230                 (undef, $debugfs_out) = tempfile('ksplice-debug-XXXXXX', DIR => tmpdir());
 231         }
 232         if (runval_raw("grep", "-qFx", "nodev\tdebugfs", "/proc/filesystems") == 0) {
 233                 my $debugfsdir = tempdir('ksplice-debugfs-XXXXXX', TMPDIR => 1);
 234                 runval(qw(mount -t debugfs debugfs), $debugfsdir);
 235                 if (-e "$debugfsdir/$update") {
 236                         copy("$debugfsdir/$update", $debugfs_out);
 237                 }
 238                 runval(qw(umount), $debugfsdir);
 239                 rmdir($debugfsdir);
 240                 return $debugfs_out;
 241         } elsif ($? >> 8 == 1) {
 242                 return ();
 243         } else {
 244                 child_error();
 245                 exit(-1);
 246         }
 247 }
 248
 249 sub get_stage {
 250         my ($kid) = @_;
 251         chomp(my $result = read_sysfs($kid, "stage"));
 252         return $result;
 253 }
 254
 255 sub get_abort_cause {
 256         my ($kid) = @_;
 257         chomp(my $result = read_sysfs($kid, "abort_cause"));
 258         return $result;
 259 }
 260
 261 sub get_conflicts {
 262         my ($kid) = @_;
 263         chomp(my $conflicts = read_sysfs($kid, "conflicts"));
 264         my @conflicts = split('\n', $conflicts);
 265         my $out = '';
 266         foreach my $conflict (@conflicts) {
 267                 my ($name, $pid, @symbols) = split(' ', $conflict);
 268                 next if (!@symbols);
 269                 $out .= "Process $name(pid $pid) is using the following symbols changed by update $kid:\n";
 270                 foreach my $symbol (@symbols) {
 271                         $out .= "  $symbol\n";
 272                 }
 273         }
 274         return $out;
 275 }
 276
 277 sub get_raw_conflicts {
 278         my ($kid) = @_;
 279         my $conflicts = read_sysfs($kid, "conflicts");
 280         return $conflicts;
 281 }
 282
 283 sub get_patch {
 284         my ($kid) = @_;
 285         my $result = read_file("/var/run/ksplice/updates/$kid/patch");
 286         return $result;
 287 }
 288
 289 sub get_short_description {
 290         my ($kid) = @_;
 291         open(INPUT, "<", "/var/run/ksplice/updates/$kid/description") or return undef;
 292         my $result = <INPUT>;
 293         close(INPUT);
 294         return $result;
 295 }
 296
 297 sub set_stage {
 298         my ($kid, $string) = @_;
 299         write_sysfs($kid, "stage", "$string\n");
 300 }
 301
 302 sub set_debug_level {
 303         my ($kid, $string) = @_;
 304         write_sysfs($kid, "debug", "$string\n");
 305 }
 306
 307 sub set_partial {
 308         my ($kid, $string) = @_;
 309         write_sysfs($kid, "partial", "$string\n");
 310 }
 311
 312 sub print_abort_error {
 313         my ($kid, %errors) = @_;
 314         my $error = get_abort_cause($kid);
 315
 316         print_abort_code($error, %errors);
 317         if ($error eq 'code_busy') {
 318                 if($raw_errors) {
 319                         print STDERR get_raw_conflicts($kid);
 320                 } else {
 321                         print STDERR get_conflicts($kid);
 322                 }
 323         }
 324         $printed_abort_code = 1;
 325 }
 326
 327 sub print_abort_code {
 328         my ($error, %errors) = @_;
 329         if($raw_errors) {
 330                 print STDERR "$error\n";
 331         } else {
 332                 $error = "UNKNOWN" if (!exists $errors{$error});
 333                 print STDERR "\n$errors{$error}\n";
 334         }
 335         $printed_abort_code = 1;
 336 }
 337
 338 END {
 339         $Verbose::level = 0;
 340         chdir("/");
 341 }
 342
 343 1;