ksplice-obj.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
  25 $Verbose::level = $ENV{KSPLICE_VERBOSE} if (defined $ENV{KSPLICE_VERBOSE});
  26
  27 sub empty_diff {
  28         my ($out) = @_;
  29         my ($obj) = $out =~ /^(.*)\.KSPLICE$/ or die;
  30         unlink "$obj.KSPLICE_primary" if (-e "$obj.KSPLICE_primary");
  31         unlink "$obj.KSPLICE_helper" if (-e "$obj.KSPLICE_helper");
  32         open OUT, '>', "$out.tmp";
  33         close OUT;
  34         rename "$out.tmp", $out;
  35 }
  36
  37 sub do_snap {
  38         my ($out) = @_;
  39         my ($obj) = $out =~ /^(.*)\.KSPLICE$/ or die;
  40         die if (!-e $obj);
  41         unlink "$obj.KSPLICE_pre" if (-e "$obj.KSPLICE_pre");
  42         empty_diff($out);
  43 }
  44
  45 sub do_diff {
  46         my ($out) = @_;
  47         my ($obj) = $out =~ /^(.*)\.KSPLICE$/ or die;
  48         my $obj_old = "$obj.KSPLICE_pre";
  49         die if (!-e $obj);
  50         die "Patch creates new object $obj" if (!-e $obj_old);
  51         if (system('cmp', '-s', '--', $obj_old, $obj) == 0) {
  52                 unlink $obj_old;
  53                 return empty_diff($out);
  54         }
  55
  56         my $objdiff = runsuc("objdiff", $obj_old, $obj);
  57         return empty_diff($out) if($objdiff !~ m/\S/);
  58
  59         runsuc_in($objdiff, "objmanip", $obj, "$obj.KSPLICE_primary", "keep-primary", $ENV{KSPLICE_KID});
  60
  61         open OUT, '>', "$out.tmp";
  62         print OUT "1\n";
  63         close OUT;
  64         rename "$out.tmp", $out;
  65
  66         runsuc("objmanip", $obj_old, "$obj.KSPLICE_helper", "keep-helper");
  67 }
  68
  69 sub do_helper {
  70         my ($out) = @_;
  71         my ($obj) = $out =~ /^(.*)\.KSPLICE_helper$/ or die;
  72         my $obj_old = "$obj.KSPLICE_pre";
  73         -e $obj_old or $obj_old = $obj;
  74         runsuc("objmanip", $obj_old, "$obj.KSPLICE_helper", "keep-helper");
  75 }
  76
  77 sub link_objs {
  78         my ($out, @ins) = @_;
  79         if (@ins == 0) {
  80                 runval(shellwords($ENV{AR}), "rcs", $out);
  81         } elsif (@ins == 1) {
  82                 copy @ins, $out;
  83         } else {
  84                 runval(shellwords($ENV{LD}), "-r", "-o", $out, @ins);
  85         }
  86 }
  87
  88 sub do_combine {
  89         my ($out, @ins) = @_;
  90         my @primaries;
  91         my @helpers;
  92         foreach my $in (@ins) {
  93                 if (my ($obj) = $in =~ /^(.*)\.KSPLICE$/) {
  94                         next if (!-s $in);
  95                         push @primaries, "$obj.KSPLICE_primary";
  96                         push @helpers, "$obj.KSPLICE_helper";
  97                 } elsif (($obj) = $in =~ /^(.*)\.KSPLICE_helper$/) {
  98                         push @helpers, "$obj.KSPLICE_helper"
  99                             unless (@helpers && $helpers[$#helpers] eq "$obj.KSPLICE_helper");
 100                 } else {
 101                         die;
 102                 }
 103         }
 104
 105         return empty_diff($out) unless (@helpers);
 106
 107         my ($obj) = $out =~ /^(.*)\.KSPLICE$/ or die;
 108         link_objs("$obj.KSPLICE_primary", @primaries);
 109         link_objs("$obj.KSPLICE_helper", @helpers);
 110
 111         open OUT, '>', "$out.tmp";
 112         print OUT "1\n";
 113         close OUT;
 114         rename "$out.tmp", $out;
 115 }
 116
 117 sub do_finalize {
 118         my ($in, $out) = @_;
 119         runsuc("objmanip", $in, $out, "finalize");
 120 }
 121
 122 sub do_rmsyms {
 123         my ($in, $out, @rmsyms) = @_;
 124         my $relocs = runsuc_in("@rmsyms\n", "objmanip", $in, $out, "rmsyms");
 125 }
 126
 127 sub do_system_map_lookup {
 128         my ($symarg) = @_;
 129         open(SYMS, "<", "$ENV{KSPLICE_CONFIG_DIR}/System.map") or die;
 130         my $line;
 131         while (defined($line = <SYMS>)) {
 132                 my ($addr, $type, $sym, $mod) = split(/\s+/, $line);
 133                 if ($sym eq $symarg) { print $addr; last; }
 134         }
 135         close(SYMS);
 136 }
 137
 138 my %handlers = (
 139         'snap' => \&do_snap,
 140         'diff' => \&do_diff,
 141         'helper' => \&do_helper,
 142         'combine' => \&do_combine,
 143         'finalize' => \&do_finalize,
 144         'rmsyms' => \&do_rmsyms,
 145         'system_map_lookup' => \&do_system_map_lookup,
 146 );
 147
 148 my ($cmd, @args) = @ARGV;
 149 if (exists $handlers{$cmd}) {
 150         my $handler = $handlers{$cmd};
 151         &$handler(@args);
 152 } else {
 153         print "Usage: ksplice-obj.pl ", join('|', keys %handlers), " ...\n";
 154         exit(1);
 155 };