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