infra/dgit-repos-policy-debian

   1 #!/usr/bin/perl -w
   2 # dgit repos policy hook script for Debian
   3 #
   4 # usages:
   5 #   dgit-repos-policy-debian DISTRO DGIT-REPOS-DIR ACTION...
   6 # ie.
   7 #   dgit-repos-policy-debian ... check-list
   8 #   dgit-repos-policy-debian ... check-package PACKAGE
   9 #   dgit-repos-policy-debian ... push PACKAGE \
  10 #         VERSION SUITE TAGNAME DELIBERATELIES [...]
  11 #
  12 # cwd for push is a temporary repo where the to-be-pushed objects have
  13 #  been received; TAGNAME is the version-based tag
  14 #
  15 # policy hook for a particular package will be invoked only once at
  16 # a time
  17
  18 use strict;
  19 use POSIX;
  20 use JSON;
  21
  22 use Debian::Dgit qw(:DEFAULT :policyflags);
  23
  24 our $distro = shift @ARGV // die "need DISTRO";
  25 our $repos = shift @ARGV // die "need DGIT-REPOS-DIR";
  26 our $action = shift @ARGV // die "need ACTION";
  27 our $pkg = shift @ARGV;
  28
  29 # We assume that it is not possible for NEW to have a version older
  30 # than sid.
  31
  32 # Whenever pushing, we check for
  33 #   source-package-local tainted history
  34 #   global tainted history
  35 #   can be overridden by --deliberately except for an admin prohib taint
  36 #
  37 # ALL of the following apply only if history is secret:
  38 #
  39 # if NEW has no version, or a version which is not in our history[1]
  40 #   (always)
  41 #   check all suites
  42 #   if any suite's version is in our history[1], publish our history
  43 #   otherwise discard our history,
  44 #     tainting --deliberately-include-questionable-history
  45 #
  46 # if NEW has a version which is in our history[1]
  47 #   (on push only)
  48 #   require explicit specification of one of
  49 #     --deliberately-include-questionable-history
  50 #     --deliberately-not-fast-forward
  51 #       (latter will taint old NEW version --d-i-q-h)
  52 #   (otherwise)
  53 #   leave it be
  54 #
  55 # [1] looking for the relevant git tag for the version number and not
  56 #    caring what that tag refers to.
  57
  58 sub apiquery ($) {
  59     my ($subpath) = @_;
  60     local $/=undef;
  61     $!=0; $?=0; my $json = `dgit -d $distro archive-api-query $subpath`;
  62     defined $json or die "$subpath $! $?";
  63     return decode_json $json;
  64 }
  65
  66 sub new_has_vsn_in_our_history () {
  67     my $in_new = apiquery "/dsc_in_suite/new/$pkg";
  68     foreach my $entry (@$in_new) {
  69         my $vsn = $entry->{version};
  70         die "$pkg ?" unless defined $vsn;
  71         my $tag = debiantag $vsn;
  72         $?=0; my $r = system qw(git show-ref --verify --quiet), $tag;
  73         return 1 if !$r;
  74         next if $r==256;
  75         die "$pkg tag $tag $? $!";
  76     }
  77     return 0;
  78 }
  79
  80 sub selectpackage () {
  81     die if $pkg =~ m#^-#;
  82     die if $pkg =~ m#[^-+.0-9a-z]#;
  83
  84     if (!chdir "$repos/$pkg") {
  85         die "$pkg $!" unless $!==ENOENT;
  86         # something
  87     }
  88     stat "." or die $!;
  89     if (~(stat _)[2] & 05) {
  90         # secret history
  91     }
  92
  93 }
  94
  95 if (defined $pkg) {
  96     selectpackage;
  97 }
  98
  99 sub action_push () {
 100
 101 }
 102
 103 my $fn = ${*::}{"action_$cmd"};
 104 $fn or die "unknown ACTION";
 105 $fn->();