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