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 strict;
  21 use warnings;
  22 use lib 'KSPLICE_DATA_DIR';
  23 use ksplice;
  24 use File::Copy;
  25 use Digest::MD5;
  26
  27 my $kid = "somekid";
  28
  29 sub empty_diff {
  30         my ($out) = @_;
  31         my ($obj) = $out =~ /^(.*)\.KSPLICE$/ or die;
  32         unlink "$obj.KSPLICE_primary" if (-e "$obj.KSPLICE_primary");
  33         unlink "$obj.KSPLICE_helper" if (-e "$obj.KSPLICE_helper");
  34         open OUT, '>', "$out.tmp";
  35         close OUT;
  36         rename "$out.tmp", $out;
  37 }
  38
  39 sub do_snap {
  40         my ($out) = @_;
  41         my ($obj) = $out =~ /^(.*)\.KSPLICE$/ or die;
  42         die if (!-e $obj);
  43         unlink "$obj.KSPLICE_pre" if (-e "$obj.KSPLICE_pre");
  44         empty_diff($out);
  45 }
  46
  47 sub do_diff {
  48         my ($out) = @_;
  49         my ($obj) = $out =~ /^(.*)\.KSPLICE$/ or die;
  50         my $obj_old = "$obj.KSPLICE_pre";
  51         return do_snap($out) if (!-e $obj_old);
  52         die if (!-e $obj);
  53         if (system('cmp', '-s', '--', $obj_old, $obj) == 0) {
  54                 unlink $obj_old;
  55                 return empty_diff($out);
  56         }
  57
  58         my ($bits, $sections, $entrysyms) = split("\n", runsuc("objdiff", $obj_old, $obj));
  59         die if ($bits ne '32' && $bits ne '64');
  60         return empty_diff($out) if ($sections eq '' && $entrysyms eq '');
  61
  62         copy($obj, "$obj.KSPLICE_primary");
  63         copy($obj_old, "$obj.KSPLICE_helper");
  64
  65         open OBJ, '<', $obj or die;
  66         open OBJ_OLD, '<', $obj_old or die;
  67         my $tag = Digest::MD5->new->addfile(*OBJ)->addfile(*OBJ_OLD)->hexdigest;
  68         close OBJ;
  69         close OBJ_OLD;
  70
  71         my $relocs_primary = runsuc("objmanip", "$obj.KSPLICE_primary", "keep-primary", "____${tag}", "_post", split(/\s/, $sections));
  72         runsuc("objmanip", "$obj.KSPLICE_primary", "globalize", "____${tag}_post");
  73
  74         my $relocs_helper = runsuc("objmanip", "$obj.KSPLICE_helper", "keep-helper", "____${tag}", "_pre");
  75         runsuc("objmanip", "$obj.KSPLICE_helper", "globalize", "____${tag}_pre");
  76
  77         my $patchlist = "";
  78         foreach my $sym (split(/\s/, $entrysyms)) {
  79                 $patchlist .= "${sym}____${tag}_pre ${sym}____${tag}_post\n";
  80         }
  81
  82         open OUT, '>', "$out.tmp";
  83         print OUT "$bits\n$patchlist\n$relocs_primary\n$relocs_helper\n";
  84         close OUT;
  85         rename "$out.tmp", $out;
  86 }
  87
  88 sub do_combine {
  89         my ($out, @ins) = @_;
  90         my @objs;
  91         my ($outbits, $patchlist, $relocs_primary, $relocs_helper) = (undef, '', '', '');
  92         foreach my $in (@ins) {
  93                 next if (!-s $in);
  94                 my ($obj) = $in =~ /^(.*)\.KSPLICE$/ or die;
  95                 push @objs, $obj;
  96
  97                 open IN, '<', $in;
  98
  99                 chomp(my $bits = <IN>);
 100                 die if (defined $outbits && $outbits ne $bits);
 101                 $outbits = $bits;
 102
 103                 $patchlist .= $_ while (($_ = <IN>) ne "\n");
 104                 $relocs_primary .= $_ while (($_ = <IN>) ne "\n");
 105                 $relocs_helper .= $_ while (($_ = <IN>) ne "\n");
 106
 107                 close IN;
 108         }
 109
 110         return empty_diff($out) unless (defined $outbits);
 111
 112         my ($obj) = $out =~ /^(.*)\.KSPLICE$/ or die;
 113         if (@objs == 1) {
 114                 copy "$objs[0].KSPLICE_primary", "$obj.KSPLICE_primary";
 115                 copy "$objs[0].KSPLICE_helper", "$obj.KSPLICE_helper";
 116         } else {
 117                 system("ld", "-r", "-o",
 118                        map { "$_.KSPLICE_primary" } ($obj, @objs));
 119                 system("ld", "-r", "-o",
 120                        map { "$_.KSPLICE_helper" } ($obj, @objs));
 121         }
 122
 123         open OUT, '>', "$out.tmp";
 124         print OUT "$outbits\n$patchlist\n$relocs_primary\n$relocs_helper\n";
 125         close OUT;
 126         rename "$out.tmp", $out;
 127 }
 128
 129 my %handlers = (
 130         'snap' => \&do_snap,
 131         'diff' => \&do_diff,
 132         'combine' => \&do_combine,
 133 );
 134
 135 my ($cmd, @args) = @ARGV;
 136 if (exists $handlers{$cmd}) {
 137         my $handler = $handlers{$cmd};
 138         &$handler(@args);
 139 } else {
 140         print "Usage: ksplice.pl ", join('|', keys %handlers), " ...\n";
 141 };