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