Only use COW hooks in diff mode.
[ksplice.git] / ksplice-view.in
blobe16be83b641342e83a4c2a44ed9c4e1bebfccf48
1 #!/usr/bin/perl
3 # Copyright (C) 2007-2008 Jeffrey Brian Arnold <jbarnold@mit.edu>
4 # Copyright (C) 2008 Anders Kaseorg <andersk@mit.edu>,
5 # Tim Abbott <tabbott@mit.edu>
7 # This program is free software; you can redistribute it and/or modify
8 # it under the terms of the GNU General Public License, version 2.
10 # This program is distributed in the hope that it will be useful,
11 # but WITHOUT ANY WARRANTY; without even the implied warranty of
12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 # GNU General Public License for more details.
15 # You should have received a copy of the GNU General Public License
16 # along with this program; if not, write to the Free Software
17 # Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA
18 # 02110-1301, USA.
20 use strict;
21 use warnings;
22 use lib 'KSPLICE_DATA_DIR';
23 use Ksplice;
25 my ($kid, $mid, $module, $update, $file);
26 GetOptions(@common_options,
27 "id=s" => \$kid,
28 "file=s" => \$file) or pod2usage(1);
30 pod2usage(1) if($help || scalar(@ARGV) != 0);
31 my $actions = (defined $kid) + (defined $file);
32 pod2usage(1) if($actions > 1);
34 view_kid() if(defined $kid);
35 view_file() if(defined $file);
36 view_list() if($actions == 0);
38 exit(0);
40 sub view_kid {
41 $kid =~ s/^ksplice[_-]//;
42 $kid =~ s/[-_].*$//; # In case we got an mid instead
43 $update = "ksplice_$kid";
44 if(!update_loaded($kid)) {
45 print "Ksplice id $kid is not present in the kernel\n";
46 exit(0);
48 my $stage = get_stage($kid);
49 print "Ksplice id $kid is present in the kernel and is $stage.\n\n";
50 my $source_diff = get_patch($kid);
51 return if($source_diff eq "");
52 print "Here is the source code patch associated with this update:\n";
53 print $source_diff;
56 sub view_file {
57 my $tmpdir = tempdir('ksplice-tmp-XXXXXX', TMPDIR => 1, CLEANUP => 1);
58 copy($file, "$tmpdir/" . basename($file));
59 chdir($tmpdir);
60 my $ksplice = unpack_update($file);
61 open(PATCH, '<', "$ksplice/patch") or die $!;
62 local $/;
63 print <PATCH>;
64 close(PATCH);
67 sub show_kid {
68 my ($kid) = @_;
69 if ($Verbose::level < 0) {
70 print "$kid\n";
71 } else {
72 my $desc = get_short_description($kid);
73 if (defined($desc)) {
74 print "$kid: $desc";
75 } else {
76 print "$kid: no description available\n";
81 sub view_list {
82 foreach(split(/\n/, runstr("lsmod"))) {
83 next unless my ($mid) = m/^ksplice_(\S*)\s/;
84 $module = "ksplice_$mid";
85 ($kid = $mid) =~ s/[-_].*$//;
86 next unless (-e "/sys/module/$module/ksplice/stage");
87 open STAGE, '<', "/sys/module/$module/ksplice/stage" or next;
88 show_kid($kid) if(<STAGE> eq "applied\n");
89 close STAGE;
91 if (-e "/sys/kernel/ksplice") {
92 chdir("/sys/kernel/ksplice");
93 foreach $update (glob("*")) {
94 ($kid = $update) =~ s/^ksplice_//;
95 show_kid($kid) if(get_stage($kid) eq "applied");
100 =head1 NAME
102 ksplice-view - View in-kernel or on-disk Ksplice kernel updates
104 =head1 SYNOPSIS
106 B<ksplice-view> [B<--id=>I<KSPLICE_ID> | B<--file=>I<UPDATE_TARBALL>]
108 =head1 DESCRIPTION
110 When called with no arguments, B<ksplice-view> lists the identification tags of
111 all of the Ksplice updates that are currently present in the running kernel.
113 B<ksplice-view> can report about a specific Ksplice update when given the
114 update's identification tag (if the update is in the kernel) or given the
115 update's tarball filename I<UPDATE_TARBALL> (if the update is on disk).
117 =head1 SEE ALSO
119 L<ksplice-create(8)>, L<ksplice-apply(8)>, L<ksplice-undo(8)>
121 =head1 BUGS
123 Please report bugs to <PACKAGE_BUGREPORT>.
125 =head1 COPYRIGHT
127 Copyright (C) 2007-2008 Jeffrey Brian Arnold <jbarnold@mit.edu>
129 Copyright (C) 2008 Anders Kaseorg <andersk@mit.edu>,
130 Tim Abbott <tabbott@mit.edu>
132 This is free software and documentation. You can redistribute and/or modify it
133 under the terms of the GNU General Public License, version 2.
135 =cut