Do not write Ksplice relocations to the middle of a patched section.
[ksplice.git] / Ksplice.pm.in
blob5fff87d9d670e4c3d752104b89ce3ccb9c1da820
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 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
31 our ($datadir, $libexecdir) = qw(KSPLICE_DATA_DIR KSPLICE_LIBEXEC_DIR);
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]; },
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;
52 return 1;
55 sub runval {
56 my (@cmd) = @_;
57 if(runval_raw(@cmd) != 0) {
58 child_error();
59 die "Failed during: @cmd\n";
63 sub runval_raw {
64 my (@cmd) = @_;
65 my ($out, $err);
66 print "+ @cmd\n" if($Verbose::level >= 1);
67 return system(@cmd);
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;
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;
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";
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";
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";
128 sub unpack_update {
129 my ($file) = @_;
130 runval("tar", "zxf", $file);
131 my ($ksplice) = glob('*/');
132 chop($ksplice); # remove the trailing slash
133 return $ksplice;
136 sub get_sysfs {
137 my ($kid) = @_;
138 if(! -d "/sys/module") {
139 die "/sys not mounted?\n";
141 my $update = "ksplice_$kid";
142 if (-d "/sys/kernel/ksplice/$kid") {
143 return "/sys/kernel/ksplice/$kid";
145 if (-d "/sys/module/$update/ksplice") {
146 return "/sys/module/$update/ksplice";
148 return undef;
151 sub update_loaded {
152 my ($kid) = @_;
153 return defined(get_sysfs($kid));
156 sub read_file {
157 my ($file) = @_;
158 local (*INPUT, $/);
159 open(INPUT, "<", $file) or die $!;
160 return <INPUT>;
163 sub write_file {
164 my ($file, $string) = @_;
165 local *INPUT;
166 open(INPUT, ">", $file) or die $!;
167 print INPUT $string;
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");
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);
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());
190 my $debugfsdir = tempdir('ksplice-debugfs-XXXXXX',
191 TMPDIR => 1, CLEANUP => 1);
192 if (runval_raw("grep", "-qFx", "nodev\tdebugfs", "/proc/filesystems") == 0) {
193 runval(qw(mount -t debugfs debugfs), $debugfsdir);
194 copy("$debugfsdir/$update", "$debugfs_out");
195 runval(qw(umount), $debugfsdir);
196 return $debugfs_out;
197 } elsif ($? >> 8 == 1) {
198 return ();
199 } else {
200 child_error();
201 die;
205 sub get_stage {
206 my ($kid) = @_;
207 chomp(my $result = read_sysfs($kid, "stage"));
208 return $result;
211 sub get_abort_cause {
212 my ($kid) = @_;
213 chomp(my $result = read_sysfs($kid, "abort_cause"));
214 return $result;
217 sub get_conflicts {
218 my ($kid) = @_;
219 chomp(my $conflicts = read_sysfs($kid, "conflicts"));
220 my @conflicts = split('\n', $conflicts);
221 my $out = '';
222 foreach my $conflict (@conflicts) {
223 my ($name, $pid, @symbols) = split(' ', $conflict);
224 next if (!@symbols);
225 $out .= "Process $name(pid $pid) is using the following symbols changed by update $kid:\n";
226 foreach my $symbol (@symbols) {
227 $out .= " $symbol\n";
230 return $out;
233 sub get_patch {
234 my ($kid) = @_;
235 my $result = read_file("/var/run/ksplice/updates/$kid/patch");
236 return $result;
239 sub get_short_description {
240 my ($kid) = @_;
241 open(INPUT, "<", "/var/run/ksplice/updates/$kid/description") or return undef;
242 my $result = <INPUT>;
243 close(INPUT);
244 return $result;
247 sub set_stage {
248 my ($kid, $string) = @_;
249 write_sysfs($kid, "stage", "$string\n");
252 sub set_debug_level {
253 my ($kid, $string) = @_;
254 write_sysfs($kid, "debug", "$string\n");
257 sub set_partial {
258 my ($kid, $string) = @_;
259 write_sysfs($kid, "partial", "$string\n");
262 END {
263 $Verbose::level = 0;
264 chdir("/");