Add canonical_symbol helper function.
[ksplice.git] / ksplice-obj.pl.in
blob0d2e3a66317aac67d710492c0f3403cfc7a717db
1 #!/usr/bin/perl
3 # Copyright (C) 2008 Anders Kaseorg <andersk@mit.edu>,
4 # Jeffrey Brian Arnold <jbarnold@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 $Verbose::level = $ENV{KSPLICE_VERBOSE} if (defined $ENV{KSPLICE_VERBOSE});
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;
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);
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);
56 my $objdiff = runsuc("objdiff", $obj_old, $obj);
57 return empty_diff($out) if($objdiff !~ m/\S/);
59 copy($obj, "$obj.KSPLICE_primary");
60 copy($obj_old, "$obj.KSPLICE_helper");
62 runsuc_in($objdiff, "objmanip", "$obj.KSPLICE_primary", "keep-primary", $ENV{KSPLICE_KID});
63 runsuc_in($objdiff, "objmanip", "$obj.KSPLICE_helper", "keep-helper", $ENV{KSPLICE_KID});
65 open OUT, '>', "$out.tmp";
66 print OUT "1\n";
67 close OUT;
68 rename "$out.tmp", $out;
71 sub do_combine {
72 my ($out, @ins) = @_;
73 my @objs;
74 foreach my $in (@ins) {
75 next if (!-s $in);
76 my ($obj) = $in =~ /^(.*)\.KSPLICE$/ or die;
77 push @objs, $obj;
80 return empty_diff($out) unless (@objs);
82 my ($obj) = $out =~ /^(.*)\.KSPLICE$/ or die;
83 if (@objs == 1) {
84 copy "$objs[0].KSPLICE_primary", "$obj.KSPLICE_primary";
85 copy "$objs[0].KSPLICE_helper", "$obj.KSPLICE_helper";
86 } else {
87 system(shellwords($ENV{LD}), "-r", "-o",
88 map { "$_.KSPLICE_primary" } ($obj, @objs));
89 system(shellwords($ENV{LD}), "-r", "-o",
90 map { "$_.KSPLICE_helper" } ($obj, @objs));
93 open OUT, '>', "$out.tmp";
94 print OUT "1\n";
95 close OUT;
96 rename "$out.tmp", $out;
99 sub do_finalize {
100 my ($obj) = @_;
101 runsuc("objmanip", "$obj", "finalize");
104 sub do_rmsyms {
105 my ($obj, @rmsyms) = @_;
106 my $relocs = runsuc("objmanip", $obj, "rmsyms", @rmsyms);
109 sub do_system_map_lookup {
110 my ($symarg) = @_;
111 open(SYMS, "<", "$ENV{KSPLICE_CONFIG_DIR}/System.map") or die;
112 my $line;
113 while (defined($line = <SYMS>)) {
114 my ($addr, $type, $sym, $mod) = split(/\s+/, $line);
115 if ($sym eq $symarg) { print $addr; last; }
117 close(SYMS);
120 my %handlers = (
121 'snap' => \&do_snap,
122 'diff' => \&do_diff,
123 'combine' => \&do_combine,
124 'finalize' => \&do_finalize,
125 'rmsyms' => \&do_rmsyms,
126 'system_map_lookup' => \&do_system_map_lookup,
129 my ($cmd, @args) = @ARGV;
130 if (exists $handlers{$cmd}) {
131 my $handler = $handlers{$cmd};
132 &$handler(@args);
133 } else {
134 print "Usage: ksplice-obj.pl ", join('|', keys %handlers), " ...\n";