pintos-os.org Git - pspp/blob - git-import-tar

   1 #! /usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5 use Getopt::Long qw(:config bundling no_ignore_case);
   6
   7 my $help = 0;
   8 my $message_file;
   9 my $message;
  10 GetOptions ("F=s" => \$message_file,
  11             "m=s" => \$message,
  12             "h|help" => \$help);
  13
  14 usage () if $help;
  15
  16 sub usage {
  17     print <<EOF;
  18 $0, for importing a tarball as a Git branch
  19 usage: $0 [OPTIONS] TARBALL BRANCH
  20 where TARBALL is the name of a tarball and BRANCH is a branch to create or
  21 update.  (If you want it to be a normal user-visible Git branch then BRANCH
  22 should start with "refs/heads".)
  23
  24 Options:
  25   -F FILE           Read commit message from FILE.
  26   -m MESSAGE        Use MESSAGE as commit message.
  27   --help            Print this usage message and exit
  28 EOF
  29     exit(0);
  30 }
  31
  32 die "$0: exactly two nonoption arguments are required (use --help for help)\n"
  33   if @ARGV != 2;
  34
  35 our ($tarball, $branch) = @ARGV;
  36
  37 my $new_branch = system ("git rev-parse --verify $branch >/dev/null 2>&1") != 0;
  38
  39 if (defined ($message_file)) {
  40     open (MESSAGE, '<', $message_file)
  41       or die "$0: failed to open \"$message_file\": $!\n";
  42     $message .= join ('', <MESSAGE>);
  43     close (MESSAGE);
  44 } elsif (!defined ($message)) {
  45     $message = "Import of $tarball.\n";
  46 }
  47
  48 if (! -e $tarball) {
  49     die "$0: $tarball: not found\n";
  50 } elsif ($tarball =~ /gz$/) {
  51     open (TARBALL, "-|", "zcat $tarball")
  52       or die "$0: \"zcat $tarball\" failed to start: $!\n";
  53 } else {
  54     open (TARBALL, '<', $tarball)
  55       or die "$0: failed to open \"$tarball\": $!\n";
  56 }
  57
  58 my $commit_user = `git config --get user.name`;
  59 chomp $commit_user;
  60 my $commit_email = `git config --get user.email`;
  61 chomp $commit_email;
  62 my $committer = "$commit_user <$commit_email>";
  63
  64 open (GFI, "|-", "git fast-import --date-format=raw --quiet")
  65   or die "$0: \"git fast-import\" failed to start: $!\n";
  66
  67 my $mark = 1;
  68 our $offset = 0;
  69 my @commit;
  70 my @metadata;
  71 my @gitignore;
  72 for (;;) {
  73     my (%member) = read_tar_header ();
  74     last if !%member;
  75     next if $member{NAME} eq '.'; # Skip root directory.
  76
  77     my $type = $member{TYPE};
  78
  79     # Add to Git commit, if it's a file type that Git supports, or
  80     # make Git ignore it otherwise.
  81     if ($type eq '-') {
  82         my ($gitmode) = $member{MODE} & 0111 ? "755" : "644";
  83         push(@commit, "M $gitmode :$mark $member{NAME}\n");
  84
  85         my $size = $member{SIZE};
  86         print GFI "blob\n";
  87         print GFI "mark :", $mark++, "\n";
  88         print GFI "data $size\n";
  89         my $remaining = $size;
  90         while ($remaining > 0) {
  91             my $chunk = $remaining > 65536 ? 65536 : $remaining;
  92             my $data = read_fully ($chunk);
  93             print GFI $data;
  94             $remaining -= $chunk;
  95         }
  96         read_fully(512 - $size % 512) if $size % 512;
  97         print GFI "\n";
  98     } elsif ($type eq 'l') {
  99         push(@commit, "M 120000 :$mark $member{NAME}\n");
 100
 101         print GFI "blob\n";
 102         print GFI "mark :", $mark++, "\n";
 103         print GFI "data ", length($member{LINKNAME}), "\n";
 104         print GFI $member{LINKNAME}, "\n";
 105     } elsif ($type eq 'd') {
 106         # We don't do anything about directories.  In particular,
 107         # ignoring them is a bad idea because files added under them
 108         # will then also be ignored.
 109     } else {
 110         print STDERR "$0: tar member $member{NAME} has type '$type' that Git cannot represent, ignoring\n"
 111     }
 112 }
 113
 114 my $commit = $mark++;
 115 print GFI "commit $branch\n";
 116 print GFI "mark :$commit\n";
 117 print GFI "committer $committer ", time(), " +0000\n";
 118 print GFI "data ", length($message), "\n";
 119 print GFI $message, "\n";
 120 print GFI "merge $branch^0\n" if !$new_branch;
 121 print GFI "deleteall\n";
 122 print GFI $_ foreach @commit;
 123 print GFI "\n";
 124
 125 close (TARBALL) or die "$0: \"zcat $tarball\" exited with status $?\n";
 126 close (GFI) or die "$0: \"git fast-import\" exited with status $?\n";
 127
 128 sub check_header {
 129     my ($header) = @_;
 130     my $magic = substr($header, 257, 5);
 131     my $version = substr($header, 263, 2);
 132     my $chksum = oct(substr($header, 148, 8));
 133     if (checksum($header) != $chksum) {
 134         fail("$tarball: bad header checksum (is this a tar archive?)");
 135     }
 136     return $header;
 137 }
 138
 139 sub checksum {
 140     my ($header) = @_;
 141     substr($header, 148, 8) = ' ' x 8;
 142     my $chksum = 0;
 143     $chksum += ord($_) foreach split('', $header);
 144     return $chksum;
 145 }
 146
 147 sub read_fully {
 148     my ($nbytes) = @_;
 149     my $data = '';
 150     while (length($data) < $nbytes) {
 151         my $chunk = $nbytes - length($data);
 152         my $bytes_read = sysread (TARBALL, $data, $chunk, length($data));
 153         $offset += $bytes_read;
 154         fail("$tarball: read error: $!") if !defined($bytes_read);
 155         fail("$tarball: unexpected end of file") if !$bytes_read;
 156     }
 157     return $data;
 158 }
 159
 160 sub zero_header_size {
 161     my ($header) = @_;
 162     substr($header, 124, 12) = ("0" x 11) . "\0";
 163     substr($header, 148, 8) = sprintf("%07o", checksum($header)) . "\0";
 164     return $header;
 165 }
 166
 167 sub fail {
 168     my ($msg) = @_;
 169     $msg =~ s/\n$//;
 170     die "$msg at $tarball offset $offset\n";
 171 }
 172
 173 sub normalize_name {
 174     my ($name) = @_;
 175     fail("$tarball: contains file with empty name or linkname") if $name eq '';
 176     fail("$tarball: contains file with .. in name")
 177       if grep($_ eq '..', split('/', $name));
 178     $name = join('/', grep($_ ne '' && $_ ne '.', split('/', $name)));
 179     $name = '.' if $name eq '';
 180     return $name;
 181 }
 182
 183 sub read_tar_header {
 184     my ($header, $type, $name, $linkname);
 185     for (;;) {
 186         $header = read_fully(512);
 187         return () if $header eq "\0" x 512;
 188         check_header($header);
 189
 190         $type = substr($header, 156, 1);
 191         last if $type !~ /[KL]/;
 192
 193         my ($size) = oct(unpack("Z*", substr($header, 124, 12)));
 194         fail("bad longname size $size") if $size < 0;
 195
 196         my ($string) = read_fully($size);
 197         read_fully (512 - $size % 512) if $size % 512;
 198         ($type eq 'L' ? $name : $linkname) = $string;
 199     }
 200
 201     # Normalize type.
 202     if ($type =~ /[70\0]/) {
 203         $type = '-';
 204     } elsif ($type !~ tr/123456/hlcbdp/) {
 205         fail("unknown file type '$type'");
 206     }
 207
 208     # Get name and linkname, if we didn't already.
 209     if (!defined($name)) {
 210         $name = unpack("Z100", $header);
 211         my ($prefix) = unpack("Z*", substr($header, 345));
 212         $name = "$prefix/$name" if $prefix ne '';
 213     }
 214     $linkname = unpack("Z*", substr($header, 157, 100)) if !defined($linkname);
 215
 216     # Normalize name.
 217     $name = normalize_name($name);
 218     $linkname = normalize_name($linkname) if $type eq 'h';
 219
 220     # Get size.
 221     my ($size) = oct(unpack("Z*", substr($header, 124, 12)));
 222     fail("bad size $size") if $size < 0;
 223     $size = 0 if $type eq 'd';
 224
 225     # Get other information.
 226     my ($mode) = oct(substr($header, 100, 8));
 227
 228     if ($type !~ /[-hlcbdp]/) {
 229         # Read and discard any data.
 230         my $remaining = int($size / 512) * 512;
 231         $size += 512 if $size % 512;
 232         while ($remaining > 0) {
 233             my $chunk = $remaining > 65536 ? 65536 : $remaining;
 234             my $data = read_fully($chunk);
 235             $remaining -= $chunk;
 236         }
 237     }
 238
 239     return (TYPE => $type,
 240             NAME => $name,
 241             MODE => $mode,
 242             SIZE => $size,
 243             LINKNAME => $linkname,
 244             TYPE => $type);
 245 }