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         my $output = runstr("$libexecdir/ksplice-$cmd", @args);
  93         if(child_error()) {
  94                 print "Output: $output\n";
  95                 die "Failed during: $libexecdir/ksplice-$cmd @args";
  96         }
  97         return $output;
  98 }
  99
 100 sub runsuc_in {
 101         my ($in, $cmd, @args) = @_;
 102         my @cmd = ("$libexecdir/ksplice-$cmd", @args);
 103         print "+ @cmd <<'EOF'\n${in}EOF\n" if($Verbose::level >= 1);
 104         local (*READ, *WRITE);
 105         my $pid = open2(\*READ, \*WRITE, @cmd);
 106         print WRITE $in;
 107         close(WRITE);
 108         waitpid($pid, 0);
 109         if(child_error()) {
 110                 die "Failed during: $libexecdir/ksplice-$cmd @args";
 111         }
 112         local $/;
 113         return <READ>;
 114 }
 115
 116 sub unpack_update {
 117         my ($file) = @_;
 118         runval("tar", "zxf", $file);
 119         my ($ksplice) = glob('*/');
 120         chop($ksplice); # remove the trailing slash
 121         return $ksplice;
 122 }
 123
 124 sub get_sysfs {
 125         my ($kid) = @_;
 126         if(! -d "/sys/module") {
 127                 die "/sys not mounted?\n";
 128         }
 129         my $update = "ksplice_$kid";
 130         if (-d "/sys/kernel/ksplice/$kid") {
 131                 return "/sys/kernel/ksplice/$kid";
 132         }
 133         if (-d "/sys/module/$update/ksplice") {
 134                 return "/sys/module/$update/ksplice";
 135         }
 136         return undef;
 137 }
 138
 139 sub update_loaded {
 140         my ($kid) = @_;
 141         return defined(get_sysfs($kid));
 142 }
 143
 144 sub read_file {
 145         my ($file) = @_;
 146         local (*INPUT, $/);
 147         open(INPUT, "<", $file) or die $!;
 148         return <INPUT>;
 149 }
 150
 151 sub write_file {
 152         my ($file, $string) = @_;
 153         local *INPUT;
 154         open(INPUT, ">", $file) or die $!;
 155         print INPUT $string;
 156 }
 157
 158 sub read_sysfs {
 159         my ($kid, $attr) = @_;
 160         my $sysfs = get_sysfs($kid);
 161         return undef if (!defined($sysfs));
 162         return read_file("$sysfs/$attr");
 163 }
 164
 165 sub write_sysfs {
 166         my ($kid, $attr, $string) = @_;
 167         my $sysfs = get_sysfs($kid);
 168         return undef if (!defined($sysfs));
 169         write_file("$sysfs/$attr", $string);
 170 }
 171
 172 sub get_debug_output {
 173         my ($kid) = @_;
 174         my $update = "ksplice_$kid";
 175         my $debug;
 176         my (undef, $debugfs_out) = tempfile('ksplice-debug-XXXXXX', DIR => tmpdir());
 177         my $debugfsdir = tempdir('ksplice-debugfs-XXXXXX',
 178                                  TMPDIR => 1, CLEANUP => 1);
 179         if (runval_raw(qw(mount -t debugfs debugfs), $debugfsdir) == 0) {
 180                 copy("$debugfsdir/$update", "$debugfs_out");
 181                 $debug = read_file("$debugfsdir/$update");
 182                 runval(qw(umount), $debugfsdir);
 183         } elsif ($? >> 8 == 32) {
 184                 my $dmesg = runstr("dmesg | grep ksplice");
 185                 while($dmesg =~ /ksplice: Preparing to reverse/) {
 186                         $dmesg = $';
 187                 }
 188                 $debug = '';
 189                 write_file($debugfs_out, $dmesg);
 190         } else {
 191                 child_error();
 192                 die;
 193         }
 194         return ($debugfs_out, $debug);
 195 }
 196
 197 sub get_stage {
 198         my ($kid) = @_;
 199         chomp(my $result = read_sysfs($kid, "stage"));
 200         return $result;
 201 }
 202
 203 sub get_abort_cause {
 204         my ($kid) = @_;
 205         chomp(my $result = read_sysfs($kid, "abort_cause"));
 206         return $result;
 207 }
 208
 209 sub get_conflicts {
 210         my ($kid) = @_;
 211         chomp(my $conflicts = read_sysfs($kid, "conflicts"));
 212         my @conflicts = split('\n', $conflicts);
 213         my $out = '';
 214         foreach my $conflict (@conflicts) {
 215                 my ($name, $pid, @symbols) = split(' ', $conflict);
 216                 next if (!@symbols);
 217                 $out .= "Process $name(pid $pid) is using the following symbols changed by update $kid:\n";
 218                 foreach my $symbol (@symbols) {
 219                         $out .= "  $symbol\n";
 220                 }
 221         }
 222         return $out;
 223 }
 224
 225 sub get_patch {
 226         my ($kid) = @_;
 227         my $result = read_file("/var/run/ksplice/updates/$kid/patch");
 228         return $result;
 229 }
 230
 231 sub set_stage {
 232         my ($kid, $string) = @_;
 233         write_sysfs($kid, "stage", "$string\n");
 234 }
 235
 236 sub set_debug_level {
 237         my ($kid, $string) = @_;
 238         write_sysfs($kid, "debug", "$string\n");
 239 }
 240
 241 END {
 242         $Verbose::level = 0;
 243         chdir("/");
 244 }
 245
 246 1;