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 @common_options $help
  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
  31 our $help = 0;
  32 our @common_options = (
  33         "help|?" => \$help,
  34         "version" => sub { print "Ksplice version PACKAGE_VERSION\n"; exit(0); },
  35         "verbose|v:+" => \$Verbose::level,
  36         "quiet|q:+" => sub { $Verbose::level -= $_[1]; },
  37 );
  38
  39 sub child_error {
  40         if($? == -1) {
  41                 print STDERR "Failed to exec child\n";
  42         } elsif(($? & 127) != 0) {
  43                 print STDERR "Child exited with signal ", ($? & 127), ($? & 128) ? " (core dumped)\n" : "\n";
  44         } elsif($? >> 8 != 0) {
  45                 print STDERR "Child exited with status ", $? >> 8, "\n";
  46         } else {
  47                 return 0;
  48         }
  49         return 1;
  50 }
  51
  52 sub runval {
  53         my (@cmd) = @_;
  54         if(runval_raw(@cmd) != 0) {
  55                 child_error();
  56                 die "Failed during: @cmd\n";
  57         }
  58 }
  59
  60 sub runval_raw {
  61         my (@cmd) = @_;
  62         my ($out, $err);
  63         print "+ @cmd\n" if($Verbose::level >= 1);
  64         return system(@cmd);
  65 }
  66
  67 sub runstr {
  68         my @cmd = @_;
  69         print "+ @cmd\n" if($Verbose::level >= 1);
  70         local $/;
  71         open PIPE, '-|', @cmd or die "Can't run @cmd: $!";
  72         my $output = <PIPE>;
  73         close PIPE or $! == 0 or die "Can't run @cmd: $!";
  74         return $output;
  75 }
  76
  77 sub runstr_err {
  78         my @cmd = @_;
  79         print "+ @cmd\n" if($Verbose::level >= 1);
  80         local (*ERROR);
  81         my $pid = open3(fileno STDIN, '>&STDOUT', \*ERROR, @cmd);
  82         local $/;
  83         my $error = <ERROR>;
  84         waitpid($pid, 0);
  85         print STDERR $error;
  86         return $error;
  87 }
  88
  89 sub runval_in {
  90         my ($in, @cmd) = @_;
  91         print "+ @cmd <<'EOF'\n${in}EOF\n" if($Verbose::level >= 1);
  92         local (*WRITE);
  93         open(WRITE, '|-', @cmd) or die "Can't run @cmd: $!";
  94         print WRITE $in;
  95         close(WRITE) or $! == 0 or die "Can't run @cmd: $!";
  96         if(child_error()) {
  97                 die "Failed during: @cmd";
  98         }
  99 }
 100
 101 sub runval_infile {
 102         my ($infile, @cmd) = @_;
 103         print "+ @cmd < $infile\n" if($Verbose::level >= 1);
 104         local (*INFILE);
 105         open(INFILE, '<', $infile) or die "Can't open $infile: $!";
 106         my $pid = open2('>&STDOUT', '<&INFILE', @cmd) or die "Can't run @cmd: $!";
 107         waitpid($pid, 0);
 108         if(child_error()) {
 109                 die "Failed during: @cmd";
 110         }
 111 }
 112
 113 sub unpack_update {
 114         my ($file) = @_;
 115         runval("tar", "zxf", $file);
 116         my ($ksplice) = glob('*/');
 117         chop($ksplice); # remove the trailing slash
 118         return $ksplice;
 119 }
 120
 121 sub get_sysfs {
 122         my ($kid) = @_;
 123         if(! -d "/sys/module") {
 124                 die "/sys not mounted?\n";
 125         }
 126         my $update = "ksplice_$kid";
 127         if (-d "/sys/kernel/ksplice/$kid") {
 128                 return "/sys/kernel/ksplice/$kid";
 129         }
 130         if (-d "/sys/module/$update/ksplice") {
 131                 return "/sys/module/$update/ksplice";
 132         }
 133         return undef;
 134 }
 135
 136 sub update_loaded {
 137         my ($kid) = @_;
 138         return defined(get_sysfs($kid));
 139 }
 140
 141 sub read_file {
 142         my ($file) = @_;
 143         local (*INPUT, $/);
 144         open(INPUT, "<", $file) or die $!;
 145         return <INPUT>;
 146 }
 147
 148 sub write_file {
 149         my ($file, $string) = @_;
 150         local *INPUT;
 151         open(INPUT, ">", $file) or die $!;
 152         print INPUT $string;
 153 }
 154
 155 sub read_sysfs {
 156         my ($kid, $attr) = @_;
 157         my $sysfs = get_sysfs($kid);
 158         return undef if (!defined($sysfs));
 159         return read_file("$sysfs/$attr");
 160 }
 161
 162 sub write_sysfs {
 163         my ($kid, $attr, $string) = @_;
 164         my $sysfs = get_sysfs($kid);
 165         return undef if (!defined($sysfs));
 166         write_file("$sysfs/$attr", $string);
 167 }
 168
 169 sub get_debug_output {
 170         my ($kid) = @_;
 171         my $update = "ksplice_$kid";
 172         my $debug;
 173         my (undef, $debugfs_out) = tempfile('ksplice-debug-XXXXXX', DIR => tmpdir());
 174         my $debugfsdir = tempdir('ksplice-debugfs-XXXXXX',
 175                                  TMPDIR => 1, CLEANUP => 1);
 176         if (runval_raw(qw(mount -t debugfs debugfs), $debugfsdir) == 0) {
 177                 copy("$debugfsdir/$update", "$debugfs_out");
 178                 $debug = read_file("$debugfsdir/$update");
 179                 runval(qw(umount), $debugfsdir);
 180         } elsif ($? >> 8 == 32) {
 181                 return ();
 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;