ksplice.pl.in

   1 #!/usr/bin/perl
   2
   3 # Copyright (C) 2008  Anders Kaseorg <andersk@mit.edu>,
   4 #                     Jeffrey Brian Arnold <jbarnold@mit.edu>,
   5 #                     Tim Abbott <tabbott@mit.edu>
   6 #
   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.
   9 #
  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.
  14 #
  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.
  19
  20 use Digest::MD5;
  21 use File::Basename;
  22 use File::Copy;
  23 use File::Path;
  24 use File::Temp;
  25 use Fatal qw(:void copy rename move chdir mkdir unlink rmtree);
  26 use strict;
  27 use warnings;
  28 use lib 'KSPLICE_DATA_DIR';
  29 use ksplice;
  30 use verbose qw(copy rename move chdir mkdir mkpath unlink rmtree mktemp mkdtemp);
  31
  32 $verbose::level = $ENV{KSPLICE_VERBOSE} if (defined $ENV{KSPLICE_VERBOSE});
  33
  34 sub empty_diff {
  35         my ($out) = @_;
  36         my ($obj) = $out =~ /^(.*)\.KSPLICE$/ or die;
  37         unlink "$obj.KSPLICE_primary" if (-e "$obj.KSPLICE_primary");
  38         unlink "$obj.KSPLICE_helper" if (-e "$obj.KSPLICE_helper");
  39         open OUT, '>', "$out.tmp";
  40         close OUT;
  41         rename "$out.tmp", $out;
  42 }
  43
  44 sub do_snap {
  45         my ($out) = @_;
  46         my ($obj) = $out =~ /^(.*)\.KSPLICE$/ or die;
  47         die if (!-e $obj);
  48         unlink "$obj.KSPLICE_pre" if (-e "$obj.KSPLICE_pre");
  49         empty_diff($out);
  50 }
  51
  52 sub do_diff {
  53         my ($out) = @_;
  54         my ($obj) = $out =~ /^(.*)\.KSPLICE$/ or die;
  55         my $obj_old = "$obj.KSPLICE_pre";
  56         return do_snap($out) if (!-e $obj_old);
  57         die if (!-e $obj);
  58         if (system('cmp', '-s', '--', $obj_old, $obj) == 0) {
  59                 unlink $obj_old;
  60                 return empty_diff($out);
  61         }
  62
  63         my ($bits, $sections, $entrysyms) = split("\n", runsuc("objdiff", $obj_old, $obj));
  64         die if ($bits ne '32' && $bits ne '64');
  65         return empty_diff($out) if ($sections eq '' && $entrysyms eq '');
  66
  67         copy($obj, "$obj.KSPLICE_primary");
  68         copy($obj_old, "$obj.KSPLICE_helper");
  69
  70         open OBJ, '<', $obj or die;
  71         open OBJ_OLD, '<', $obj_old or die;
  72         my $tag = Digest::MD5->new->addfile(*OBJ)->addfile(*OBJ_OLD)->hexdigest;
  73         close OBJ;
  74         close OBJ_OLD;
  75
  76         runsuc("objmanip", "$obj.KSPLICE_primary", "keep-primary", "____${tag}", "_post", split(/\s/, $sections));
  77         runsuc("objmanip", "$obj.KSPLICE_helper", "keep-helper", "____${tag}", "_pre");
  78
  79         runsuc("objmanip", "$obj.KSPLICE_primary", "sizelist", "____${tag}", "_post");
  80         runsuc("objmanip", "$obj.KSPLICE_helper", "sizelist", "____${tag}", "_pre");
  81
  82         runsuc("objmanip", "$obj.KSPLICE_primary", "patchlist", "____${tag}", "_pre", "_post", split(/\s/, $entrysyms));
  83
  84         open OUT, '>', "$out.tmp";
  85         print OUT "$bits\n";
  86         close OUT;
  87         rename "$out.tmp", $out;
  88 }
  89
  90 sub do_combine {
  91         my ($out, @ins) = @_;
  92         my @objs;
  93         my $outbits = undef;
  94         foreach my $in (@ins) {
  95                 next if (!-s $in);
  96                 my ($obj) = $in =~ /^(.*)\.KSPLICE$/ or die;
  97                 push @objs, $obj;
  98
  99                 open IN, '<', $in;
 100
 101                 chomp(my $bits = <IN>);
 102                 die if (defined $outbits && $outbits ne $bits);
 103                 $outbits = $bits;
 104
 105                 close IN;
 106         }
 107
 108         return empty_diff($out) unless (defined $outbits);
 109
 110         my ($obj) = $out =~ /^(.*)\.KSPLICE$/ or die;
 111         if (@objs == 1) {
 112                 copy "$objs[0].KSPLICE_primary", "$obj.KSPLICE_primary";
 113                 copy "$objs[0].KSPLICE_helper", "$obj.KSPLICE_helper";
 114         } else {
 115                 system("ld", "-r", "-o",
 116                        map { "$_.KSPLICE_primary" } ($obj, @objs));
 117                 system("ld", "-r", "-o",
 118                        map { "$_.KSPLICE_helper" } ($obj, @objs));
 119         }
 120
 121         open OUT, '>', "$out.tmp";
 122         print OUT "$outbits\n";
 123         close OUT;
 124         rename "$out.tmp", $out;
 125 }
 126
 127 sub do_rmsyms {
 128         my ($obj, @rmsyms) = @_;
 129         my $relocs = runsuc("objmanip", $obj, "rmsyms", @rmsyms);
 130 }
 131
 132 sub do_system_map_lookup {
 133         my ($symarg) = @_;
 134         open(SYMS, "<", "$ENV{KSPLICE_CONFIG_DIR}/System.map") or die;
 135         my $line;
 136         while (defined($line = <SYMS>)) {
 137                 my ($addr, $type, $sym, $mod) = split(/\s+/, $line);
 138                 if ($sym eq $symarg) { print $addr; last; }
 139         }
 140         close(SYMS);
 141 }
 142
 143 my %handlers = (
 144         'snap' => \&do_snap,
 145         'diff' => \&do_diff,
 146         'combine' => \&do_combine,
 147         'rmsyms' => \&do_rmsyms,
 148         'system_map_lookup' => \&do_system_map_lookup,
 149 );
 150
 151 my ($cmd, @args) = @ARGV;
 152 if (exists $handlers{$cmd}) {
 153         my $handler = $handlers{$cmd};
 154         &$handler(@args);
 155 } else {
 156         print "Usage: ksplice.pl ", join('|', keys %handlers), " ...\n";
 157 };