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