dh-kpatches 0.99.36+nmu1 / usr / bin / dh_installkpatches

#!/usr/bin/perl -w
#
# dh_installkpatches $Revision: 1.17.1.4.1.24.1.5 $
#
# 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();

my $pkgdeps = "bash (>= 2.0), patch, grep-dctrl";

# Irregular kernel versions by branch, and their predecessor and successors.
# (Key is the predecessor, value is an array ref;
#  contains the irregular version itself and the successor.)
my %irregular_kversions = (
  # "2.6" => {
  #   "8" => [ "8.1", "9" ]
  # }
);

# Gives back an array containing all the kernel versions
# from $branch.".".$start to $branch.".".$end (inclusive).
# Handles some irregular versions correctly, but depends on
# the monotonic numeric relation of successive versions.
sub iterate_over_kversions {
  my ($branch, $start, $end) = @_;
  my @ret;

  my $v = $start;
  while ($v <= $end) {
    push @ret, $branch . "." . $v;
    if (exists $irregular_kversions{$branch}->{$v}) {
      if ($irregular_kversions{$branch}->{$v}[0] <= $end) {
        push @ret, $branch . "." . $irregular_kversions{$branch}->{$v}[0];
        $v = $irregular_kversions{$branch}->{$v}[1];
      } else {
        last;
      }
    } else {
      $v++;
    }
  }

  return @ret;
}
sub read_control_file {
  my ($file) = @_;

  my %patchinfo = ('general' => {},
                   'defaults' => {},
                   'alternatives' => []);

  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});
    my $cfs = {};
    while (read_control_file_section ($cfs)) {
      push (@{$patchinfo{alternatives}},
            control_file_v0_section_to_alternative($cfs));
      $cfs = {};
    }

    # } 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;
}
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'});
    }
  }
}
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;
}
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'},
                         }
                        ],
         };
}
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;
}
my $FIELD_MANDATORY = 0;
my $FIELD_INHERITS = 1;
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;
}
# 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";
  }
}

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;

  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 2>/dev/null |"
             . "grep -q '^Depends: .*KPATCHISUSED'") != 0;

  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;

    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}}) {
      my $op = $alternative->{operations}->[0];
      $alternative->{depends} = field_value ($patchinfo{general}, $alternative,
                                             'depends', $FIELD_INHERITS, "",
                                             \%patchinfo);
      $alternative->{depends} =~ s/, */ /g;
      {
       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;
       }
      }
      {
       # pattern matching any kernel version (marks branch as $1 and version as $2)
       my $ranged_kversion_pattern  = qr/^(\d+\.\d+)\.(\d+(?:\.\d+)?)$/;
       my $minimal_kversion_pattern = qr/^(\d+\.\d+)\.(\d+(?:\.\d+)?)/;

        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] =~ $ranged_kversion_pattern 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] =~ $ranged_kversion_pattern 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] =~ $minimal_kversion_pattern or die "Malformed kernel version: `$kv[0]'";
        }

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

      $op->{'path-strip-level'} = field_value ($patchinfo{general}, $op,
                                               'path-strip-level', $FIELD_INHERITS, 1,
                                               $alternative, \%patchinfo);
      $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);
      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", "-9fq", "$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", "-9fq", "$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'} = '';
      }
      foreach my $arch (@{$alternative->{conditions}->{architecture}}) {
        if ((ref $alternative->{conditions}->{'kernel-version'}) eq 'ARRAY') {
          my @kernel_version = @{$alternative->{conditions}->{'kernel-version'}};
          foreach my $version (iterate_over_kversions($kernel_version[0], $kernel_version[1], $kernel_version[2])) {
            record_patchfile_field (\%kversions, $arch, $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'} . '"');
          }
        } 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'} . '"');
        }
      }
    }
    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 < /usr/share/debhelper/dh-kpatches/' . "$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#/0.99.36+nmu1/g'" .
                      " -e 's,#TMPLDIR#,/usr/share/debhelper/dh-kpatches,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',
              '/usr/share/debhelper/dh-kpatches/README-kernelpatch.Debian',
              "$tmp/usr/share/doc/$package/");
      }
    }
  }

  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");
}