#! /usr/bin/perl

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

my $help = 0;
my $message_file;
my $message;
GetOptions ("F=s" => \$message_file,
	    "m=s" => \$message,
	    "h|help" => \$help);

usage () if $help;

sub usage {
    print <<EOF;
$0, for importing a tarball as a Git branch
usage: $0 [OPTIONS] TARBALL BRANCH
where TARBALL is the name of a tarball and BRANCH is a branch to create or
update.  (If you want it to be a normal user-visible Git branch then BRANCH
should start with "refs/heads".)

Options:
  -F FILE           Read commit message from FILE.
  -m MESSAGE        Use MESSAGE as commit message.
  --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, $branch) = @ARGV;

my $new_branch = system ("git rev-parse --verify $branch >/dev/null 2>&1") != 0;

if (defined ($message_file)) {
    open (MESSAGE, '<', $message_file)
      or die "$0: failed to open \"$message_file\": $!\n";
    $message .= join ('', <MESSAGE>);
    close (MESSAGE);
} elsif (!defined ($message)) {
    $message = "Import of $tarball.\n";
}

if (! -e $tarball) {
    die "$0: $tarball: not found\n";
} elsif ($tarball =~ /gz$/) {
    open (TARBALL, "-|", "zcat $tarball")
      or die "$0: \"zcat $tarball\" failed to start: $!\n";
} else {
    open (TARBALL, '<', $tarball)
      or die "$0: failed to open \"$tarball\": $!\n";
}

my $committer_ident = `git var GIT_COMMITTER_IDENT`;
chomp $committer_ident;

open (GFI, "|-", "git fast-import --date-format=raw --quiet")
  or die "$0: \"git fast-import\" failed to start: $!\n";

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

        print GFI "blob\n";
        print GFI "mark :", $mark++, "\n";
        print GFI "data ", length($member{LINKNAME}), "\n";
        print GFI $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 "$0: tar member $member{NAME} has type '$type' that Git cannot represent, ignoring\n"
    }
}

my $commit = $mark++;
print GFI "commit $branch\n";
print GFI "mark :$commit\n";
print GFI "committer $committer_ident\n";
print GFI "data ", length($message), "\n";
print GFI $message, "\n";
print GFI "merge $branch^0\n" if !$new_branch;
print GFI "deleteall\n";
print GFI $_ foreach @commit;
print GFI "\n";

close (TARBALL) or die "$0: \"zcat $tarball\" exited with status $?\n";
close (GFI) or die "$0: \"git fast-import\" exited with status $?\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 (TARBALL, $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));

    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,
            SIZE => $size,
            LINKNAME => $linkname,
            TYPE => $type);
}