ksplice-obj.pl.in

   1 #!/usr/bin/perl
   2
   3 # Copyright (C) 2008-2009  Ksplice, Inc.
   4 # Authors: Anders Kaseorg, Jeff Arnold, Tim Abbott
   5 #
   6 # This program is free software; you can redistribute it and/or modify
   7 # it under the terms of the GNU General Public License, version 2.
   8 #
   9 # This program is distributed in the hope that it will be useful,
  10 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12 # GNU General Public License for more details.
  13 #
  14 # You should have received a copy of the GNU General Public License
  15 # along with this program; if not, write to the Free Software
  16 # Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA
  17 # 02110-1301, USA.
  18
  19 use strict;
  20 use warnings;
  21 use lib 'KSPLICE_DATA_DIR';
  22 use Ksplice;
  23
  24 $Verbose::level = $ENV{KSPLICE_VERBOSE} if (defined $ENV{KSPLICE_VERBOSE});
  25
  26 sub empty_diff {
  27         my ($out) = @_;
  28         my ($obj) = $out =~ /^(.*)\.KSPLICE$/ or die;
  29         unlink "$obj.KSPLICE_new_code" if (-e "$obj.KSPLICE_new_code");
  30         unlink "$obj.KSPLICE_old_code" if (-e "$obj.KSPLICE_old_code");
  31         open OUT, '>', "$out.tmp";
  32         close OUT;
  33         rename "$out.tmp", $out;
  34 }
  35
  36 sub do_snap {
  37         my ($out) = @_;
  38         my ($obj) = $out =~ /^(.*)\.KSPLICE$/ or die;
  39         die if (!-e $obj);
  40         unlink "$obj.KSPLICE_pre" if (-e "$obj.KSPLICE_pre");
  41         empty_diff($out);
  42 }
  43
  44 sub do_diff {
  45         my ($out) = @_;
  46         my ($obj) = $out =~ /^(.*)\.KSPLICE$/ or die;
  47         my $obj_pre = "$obj.KSPLICE_pre";
  48         die if (!-e $obj);
  49         die "Patch creates new object $obj" if (!-e $obj_pre);
  50         if (system('cmp', '-s', '--', $obj_pre, $obj) == 0) {
  51                 unlink $obj_pre;
  52                 return empty_diff($out);
  53         }
  54
  55         runval("$libexecdir/ksplice-objmanip", $obj, "$obj.KSPLICE_new_code", "keep-new-code", "$obj.KSPLICE_pre", $ENV{KSPLICE_KID});
  56         return empty_diff($out) if (!-e "$obj.KSPLICE_new_code");
  57
  58         open OUT, '>', "$out.tmp";
  59         print OUT "1\n";
  60         close OUT;
  61         rename "$out.tmp", $out;
  62
  63         runval("$libexecdir/ksplice-objmanip", $obj_pre, "$obj.KSPLICE_old_code", "keep-old-code");
  64 }
  65
  66 sub do_old_code {
  67         my ($out) = @_;
  68         my ($obj) = $out =~ /^(.*)\.KSPLICE_old_code$/ or die;
  69         my $obj_pre = "$obj.KSPLICE_pre";
  70         -e $obj_pre or $obj_pre = $obj;
  71         runval("$libexecdir/ksplice-objmanip", $obj_pre, "$obj.KSPLICE_old_code", "keep-old-code");
  72 }
  73
  74 sub link_objs {
  75         my ($out, @ins) = @_;
  76         if (@ins == 0) {
  77                 runval(shellwords($ENV{AR}), "rcs", $out);
  78         } elsif (@ins == 1) {
  79                 copy @ins, $out;
  80         } else {
  81                 runval(shellwords($ENV{LD}), "-r", "-o", $out, @ins);
  82         }
  83 }
  84
  85 sub do_combine {
  86         my ($out, @ins) = @_;
  87         my @new_code_objs;
  88         my @old_code_objs;
  89         foreach my $in (@ins) {
  90                 if (my ($obj) = $in =~ /^(.*)\.KSPLICE$/) {
  91                         next if (!-s $in);
  92                         push @new_code_objs, "$obj.KSPLICE_new_code";
  93                         push @old_code_objs, "$obj.KSPLICE_old_code";
  94                 } elsif (($obj) = $in =~ /^(.*)\.KSPLICE_old_code$/) {
  95                         push @old_code_objs, "$obj.KSPLICE_old_code"
  96                             unless (@old_code_objs && $old_code_objs[$#old_code_objs] eq "$obj.KSPLICE_old_code");
  97                 } elsif ("$in.KSPLICE" eq $out) {
  98                         my $pre = "$in.KSPLICE_pre";
  99                         if (system('cmp', '-s', '--', $pre, $in) == 0) {
 100                                 unlink $pre;
 101                         }
 102                 } else {
 103                         die "Unexpected input $in for $out";
 104                 }
 105         }
 106
 107         return empty_diff($out) unless (@old_code_objs);
 108
 109         my ($obj) = $out =~ /^(.*)\.KSPLICE$/ or die;
 110         link_objs("$obj.KSPLICE_new_code", @new_code_objs);
 111         link_objs("$obj.KSPLICE_old_code", @old_code_objs);
 112
 113         open OUT, '>', "$out.tmp";
 114         print OUT "1\n";
 115         close OUT;
 116         rename "$out.tmp", $out;
 117 }
 118
 119 sub do_finalize {
 120         my ($in, $out, $target) = @_;
 121         my $ret = runval_raw("$libexecdir/ksplice-objmanip", $in, $out, "finalize", $target);
 122         if ($ret == 0) {
 123         } elsif ($ret >> 8 == 66) {
 124                 runval(shellwords($ENV{AR}), "rcs", $out);
 125         } else {
 126                 child_error();
 127         }
 128 }
 129
 130 sub do_rmsyms {
 131         my ($in, $out) = @_;
 132         runval("$libexecdir/ksplice-objmanip", $in, $out, "rmsyms");
 133 }
 134
 135 sub do_system_map_lookup {
 136         my ($symarg) = @_;
 137         open(SYMS, "<", "$ENV{KSPLICE_CONFIG_DIR}/System.map") or die;
 138         my $line;
 139         while (defined($line = <SYMS>)) {
 140                 my ($addr, $type, $sym, $mod) = split(/\s+/, $line);
 141                 if ($sym eq $symarg) { print $addr; last; }
 142         }
 143         close(SYMS);
 144 }
 145
 146 my %handlers = (
 147         'snap' => \&do_snap,
 148         'diff' => \&do_diff,
 149         'old_code' => \&do_old_code,
 150         'combine' => \&do_combine,
 151         'finalize' => \&do_finalize,
 152         'rmsyms' => \&do_rmsyms,
 153         'system_map_lookup' => \&do_system_map_lookup,
 154 );
 155
 156 my ($cmd, @args) = @ARGV;
 157 if (exists $handlers{$cmd}) {
 158         my $handler = $handlers{$cmd};
 159         &$handler(@args);
 160 } else {
 161         print "Usage: ksplice-obj.pl ", join('|', keys %handlers), " ...\n";
 162         exit(1);
 163 };