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 $committer_ident = `git var GIT_COMMITTER_IDENT`;
  59 chomp $committer_ident;
  60
  61 open (GFI, "|-", "git fast-import --date-format=raw --quiet")
  62   or die "$0: \"git fast-import\" failed to start: $!\n";
  63
  64 my $mark = 1;
  65 our $offset = 0;
  66 my @commit;
  67 my @metadata;
  68 my @gitignore;
  69 for (;;) {
  70     my (%member) = read_tar_header ();
  71     last if !%member;
  72     next if $member{NAME} eq '.'; # Skip root directory.
  73
  74     my $type = $member{TYPE};
  75
  76     # Add to Git commit, if it's a file type that Git supports, or
  77     # make Git ignore it otherwise.
  78     if ($type eq '-') {
  79         my ($gitmode) = $member{MODE} & 0111 ? "755" : "644";
  80         push(@commit, "M $gitmode :$mark $member{NAME}\n");
  81
  82         my $size = $member{SIZE};
  83         print GFI "blob\n";
  84         print GFI "mark :", $mark++, "\n";
  85         print GFI "data $size\n";
  86         my $remaining = $size;
  87         while ($remaining > 0) {
  88             my $chunk = $remaining > 65536 ? 65536 : $remaining;
  89             my $data = read_fully ($chunk);
  90             print GFI $data;
  91             $remaining -= $chunk;
  92         }
  93         read_fully(512 - $size % 512) if $size % 512;
  94         print GFI "\n";
  95     } elsif ($type eq 'l') {
  96         push(@commit, "M 120000 :$mark $member{NAME}\n");
  97
  98         print GFI "blob\n";
  99         print GFI "mark :", $mark++, "\n";
 100         print GFI "data ", length($member{LINKNAME}), "\n";
 101         print GFI $member{LINKNAME}, "\n";
 102     } elsif ($type eq 'd') {
 103         # We don't do anything about directories.  In particular,
 104         # ignoring them is a bad idea because files added under them
 105         # will then also be ignored.
 106     } else {
 107         print STDERR "$0: tar member $member{NAME} has type '$type' that Git cannot represent, ignoring\n"
 108     }
 109 }
 110
 111 my $commit = $mark++;
 112 print GFI "commit $branch\n";
 113 print GFI "mark :$commit\n";
 114 print GFI "committer $committer_ident\n";
 115 print GFI "data ", length($message), "\n";
 116 print GFI $message, "\n";
 117 print GFI "merge $branch^0\n" if !$new_branch;
 118 print GFI "deleteall\n";
 119 print GFI $_ foreach @commit;
 120 print GFI "\n";
 121
 122 close (TARBALL) or die "$0: \"zcat $tarball\" exited with status $?\n";
 123 close (GFI) or die "$0: \"git fast-import\" exited with status $?\n";
 124
 125 sub check_header {
 126     my ($header) = @_;
 127     my $magic = substr($header, 257, 5);
 128     my $version = substr($header, 263, 2);
 129     my $chksum = oct(substr($header, 148, 8));
 130     if (checksum($header) != $chksum) {
 131         fail("$tarball: bad header checksum (is this a tar archive?)");
 132     }
 133     return $header;
 134 }
 135
 136 sub checksum {
 137     my ($header) = @_;
 138     substr($header, 148, 8) = ' ' x 8;
 139     my $chksum = 0;
 140     $chksum += ord($_) foreach split('', $header);
 141     return $chksum;
 142 }
 143
 144 sub read_fully {
 145     my ($nbytes) = @_;
 146     my $data = '';
 147     while (length($data) < $nbytes) {
 148         my $chunk = $nbytes - length($data);
 149         my $bytes_read = sysread (TARBALL, $data, $chunk, length($data));
 150         $offset += $bytes_read;
 151         fail("$tarball: read error: $!") if !defined($bytes_read);
 152         fail("$tarball: unexpected end of file") if !$bytes_read;
 153     }
 154     return $data;
 155 }
 156
 157 sub zero_header_size {
 158     my ($header) = @_;
 159     substr($header, 124, 12) = ("0" x 11) . "\0";
 160     substr($header, 148, 8) = sprintf("%07o", checksum($header)) . "\0";
 161     return $header;
 162 }
 163
 164 sub fail {
 165     my ($msg) = @_;
 166     $msg =~ s/\n$//;
 167     die "$msg at $tarball offset $offset\n";
 168 }
 169
 170 sub normalize_name {
 171     my ($name) = @_;
 172     fail("$tarball: contains file with empty name or linkname") if $name eq '';
 173     fail("$tarball: contains file with .. in name")
 174       if grep($_ eq '..', split('/', $name));
 175     $name = join('/', grep($_ ne '' && $_ ne '.', split('/', $name)));
 176     $name = '.' if $name eq '';
 177     return $name;
 178 }
 179
 180 sub read_tar_header {
 181     my ($header, $type, $name, $linkname);
 182     for (;;) {
 183         $header = read_fully(512);
 184         return () if $header eq "\0" x 512;
 185         check_header($header);
 186
 187         $type = substr($header, 156, 1);
 188         last if $type !~ /[KL]/;
 189
 190         my ($size) = oct(unpack("Z*", substr($header, 124, 12)));
 191         fail("bad longname size $size") if $size < 0;
 192
 193         my ($string) = read_fully($size);
 194         read_fully (512 - $size % 512) if $size % 512;
 195         ($type eq 'L' ? $name : $linkname) = $string;
 196     }
 197
 198     # Normalize type.
 199     if ($type =~ /[70\0]/) {
 200         $type = '-';
 201     } elsif ($type !~ tr/123456/hlcbdp/) {
 202         fail("unknown file type '$type'");
 203     }
 204
 205     # Get name and linkname, if we didn't already.
 206     if (!defined($name)) {
 207         $name = unpack("Z100", $header);
 208         my ($prefix) = unpack("Z*", substr($header, 345));
 209         $name = "$prefix/$name" if $prefix ne '';
 210     }
 211     $linkname = unpack("Z*", substr($header, 157, 100)) if !defined($linkname);
 212
 213     # Normalize name.
 214     $name = normalize_name($name);
 215     $linkname = normalize_name($linkname) if $type eq 'h';
 216
 217     # Get size.
 218     my ($size) = oct(unpack("Z*", substr($header, 124, 12)));
 219     fail("bad size $size") if $size < 0;
 220     $size = 0 if $type eq 'd';
 221
 222     # Get other information.
 223     my ($mode) = oct(substr($header, 100, 8));
 224
 225     if ($type !~ /[-hlcbdp]/) {
 226         # Read and discard any data.
 227         my $remaining = int($size / 512) * 512;
 228         $size += 512 if $size % 512;
 229         while ($remaining > 0) {
 230             my $chunk = $remaining > 65536 ? 65536 : $remaining;
 231             my $data = read_fully($chunk);
 232             $remaining -= $chunk;
 233         }
 234     }
 235
 236     return (TYPE => $type,
 237             NAME => $name,
 238             MODE => $mode,
 239             SIZE => $size,
 240             LINKNAME => $linkname,
 241             TYPE => $type);
 242 }