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