dh-kpatches implementation

Overall design

The dh-kpatches system is made of two parts. The first one takes patch descriptions, and produces kernel-patch packages; the second one is (currently) contained in those patch packages, and handles application of the patches to a kernel source tree, as well as their removal.

The application/removal scripts are (currently) generated from templates by the dh_installkpatches script for each kernel-patch package.

Currently, the patch descriptions are completely parsed by dh_installkpatches, and the apply/unpatch scripts are specific to each package, and can only act on the patches dh_installkpatches taught them about.

The parts

The dh_installkpatches helper

The base structure of the script is that of a standard debhelper script. 

<dh_installkpatches.in>=
#!/usr/bin/perl -w
#
# dh_installkpatches $Revision: 1.17.1.4.1.6 $
#
# Reads debian/$package.kpatches[.foo], installs all files necessary
# to have make-kpkg use the kernel patches described in there.
#
# (c) 2000-2003 Yann Dirson <dirson@debian.org>
# Some parts based on code from Adam Di Carlo and Joey Hess

use strict;
use Debian::Debhelper::Dh_Lib;
init();

<definitions for the core kpatch system>

PACKAGE: foreach my $package (@{$dh{DOPACKAGES}}) {
  my $tmp = tmpdir($package);
  my $ext = pkgext($package);

  # There are two filename formats, the usual
  # plus an extended format (debian/package.*).

  opendir(DEB,"debian/") || error("can't read debian directory: $!");
  # If this is the main package, we need to handle unprefixed filenames.
  # For all packages, we must support both the usual filename format plus
  # that format with a period an something appended.
  my $regexp="\Q$package\E\.";
  if ($package eq $dh{MAINPACKAGE}) {
    $regexp="(|$regexp)";
  }
  my @files = grep { /^${regexp}kpatches(\..*)?$/ } readdir(DEB);
  closedir(DEB);

  # next package if there are no patches in there
  next PACKAGE if $#files < 0;

  <process binary package $package>
}

The apply/unpatch scripts

They are not yet under noweb control.

Reading a kpatches control file

When reading a kpatches control file, we store its contents according the the v1-format model: a hash of general fields taken from the initial stance (eg. PatchName), a hash of default values also taken from the initial stance, and a sequence of alternative versions of the patch, each of which containing a sequence of operations to apply to the kernel tree: 

<initialise %patchinfo with skeleton structure>= (U->)
my %patchinfo = ('general' => {},
                 'defaults' => {},
                 'alternatives' => []);

We provide a single entry-point to the controlfile reader, which will act in different ways according to the format-version.

If we have a v0 header, we migrate the relevant contents of the v0 header into the default-values section ot the %patchinfo structure, before going on reading. 

<definitions for the core kpatch system>= (<-U) [D->]
sub read_control_file {
  my ($file) = @_;

  <initialise %patchinfo with skeleton structure>

  open (IN, $file) or die "cannot open $file: $!";

  # read control-file header
  read_control_file_section ($patchinfo{general});

  if ((!defined $patchinfo{general}->{'kpatch-format-version'}) or
      ($patchinfo{general}->{'kpatch-format-version'} == 0)) {
    $patchinfo{defaults} = control_file_v0_header_to_v1_defaults ($patchinfo{general});
    <read v0 file content>

    # } elsif ($patchinfo{general}->{'kpatch-format-version'} == 1) {
    # Revision 1
    # Eh, not yet :)
  } else {
    die "Unsupported Kpatch-format-version: \`" .
      $patchinfo{general}->{'kpatch-format-version'} . "'";
  }

  close IN;

  validate (\%patchinfo);
  return %patchinfo;
}

A v0 kpatches file is just a list of alternatives, each composed of only one diff operation. We have to convert them into proper structures so that the v1-based processing works as expected. 

<read v0 file content>= (<-U)
my $cfs = {};
while (read_control_file_section ($cfs)) {
  push (@{$patchinfo{alternatives}},
        control_file_v0_section_to_alternative($cfs));
  $cfs = {};
}

The function that does the conversion simply maps known fields into their final location. 

<definitions for the core kpatch system>+= (<-U) [<-D->]
sub control_file_v0_section_to_alternative {
  my ($cfs) = @_;

  # FIXME: should also process general section, and convert default
  # values - probably in a similar function

  return {
          conditions => {
                         'kernel-version' => $cfs->{'kernel-version'},
                         'architecture' => $cfs->{architecture},
                        },
          depends => $cfs->{depends},
          defaults => {},
          operations => [
                         {
                          'format' => 'diff',
                          'diff-file' => $cfs->{'patch-file'},
                          'debian-diff-file' => $cfs->{'debian-patch-file'},
                          'path-strip-level' => $cfs->{'path-strip-level'},
                         }
                        ],
         };
}

The v0 header differs from the v1 header, in that "default" entries are implicit, and for a small well-defined set of fields. When reading a v0 header, we have to explicit them, and strip them from the general fields. 

<definitions for the core kpatch system>+= (<-U) [<-D->]
sub control_file_v0_header_to_v1_defaults {
  my ($header) = @_;
  my %defaults;

  foreach my $key (keys %{$header}) {
    if (! grep { $key eq $_ } ('patch-name', 'patch-id')) {
      $defaults{$key} = $header->{$key};
      delete $header->{$key};
    }
  }

  return \%defaults;
}

Once a %patchinfo structure has been filled, we can run some checks on it, to make as sure as possible that it is correct.

FIXME: this should do much more tests ! 

<definitions for the core kpatch system>+= (<-U) [<-D->]
sub validate {
  my ($patchinfo) = @_;

  die "Patch-Id can only contain alphanumerics, hyphens, and underscores"
    if $patchinfo->{general}->{'patch-id'} =~ /[^\w-]/;

  foreach my $alternative (@{$patchinfo->{alternatives}}) {
    foreach my $operation (@{$alternative->{operations}}) {
      die "Diff file does not exist: " . $operation->{'diff-file'}
        if ($operation->{format} eq 'diff') and ! -r $operation->{'diff-file'};
      die "Diff file changes EXTRAVERSION: " . $operation->{'diff-file'}
        if 0 == system ('grep -q "^-EXTRAVERSION\>" ' . $operation->{'diff-file'});
    }
  }
}

Reading a control-file section is something quite generic. Maybe there is a generic API for doing that now ?

This function slightly adapted from code in Adam Di Carlo's install-docs, and this is the main reason why it is not split into chunks. 

<definitions for the core kpatch system>+= (<-U) [<-D->]
sub read_control_file_section {
  my ($pfields) = @_;

  my $alreadyreadsomething = 0;
  my ($key,$value);
  while (<IN>) {
    chomp;

    # empty line?
    if (/^\s*$/o) {
      if ($alreadyreadsomething) {
        last;
      } else {
        next;
      }
    }

    $alreadyreadsomething = 1;

    if (/^(\S+)\s*:\s*(.*)$/) {
      # first line of a new field

      ($key,$value) = (lc $1,$2);
      #print STDERR "$key -> $value\n";
      if (exists $pfields->{$key}) {
        warn "warning: $key: overwriting previous setting of control field";
      }
      $pfields->{$key} = $value;

    } elsif (/^\s+(\S.*)$/) {
      # additional line in a multi-line field
      $value = $1;
      defined($key) or die "syntax error in control file: no field specified";
      #print STDERR "$key -> $value (continued)\n";
      $pfields->{$key} .= "\n$value";

    } else {
      die "syntax error in control file: $_";
    }
  }

  return $alreadyreadsomething;
}

Fields of kpatch files

There are 2 types of fields. Some are mandatory, some are optional. The optional ones can all be given a default value, but mandatory ones cannot use this inheritance mechanism -- hence the $FIELD_INHERITS name. 

<definitions for the core kpatch system>+= (<-U) [<-D->]
my $FIELD_MANDATORY = 0;
my $FIELD_INHERITS = 1;

Due to this inheritance mechanism, the final value of a field has to be computed according to given rules for inheritance and defaulting. $inherits should have one of the values defined above. $default can be undef when there's no default value for the field. 

<definitions for the core kpatch system>+= (<-U) [<-D->]
sub field_value {
  my ($general, $hash, $name, $inherits, $default, @defaultlists) = @_;

  my $value = $hash->{$name};
  if ($inherits == $FIELD_MANDATORY) {
    die "Patchfile info lacks $name field" unless defined $value;
  }
  # first go through explicit default values
  foreach my $defaultlist (@defaultlists) {
    $value = $defaultlist->{defaults}->{$name} unless defined $value;
  }
  # then use hardcoded default as a fallback
  if (defined $default) {
    $value = $default unless defined $value;
  }

  return $value;
}

This is simplest of all fields, nothing special is done apart from memorizing it. 

<compute 'path-strip-level' field>= (U->)
$op->{'path-strip-level'} = field_value ($patchinfo{general}, $op,
                                         'path-strip-level', $FIELD_INHERITS, 1,
                                         $alternative, \%patchinfo);

We record all archs mentionned in the kpatches file, so that we know for which archs we have to generate the apply/unpatch scripts. 

<compute and split 'architecture' field>= (U->)
{
 my @archfield =
 split (/, */, field_value ($patchinfo{general}, $alternative->{conditions},
                            'architecture', $FIELD_INHERITS, 'all',
                            \%patchinfo));
 $alternative->{conditions}->{architecture} = \@archfield;

 foreach my $arch (@archfield) {
   push @archs, $arch unless grep { $_ eq $arch } @archs;
 }
}

The kernel version can be specified either as a single version or as a range.

FIXME: how a is value "all" handled ? It seems filtered out by the test below... 

<compute 'kernel-version' value or range>= (U->)
{
  my $kversion = field_value ($patchinfo{general}, $alternative->{conditions},
                              'kernel-version', $FIELD_MANDATORY);
  # parse "2.4.5 - 2.4.7" and "2.5.4 -" syntaxes

  my @kv = split (/\s+/, $kversion);
  if ($#kv > 0) {
    # FIXME: validity check is really too strict, but we need a
    # good kversion comparison algorithm to attempt any better
    # (ie. "-pre" and "-test" at least are special)
    $kv[0] =~ m/^(\d+\.\d+)\.(\d+)$/ or die "Malformed kernel version: `$kv[0]'";

    my ($branch, $first) = ($1, $2);
    die "Malformed kernel-version range \`$kversion'"
      unless ($kv[1] eq '-') && ($#kv <= 2);
    if ($#kv == 1) {
      die "Unbounded ranges not supported yet: \`$kversion'";
      $kversion = [ $branch, $first ];
    } else {
      $kv[2] =~ m/^(\d+\.\d+)\.(\d+)$/ or die "Malformed kernel version: `$kv[2]'";
      die "Cross-branch ranges are not allowed: `$kversion'"
        unless $1 == $branch;
      die "Reverse-ordered range: `$kversion'" if $2 < $first;
      $kversion = [ $branch, $first, $2 ];
    }
  } else {
    $kv[0] =~ m/^(\d+\.\d+)\.(\d+)/ or die "Malformed kernel version: `$kv[0]'";
  }

  $alternative->{conditions}->{'kernel-version'} = $kversion;
}

Since the diff files may be compressed, we're only recording here their location in the source tree, and we're delaying the recording of their final filename until they're installed and maybe compressed. This will be done as we <install the diff files>. 

<compute (debian-)diff-file fields>= (U->)
$op->{'diff-file'} = field_value ($patchinfo{general}, $op,
                                  'diff-file', $FIELD_MANDATORY);
$op->{'debian-diff-file'} = field_value ($patchinfo{general}, $op,
                                         'debian-diff-file', $FIELD_INHERITS);

Depends is a comma- and space-separated list, and will be used in the bash apply script to initialize an array, so must be made space-separated only. 

<compute 'depends' field>= (U->)
$alternative->{depends} = field_value ($patchinfo{general}, $alternative,
                                       'depends', $FIELD_INHERITS, "",
                                       \%patchinfo);
$alternative->{depends} =~ s/, */ /g;

FIXME: should be put in a better place ? 

<definitions for the core kpatch system>+= (<-U) [<-D->]
# records a field value for a given patchfile on a given arch
sub record_patchfile_field {
  my ($hash, $arch, $value) = @_;

  if (defined $hash->{$arch}) {
    $hash->{$arch} .= " $value";
  } else {
    $hash->{$arch} = "$value";
  }
}

Patch processing

For each binary package, all kpatches files are processed to generate one apply with a single diff operation (and its corresponding unpatch script).

A kpatch:depends substvar is also generated. 

<process binary package $package>= (<-U)
<assert kpatch:depends is referenced in control file>

foreach my $file (@files) {
  my %patchinfo = read_control_file ("debian/$file");

  #   use Data::Dumper;
  #   print Dumper (%patchinfo);

  my $patchid = $patchinfo{general}->{'patch-id'};

  # transformation of the ID to be acceptable as part of an envvar's name
  $patchinfo{general}->{'clean-patch-id'} = $patchinfo{general}->{'patch-id'};
  $patchinfo{general}->{'clean-patch-id'} =~ s/-/_/g;

  # protect pipes and dquotes for sed command-line
  $patchinfo{general}->{'patch-name'} =~ s,([|\"]),\\$1,g;

  <generate apply/unpatch scripts for given $package and kpatches $file>
}

<set kpatch:Depends substvar>

In a single apply script, all alternatives are handled, and the one to use will be determined at runtime.

We currently support only one operation per alternative (v0 format), and if we stay with the current apply-script-in-package approach, we will most probably need to split out operations into per-operation apply scripts, maybe called by per-alternative mini-scripts, themselves called by the main apply script.

Or we use the opposite approach, namely to put everything including kpatches file parsing into a generic apply script, and have patch packages only symlink to this one. 

<generate apply/unpatch scripts for given $package and kpatches $file>= (<-U)
my %kversions=();
my %patchfiles=();
my %debpatchfiles=();
my %striplevels=();
my %depends=();
my @archs=();

# put the right files in the right places
foreach my $alternative (@{$patchinfo{alternatives}}) {
  <compute values for $alternative>
}
<output apply/unpatch scripts>

For each alternative, we compute the value to use for each field, possibly using a default value if none was provided, and in some cases splitting into an array. The final value is stored in the place of the original one.

Diff files thus identified are then installed, and entries for the diff files are then recorded for use when generating the apply/unpatch scripts for each of the named architectures.

There is no particular ordering required between the computation of the various fields, but to help moving towards v1 format, we group them by first handling those specific to the alternative itself, and then those specific to the single diff operation in this alternative. 

<compute values for $alternative>= (<-U)
<compute 'depends' field>
<compute and split 'architecture' field>
<compute 'kernel-version' value or range>

my $op = $alternative->{operations}->[0];
<compute 'path-strip-level' field>
<compute (debian-)diff-file fields>

<install the diff files>
<record the patch entry>

All diff files are now located under a single /usr/src/kernel-patches/diffs/ tree. 

<install the diff files>= (<-U)
my $srcdir = "/usr/src/kernel-patches/diffs/$patchid";
doit ("mkdir",  "-p", "$tmp$srcdir") unless -d "$tmp$srcdir";

$op->{'installed-diff-file'} = "$srcdir/" . basename($op->{'diff-file'});
doit ("cp", $op->{'diff-file'}, "$tmp$op->{'installed-diff-file'}");
doit ("gzip", "-9f", "$tmp$op->{'installed-diff-file'}");
$op->{'installed-diff-file'} = "$op->{'installed-diff-file'}.gz"
  if -r "$tmp$op->{'installed-diff-file'}.gz";

if (defined $op->{'debian-diff-file'}) {
  $op->{'installed-debian-diff-file'} = "$srcdir/" . basename($op->{'debian-diff-file'});
  doit ("cp", $op->{'debian-diff-file'}, "$tmp$op->{'installed-debian-diff-file'}");
  doit ("gzip", "-9f", "$tmp$op->{'installed-debian-diff-file'}");
  $op->{'installed-debian-diff-file'} = "$op->{'installed-debian-diff-file'}.gz"
    if -r "$tmp$op->{'installed-debian-diff-file'}.gz";
} else {
  $op->{'installed-debian-diff-file'} = '';
}

Version ranges are currently emulated, by duplicating the entry for each integer kernel revision in the range.

This is a temporary behaviour, which does not allow pre-release kernel versions to be seen as part of the range. Adequate version-comparison function and data-structures will be used instead, when time permits. 

<record the patch entry>= (<-U)
foreach my $arch (@{$alternative->{conditions}->{architecture}}) {
  if ((ref $alternative->{conditions}->{'kernel-version'}) eq 'ARRAY') {
    for (my $v = $alternative->{conditions}->{'kernel-version'}->[1];
         $v <= $alternative->{conditions}->{'kernel-version'}->[2];
         $v++) {
      record_patchfile_field (\%kversions, $arch, 
                              $alternative->{conditions}->{'kernel-version'}->[0] . '.' . $v);
      record_patchfile_field (\%striplevels, $arch, $op->{'path-strip-level'});
      record_patchfile_field (\%depends, $arch, '"' . $alternative->{depends} . '"');
      record_patchfile_field (\%patchfiles, $arch, '"' . $op->{'installed-diff-file'} . '"');
      record_patchfile_field (\%debpatchfiles, $arch, '"' . $op->{'installed-debian-diff-file'} . '"');
    }
  } else {
    record_patchfile_field (\%kversions, $arch, 
                            $alternative->{conditions}->{'kernel-version'});
    record_patchfile_field (\%striplevels, $arch, $op->{'path-strip-level'});
    record_patchfile_field (\%depends, $arch, '"' . $alternative->{depends} . '"');
    record_patchfile_field (\%patchfiles, $arch, '"' . $op->{'installed-diff-file'} . '"');
    record_patchfile_field (\%debpatchfiles, $arch, '"' . $op->{'installed-debian-diff-file'} . '"');
  }
}

apply and unpatch are currently generated from templates, by substituting in there the values computed from the patch definition expressed in the kpatches file. 

<output apply/unpatch scripts>= (<-U)
foreach my $arch (@archs) {
  my $pdir = "/usr/src/kernel-patches/$arch";
  foreach my $script ('apply', 'unpatch') {
    doit ("mkdir", "-p", "$tmp$pdir/$script");
    complex_doit ('sed < @TMPLDIR@/' . "$script.tmpl >$tmp$pdir/$script/$patchid" .
                  ' -e \'s/#PATCHID#/' . $patchinfo{general}->{'patch-id'} . '/g\'' .
                  ' -e \'s/#CLEANPATCHID#/' . $patchinfo{general}->{'clean-patch-id'} . '/g\'' .
                  ' -e \'s|#PATCHNAME#|' . $patchinfo{general}->{'patch-name'} . '|g\'' .
                  " -e 's/#DHKPVERS#/@DHKPVERS@/g'" .
                  " -e 's,#TMPLDIR#,@TMPLDIR@,g'" .
                  " -e 's/#DEPENDS#/$depends{$arch}/g'" .
                  " -e 's/#KVERSIONS#/$kversions{$arch}/g'" .
                  " -e 's|#PATCHFILES#|$patchfiles{$arch}|g'" .
                  " -e 's|#DEBPATCHFILES#|$debpatchfiles{$arch}|g'" .
                  " -e 's/#PATCHARCH#/$arch/g'" .
                  " -e 's/#STRIPLEVELS#/$striplevels{$arch}/g'"
                 );
    doit ("chmod", "0755", "$tmp$pdir/$script/$patchid");

    doit ("mkdir", "-p", "$tmp/usr/share/doc/$package");
    doit ('cp',
          '@TMPLDIR@/README-kernelpatch.Debian',
          "$tmp/usr/share/doc/$package/");
  }
}

kpatch:depends substvar

Those packages are needed by kernel-patch packages:

bash 2.x or better
because apply scripts use arrays
patch
because we only apply patches made of diff files
grep-dctrl
is used to register the version of the kernel-patch package into the kernel-image package 
<definitions for the core kpatch system>+= (<-U) [<-D]
my $pkgdeps = "bash (>= 2.0), patch, grep-dctrl";

The substvar code was derived from similar functionnality in dh_perl v3.4.1. For idempotency, we first remove anything this program might have previously added to the substvars file. 

<set kpatch:Depends substvar>= (<-U)
if (-e "debian/${ext}substvars") {
  complex_doit("grep -v ^kpatch:Depends= debian/${ext}substvars > debian/${ext}substvars.new || true");
  doit("mv", "debian/${ext}substvars.new","debian/${ext}substvars");
}

complex_doit("echo 'kpatch:Depends=$pkgdeps' >> debian/${ext}substvars");

We also make sure the package uses our substvar, and abort if not. 

<assert kpatch:depends is referenced in control file>= (<-U)
die 'debian/control must make package ' . $package . ' depend on ${kpatch:Depends}'
  if system ("dpkg-gencontrol -p$package -Pdebian -O -T/dev/null -Vkpatch:Depends=KPATCHISUSED |"
           . "grep -q '^Depends: .*KPATCHISUSED'") != 0;

Index of chunks

*