#! /bin/bash
#
# usage:
#     tag2upload-obtain-origs <setting>=<value> ...
#
#     Writes tag2upload report information to stdout;
#     errors and executed commands to stderr.
#     
# ATTENTION!  This program lives is in the tag2upload builder image,
# but is called by dgit-repos-server on the tag2upload oracle.
# Maintain compatibility and attend to deployment order.
# See dgit-infra-notes-scripts/services-diagram.pdf.
#
# settings:
#
#     v=VERSION-REVISION
#     p=PACKAGE
#     s=SUITE
#     u=UPSTREAM-COMMITID
#     pristine_tar=PRISTINE-TAR-COMMITID
#
# optional settings:
#
#     bpd                          defaults to ../bpd
#
# Exit status
#
#   Nonretriable errors:
#
#     1     unexpected error in mv, printf, etc.
#           sha256 checksum failed, failed to regenerated required orig
#
#     16    bad configuration or bad arguments (nonretriable error)
#
#     any other (not specially handled)
#
#   Retriable errors:
#
#     75    dgit download-unfetched-origs failed (might be network
#           trouble, or required service unavailable).
#           (EX_TEMPFAIL from sysexits.h)

# Rune for local testing of pristine-tar support without accessing archive:
#
# DGIT_DRS_DGIT='perl -e exit(4) --' ~/things/Dgit/dgit/using-these tag2upload-obtain-origs pristine_tar=$(git-rev-parse pristine-tar) v=1.0-1 p=example s=unstable u=$(git-rev-parse upstream/1.0) bpd=..

# We rely on nothing exiting 75 (EX_TEMPFAIL) when it doesn't mean it
set -eu${DGIT_TEST_T2UOO_DEBUG=} -o pipefail
shopt -s inherit_errexit # #514862, wtf

prtrar-to-command-ignore () {
    # avoid tar getting SIGPIPE
    cat >/dev/null
    exit 0
}

# Do this before loading our shell functions; it's reinvoked once per file!
if [ "x${1-}" = x--reinvoked-by-tar-to-command ]; then
    shift
    treeid="$1"

    # It is very important that nothing is ignored here that
    # the tarball processing below expects us to check.
    # If there were, a weird tarball could smuggle an unchecked file.
    #
    # So, we process everything that is a file whose name contains a `/`
    case "$TAR_FILETYPE" in
	f) ;;
	*) prtrar-to-command-ignore ;;
    esac
    case "$TAR_REALNAME" in
	*/*) f="${TAR_REALNAME#*/}" ;;
	*) prtrar-to-command-ignore ;;
    esac

    # On error, identify the problematic filename
    trap '
        set +e
        fq=$(perl -we '\''
            use Debian::Dgit::Core;
            print messagequote $ARGV[0];
        '\'' -- "$f")
        echo >&2 "pristine-tar .id file and $TAR_ARCHIVE disagree about $fq ?"
        cat <&3 >/dev/null # stop tar getting SIGPIPE
        exit 1
    ' EXIT

    # This pratting around with fd 3 allows us to avoid a temporary file
    exec 3<&0
    git cat-file blob "$treeid:$f" | cmp - /dev/fd/3

    # All OK
    trap '' EXIT
    exit 0
fi

us="$(basename "$0")"
sharedir=/usr/share/dgit ###substituted###
. "$sharedir"/dgit-functions.sh

parse-args-settings "$@"

uversion="${s_v%-*}" # strip revision
fversion="${uversion#*:}" # strip epoch

tmp="$(git rev-parse --git-dir)"
tmp+=/dgit/t2uoo
rm -rf "$tmp"
mkdir -p "$tmp"
tmp_abs=$(realpath -L -- "$tmp")

set +e
run-dgit download-unfetched-origs			\
	 --write-sha256sums="$tmp"/origs.sha256sums
rc=$?
set -e

need_checksums_check=false

case "$rc" in
    0)
	report 'using existing orig(s)'
	exit 0
	;;
    3)
	need_checksums_check=true
	report \
 'some orig(s) not available from archive mirrors, trying to regenerate'
	;;
    4)
	report 'no orig(s) in archive, generating'
	;;
    5)
	report \
'conflicting orig(s) in archive, regenerating, hoping to reproduce a good one'
	;;
    6|8|12)
	fail "unexpected exit status $rc from dgit download-unfetched-origs"
	;;
    *)
	tempfail "failed querying archive for existing orig(s), status $rc"
	;;
esac

if [ "x${s_pristine_tar-}" = x ]; then

    # TODO want git-deborig to support bpd
    x ${DGIT_DEBORIG_TEST-git deborig} "$s_u"
    mv ../"${s_p}_${fversion}.orig".* "$s_bpd"/

else

    # We could use origtargz to do this, but we want to know precisely
    # what we're doing.  So we reimplement it.

    git update-ref refs/heads/pristine-tar "$s_pristine_tar"

    # Our approach:
    #
    #  * Look for .id, .delta and .asc files in the pristine-tar commit,
    #    that are apparently-relevant (filename starts with the right thing)
    #
    #  * That tells us which tarballs we want to try to generate.
    #    We ignore the files with other extensions.
    #    We trust pristine-tar (and future updates to it) not to
    #    stick such things in its eye.
    #
    #  * Ask pristine-tar to generate each such tarball.
    #
    #  * Verify each tarball against its .id file as follows:
    #
    #    - Run tar --quoting-style=c --to-command=SELF -avvxf ...
    #      This does two things, at once:
    #        (1) writes an unambiguous listing to stdout
    #        (2) pipes every plain file to SELF
    #
    #    - Parse the output.  (This is very annoying.)
    #      Discard entries for directories and fifos.
    #      Check that there's precisely one subdir in the tarball.
    #      Check entries for symlinks against the git tree in the .id file.
    #      Check permissions of files (also against the git tree).
    #      Output a list of paths that should be in git (files and symlinks).
    #
    #    - Compare the file list from the tarball with git-ls-tree.
    #
    #    - SELF is
    #          tag2upload-obtain-origs --reinvoked-by-tar-to-command TREEID
    #      We check the *contents* of *files* using git-cat-file and cmp.
    #      This check ignore non-file objects (TAR_FILETYPE not f)
    #      (which current tar doesn't process anyway).
    #
    #    - Fine point - filename mapping:
    #      Paths in the tarball must be in the form SUBDIR or SUBDIR/GIT-PATH
    #      where GIT-PATH is the path within the .id file's tree object.
    #      So during both processes above, we strip a single SUBDIR
    #      from the front of the path.
    #      The tar vv parser insists that there's *one* such SUBDIR.
    #      The SELF invocation has to be stateless so does not; it simply
    #      strips the first path component (and ignores entries with no /).
    #
    #    After all this we know that the individual tarball contents are good
    #    and correspond to the .id file.
    #
    #  * Construct a synthetic git tree object out of all each of the
    #    relevant subtree ids (from the id files) and diff it
    #    against our upstream commitish.
    #
    # See below for rationale for our approach to tarball parsing.

    # Security considerations
    #
    # The data we are processing here has been found via a tag signed by a
    # Debian uploader.  The precise pristine-tar commit is named in the
    # uploader's tag.  However, in practice, we think that many uploaders do
    # not perform any meaningful checks; indeed, pristine-tar data is pretty
    # difficult to make sense of without running pristine-tar, and (as you can
    # see below) carefully inspecting a tarfile is also quite difficult
    # (although, easier in specific situations, where you know more about what
    # you're expecting).
    #
    # So we try to defend our downstreams (principally, dgit-repos and the
    # archive) from anomalies smuggled via the pristine-tar branch.
    #
    # That's the main reason for all these checks.  The result is supposed to
    # ensure that (modulo a few minor possible differences mentioned in
    # tag2upload(5)) the tarballs are not only reasonable, but also imply git
    # trees which are identical to the "upstream" git tree that the user is
    # using.
    #
    # We also insist that the .id files match the tarballs.  pristine-tar does
    # not insist on this, but its usual use via gbp import-orig will always
    # produce such a correspondence.
    #
    # The tag2upload service is not supposed to execute code from the input
    # git information or the source package.  So the code that follows is not
    # supposed to be subornable by weird input.

    prtar_items=$(git ls-tree -z refs/heads/pristine-tar | perl -0we '
        use warnings;
        use strict;
	use Debian::Dgit::Core;

	$debuglevel = length $ENV{DGIT_TEST_T2UOO_DEBUG};
	$debugprefix = "T2UOO PRTAR ITEMS ";
	open DEBUG, ">&2";

        our $fprefix = "'"${s_p}_${fversion}.orig"'";
	our %out; # $out{$comp}{$name}{$ext} = COUNT

	while (<>) {
	    s/\0$// or die;
	    my ($type, $name) = split /\t/, $_, 2;
	    printdebug "data: $type; $name\n";

	    next unless substr($name, 0, length $fprefix) eq $fprefix;

	    # File seems relevant
	    my $rhs = substr($name, length $fprefix);
	    printdebug "data: $type; $name, relevant, rhs=$rhs\n";

	    die
 "apparently-relevant pristine-tar info $name is not a non-excutable file\n"
		unless $type =~ m/^100644 blob /;

	    die sprintf
 "apparently-relevant pristine-tar git object with byte 0x%02x in its name\n",
		ord $&
		if $name =~ m/[^-+_.0-9a-zA-Z]/;

	    # From here on we know $name is completely shell safe.
	    # We are going to emit it in a fragment the shell will eval!

	    if ($name =~ m/\.asc$/) {
                printdebug "data: $type; $name, signature\n";
		print "signatures+=($name)\n";
		next;
	    }

	    $name =~ m/\.(id|delta)$/
		or next;
	    my $ext = $1;
	    my $tarball = $`;

	    my $comp =
		$rhs =~ m/^\.tar\./ ? "." :
		$rhs =~ m/-((?!-)[-0-9a-zA-Z]+)\.tar\./ ? $1 :
		die
 "apparently-relevant pristine-tar info $name with unsupported filename\n";

            printdebug "data: $type; $name, tarball comp=$comp .$ext\n";

	    $out{$comp}{$tarball}{$ext}++;
        }

	defined $out{"."} or die
"no pristine-tar data for $fprefix.tar*\n";

	foreach my $comp (sort keys %out) {
	    my ($tarball, @wrong_extra) = keys %{ $out{$comp} };
	    printdebug "out: comp=$comp tarball=$tarball wrong=@wrong_extra\n";
	    @wrong_extra == 0 or die
"pristine-tar data contains multiple conflicting $fprefix*.tar* for component '\''$comp'\''\n";
	    foreach my $ext (qw(id delta)) {
		my $count = $out{$comp}{$tarball}{$ext};
		$count or die
"pristine-tar data file $tarball.$ext missing\n";
		$count == 1 or die "internal error $count $comp $tarball";
	    }
	    print "tarball_infos+=(\"comp=$comp tarball=$tarball\")\n";
	}
    ')
    eval "$prtar_items"

    for info in "${tarball_infos[@]}"; do
	eval "$info"

	# Read the .id file
	id_file=$tarball.id
	id=$(git cat-file blob -- pristine-tar:$id_file)
	case "$id" in
	    ''|*[^0-9a-f]*) fail "unexpected data in pristine-tar $id_file";;
	esac

	# Run pristine-tar
	x pristine-tar checkout -- "$s_bpd"/"$tarball"

	echo "tag2upload-obtain-origs: checking generated tarball $tarball"

	# Process the tarball
	#
	# This is pretty nasty.  It is actually quite difficult to thoroughly
	# check the contents of a tarfile.  We could extract the tarball
	# to the filesystem but then we'd be inspecting the filesystem
	# which is not going to be significantly easier (we'd end up with
	# some pretty gnarly find runes, probably).  We could use a tar
	# parsing library, but we want to parse the tarball the same way
	# that dpkg-source does - ie, using GNU tar.
	#
	# GNU tar does offer us two things which together are sufficient.
	# The -vv output when used with -x goes to stdout, not stderr,
	# and the format is documented and can be parsed.
	# The information is sufficient for everything except file contents.
	# And the --to-command option lets us check the file contents.

	# Fine points:
	#
	# Using tar ax here means we will ignore anything after the
	# end of the first compressed component - but that's what
	# dpkg and tar normally do.  So I guess it's OK?
	#
	# --numeric-owner so that our parser can't get confused by any weird
	# user or group strings.
	#
	# --absolute-names stops our tar from stripping / off, so that we
	# can see them if they're there and reject them.
        DGIT_TEST_T2UOO_DEBUG=${DGIT_TEST_T2UOO_DEBUG#x}	\
	tar --quoting-style=c --numeric-owner --absolute-names	\
	    --to-command="$0 --reinvoked-by-tar-to-command $id"	\
	     -avvxf "$s_bpd"/"$tarball"				\
        | perl -wne '
	    use warnings;
            use strict;
            use Debian::Dgit;

	    our ($tree, $f, $org_f);
            BEGIN {
                open DEBUG, ">&2" or die $!;
                DEBUG->autoflush(1);
		$debugprefix = "T2UOO TAR VV PARSE ";
                $debuglevel = length $ENV{DGIT_TEST_T2UOO_DEBUG};
                $Data::Dumper::Indent = 0;
                $tree = "'"$id"'";
            }

	    sub dprint {
                return unless $debuglevel >= 1;
		my $o = shift @_;
                foreach (@_) {
                    $o .= " ";
		    my $s = $_;
                    $s =~ s{(\\|[^!-~])}{ sprintf "\\x%02x", ord $& }ge;
                    $o .= $s;
                }
		printdebug $o."\n";
            }

	    sub consume_dequote_filename_after_quote () {
                local $debuglevel = $debuglevel-1;
		my $o = "";
		my $o_chr = sub {
		    my ($c) = @_;
                    # One would hope tar would defend us from this, but
                    # I do not trust it, and it is hard to test for.
		    die "filename in tarball contains nul byte\n" unless $c;
                    $o .= chr $c;
                };
		while (!s/^"//) {
                    dprint "F PARSE 1 ", "o=$o", "_=$_";
            '"$(for esc in a b e f n r t; do echo '
		    s/^\\'$esc'// ? $o .= "\'$esc'" :
            '; done)"'
		    s/^\\v// ? $o .= "\x0b" : # perl has no \v
		    s/^\\([0-7]{1,3})// ? $o_chr->(oct $1) :
		    s/^\\x([0-9a-f]{1,2})//i ? $o .= $o_chr->(hex $1) :
		    # strip the \: " ? \ and single quote
		    s/^\\(["?\\'\''])// ? $o .= "$1" :
		    # passthrough: ascii printing except \ ", plus space
		    s/^[]-~ !#-[]+// ? $o .= $& :
		    die "unexpected c-quoted (or unquoted) in tar output";
		}
                dprint "F PARSE E ", "o=$o", "_=$_";
                return $o;
            }

	    dprint "IN| ", $_;
	    s/^(\S+) [^"]+"// or die "unexpected tar vv output";
	    my $mode = $1;
	    $f = consume_dequote_filename_after_quote();
	    $org_f = $f;

	    sub bad {
                die "unexpected contents: ".(messagequote $org_f).": @_\n";
	    };

	    my $rwx_re = qr{[r-][w-][x-]};
	    $mode =~ m/^.$rwx_re{3}$/ or
	    $mode =~ m/^d$rwx_re[r-][w-][xsS-]$rwx_re$/ or
    	        bad "forbidden file permissions: $mode";

            # Important: changing the filename processing here requires
            # also changing it above, in --reinvoked-by-tar-to-command.

            our $subdir;
	    my $tsubdir;
	    if ($f =~ m{^[./]}) {
                bad "path in tarball may not start with . or /";
            } elsif ($f =~ m{/}) {
	        $tsubdir = $`;
		$f = $'\'';
            } else {
                $mode =~ m/^d/ or bad
		    "top-level object not a directory, might be a tarbomb?";
                $tsubdir = $_;
                $f = undef;
            }
            if (defined $subdir) {
                $tsubdir eq $subdir or bad
                    "first directory part varies - tarfile is a tarbomb";
            } else {
                $subdir = $tsubdir;
            }

            my $file_in_tree = sub {
                my $gitmode = $mode =~ m/^..*x/ ? "100755" : "100644";
		# Matches massaged git-ls-tree output, below
                print STDOUT "$gitmode blob\t$f\0" or die $!;
            };

	    if ($mode =~ m/^[dp]/) {
                # directory or fifo - unchecked, ignore
	    } elsif ($mode =~ m/^-/) {
                # plain file - contents checked via --to-command
		$file_in_tree->();
	    } elsif ($mode =~ m/^l/) {
                s/^ -\> "// or die "tar symlink output without `->`";
                my $tar_target = consume_dequote_filename_after_quote();
                my $git_target = git_cat_file "$tree:$f", "blob";
                $tar_target eq $git_target
		    or bad "link target differs between tar and git";
                print STDOUT "120000 blob\t$f\0" or die $!;
	    } elsif ($mode =~ m/^h/) {
	        s/^ link to "// or die "tar hardlink, but no target";
		my $target = consume_dequote_filename_after_quote();
		$target =~ s{^([^/]+)/}{};
		$1 eq $subdir or die "hardlink to outside of tarfile!";
		# Check that the two sets of file contents are the same.
                # (tar does not send it to --to-command)
		my $get_info = sub {
		    my ($g) = @_;
                    my $i = cmdoutput (qw(git ls-tree -z), "$tree:", "--", $g);
                    $i =~ s/\0$// or bad
		        "hardlink, missing ".(messagequote $g);
		    $i =~ m/\0/ and die;
                    $i =~ m/\t/ or die;
                    return $`;
		};
                my $f_info = $get_info->($f);
                my $t_info = $get_info->($target);
		$f_info eq $t_info
                    or bad "hardlink target has different contents in git";
		$f_info =~ m/ \w+$/;
                print STDOUT "$`\t$f\0" or die $!;
            } else {
	        bad "forbidden object type: $mode";
            }
            s/\n$// or die "tar output contains unexpected info";

            END { flush STDOUT or die $!; }
        '					\
        | sort -z				\
        > "$tmp/files-list-tar"

	# Ideally we would use
	#   git ls-tree -r --format='%(objectmode)%x09%(path)' -z ...
	# but --format re-enables the filename quoting that -z turns off.
        git ls-tree -r -z "$id:"		\
        | perl -0wpe 's/^(\S+ \S+) \S+\t/$1\t/'	\
        | sort -z				\
        > "$tmp/files-list-git"

	if ! cmp -- "$tmp/files-list-"{git,tar}; then
	    show-files-list () { perl -pe 's/\0/\n/g' "$tmp/files-list-$1"; }
	    diff -u						\
		 --label "git@$id:/" <(show-files-list git)	\
		 --label "$tarball/" <(show-files-list tar)	\
		 | cat -v					\
		 || :
	    fail 'file list in tarball does not match file list in git'
	fi

	# Add this component to the tree we're building.
	# Extra components come after, so they overwrite contents for
	# their subdirectories: git-mktree does this just like dpkg-source.
	if [ "x$comp" = x. ]; then
	    git ls-tree -z "$id" >"$tmp"/reconstruct-tree
	else
	    printf "040000 tree %s\t%s\0" "$id" "$comp" \
		   >>"$tmp"/reconstruct-tree
	fi

    done

    echo "tag2upload-obtain-origs: checking implied upstream tree"

    expected_tree=$(git rev-parse "$s_u:") # rev-parse doesn't understand -- !
    reconstructed_tree=$(git mktree -z <"$tmp"/reconstruct-tree)

    if [ "x$reconstructed_tree" != "x$expected_tree" ]; then
	fail 'upstream tarball contents are not treesame to upstream commit'
    fi

    # Signatures

    for asc in "${signatures[@]}"; do
	echo "tag2upload-obtain-origs: extracting tarball signature file $asc"
	git cat-file blob "pristine-tar:$asc" >"$s_bpd"/$asc
    done

    # Now everything has been regenerated using pristine-tar.
    # We still might want to check it against the archive.

fi

report 'created orig'

if $need_checksums_check; then
    set +e
    (
	set -e
	cd "$s_bpd"
	sha256sum >&2 -c <"$tmp_abs"/origs.sha256sums
    )
    rc=$?
    set -e
    if [ $rc = 0 ]; then
	report 'successfully regenerated orig'
    else
	tempfail 'regenerated orig does not match; hopefully the real orig will become available'
    fi
fi

exit 0
