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 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 $version_str
  22         child_error runval runval_raw runstr runstr_err runsuc runsuc_in unpack_update
  23         get_stage set_stage set_debug_level get_abort_cause get_patch update_loaded
  24         get_debug_output get_conflicts
  25         abs_path getcwd basename dirname tmpdir
  26         copy rename move utime chdir mkdir mkpath unlink rmtree tempfile tempdir
  27 );
  28
  29 our ($datadir, $libexecdir) = qw(KSPLICE_DATA_DIR KSPLICE_LIBEXEC_DIR);
  30 our $version_str = "Ksplice version PACKAGE_VERSION\n";
  31
  32 sub child_error {
  33         if($? == -1) {
  34                 print STDERR "Failed to exec child\n";
  35         } elsif(($? & 127) != 0) {
  36                 print STDERR "Child exited with signal ", ($? & 127), ($? & 128) ? " (core dumped)\n" : "\n";
  37         } elsif($? >> 8 != 0) {
  38                 print STDERR "Child exited with status ", $? >> 8, "\n";
  39         } else {
  40                 return 0;
  41         }
  42         return 1;
  43 }
  44
  45 sub runval {
  46         my (@cmd) = @_;
  47         if(runval_raw(@cmd) != 0) {
  48                 child_error();
  49                 die "Failed during: @cmd\n";
  50         }
  51 }
  52
  53 sub runval_raw {
  54         my (@cmd) = @_;
  55         my ($out, $err);
  56         print "+ @cmd\n" if($Verbose::level >= 1);
  57         if($Verbose::level < 1) {
  58                 open $out, ">&STDOUT" or die "Can't dup STDOUT: $!";
  59                 open $err, ">&STDERR" or die "Can't dup STDERR: $!";
  60                 open STDOUT, '>', "/dev/null" or die "Can't hide STDOUT: $!";
  61                 open STDERR, '>', "/dev/null" or die "Can't hide STDERR: $!";
  62         }
  63         my $val = system(@cmd);
  64         if($Verbose::level < 1) {
  65                 open STDOUT, ">&", $out or die "Can't restore STDOUT: $!";
  66                 open STDERR, ">&", $err or die "Can't restore STDERR: $!";
  67         }
  68         return $val;
  69 }
  70
  71 sub runstr {
  72         my @cmd = @_;
  73         print "+ @cmd\n" if($Verbose::level >= 1);
  74         local $/;
  75         open PIPE, '-|', @cmd or die "Can't run @cmd: $!";
  76         my $output = <PIPE>;
  77         close PIPE or $! == 0 or die "Can't run @cmd: $!";
  78         return $output;
  79 }
  80
  81 sub runstr_err {
  82         my @cmd = @_;
  83         print "+ @cmd\n" if($Verbose::level >= 1);
  84         my $pid = open3(\*WRITE, \*READ, \*ERROR, @cmd);
  85         waitpid($pid, 0);
  86         local $/;
  87         return <ERROR>;
  88 }
  89
  90 sub runsuc {
  91         my ($cmd, @args) = @_;
  92         return runval("$libexecdir/ksplice-$cmd", @args);
  93 }
  94
  95 sub runsuc_in {
  96         my ($in, $cmd, @args) = @_;
  97         my @cmd = ("$libexecdir/ksplice-$cmd", @args);
  98         print "+ @cmd <<'EOF'\n${in}EOF\n" if($Verbose::level >= 1);
  99         local (*WRITE);
 100         open(WRITE, '|-', @cmd) or die "Can't run @cmd: $!";
 101         print WRITE $in;
 102         close(WRITE) or $! == 0 or die "Can't run @cmd: $!";
 103         if(child_error()) {
 104                 die "Failed during: $libexecdir/ksplice-$cmd @args";
 105         }
 106 }
 107
 108 sub unpack_update {
 109         my ($file) = @_;
 110         runval("tar", "zxf", $file);
 111         my ($ksplice) = glob('*/');
 112         chop($ksplice); # remove the trailing slash
 113         return $ksplice;
 114 }
 115
 116 sub get_sysfs {
 117         my ($kid) = @_;
 118         if(! -d "/sys/module") {
 119                 die "/sys not mounted?\n";
 120         }
 121         my $update = "ksplice_$kid";
 122         if (-d "/sys/kernel/ksplice/$kid") {
 123                 return "/sys/kernel/ksplice/$kid";
 124         }
 125         if (-d "/sys/module/$update/ksplice") {
 126                 return "/sys/module/$update/ksplice";
 127         }
 128         return undef;
 129 }
 130
 131 sub update_loaded {
 132         my ($kid) = @_;
 133         return defined(get_sysfs($kid));
 134 }
 135
 136 sub read_file {
 137         my ($file) = @_;
 138         local (*INPUT, $/);
 139         open(INPUT, "<", $file) or die $!;
 140         return <INPUT>;
 141 }
 142
 143 sub write_file {
 144         my ($file, $string) = @_;
 145         local *INPUT;
 146         open(INPUT, ">", $file) or die $!;
 147         print INPUT $string;
 148 }
 149
 150 sub read_sysfs {
 151         my ($kid, $attr) = @_;
 152         my $sysfs = get_sysfs($kid);
 153         return undef if (!defined($sysfs));
 154         return read_file("$sysfs/$attr");
 155 }
 156
 157 sub write_sysfs {
 158         my ($kid, $attr, $string) = @_;
 159         my $sysfs = get_sysfs($kid);
 160         return undef if (!defined($sysfs));
 161         write_file("$sysfs/$attr", $string);
 162 }
 163
 164 sub get_debug_output {
 165         my ($kid) = @_;
 166         my $update = "ksplice_$kid";
 167         my $debug;
 168         my (undef, $debugfs_out) = tempfile('ksplice-debug-XXXXXX', DIR => tmpdir());
 169         my $debugfsdir = tempdir('ksplice-debugfs-XXXXXX',
 170                                  TMPDIR => 1, CLEANUP => 1);
 171         if (runval_raw(qw(mount -t debugfs debugfs), $debugfsdir) == 0) {
 172                 copy("$debugfsdir/$update", "$debugfs_out");
 173                 $debug = read_file("$debugfsdir/$update");
 174                 runval(qw(umount), $debugfsdir);
 175         } elsif ($? >> 8 == 32) {
 176                 my $dmesg = runstr("dmesg | grep ksplice");
 177                 while($dmesg =~ /ksplice: Preparing to reverse/) {
 178                         $dmesg = $';
 179                 }
 180                 $debug = '';
 181                 write_file($debugfs_out, $dmesg);
 182         } else {
 183                 child_error();
 184                 die;
 185         }
 186         return ($debugfs_out, $debug);
 187 }
 188
 189 sub get_stage {
 190         my ($kid) = @_;
 191         chomp(my $result = read_sysfs($kid, "stage"));
 192         return $result;
 193 }
 194
 195 sub get_abort_cause {
 196         my ($kid) = @_;
 197         chomp(my $result = read_sysfs($kid, "abort_cause"));
 198         return $result;
 199 }
 200
 201 sub get_conflicts {
 202         my ($kid) = @_;
 203         chomp(my $conflicts = read_sysfs($kid, "conflicts"));
 204         my @conflicts = split('\n', $conflicts);
 205         my $out = '';
 206         foreach my $conflict (@conflicts) {
 207                 my ($name, $pid, @symbols) = split(' ', $conflict);
 208                 next if (!@symbols);
 209                 $out .= "Process $name(pid $pid) is using the following symbols changed by update $kid:\n";
 210                 foreach my $symbol (@symbols) {
 211                         $out .= "  $symbol\n";
 212                 }
 213         }
 214         return $out;
 215 }
 216
 217 sub get_patch {
 218         my ($kid) = @_;
 219         my $result = read_file("/var/run/ksplice/updates/$kid/patch");
 220         return $result;
 221 }
 222
 223 sub set_stage {
 224         my ($kid, $string) = @_;
 225         write_sysfs($kid, "stage", "$string\n");
 226 }
 227
 228 sub set_debug_level {
 229         my ($kid, $string) = @_;
 230         write_sysfs($kid, "debug", "$string\n");
 231 }
 232
 233 END {
 234         $Verbose::level = 0;
 235         chdir("/");
 236 }
 237
 238 1;