#! /usr/bin/perl

use strict;
use warnings;
use Getopt::Long qw(:config bundling no_ignore_case);

my $help = 0;
my $build_binary = 1;
my $batch = 0;
my $builddir;
my $build_number;
GetOptions ("h|help" => \$help);

usage () if $help;

sub usage {
    print <<EOF;
$0, for importing a tarball as a Git branch or tag
usage: $0 [OPTIONS] TARBALL REFNAME
where TARBALL is the name of a tarball
  and REF is a Git tag (refs/tags/...) or branch (refs/heads/...).

Options:
  --help            Print this usage message and exit
EOF
    exit(0);
}

die "$0: exactly two nonoption arguments are required (use --help for help)\n"
  if @ARGV != 2;

our $tarball = $ARGV[0];
our $refname = $ARGV[1];
die "$0: \"$refname\" does not start with refs/tags or refs/heads\n"
  if $refname !~ /^refs/(tags|heads)/;

my $branch = $ENV{'branch'};
$branch = "refs/heads/$branch" if $branch !~ m(/);
my $new_branch = system("git rev-parse --verify $branch >/dev/null 2>&1") != 0;

open(MESSAGE, '<', $ARGV[0]) or die "$ARGV[0]: open: $!\n";
my $message = join('', <MESSAGE>);
close(MESSAGE);

my $mark = 1;
our $offset = 0;
my @commit;
my @metadata;
my @gitignore;
for (;;) {
    my (%member) = read_tar_header();
    last if !%member;
    next if $member{NAME} eq '.'; # Skip root directory.

    my $type = $member{TYPE};

    # Add to Git commit, if it's a file type that Git supports, or
    # make Git ignore it otherwise.
    if ($type eq '-') {
        my ($gitmode) = $member{MODE} & 0111 ? "755" : "644";
        push(@commit, "M $gitmode :$mark $member{NAME}\n");

        my $size = $member{SIZE};
        print "blob\n";
        print "mark :", $mark++, "\n";
        print "data $size\n";
        my $remaining = $size;
        while ($remaining > 0) {
            my $chunk = $remaining > 65536 ? 65536 : $remaining;
            my $data = read_fully($chunk);
            print $data;
            $remaining -= $chunk;
        }
        read_fully(512 - $size % 512) if $size % 512;
        print "\n";
    } elsif ($type eq 'l') {
        push(@commit, "M 120000 :$mark $member{NAME}\n");

        print "blob\n";
        print "mark :", $mark++, "\n";
        print "data ", length($member{LINKNAME}), "\n";
        print $member{LINKNAME}, "\n";
    } elsif ($type eq 'd') {
        # We don't do anything about directories.  In particular,
        # ignoring them is a bad idea because files added under them
        # will then also be ignored.
    } else {
	print STDERR "$member{NAME}: Git cannot represent tar member of type '$type', ignoring\n"
    }
}

my $commit = $mark++;
print "commit $branch\n";
print "mark :$commit\n";
print "committer $ENV{GIT_COMMITTER_NAME} <$ENV{GIT_COMMITTER_EMAIL}> ",
  time(), " +0000\n";
print "data ", length($message), "\n";
print $message, "\n";
print "merge $branch^0\n" if !$new_branch;
print "deleteall\n";
print $_ foreach @commit;
print "\n";

sub check_header {
    my ($header) = @_;
    my $magic = substr($header, 257, 5);
    my $version = substr($header, 263, 2);
    my $chksum = oct(substr($header, 148, 8));
    if (checksum($header) != $chksum) {
        fail("$tarball: bad header checksum (is this a tar archive?)");
    }
    return $header;
}

sub checksum {
    my ($header) = @_;
    substr($header, 148, 8) = ' ' x 8;
    my $chksum = 0;
    $chksum += ord($_) foreach split('', $header);
    return $chksum;
}

sub read_fully {
    my ($nbytes) = @_;
    my $data = '';
    while (length($data) < $nbytes) {
        my $chunk = $nbytes - length($data);
        my $bytes_read = sysread(STDIN, $data, $chunk, length($data));
        $offset += $bytes_read;
        fail("$tarball: read error: $!") if !defined($bytes_read);
        fail("$tarball: unexpected end of file") if !$bytes_read;
    }
    return $data;
}

sub zero_header_size {
    my ($header) = @_;
    substr($header, 124, 12) = ("0" x 11) . "\0";
    substr($header, 148, 8) = sprintf("%07o", checksum($header)) . "\0";
    return $header;
}

sub fail {
    my ($msg) = @_;
    $msg =~ s/\n$//;
    die "$msg at $tarball offset $offset\n";
}

sub normalize_name {
    my ($name) = @_;
    fail("$tarball: contains file with empty name or linkname") if $name eq '';
    fail("$tarball: contains file with .. in name")
      if grep($_ eq '..', split('/', $name));
    $name = join('/', grep($_ ne '' && $_ ne '.', split('/', $name)));
    $name = '.' if $name eq '';
    return $name;
}

sub read_tar_header {
    my ($header, $type, $name, $linkname);
    for (;;) {
        $header = read_fully(512);
        return () if $header eq "\0" x 512;
        check_header($header);

        $type = substr($header, 156, 1);
        last if $type !~ /[KL]/;

        my ($size) = oct(unpack("Z*", substr($header, 124, 12)));
        fail("bad longname size $size") if $size < 0;

        my ($string) = read_fully($size);
        read_fully (512 - $size % 512) if $size % 512;
        ($type eq 'L' ? $name : $linkname) = $string;
    }

    # Normalize type.
    if ($type =~ /[70\0]/) {
        $type = '-';
    } elsif ($type !~ tr/123456/hlcbdp/) {
        fail("unknown file type '$type'");
    }

    # Get name and linkname, if we didn't already.
    if (!defined($name)) {
        $name = unpack("Z100", $header);
        my ($prefix) = unpack("Z*", substr($header, 345));
        $name = "$prefix/$name" if $prefix ne '';
    }
    $linkname = unpack("Z*", substr($header, 157, 100)) if !defined($linkname);

    # Normalize name.
    $name = normalize_name($name);
    $linkname = normalize_name($linkname) if $type eq 'h';

    # Get size.
    my ($size) = oct(unpack("Z*", substr($header, 124, 12)));
    fail("bad size $size") if $size < 0;
    $size = 0 if $type eq 'd';

    # Get other information.
    my ($mode) = oct(substr($header, 100, 8));
    my ($mtime) = oct(substr($header, 136, 12));

    if ($type !~ /[-hlcbdp]/) {
        # Read and discard any data.
        my $remaining = int($size / 512) * 512;
        $size += 512 if $size % 512;
        while ($remaining > 0) {
            my $chunk = $remaining > 65536 ? 65536 : $remaining;
            my $data = read_fully($chunk);
            $remaining -= $chunk;
        }
    }

    return (TYPE => $type,
            NAME => $name,
            MODE => $mode,
            MTIME => $mtime,
            SIZE => $size,
            LINKNAME => $linkname,
            TYPE => $type);
}