ksplice.pm.in

   1 package ksplice;
   2 use Cwd 'abs_path';
   3 use File::Basename;
   4 use File::Copy;
   5 use File::Path;
   6 use File::Temp;
   7 use Fatal qw(:void copy rename move chdir mkdir unlink rmtree);
   8 use strict;
   9 use warnings;
  10 use verbose qw(copy rename move chdir mkdir mkpath unlink rmtree mktemp mkdtemp);
  11 require Exporter;
  12 our @ISA = qw(Exporter);
  13 our @EXPORT = qw($datadir $libexecdir $version_str init_tmpdir runstr runval runval_raw runsuc unpack_update get_debugfs);
  14
  15 our ($datadir, $libexecdir) = qw(KSPLICE_DATA_DIR KSPLICE_LIBEXEC_DIR);
  16 our $version_str = "Ksplice version PACKAGE_VERSION\n";
  17
  18 sub init_tmpdir {
  19         my $argdir = $ENV{TMPDIR};
  20         $argdir = "/tmp" if(!defined $argdir || ! -d $argdir);
  21         die if(! -d $argdir);
  22
  23         my $tmpdir = mkdtemp("$argdir/ksplice-tmp-XXXXXX");
  24         die if(!defined $tmpdir || ! -d $tmpdir);
  25         return $tmpdir;
  26 }
  27
  28 sub runval {
  29         my (@cmd) = @_;
  30         if(runval_raw(@cmd) != 0) {
  31                 die "Failed during: @cmd\n";
  32         }
  33 }
  34
  35 sub runval_raw {
  36         my (@cmd) = @_;
  37         my ($out, $err);
  38         print "+ @cmd\n" if($verbose::level);
  39         if(!$verbose::level) {
  40                 open $out, ">&STDOUT" or die "Can't dup STDOUT: $!";
  41                 open $err, ">&STDERR" or die "Can't dup STDERR: $!";
  42                 open STDOUT, '>', "/dev/null" or die "Can't hide STDOUT: $!";
  43                 open STDERR, '>', "/dev/null" or die "Can't hide STDERR: $!";
  44         }
  45         my $val = system(@cmd);
  46         if(!$verbose::level) {
  47                 open STDOUT, ">&", $out or die "Can't restore STDOUT: $!";
  48                 open STDERR, ">&", $err or die "Can't restore STDERR: $!";
  49         }
  50         return $val;
  51 }
  52
  53 sub runstr {
  54         my @cmd = @_;
  55         print "+ @cmd\n" if($verbose::level);
  56         local $/;
  57         open PIPE, '-|', @cmd or die "Can't run @cmd: $!";
  58         my $output = <PIPE>;
  59         close PIPE or $! == 0 or die "Can't run @cmd: $!";
  60         return $output;
  61 }
  62
  63 sub runsuc {
  64         my ($cmd, @args) = @_;
  65         my $output = runstr("$libexecdir/ksplice-$cmd", @args);
  66         if($? != 0) {
  67                 print "Output: $output\n";
  68                 die "Failed during: $libexecdir/ksplice-$cmd @args";
  69         }
  70         return $output;
  71 }
  72
  73 sub unpack_update {
  74         my ($file) = @_;
  75         runval("tar", "zxf", $file);
  76         my ($ksplice) = glob('*/');
  77         chop($ksplice); # remove the trailing slash
  78         return $ksplice;
  79 }
  80
  81 sub get_debugfs {
  82         my ($modname, $debugfs_out) = @_;
  83         my $debug;
  84         my $debugfsdir = init_tmpdir();
  85         runval_raw(qw(mount -t debugfs debugfs), $debugfsdir);
  86         if (-e "$debugfsdir/$modname") {
  87                 system(qw(cp -a), "$debugfsdir/$modname", "$debugfs_out");
  88                 $debug = runstr("cat", "$debugfsdir/$modname");
  89                 runval_raw(qw(rmdir), $debugfsdir);
  90         }
  91         runval_raw(qw(umount), $debugfsdir);
  92         return $debug;
  93 }
  94
  95 1;