Lý sự pclouds

Hôm nay là ngày âm nhạc quốc tế :D

Để nghe đài phát thanh last.fm có thể dùng Shell.FM - một tiện ích nhỏ và gọn, chỉ cần bàn phím và một dấu nhắc shell để sử dụng.

Nói tiện và gọn là vì ngay cả biên dịch cũng cực gọn. Bung nó ra, vào thư mục shell-fm. Chạy lệnh make. Xong. Bây giờ đã có shell-fm trong thư mục hiện thời. Muốn nghe gì thì cứ shell-fm lastfm://url. Xem trang web trên để biết thêm cách điều khiển.

Tiện và quá gọn nên chỉ hỗ trợ OSS. Do đó cũng chịu cùng khuyết điểm của nasd, mỗi lúc chỉ có một ứng dụng có thể điều khiển đầu ra âm thanh. Patch sau (dành cho bản SVN) dùng libao để hỗ trợ thêm các loại trình điều khiển âm thanh khác như.. nói chung, chủ yếu là ALSA. Gõ make shell-fm.ao để có shell-fm.ao - phiên bản hỗ trợ libao của shell-fm.

Index: play.c
===================================================================
--- play.c	(revision 38)
+++ play.c	(working copy)
@@ -23,11 +23,21 @@
 #include <signal.h>
 
 #include <sys/ioctl.h>
+#ifdef __HAVE_LIBAO__
+#include <ao/ao.h>
+#else
 #include <linux/soundcard.h>
+#endif
 
 struct stream {
 	FILE * streamfd;
+#ifdef __HAVE_LIBAO__
+	int driver_id;
+	ao_device *device;
+	ao_sample_format fmt;
+#else
 	int audiofd;
+#endif
 	pid_t parent;
 };
 
@@ -39,9 +49,49 @@
 
 void * findsync(register unsigned char *, unsigned);
 
+#ifdef __HAVE_LIBAO__
 void playback(FILE * streamfd) {
+	static int ao_initialized = 0;
 	struct stream data;
 	struct mad_decoder dec;
+
+	if (!ao_initialized) {
+		ao_initialize();
+		ao_initialized = 1;
+	}
+
+	memset(& data, 0, sizeof(struct stream));
+	
+	data.streamfd = streamfd;
+	data.driver_id = ao_default_driver_id();
+	data.parent = getppid();
+
+	if(-1 == data.driver_id) {
+		fprintf(stderr, "Unable to find any usable output device!\n");
+		return;
+	}
+
+	data.fmt.bits = 16;
+	data.fmt.rate = 44100;
+	data.fmt.channels = 2;
+	data.fmt.byte_format = AO_FMT_BIG;
+	data.device = ao_open_live(data.driver_id,&data.fmt,NULL);
+
+	if (NULL == data.device) {
+		fprintf(stderr, "Unable to open device. Errno: %d\n",errno);
+		return;
+	}
+
+	mad_decoder_init(& dec, & data, input, NULL, NULL, output, NULL, NULL);
+	mad_decoder_run(& dec, MAD_DECODER_MODE_SYNC);
+	mad_decoder_finish(& dec);
+
+	fprintf(stderr, "Reached end of stream.\n");
+}
+#else
+void playback(FILE * streamfd) {
+	struct stream data;
+	struct mad_decoder dec;
 	unsigned arg;
 
 	memset(& data, 0, sizeof(struct stream));
@@ -64,6 +114,7 @@
 
 	fprintf(stderr, "Reached end of stream.\n");
 }
+#endif
 
 static enum mad_flow input(void * data, struct mad_stream * stream) {
 	static unsigned nbyte = 0;
@@ -98,12 +149,60 @@
 	return MAD_FLOW_CONTINUE;
 }
 
+#ifdef __HAVE_LIBAO__
 static enum mad_flow output(
 		void * data,
 		const struct mad_header * head,
 		struct mad_pcm * pcm) {
 	struct stream * ptr = (struct stream *) data;
 
+	unsigned nchan = pcm->channels, rate = pcm->samplerate;
+	register unsigned nsample = pcm->length;
+	mad_fixed_t * left = pcm->samples[0], * right = pcm->samples[1];
+	char *stream, *stream_ptr;
+
+	head = NULL;
+
+	if (rate != ptr->fmt.rate || nchan != ptr->fmt.channels) {
+		ptr->fmt.rate = rate;
+		ptr->fmt.channels = nchan;
+		if (ptr->device != NULL)
+			ao_close(ptr->device);
+		ptr->device = ao_open_live(ptr->driver_id,&ptr->fmt,NULL);
+
+		if (NULL == ptr->device) {
+			fprintf(stderr, "Unable to open device. Errno: %d\n",errno);
+			return MAD_FLOW_BREAK;
+		}
+	}
+
+	stream_ptr = stream = malloc(pcm->length * (pcm->channels == 2 ? 4 : 2));
+	
+	while(nsample--) {
+		signed int sample;
+
+		sample = scale(* left++);
+		*stream_ptr++ = (sample & 0xFF);
+		*stream_ptr++ = (sample >> 8) & 0xFF;
+
+		if(nchan == 2) {
+			sample = scale(* right++);
+			*stream_ptr++ = (sample & 0xFF);
+			*stream_ptr++ = (sample >> 8) & 0xFF;
+		}
+	}
+	ao_play(ptr->device, stream, pcm->length * (pcm->channels == 2 ? 4 : 2));
+	free(stream);
+
+	return MAD_FLOW_CONTINUE;
+}
+#else
+static enum mad_flow output(
+		void * data,
+		const struct mad_header * head,
+		struct mad_pcm * pcm) {
+	struct stream * ptr = (struct stream *) data;
+
 	unsigned nchan = pcm->channels, rate = pcm->samplerate, arg;
 	register unsigned nsample = pcm->length;
 	mad_fixed_t * left = pcm->samples[0], * right = pcm->samples[1];
@@ -134,6 +233,7 @@
 
 	return MAD_FLOW_CONTINUE;
 }
+#endif
 
 signed scale(register mad_fixed_t sample) {
 	sample += (1L << (MAD_F_FRACBITS - 16));
Index: Makefile
===================================================================
--- Makefile	(revision 38)
+++ Makefile	(working copy)
@@ -33,6 +33,9 @@
 all	: $(CODE) $(HEAD)
 	$(CC) -o $(OUTPUT) $(CFLAGS) $(CODE) && /usr/bin/strip $(OUTPUT)
 
+$(OUTPUT).ao: $(CODE) $(HEAD)
+	$(CC) -o $(OUTPUT).ao -D__HAVE_LIBAO__ $(CFLAGS) $(CODE) `pkg-config ao --cflags --libs` && /usr/bin/strip $(OUTPUT).ao
+
 install	: $(all)
 	mkdir -p $(BINPATH)
 	install -m 755 shell-fm $(BINPATH)

Một ngày cuối tháng hết sức tốt đẹp. Không kể nguyên tháng sáu không tốt đẹp gì lắm. Và cả mấy tháng tới cũng chả tốt đẹp là bao khi phải tiếp tục ở tù.

nasd (NAS server) chạy với Open Sound System. Nếu một chương trình khác đã chiếm quyền điều khiển /dev/dsp thì nasd sẽ không chạy. Tương tự, nếu nasd chiếm /dev/dsp thì những ứng dụng khác cũng câm. nasd mặc dù chưa hỗ trợ ALSA nhưng vẫn có thể tạm khắc phục bằng gói alsa-oss. Gói này có một chương trình tên là aoss dùng để bao các ứng dụng OSS lại, chạy với ALSA. Chạy nasd với aoss dễ òm:

aoss nasd

Bây giờ nasd có thể chung sống hoà bình với ít nhất là Rhythmbox.

Đã cho patch lên bug 345633. Chạy tốt với Rhythmbox. Vẫn chưa xử lý cơ chế lỗi cho hợp lý nên có thể sẽ crash nếu vừa chạy vừa tắt nasd

Chỉ cần hai tập tin nassink.c và nassink.h từ CVS, gắn patch trên bug 345633 vào rồi dùng lệnh sau để biên dịch:

gcc nassink.c `pkg-config --cflags gstreamer-0.10 gstreamer-plugins-base-0.10 --libs gstreamer-base-0.10` -DVERSION=\"0.10.3\" -DPACKAGE=\"nassink\" -DGST_PACKAGE_NAME=\"gst-plugins-bad\" -DGST_PACKAGE_ORIGIN=\"http://gstreamer.net\" -laudio -lgstaudio-0.10 -fPIC -DPIC -shared -o libgstnassink.so

Kết quả là libgstnassink.so. Cho nó vô /usr/lib/gstreamer-0.10. Dùng gst-inspect-0.10 sẽ thấy có một plugin mới là nassink.Kiểm tra nassink bằng lệnh sau:

gst-launch-0.10 audiotestsrc ! nassink

Hoặc kiểm tra màu mè hơn:

gst-launch-0.10 filesrc location=tập-tin-mp3 ! decodebin ! audioconvert !  audioresample ! nassink

Cần đặt biến AUDIOSERVER hoặc thêm tham số host=.... sau nassink trong lệnh trên

Để sử dụng nassink cho toàn hệ thống GNOME, đặt khoá GConf /system/gstreamer/0.10/default/audiosink là nassink

nassink bị "not negotiated" là bởi vì gst_nassink_prepare luôn trả về FALSE. Lúc chỉnh mã, chẳng hiểu sao lại làm rơi rớt một dấu !. Hậu quả là hễ nó "prepare" thành công thì nó báo thất bại. :(

nassink đã biên dịch tốt, chạy được. Chạy

gst-launch-0.10 audiotestsrc ! audioconvert ! audioresample ! nassink

nó nghe "rè tè rè tè.." trong khi dùng alsasink nghe "teeeee". Đau.

.. dành cho những ai .. ba chấm .. tại đây: http://www.revolution-os.com/musicvideo.html

Nghe đồn RMS viết bài hát này. Nhưng may quá, ông không hát. Có một chút gì đó của châu Phi với nhạc đồng quê Mỹ trong đó.

Thử đóng vai người hùng, port nassink từ gstreamer 0.8 sang gstreamer 0.10. Hậu quả: mai phải coi thử coi bytes_per_sample của NAS là bao nhiêu, mò lại OSS coi segsize và segtotal là cái khỉ gì. Bởi vì nassink hết chạy. :(

Luộc xong gst_nassink_prepare sẽ phải ngó tiếp tới gst_nassink_delay, chả biết phải cài hàm này thế nào

Nhân bài báo WinFS is Dead, mò lại GNOME Storage. Vẫn không có gì thay đổi. Có vẻ như GNOME Storage chết còn sớm hơn WinFS.

Tại vì các plugin import lại hàm gettext() (hàm _()) trong khi rb-python-module.c đã import hàm này dùm rồi, thông qua gettext.install(). Import _() đè lên cái cũ nên hậu quả là gettext hết chạy. Hi vọng đây là nguyên nhân gây ra lỗi 343081.

bằng Ctrl-Shift-Click, Shift-Click không hoạt động.

Tháng 12/2005

• 27/11 - 4/12
  • Scorpions - 88
  • Blackmore's Night - 30
  • Alanis Morisette (quái đản, mình nghe Alanis từ tháng 12??)
• 4/12 - 11/12
  • Blackmore's Night - 40
  • Queensrÿche - 28
  • Dream Theater - 21
  • ABBA - 19
  • To/Die/For - 16
• 11/12 - 18/12
  • Nightwish - 42
  • Metallica - 30
  • Scorpions - 16
• 25/12 - 1/1: Metallica - 9

Tháng 1/2006

• 1/1 - 8/1: Lại Metallica - 15

• 8/1 - 15/1

  • Queensrÿche - 12
  • Guns n' Roses - 7
  • • Megadeth - 6

• 15/1 - 22/1

  • Within Temptation - 28
  • Nightwish - 26

• 23/1 - 30/1

  • Metallica - 21
  • Nightwish - 16
  • Dream Theater - 12
  • Queensrÿche - 11

• 29/1 - 5/2: Scorpions, Dream Theater, Blackmore's Night (7-8)

• 5/2 - 12/2

  • Rhapsody - 8
  • Metallica - 7
  • Apocalyptica - 6

• 12/2 - 19/2

  • Apocalyptica - 50 (mèn)
  • Guns n' Roses - 11
  • Nightwish - 10

• 19/2 - 26/2

  • Apocalyptica - 107 (má ơi)
  • Nightwish - 59
  • Metallica - 35
  • Queensrÿche - 33
  • Rhapsody - 32
  • Blackmore's Night - 24
  • Alanis Morisette - 20

Tháng 3/2006

• 26/2 - 5/3
  • Apocalyptica - 50
  • Nightwish - 40
  • Rhapsody - 25
  • Metallica - 24
• 5/3 - 12/3
  • Nightwish - 78
  • Within Temptation - 47
  • Nirvana - 40
• 12/3 - 19/3
  • Metallica - 109
  • Apocalyptica - 66
  • Nightwish - 37
  • Ozzy Osbourne - 28
• 19/3 - 26/3
  • Therion - 131
  • Apocalyptica - 50
  • Nightwish - 43

Tháng 4/2006

• 26/3 - 2/4
  • Within Temptation - 189
  • The Cranberries - 98
• 2/4 - 9/4
  • Therion - 67
  • Within Temptation - 61
  • Apocalyptica - 50
  • Metallica - 33
• 9/4 - 16/4
  • Metallica - 49
  • Blackmore's Night - 19
• 16/4 - 23/4
  • Metallica - 109
  • Moonspell - 50
  • Guns n' Roses - 45
• 23/4 - 30/4
  • Moonspell - 27
  • Metallica - 20
  • Dream Theater - 19
  • Within Temptation - 19
  • Guns n' Roses - 17
  • Nightwish - 15
  • Rise Against - 12

Tháng 5/2006

• 30/4 - 7/5
  • Apocalyptica - 35
  • Nightwish - 27
  • Metallica - 18
• 7/5 - 14/5
  • Metallica - 39
  • Apocalyptica - 34
  • The Cranberries - 28
  • Blackmore's Night - 21
• 14/5 - 21/5
  • Alanis Morisette - 52
  • Apocalyptica - 42
  • Metallica - 29
  • Leaves' Eyes - 26
  • Therion - 21
  • The Cranberries - 20
• 21/5 - 28/5
  • The Cranberries - 58
  • Metallica - 36
  • Nightwish - 29
  • Therion - 29
  • Leaves' Eyes - 24

Đêm qua mơ dáng em đang ôm đàn tằng tăng tắng tăng...

Sử dụng memtest86 rất dễ. Cài memtest86 vào (ý là emerge memtest86), nó sẽ cài vào /boot/memtest86/memtest.bin. Thêm vào grub một dòng đại loại như:

title Memtest86
root (hd0,4)
kernel /memtest86/memtest.bin

Khởi động lại máy và chạy memtest từ grub. Kết quả thật mĩ mãn: 641 lỗi sau hai lần chạy (635 thuộc về test 8, 4 cho test 5 và 2 cho test 6).

Phiên bản git.pl đã có thể push toàn bộ git.git lên một repository rỗng, git fsck-objects --full hoàn toàn không thành vấn đề.

Vấn đề bây giờ là .. có sự khác biệt về "pack". Có hai loại pack là pack bình thường và thin pack. Với pack bình thường thì base object của delta object phải nằm trong cùng pack. Trong khi với thin pack thì không bị ràng buộc điều kiện này. Do thin pack không cần kèm theo base object nên sẽ nhỏ gọn hơn và thích hợp truyền qua mạng hơn. Trong khi đó pack bình thường được dùng để lưu trong objects/pack - cũng có nghĩa là nếu lưu lại các pack được truyền qua mạng, cho vào objects/pack thì kho đó vi phạm nguyên tắc. http-fetch sử dụng nguyên tắc này. Do không có sự hỗ trợ từ phía kho http, http-fetch phải duyệt lần lượt từng object tính từ các đầu nhánh. Nếu móc một thin pack về, nó sẽ thiếu base object - vậy tìm base object ở đâu đây? Mặc dù git.pl/receive-pack.pl chạy, nhưng cũng không xài được vì http-fetch đình công :(

Nếu không giữ thin pack lại mà bung hết ra thì http-fetch cũng chạy. Nhưng http transport xem ra không hiệu quả chút nào nếu cứ phải chạy vòng vòng tìm từng object (không nén). Tuy nhiên, nếu không dùng http-fetch thì cũng có nghĩa là giờ phải làm luôn send-pack bằng Perl! git rev-list và thuật toán delta sẽ là hai cái nhức đầu nhất.

Dù gì thì gì, cũng coi như có được cái nền git khá ngon bằng perl rồi. Tuy chậm hơn nhiều so với bản bằng C nhưng lại chạy được ở những nơi không có gcc

#!/usr/bin/perl -w

use Compress::Zlib;
use Digest::SHA1;

$report_status = 0;
$capabilities = "report-status";
$capabilities_sent = 0;
$keep_packs = 1;
$write_pack = undef;
@cache = ();
$cache_size = 32;

sub cache_add {
	my ($buffer, $sha1, $type) = @_;
	while ($#cache > $cache_size) {
		shift @cache;
	}
	$cache[++$#cache] = { "sha1" => $sha1, "data" => $buffer, "type" => $type};
}

sub cache_search {
	my ($sha1, $type) = @_;
	foreach $item (@cache) {
		if ($item->{sha1} eq $sha1) {
			cache_add ($item->{data}, $item->{sha1}, $item->{type});
			$$type = $item->{type};
			return $item->{data};
		}
	}
	undef;
}

sub usage {
        die "git-receive-pack.pl <git-dir>";
}

sub validate_symref {
        my ($path) = @_;

        if (-l $path) {
                my $real_path = readlink $path;
                return $real_path =~ m,^refs/, ? 0 : -1;
        }
        open FH, $path or return -1;
        my $line = <FH>;
        close FH;
        $line =~ m,^ref: *refs/., ? 0 : -1;
}

sub check_repository_format {
        #TODO
        return 0;
}

sub setup_git_env {
        $git_dir = $ENV{"GIT_DIR"};
        $git_dir = '.git' if !defined($git_dir);

        $git_object_dir = $ENV{"GIT_OBJECT_DIRECTORY"};
        $git_object_dir = "$git_dir/objects"
                unless defined($git_object_dir);

        #$git_refs_dir = "$git_dir/refs";

        $git_index_file = $ENV{"GIT_INDEX_FILE"};
        $git_index_file = "$git_dir/index"
                unless defined($git_index_file);

        $git_graft_file = $ENV{"GIT_GRAFT_FILE"};
        $git_graft_file = "$git_dir/info/grafts"
                unless defined($git_graft_file);
}

sub resolve_ref {
        my ($path, $sha1, $reading) = @_;
        my $depth = 5; #MAXDEPTH
        my $len;

        while (1) {
                return 0 if --$depth < 0;

                if (! -f $path) {
                        return 0 if $reading || !defined($!{ENOENT});
                        $$sha1 = "0000000000000000000000000000000000000000";
                        return $path;
                }

                if (-l $path) {
                        my $real_path = readlink ($path);
                        if ($real_path =~ m,^refs/,) {
                                $path = "$git_dir/$real_path";
                                next;
                        }
                }

                open FH, $path or return 0;
                my $line = <FH>;
                close FH;

                chomp($line);
                if ($line =~ m/^ref: *(.*)$/) {
                        $path = "$git_dir/$1";
                        next;
                }

                $$sha1 = $line;
                return $path;
        }
        return $path;
}

sub read_ref {
        my ($filename, $sha1) = @_;
        resolve_ref($filename, $sha1, 1) ? 0 : -1;
}

sub packet_write {
        my ($fd, $text) = @_;

        my $len = length($text)+4;
        #printf STDERR "packet_write: %d %04x %s", $len, $len, $text;
        printf "%04x%s", $len, $text;
}

sub packet_flush {
        my ($fd) = @_;

        print "0000";
        #print STDERR "packet_flush\n";
}


@commands = ();

sub read_head_info {
        while (1) {
                my $len;
                my $ret = read(STDIN, $len, 4);
                die "packet_read error: $!\n" if !defined($ret) || $ret != 4;
                die "protocol error: bad line length character: <$len>" if $len !~ m/^[0-9a-fA-F]{4}$/;
                $len = hex($len);
                last if !$len;
                $len -= 4;
                my $line;
                $ret = read(STDIN, $line, $len);
                die "packet_read error: $!\n" if !defined($ret) || $ret != $len;
                die "protocol error: bad line length $len" if $len != length($line);
                #print STDERR "packet_read: $line\n";
                die "protocol error: expected old/new/ref, got $line" 
                        if $line !~ /^([0-9a-fA-F]{40}) ([0-9a-fA-F]{40}) ([^\0]+)(\0report-status)?$/;

                $report_status = 1 if defined($4);

                my $cmd = {
                        'old_sha1' => $1,
                        'new_sha1' => $2,
                        'ref_name' => $3,
                        'error_string' => 0,
                };
                $commands[$#commands+1] = $cmd;
        }
}

%PACK_TYPE = (
        OBJ_EXT => 0,
        OBJ_COMMIT => 1,
        OBJ_TREE => 2,
        OBJ_BLOB => 3,
        OBJ_TAG => 4,
        OBJ_DELTA => 7
);

%PACK_SIG = ( 1 => "commit", 2 => "tree", 3 => "blob", 4 => "tag" );

$pack_buffer = '';
$pack_count = 0;

sub fill {
        my ($min) = @_;

        if ($min > length($pack_buffer)) {
                my $buf;
                read(STDIN, $buf, 4096);
                $pack_buffer .= $buf;
        }
        substr($pack_buffer, 0, $min);
}

sub throw_away {
        my ($len) = @_;
        my $data = substr($pack_buffer, 0, $len);
        $pack_sha->add($data);
        print PACK $data if defined($write_pack);
        $pack_buffer = substr($pack_buffer, $len);
        $pack_count += $len;
}

sub fill_and_throw {
        my ($len) = @_;
        $a = fill($len);
        throw_away($len);
        $a;
}

%pack_blobs = ();

sub get_data {
        my ($size) = @_;

        my $x = inflateInit() or die "Cannot create a inflation stream\n";
        my $buffer = '';
        my ($output, $status, $c);
        while (1) {
                fill(1);
                $c = $pack_buffer;
                ($output, $status) = $x->inflate(\$c);
                throw_away(length($pack_buffer)-length($c));
                $buffer .= $output if $status == Z_OK or $status == Z_STREAM_END;
                last if $status != Z_OK;
        }
        die "inflation failed\n" unless $status == Z_STREAM_END && length($buffer) == $size;
        $buffer;
}

sub unpack_non_delta_entry {
        my ($type, $size) = @_;

        my $buffer = get_data($size);
        $buffer;
        #print STDERR "Got $type\n";
}

sub prepare_packed_git {
        %packed_sha1 = ();
        while (<$git_object_dir/pack/*.pack>) {
                my $pack_file = $_;
                my $idx_file = $pack_file;
                $idx_file =~ s/\.pack$/.idx/;
                next unless -e $idx_file;

                open IDX, "<$idx_file" or next;
                binmode IDX;
                my $buf;

                read IDX,$buf,4*256;
                my $count = unpack("N",substr($buf,4*255));
                my $blen = read(IDX,$buf,(4+20)*$count);
                my @idx = unpack("(NH40)$count",$buf);
                for ($i = 0;$i < $count;$i ++) {
                        $packed_sha1{$idx[$i*2+1]} = {"filename" => $pack_file, "pos" => $idx[$i*2]};
                }
        }
}

sub find_pack_entry {
        my ($sha1) = @_;
        defined($packed_sha1{$sha1});
}

sub read_packed_sha1 {
        my ($sha1, $type) = @_;

	my $buffer = cache_search($sha1, $type);
	return $buffer if defined($buffer);
	
        open FH, $packed_sha1{$sha1}->{filename}
                or die "Cannot open pack ".$packed_sha1{$sha1}->{filename}.".\n";
        binmode FH;
        my $c;
        seek FH, $packed_sha1{$sha1}->{pos}, 0;
        read FH, $c, 1;
        $c = ord($c);
        $$type = ($c >> 4) & 7;
        my $size = ($c & 15);
        my $shift = 4;
        while ($c & 0x80) {
                read FH, $c, 1;
                $c = ord($c);
                $size += ($c & 0x7f) << $shift;
                $shift += 7;
        }
        my $base_sha1;
        if ($$type == $PACK_TYPE{OBJ_DELTA}) {
                read FH, $base_sha1, 20;
                $base_sha1 = unpack("H40",$base_sha1);
        }
        my $x = inflateInit() or die "Cannot create inflation object";
        my ($input, $output, $status);
        while (read(FH, $input, 4096)) {
                ($output, $status) = $x->inflate(\$input);
                $buffer .= $output if $status == Z_OK || $status == Z_STREAM_END;
                last if $status != Z_OK;
        }
        close FH;
        die "read_packed_sha1: inflation failed\n" unless $status == Z_STREAM_END;
        die "data length unmatched: $size" unless length($buffer) == $size;
        return $buffer unless $$type == $PACK_TYPE{OBJ_DELTA};
        die "failed to find delta-pack base object"
                unless defined($packed_sha1{$base_sha1}) &&
                        $packed_sha1{$base_sha1}->{filename} eq $packed_sha1{$sha1}->{filename};
        my $base = read_packed_sha1 ($base_sha1, $type);
        my $b = patch_delta ($base, $buffer);
        die "Patch failed\n" unless defined ($b);
	cache_add($b, $sha1, $$type);
        $b;
}

sub find_sha1_file {
        my ($sha1) = @_;

        #TODO no altdb support
        -f "$git_object_dir/".substr($sha1,0,2)."/".substr($sha1,2,38);
}

sub has_sha1_file {
        my ($sha1) = @_;
        return 1 if find_pack_entry($sha1);
        find_sha1_file($sha1);
}

%delta_queue = ();
sub add_delta_to_list {
        my ($base_sha1, $delta_data, $pos) = @_;
        $delta_queue{$base_sha1} = [] unless defined $delta_queue{$base_sha1};
        push @{$delta_queue{$base_sha1}}, {"delta" => $delta_data, "pos" => $pos};
        #print STDERR "Queued $base_sha1\n";
}

sub read_sha1_file {
        my ($sha, $type) = @_;
        return read_packed_sha1($sha, $type)
                if find_pack_entry($sha);

        open BLOB, "<$git_object_dir/".substr($sha,0,2)."/".substr($sha,2,38)
                or die "Cannot open $sha\n";
        binmode BLOB;

        # uncompress the header
        my $x = inflateInit() or die "Cannot create inflation object\n";
        my $input = '';
        my ($data,$header,$output,$status);
        while (read(BLOB,$input,4096)) {
                ($output, $status) = $x->inflate(\$input) ;
                $header .= $output
                        if  $status == Z_OK or $status == Z_STREAM_END ;
                last if $status != Z_OK;
        }
        close BLOB;
        die "$sha: blob header inflation failed\n" unless $status == Z_STREAM_END;
        
        #parse the header
        die "invalid blob"
                unless $header =~ m/^([^ ]*) ([1-9][0-9]*)\0/;

        my $size = $2;
        my $header_len = length($&);
        if ($1 eq "commit") {
                $$type = 1;
        } elsif ($1 eq "tree") {
                $$type = 2;
        } elsif ($1 eq "blob") {
                $$type = 3;
        } elsif ($1 eq "tag") {
                $$type = 4;
        } else {
                die "invalid blob type $1\n";
        }

        die "blob length unmatch $size" unless $size == length($header) - $header_len;
        substr($header, $header_len);
}

sub patch_delta {
        my ($base, $delta) = @_;
        my $DELTA_SIZE_MIN = 4;

        return undef if length($delta) < $DELTA_SIZE_MIN;
        
        my $output = '';
        my $i = 0;
        my $cmd;
        my $size = 0;
        my $shift = 0;

        do {
                $cmd = ord(substr($delta,$i++,1));
                $size |= ($cmd & ~0x80) << $shift;
                $shift += 7;
        } while ($cmd & 0x80 && $i < length($delta));
        return undef if $size != length($base);

        $shift = 0;
        $size = 0;
        do {
                $cmd = ord(substr($delta,$i++,1));
                $size |= ($cmd & ~0x80) << $shift;
                $shift += 7;
        } while ($cmd & 0x80 && $i < length($delta));

        while ($i < length($delta)) {
                $cmd = ord(substr($delta,$i++,1));
                if ($cmd & 0x80) {
                        my $cp_off = 0;
                        my $cp_size = 0;
                        $cp_off = ord(substr($delta,$i++,1)) if $cmd & 0x01;
                        $cp_off |= ord(substr($delta,$i++,1)) << 8 if $cmd & 0x02;
                        $cp_off |= ord(substr($delta,$i++,1)) << 16 if $cmd & 0x04;
                        $cp_off |= ord(substr($delta,$i++,1)) << 24 if $cmd & 0x08;

                        $cp_size = ord(substr($delta,$i++,1)) if $cmd & 0x10;
                        $cp_size |= ord(substr($delta,$i++,1)) << 8 if $cmd & 0x20;
                        $cp_size |= ord(substr($delta,$i++,1)) << 16 if $cmd & 0x40;
                        $cp_size = 0x10000 if $cp_size == 0;
                        $output .= substr($base,$cp_off, $cp_size);
                } elsif ($cmd) {
                        $output .= substr($delta, $i, $cmd);
                        $i += $cmd;
                } else {
                        print STDERR "BAAAA\n";
                        return undef;
                }
        }
        length($output) == $size ? $output : undef;
}

sub resolve_delta {
        my ($base, $delta) = @_;
        patch_delta ($base, $delta);
}

sub unpack_delta_entry {
        my ($size,$type, $pos) = @_;

        my $base_sha1 = unpack("H40",fill_and_throw(20));

        my $delta_data = get_data($size);

        if (!has_sha1_file($base_sha1)) {
                add_delta_to_list ($base_sha1, $delta_data, $pos);
                return undef;
        }

        my $base = read_sha1_file($base_sha1, $type);
        die "failed to read delta-pack base object $base_sha1\n"
                unless defined($base);

        my $buffer = resolve_delta($base, $delta_data);
        $buffer;
}

sub object_added {
        my ($type, $buffer, $sha1, $pos) = @_;
        
	$packed_sha1{$sha1} = {"filename" => $write_pack, "pos" => $pos}
		if defined($pos) && defined($write_pack);
	$pack_blobs{$sha1} = $pos if defined($pos);

        if (defined($delta_queue{$sha1})) {
                foreach $delta (@{$delta_queue{$sha1}}) {
                        my $new_buffer = resolve_delta($buffer, $delta->{delta});
                        if ($keep_packs) {
                                my $sha = Digest::SHA1->new();
                                $sha->add($PACK_SIG{$type}." ".length($new_buffer)."\0");
                                $sha->add($new_buffer);
                                $sha1 = $sha->hexdigest();
                                object_added ($type, $new_buffer, $sha1, $delta->{pos});
                        } else {
                                write_object ($type, $new_buffer, $delta->{pos});
                        }
                }
#print STDERR "Unqueued $sha1\n";
                undef $delta_queue{$sha1};
        }
}

sub write_object {
        my ($type, $buffer, $pos) = @_;

        my $header = $PACK_SIG{$type}." ".length($buffer)."\0";
        my $sha = Digest::SHA1->new();
        $sha->add($header);
        $sha->add($buffer);
        my $sha1 = $sha->hexdigest();

        my $blob_filename = "$git_object_dir/".substr($sha1,0,2)."/".substr($sha1,2,38);
        if ( ! -f $blob_filename) {
        #if (1) {
                my $x = deflateInit()
                        or die "Cannot create deflation object\n";
                my $output2;
                my ($output, $status) = $x->deflate($header.$buffer);
                $status == Z_OK or die "deflation failed\n";
                $output2 = $output;
                ($output, $status) = $x->flush();
                $status == Z_OK or die "deflation failed\n";
                $output2 .= $output;
                safe_create_leading_directories ($blob_filename);
                if (!open BLOB, ">$blob_filename") {
                        die "Can't write to $blob_filename\n";
                }
                binmode BLOB;
                print BLOB $output2;
                close BLOB;

                #print STDERR "Wrote $sha1\n";
                object_added ($type, $buffer, $sha1, $pos);
        }
        $sha1;
}

sub unpack_one {
        my ($nr, $total) = @_;
        my $pos = $pack_count;
        my $c = fill_and_throw(1);
        $c = ord($c);
        my $type = ($c >> 4) & 7;
        my $size = ($c & 15);
        my $shift = 4;
        while ($c & 0x80) {
                $c = fill_and_throw(1);
                $c = ord($c);
                $size += ($c & 0x7f) << $shift;
                $shift += 7;
        }
        if (!defined($quiet)) {
                $last_sec = 0 if ! defined ($last_sec);
                $last_percent = 0 if ! defined ($last_percent);
                my $percentage = ($nr * 100) / $total;
                my $now = time();
                if ($percentage != $last_percent || $now != $last_sec) {
                        $last_sec = $now;
                        $last_percent = $percentage;
                        printf STDERR "%4u%% (%u/%u) done\r", $percentage, $nr, $total;
                }
        }
        my $buffer;
        if ($type == $PACK_TYPE{OBJ_COMMIT} ||
                $type == $PACK_TYPE{OBJ_TREE} ||
                $type == $PACK_TYPE{OBJ_BLOB} ||
                $type == $PACK_TYPE{OBJ_TAG}) {
                $buffer = unpack_non_delta_entry($type,$size);
        } elsif ($type == $PACK_TYPE{OBJ_DELTA}) {
                $buffer = unpack_delta_entry($size,\$type, $pos);
        } else {
                die "bad object type $type\n";
        }

        if (defined($buffer)) {
                my $sha1;
                if ($keep_packs) {
                        my $sha = Digest::SHA1->new();
                        $sha->add($PACK_SIG{$type}." ".length($buffer)."\0");
                        $sha->add($buffer);
                        $sha1 = $sha->hexdigest();
                        object_added ($type, $buffer, $sha1, $pos);
                } else {
                        $sha1 = write_object($type,$buffer, $pos);
                }
        }
}

sub process_pack {
        $pack_sha = Digest::SHA1->new();
        my $signature = fill_and_throw(4);
        die "not a pack. Wrong signature: $signature\n" unless $signature =~ m/^PACK/;

        my $version = fill_and_throw(4);
        $version = unpack("N",$version);
        die "unknown pack file version $version" unless $version == 2 || $version == 3;

        my $nr_obj = fill_and_throw(4);
        $nr_obj = unpack("N",$nr_obj);

        for ($i = 0;$i < $nr_obj; $i ++) {
                unpack_one($i+1, $nr_obj);
        }

        my $digest_sha = $pack_sha->hexdigest();
        my $sha = unpack("H40",fill_and_throw(20));
        die "final sha did not match\n" unless $sha eq $digest_sha;
        $sha;
}

sub show_ref {
        my ($path, $sha1) = @_;

        packet_write(1, $capabilities_sent ? "$sha1 $path\n" : "$sha1 $path\0$capabilities\n");
        $capabilities_sent = 1;
        0;
}

sub do_for_each_ref {
        my ($base) = @_;
        my $sha1;

        opendir(DIR,"$git_dir/$base") || die $!;
        $base =~ s,/*$,/,;
        foreach $dir (readdir(DIR)) {
                next if ($dir =~ /^\./ || length($dir) > 255 || $dir =~ /\.lock$/);
                my $path = $base.$dir;
                if (-d "$git_dir/$path") {
                        last if do_for_each_ref($path);
                        next;
                }
                if (read_ref("$git_dir/$path",\$sha1) < 0) {
                        print STDERR "$path points nowhere!\n";
                        next;
                }
                if (!has_sha1_file($sha1)) {
                        print STDERR "$path does not point to a valid commit object!\n";
                        next;
                }
                last if show_ref($path,$sha1);
        }
        closedir DIR;
        0;
}

sub write_head_info {
        do_for_each_ref("refs");
        show_ref("capabilities^{}", "0000000000000000000000000000000000000000") 
                unless $capabilities_sent;
}

sub index_pack {
        my ($sha1,$indices) = @_;

        $sha = Digest::SHA1->new();
        my $sha_buf;
        my $idx_filename = "$git_object_dir/pack/pack-$sha1.idx";
        open IDX, ">$idx_filename"
                        or die "Cannot create file $idx_filename\n";
        binmode IDX;
        my @sha1s = sort(keys(%{$indices}));
        my ($sha_base, $sha_count, @fanout);
        foreach $sha (@sha1s) {
                $sha_base = substr($sha,0,2) unless defined($sha_base);
                if ($sha_base ne substr($sha,0,2)) {
                        @fanout[hex($sha_base)] = $sha_count;
                        $sha_base = substr($sha,0,2);
                }
                $sha_count ++;
        }
        @fanout[hex($sha_base)] = $sha_count;
	$sha_count = 0;
        for ($i = 0;$i < 256; $i ++) {
		$sha_count = $fanout[$i] if defined($fanout[$i]);
                $sha_buf .= pack("N",$sha_count);
        }
        $sha->add($sha_buf);
        print IDX $sha_buf;
        $sha_buf = '';
        foreach $i (@sha1s) {
                $sha_buf = pack("N", ${$indices}{$i}).pack("H40", $i);
                $sha->add($sha_buf);
                print IDX $sha_buf;
        }
        $sha_buf = pack("H40", $sha1);
        $sha->add($sha_buf);
        print IDX $sha_buf;
        print IDX pack("H40", $sha->hexdigest());
        close IDX;
}

sub upload_pack {
        if ($keep_packs) {
                my $basename = ".pack-".time();
                my $pack_filename = "$git_object_dir/pack/$basename.pack";
                open PACK, ">$pack_filename"
                        or die "Cannot create file $pack_filename\n";
                binmode PACK;
		PACK->autoflush(1);

                $write_pack = $pack_filename;
                $sha = process_pack();
                close PACK;
                my $new_pack_filename = "$git_object_dir/pack/pack-$sha.pack";
                if (!rename $pack_filename, $new_pack_filename) {
			unlink $pack_filename;
			die "Cannot rename $pack_filename to $new_pack_filename\n";
		}
                        
                index_pack($sha,\%pack_blobs);
                prepare_packed_git;
        } else {
                process_pack();
        }
        0;
}

sub bad_ref_char {
        1;
}

sub verify_old_ref {
        my ($name, $hex) = @_;
        return 0 if $hex eq "0000000000000000000000000000000000000000";
        open LOCK, "<$name" or return -1;
        my $buf;
        my $ret = read LOCK, $buf, 40;
        close LOCK;
        return -1 if $ret != 40;
        return -1 unless $buf eq $hex;
        0;
}

sub adjust_shared_perm {
        0;
}

sub safe_create_leading_directories {
        my ($path) = @_;

        my @path = split("/", $path);
        shift @path if $path[0] eq "/";
        pop @path;
        my $pp = '';
        foreach $p (@path) {
                $pp .= '/' unless $pp eq '';
                $pp .= $p;

                if ( -e $pp) {
                        return -3 if (! -d $pp);
                } elsif (!mkdir($pp)) {
                        return -1;
                } elsif (adjust_shared_perm($pp)) {
                        return -2;
                }
        }
        0;
}

sub update {
        my ($cmd) = @_;

        $cmd->{error_string} = undef;
        if ($cmd->{ref_name} =~ m,^refs/, && !bad_ref_char($cmd->{ref_name})) {
                $cmd->{error_string} = "funny refname";
                print STDERR "refusing to create funny ref '$cmd->{ref_name}' locally\n";
                return 0;
        }
        my $lock_name = $cmd->{ref_name}.".lock";
        if (!has_sha1_file ($cmd->{new_sha1})) {
                $cmd->{error_string} = "bad pack";
                print STDERR "unpack should have generated $cmd->{new_sha1} but I can't find it!\n";
                return 0;
        }
        safe_create_leading_directories($lock_name);
        if (!open LOCK, ">$lock_name") {
                $cmd->error_string = "can't lock";
                print STDERR "unable to create $lock_name ($!)\n";
                return 0;
        }
        $result = print LOCK $cmd->{new_sha1}."\n";
        close LOCK;
        if (!$result) {
                unlink ($lock_name);
                $cmd->{error_string} = "can't write";
                print STDERR "unable to write $lock_name\n";
                return 0;
        }
        if (verify_old_ref($cmd->{ref_name}, $cmd->{old_sha1}) < 0) {
                unlink ($lock_name);
                $cmd->{error_string} = "raced";
                print STDERR "$cmd->{ref_name} changed during push\n";
                return 0;
        }
        if (!rename($lock_name, $cmd->{ref_name})) {
                unlink ($lock_name);
                $cmd->{error_string} = "can't rename";
                print STDERR "unable to replace $cmd->{ref_name}\n";
                return 0;
        } else {
                print STDERR "$cmd->{ref_name}: $cmd->{old_sha1} -> $cmd->{new_sha1}\n";
                return 0;
        }
}

sub execute_commands {
        foreach $cmd (@commands) {
                update $cmd;
        }
        #run_update_post_hook
}

sub report {
        my ($status) = @_;

        packet_write (1, $status ? "unpack $status\n" : "unpack ok\n");
        foreach $cmd (@commands) {
                if (${$cmd}{'error_string'}) {
                        packet_write (1, "ng ".${$cmd}{'ref_name'}." ".${$cmd}{'error_string'}."\n");
                } else {
                        packet_write (1, "ok ".${$cmd}{'ref_name'}."\n");
                }
        }
        packet_flush (1);
}

sub enter_repo {
        my ($path,$strict) = @_;
        my ($used_path, $validate_path);

        return 0 if !defined ($path);

        if (!$strict) {
                $path =~ s/^~/$ENV{"HOME"}/e;
                foreach $suffix ('.git/.git','/.git','.git','') {
                        if ( -d $path.$suffix ) {
                                $path .= $suffix;
                                last;
                        }
                }
        }

        chdir $path or return 0;

        if (-d "objects" && -d "refs" && !validate_symref("HEAD")) {
                $ENV{"GIT_DIR"} = ".";
                setup_git_env;
                prepare_packed_git;
                check_repository_format;
                return $path;
        }
        0;
}

sub update_info_refs {
        my $sha1;

        my $ref_file = "$git_dir/info/refs";
        safe_create_leading_directories($ref_file);
        if (!open REFINFO, ">$ref_file+") {
                print STDERR "unable to update $ref_file+\n";
                return 0;
        }
        my @path = ("refs");
        while ($#path >= 0) {
                my $path = shift @path;
                opendir(DIR,"$git_dir/$path") || next;
                foreach $dir (readdir(DIR)) {
                        next if ($dir =~ /^\./ || length($dir) > 255 || $dir =~ /\.lock$/);
                        if (-d "$git_dir/$path/$dir") {
                                push @path, "$path/$dir";
                                next;
                        }
                        if (read_ref("$git_dir/$path/$dir",\$sha1) < 0) {
                                print STDERR "$path/$dir points nowhere!\n";
                                next;
                        }
                        if (!has_sha1_file($sha1)) {
                                print STDERR "$path/$dir does not point to a valid commit object!\n";
                                next;
                        }
                        print REFINFO "$sha1\t$path/$dir\n";
                        my ($buffer, $type, $tag_sha1);
                        $tag_sha1 = $sha1;
                        while (1) {
                                $buffer = read_sha1_file($tag_sha1, \$type);
                                last if ($type != $PACK_TYPE{OBJ_TAG});
                                $tag_sha1 = $1 if $buffer =~ m/^object ([0-9a-fA-F]{40})/;
                        } 
                        print REFINFO "$tag_sha1\t$path/$dir^{}\n"
                                unless $tag_sha1 eq $sha1;
                }
                closedir DIR;
        }
        close REFINFO;
        rename "$ref_file+", $ref_file;
        0;
}

sub update_info_packs {
        my ($force) = @_;

        $outfile = "$git_object_dir/info/packs";

        safe_create_leading_directories($outfile);

        if (!open REFINFO, ">$outfile+") {
                print STDERR "Cannot write to $outfile+\n";
                return 0;
        }
        while (<$git_object_dir/pack/*.pack>) {
                print REFINFO "P $1\n"
                        if m,/(pack-[0-9a-fA-F]{40}.pack)$,;
        }
        print REFINFO "\n";
        close REFINFO;
        rename "$outfile+", "$outfile";
}

# main entry

$quiet = 1 unless -t STDERR;

$| = 1;

setup_git_env;
prepare_packed_git;

if ($0 =~ m/receive-pack(\.pl)?/) {
        foreach $arg (@ARGV) {
                usage() if $arg =~ m/^-/;
                usage() if defined($dir);
                $dir = $arg;
        }

        usage() if !defined($dir);

        enter_repo($dir, 0) or die "'$dir': unable to chdir or not a git archive\n";

        write_head_info;

        packet_flush(1);

        read_head_info;

        if ($#commands >= 0) {
                my $unpack_status = upload_pack;
                execute_commands if !$unpack_status;
                report($unpack_status) if $report_status;
        }

        update_info_refs();#if -e "$git_dir/info/refs";
        update_info_packs();# if -e "$git_object_dir/info/packs";
        exit 0;
}

if ($0 =~ m/unpack-objects(\.pl)?/) {
        $sha = process_pack;
        print STDERR "unpacked $sha\n";
        foreach $sha (sort(keys %pack_blobs)) {
                print pack("N",$pack_blobs{$sha});
                print pack("H40",$sha);
        }
        exit 0;
}

if ($0 =~ m/cat-file(.pl)?/) {
        my ($buffer,$type);
        $buffer = read_sha1_file($ARGV[0],\$type);
        print $PACK_SIG{$type}." - ".length($buffer)."\n";
        print $buffer;
        exit 0;
}

if ($0 =~ m/update-server-info(.pl)?/) {
        my $force = 0;
        foreach $arg (@ARGV) {
                if ($arg =~ m/--f(orce)?/) {
                        $force = 1;
                } else {
                        print STDERR "Usage: git-update-server-info [--force]\n";
                        exit 0;
                }
        }
        update_info_refs($force);
        update_info_packs($force);
        unlink("$git_dir/info/rev-cache");
        exit 0;
}

if ($0 =~ /index-pack(.pl)?/) {
        $keep_packs = 1; # so it won't write anything
        $sha = process_pack();
        index_pack($sha,\%pack_blobs);
        exit 0;
}

print STDERR "Unknown command $0\n";

git push nguyên kho git, chạy mát trời (hơi chậm). Nhưng cái index phát sinh hình như bị thiếu hết phân nửa :( Có thể là do mấy cái delta object. Bố khỉ, còn có tí xíu.

#!/usr/bin/perl -w

use Compress::Zlib;
use Digest::SHA1;

$report_status = 0;
$capabilities = "report-status";
$capabilities_sent = 0;
$keep_packs = 1;
$write_pack = 0;

sub usage {
	die "git-receive-pack.pl <git-dir>";
}

sub validate_symref {
	my ($path) = @_;

	if (-l $path) {
		my $real_path = readlink $path;
		return $real_path =~ m,^refs/, ? 0 : -1;
	}
	open FH, $path or return -1;
	my $line = <FH>;
	close FH;
	$line =~ m,^ref: *refs/., ? 0 : -1;
}

sub check_repository_format {
	#TODO
	return 0;
}

sub setup_git_env {
	$git_dir = $ENV{"GIT_DIR"};
	$git_dir = '.git' if !defined($git_dir);

	$git_object_dir = $ENV{"GIT_OBJECT_DIRECTORY"};
	$git_object_dir = "$git_dir/objects"
		unless defined($git_object_dir);

	#$git_refs_dir = "$git_dir/refs";

	$git_index_file = $ENV{"GIT_INDEX_FILE"};
	$git_index_file = "$git_dir/index"
		unless defined($git_index_file);

	$git_graft_file = $ENV{"GIT_GRAFT_FILE"};
	$git_graft_file = "$git_dir/info/grafts"
		unless defined($git_graft_file);
}

sub resolve_ref {
	my ($path, $sha1, $reading) = @_;
	my $depth = 5; #MAXDEPTH
	my $len;

	while (1) {
		return 0 if --$depth < 0;

		if (! -f $path) {
			return 0 if $reading || !defined($!{ENOENT});
			$$sha1 = "0000000000000000000000000000000000000000";
			return $path;
		}

		if (-l $path) {
			my $real_path = readlink ($path);
			if ($real_path =~ m,^refs/,) {
				$path = "$git_dir/$real_path";
				next;
			}
		}

		open FH, $path or return 0;
		my $line = <FH>;
		close FH;

		chomp($line);
		if ($line =~ m/^ref: *(.*)$/) {
			$path = "$git_dir/$1";
			next;
		}

		$$sha1 = $line;
		return $path;
	}
	return $path;
}

sub read_ref {
	my ($filename, $sha1) = @_;
	resolve_ref($filename, $sha1, 1) ? 0 : -1;
}

sub packet_write {
	my ($fd, $text) = @_;

	my $len = length($text)+4;
	#printf STDERR "packet_write: %d %04x %s", $len, $len, $text;
	printf "%04x%s", $len, $text;
}

sub packet_flush {
	my ($fd) = @_;

	print "0000";
	#print STDERR "packet_flush\n";
}


@commands = ();

sub read_head_info {
	while (1) {
		my $len;
		my $ret = read(STDIN, $len, 4);
		die "packet_read error: $!\n" if !defined($ret) || $ret != 4;
		die "protocol error: bad line length character: <$len>" if $len !~ m/^[0-9a-fA-F]{4}$/;
		$len = hex($len);
		last if !$len;
		$len -= 4;
		my $line;
		$ret = read(STDIN, $line, $len);
		die "packet_read error: $!\n" if !defined($ret) || $ret != $len;
		die "protocol error: bad line length $len" if $len != length($line);
		#print STDERR "packet_read: $line\n";
		die "protocol error: expected old/new/ref, got $line" 
			if $line !~ /^([0-9a-fA-F]{40}) ([0-9a-fA-F]{40}) ([^\0]+)(\0report-status)?$/;

		$report_status = 1 if defined($4);

		my $cmd = {
			'old_sha1' => $1,
			'new_sha1' => $2,
			'ref_name' => $3,
			'error_string' => 0,
		};
		$commands[$#commands+1] = $cmd;
	}
}

%PACK_TYPE = (
	OBJ_EXT => 0,
	OBJ_COMMIT => 1,
	OBJ_TREE => 2,
	OBJ_BLOB => 3,
	OBJ_TAG => 4,
	OBJ_DELTA => 7
);

%PACK_SIG = ( 1 => "commit", 2 => "tree", 3 => "blob", 4 => "tag" );

$pack_buffer = '';
$pack_count = 0;

sub fill {
	my ($min) = @_;

	if ($min > length($pack_buffer)) {
		my $buf;
		read(STDIN, $buf, 4096);
		$pack_buffer .= $buf;
	}
	substr($pack_buffer, 0, $min);
}

sub throw_away {
	my ($len) = @_;
	my $data = substr($pack_buffer, 0, $len);
	$pack_sha->add($data);
	print PACK $data if $keep_packs and $write_pack;
	$pack_buffer = substr($pack_buffer, $len);
	$pack_count += $len;
}

sub fill_and_throw {
	my ($len) = @_;
	$a = fill($len);
	throw_away($len);
	$a;
}

%pack_blobs = ();

sub get_data {
	my ($size) = @_;

	my $x = inflateInit() or die "Cannot create a inflation stream\n";
	my $buffer = '';
	my ($output, $status, $c);
	while (1) {
		fill(1);
		$c = $pack_buffer;
		($output, $status) = $x->inflate(\$c);
		throw_away(length($pack_buffer)-length($c));
		$buffer .= $output if $status == Z_OK or $status == Z_STREAM_END;
		last if $status != Z_OK;
	}
	die "inflation failed\n" unless $status == Z_STREAM_END && length($buffer) == $size;
	$buffer;
}

sub unpack_non_delta_entry {
	my ($type, $size) = @_;

	my $buffer = get_data($size);
	$buffer;
	#print STDERR "Got $type\n";
}

sub prepare_packed_git {
	%packed_sha1 = ();
	while (<$git_object_dir/pack/*.pack>) {
		my $pack_file = $_;
		my $idx_file = $pack_file;
		$idx_file =~ s/\.pack$/.idx/;
		next unless -e $idx_file;

		open IDX, "<$idx_file" or next;
		binmode IDX;
		my $buf;

		read IDX,$buf,4*256;
		my $count = unpack("N",substr($buf,4*255));
		my $blen = read(IDX,$buf,(4+20)*$count);
		my @idx = unpack("(NH40)$count",$buf);
		for ($i = 0;$i < $count;$i ++) {
			$packed_sha1{$idx[$i*2+1]} = {"filename" => $pack_file, "pos" => $idx[$i*2]};
		}
	}
}

sub find_pack_entry {
	my ($sha1) = @_;
	defined($packed_sha1{$sha1});
}

sub read_packed_sha1 {
	my ($sha1, $type) = @_;

	open FH, $packed_sha1{$sha1}->{filename}
		or die "Cannot open pack ".$packed_sha1{$sha1}->{filename}.".\n";
	binmode FH;
	my $c;
	seek FH, $packed_sha1{$sha1}->{pos}, 0;
	read FH, $c, 1;
	$c = ord($c);
	$$type = ($c >> 4) & 7;
	my $size = ($c & 15);
	my $shift = 4;
	while ($c & 0x80) {
		read FH, $c, 1;
		$c = ord($c);
		$size += ($c & 0x7f) << $shift;
		$shift += 7;
	}
	my $base_sha1;
	if ($$type == $PACK_TYPE{OBJ_DELTA}) {
		read FH, $base_sha1, 20;
		$base_sha1 = unpack("H40",$base_sha1);
	}
	my $x = inflateInit() or die "Cannot create inflation object";
	my ($buffer, $input, $output, $status);
	while (read(FH, $input, 4096)) {
		($output, $status) = $x->inflate(\$input);
		$buffer .= $output if $status == Z_OK || $status == Z_STREAM_END;
		last if $status != Z_OK;
	}
	close FH;
	die "read_packed_sha1: inflation failed\n" unless $status == Z_STREAM_END;
	die "data length unmatched: $size" unless length($buffer) == $size;
	return $buffer unless $$type == $PACK_TYPE{OBJ_DELTA};
	die "failed to find delta-pack base object"
		unless defined($packed_sha1{$base_sha1}) &&
			$packed_sha1{$base_sha1}->{filename} eq $packed_sha1{$sha1}->{filename};
	my $base = read_packed_sha1 ($base_sha1, $type);
	my $b = patch_delta ($base, $buffer);
	die "Patch failed\n" unless defined ($b);
	$b;
}

sub find_sha1_file {
	my ($sha1) = @_;

	#TODO no altdb support
	-f "$git_object_dir/".substr($sha1,0,2)."/".substr($sha1,2,38);
}

sub has_sha1_file {
	my ($sha1) = @_;
	return 1 if find_pack_entry($sha1);
	find_sha1_file($sha1);
}

%delta_queue = ();
sub add_delta_to_list {
	my ($base_sha1, $delta_data, $size) = @_;
	$delta_queue{$base_sha1} = [] unless defined $delta_queue{$base_sha1};
	push @{$delta_queue{$base_sha1}}, $delta_data;
	#print STDERR "Queued $base_sha1\n";
}

sub read_sha1_file {
	my ($sha, $type) = @_;
	return read_packed_sha1($sha, $type)
		if find_pack_entry($sha);

	open BLOB, "<$git_object_dir/".substr($sha,0,2)."/".substr($sha,2,38)
		or die "Cannot open $sha\n";
	binmode BLOB;

	# uncompress the header
	my $x = inflateInit() or die "Cannot create inflation object\n";
	my $input = '';
	my ($data,$header,$output,$status);
	while (read(BLOB,$input,4096)) {
		($output, $status) = $x->inflate(\$input) ;
		$header .= $output
			if  $status == Z_OK or $status == Z_STREAM_END ;
		last if $status != Z_OK;
	}
	close BLOB;
	die "$sha: blob header inflation failed\n" unless $status == Z_STREAM_END;
	
	#parse the header
	die "invalid blob"
		unless $header =~ m/^([^ ]*) ([1-9][0-9]*)\0/;

	my $size = $2;
	my $header_len = length($&);
	if ($1 eq "commit") {
		$$type = 1;
	} elsif ($1 eq "tree") {
		$$type = 2;
	} elsif ($1 eq "blob") {
		$$type = 3;
	} elsif ($1 eq "tag") {
		$$type = 4;
	} else {
		die "invalid blob type $1\n";
	}

	die "blob length unmatch $size" unless $size == length($header) - $header_len;
	substr($header, $header_len);
}

sub patch_delta {
	my ($base, $delta) = @_;
	my $DELTA_SIZE_MIN = 4;

	return undef if length($delta) < $DELTA_SIZE_MIN;
	
	my $output = '';
	my $i = 0;
	my $cmd;
	my $size = 0;
	my $shift = 0;

	do {
		$cmd = ord(substr($delta,$i++,1));
		$size |= ($cmd & ~0x80) << $shift;
		$shift += 7;
	} while ($cmd & 0x80 && $i < length($delta));
	return undef if $size != length($base);

	$shift = 0;
	$size = 0;
	do {
		$cmd = ord(substr($delta,$i++,1));
		$size |= ($cmd & ~0x80) << $shift;
		$shift += 7;
	} while ($cmd & 0x80 && $i < length($delta));

	while ($i < length($delta)) {
		$cmd = ord(substr($delta,$i++,1));
		if ($cmd & 0x80) {
			my $cp_off = 0;
			my $cp_size = 0;
			$cp_off = ord(substr($delta,$i++,1)) if $cmd & 0x01;
			$cp_off |= ord(substr($delta,$i++,1)) << 8 if $cmd & 0x02;
			$cp_off |= ord(substr($delta,$i++,1)) << 16 if $cmd & 0x04;
			$cp_off |= ord(substr($delta,$i++,1)) << 24 if $cmd & 0x08;

			$cp_size = ord(substr($delta,$i++,1)) if $cmd & 0x10;
			$cp_size |= ord(substr($delta,$i++,1)) << 8 if $cmd & 0x20;
			$cp_size |= ord(substr($delta,$i++,1)) << 16 if $cmd & 0x40;
			$cp_size = 0x10000 if $cp_size == 0;
			$output .= substr($base,$cp_off, $cp_size);
		} elsif ($cmd) {
			$output .= substr($delta, $i, $cmd);
			$i += $cmd;
		} else {
			print STDERR "BAAAA\n";
			return undef;
		}
	}
	length($output) == $size ? $output : undef;
}

sub resolve_delta {
	my ($base, $delta) = @_;
	patch_delta ($base, $delta);
}

sub unpack_delta_entry {
	my ($size,$type) = @_;

	my $base_sha1 = unpack("H40",fill_and_throw(20));

	my $delta_data = get_data($size);

	if (!has_sha1_file($base_sha1)) {
		add_delta_to_list ($base_sha1, $delta_data, $size);
		return undef;
	}

	my $base = read_sha1_file($base_sha1, $type);
	die "failed to read delta-pack base object $base_sha1\n"
		unless defined($base);

	my $buffer = resolve_delta($base, $delta_data);
	$buffer;
}

sub object_added {
	my ($type, $buffer, $sha1) = @_;
	
	if (defined($delta_queue{$sha1})) {
		foreach $delta (@{$delta_queue{$sha1}}) {
			my $new_buffer = resolve_delta($buffer, $delta);
			if ($keep_packs) {
				my $sha = Digest::SHA1->new();
				$sha->add($PACK_SIG{$type}." ".length($new_buffer)."\0");
				$sha->add($new_buffer);
				$sha1 = $sha->hexdigest();
				object_added ($type, $new_buffer, $sha1);
			} else {
				write_object ($type, $new_buffer);
			}
		}
#print STDERR "Unqueued $sha1\n";
		undef $delta_queue{$sha1};
	}
}

sub write_object {
	my ($type, $buffer) = @_;

	my $header = $PACK_SIG{$type}." ".length($buffer)."\0";
	my $sha = Digest::SHA1->new();
	$sha->add($header);
	$sha->add($buffer);
	my $sha1 = $sha->hexdigest();

	my $blob_filename = "$git_object_dir/".substr($sha1,0,2)."/".substr($sha1,2,38);
	if ( ! -f $blob_filename) {
	#if (1) {
		my $x = deflateInit()
			or die "Cannot create deflation object\n";
		my $output2;
		my ($output, $status) = $x->deflate($header.$buffer);
		$status == Z_OK or die "deflation failed\n";
		$output2 = $output;
		($output, $status) = $x->flush();
		$status == Z_OK or die "deflation failed\n";
		$output2 .= $output;
		safe_create_leading_directories ($blob_filename);
		if (!open BLOB, ">$blob_filename") {
			die "Can't write to $blob_filename\n";
		}
		binmode BLOB;
		print BLOB $output2;
		close BLOB;

		#print STDERR "Wrote $sha1\n";
		object_added ($type, $buffer, $sha1);
	}
	$sha1;
}

sub unpack_one {
	my ($nr, $total) = @_;
	my $pos = $pack_count;
	my $c = fill_and_throw(1);
	$c = ord($c);
	my $type = ($c >> 4) & 7;
	my $size = ($c & 15);
	my $shift = 4;
	while ($c & 0x80) {
		$c = fill_and_throw(1);
		$c = ord($c);
		$size += ($c & 0x7f) << $shift;
		$shift += 7;
	}
	if (!defined($quiet)) {
		$last_sec = 0 if ! defined ($last_sec);
		$last_percent = 0 if ! defined ($last_percent);
		my $percentage = ($nr * 100) / $total;
		my $now = time();
		if ($percentage != $last_percent || $now != $last_sec) {
			$last_sec = $now;
			$last_percent = $percentage;
			printf STDERR "%4u%% (%u/%u) done\r", $percentage, $nr, $total;
		}
	}
	my $buffer;
	if ($type == $PACK_TYPE{OBJ_COMMIT} ||
		$type == $PACK_TYPE{OBJ_TREE} ||
		$type == $PACK_TYPE{OBJ_BLOB} ||
		$type == $PACK_TYPE{OBJ_TAG}) {
		$buffer = unpack_non_delta_entry($type,$size);
	} elsif ($type == $PACK_TYPE{OBJ_DELTA}) {
		$buffer = unpack_delta_entry($size,\$type);
	} else {
		die "bad object type $type\n";
	}

	if (defined($buffer)) {
		my $sha1;
		if ($keep_packs) {
			my $sha = Digest::SHA1->new();
			$sha->add($PACK_SIG{$type}." ".length($buffer)."\0");
			$sha->add($buffer);
			$sha1 = $sha->hexdigest();
			object_added ($type, $buffer, $sha1);
		} else {
			$sha1 = write_object($type,$buffer);
		}
		$pack_blobs{$sha1} = $pos;
	}
}

sub process_pack {
	$pack_sha = Digest::SHA1->new();
	my $signature = fill_and_throw(4);
	die "not a pack. Wrong signature: $signature\n" unless $signature =~ m/^PACK/;

	my $version = fill_and_throw(4);
	$version = unpack("N",$version);
	die "unknown pack file version $version" unless $version == 2 || $version == 3;

	my $nr_obj = fill_and_throw(4);
	$nr_obj = unpack("N",$nr_obj);

	for ($i = 0;$i < $nr_obj; $i ++) {
		unpack_one($i+1, $nr_obj);
	}

	my $digest_sha = $pack_sha->hexdigest();
	my $sha = unpack("H40",fill_and_throw(20));
	die "final sha did not match\n" unless $sha eq $digest_sha;
	$sha;
}

sub show_ref {
	my ($path, $sha1) = @_;

	packet_write(1, $capabilities_sent ? "$sha1 $path\n" : "$sha1 $path\0$capabilities\n");
	$capabilities_sent = 1;
	0;
}

sub do_for_each_ref {
	my ($base) = @_;
	my $sha1;

	opendir(DIR,"$git_dir/$base") || die $!;
	$base =~ s,/*$,/,;
	foreach $dir (readdir(DIR)) {
		next if ($dir =~ /^\./ || length($dir) > 255 || $dir =~ /\.lock$/);
		my $path = $base.$dir;
		if (-d "$git_dir/$path") {
			last if do_for_each_ref($path);
			next;
		}
		if (read_ref("$git_dir/$path",\$sha1) < 0) {
			print STDERR "$path points nowhere!\n";
			next;
		}
		if (!has_sha1_file($sha1)) {
			print STDERR "$path does not point to a valid commit object!\n";
			next;
		}
		last if show_ref($path,$sha1);
	}
	closedir DIR;
	0;
}

sub write_head_info {
	do_for_each_ref("refs");
	show_ref("capabilities^{}", "0000000000000000000000000000000000000000") 
		unless $capabilities_sent;
}

sub index_pack {
	my ($sha1,$indices) = @_;

	$sha = Digest::SHA1->new();
	my $sha_buf;
	my $idx_filename = "$git_object_dir/pack/pack-$sha1.idx";
	open IDX, ">$idx_filename"
			or die "Cannot create file $idx_filename\n";
	binmode IDX;
	my @sha1s = sort(keys(%{$indices}));
	my ($sha_base, $sha_count, @fanout);
	foreach $sha (@sha1s) {
		$sha_base = substr($sha,0,2) unless defined($sha_base);
		if ($sha_base ne substr($sha,0,2)) {
			@fanout[hex($sha_base)] = $sha_count;
			$sha_base = substr($sha,0,2);
		}
		$sha_count ++;
	}
	@fanout[hex($sha_base)] = $sha_count;
	for ($i = 0;$i < 256; $i ++) {
		$sha_buf .= pack("N",defined($fanout[$i]) ? $fanout[$i] : 0);
	}
	$sha->add($sha_buf);
	print IDX $sha_buf;
	$sha_buf = '';
	foreach $i (@sha1s) {
		$sha_buf = pack("N", ${$indices}{$i}).pack("H40", $i);
		$sha->add($sha_buf);
		print IDX $sha_buf;
	}
	$sha_buf = pack("H40", $sha1);
	$sha->add($sha_buf);
	print IDX $sha_buf;
	print IDX pack("H40", $sha->hexdigest());
	close IDX;
}

sub upload_pack {
	if ($keep_packs) {
		my $basename = ".pack-".time();
		my $pack_filename = "$git_object_dir/pack/$basename.pack";
		open PACK, ">$pack_filename"
			or die "Cannot create file $pack_filename\n";
		binmode PACK;

		$write_pack = 1;
		$sha = process_pack();
		close PACK;
		my $new_pack_filename = "$git_object_dir/pack/pack-$sha.pack";
		rename $pack_filename, $new_pack_filename
			or die "Cannot rename $pack_filename to $new_pack_filename\n";
			
		index_pack($sha,\%pack_blobs);
		prepare_packed_git;
	} else {
		process_pack();
	}
	0;
}

sub bad_ref_char {
	1;
}

sub verify_old_ref {
	my ($name, $hex) = @_;
	return 0 if $hex eq "0000000000000000000000000000000000000000";
	open LOCK, "<$name" or return -1;
	my $buf;
	my $ret = read LOCK, $buf, 40;
	close LOCK;
	return -1 if $ret != 40;
	return -1 unless $buf eq $hex;
	0;
}

sub adjust_shared_perm {
	0;
}

sub safe_create_leading_directories {
	my ($path) = @_;

	my @path = split("/", $path);
	shift @path if $path[0] eq "/";
	pop @path;
	my $pp = '';
	foreach $p (@path) {
		$pp .= '/' unless $pp eq '';
		$pp .= $p;

		if ( -e $pp) {
			return -3 if (! -d $pp);
		} elsif (!mkdir($pp)) {
			return -1;
		} elsif (adjust_shared_perm($pp)) {
			return -2;
		}
	}
	0;
}

sub update {
	my ($cmd) = @_;

	$cmd->{error_string} = undef;
	if ($cmd->{ref_name} =~ m,^refs/, && !bad_ref_char($cmd->{ref_name})) {
		$cmd->{error_string} = "funny refname";
		print STDERR "refusing to create funny ref '$cmd->{ref_name}' locally\n";
		return 0;
	}
	my $lock_name = $cmd->{ref_name}.".lock";
	if (!has_sha1_file ($cmd->{new_sha1})) {
		$cmd->{error_string} = "bad pack";
		print STDERR "unpack should have generated $cmd->{new_sha1} but I can't find it!\n";
		return 0;
	}
	safe_create_leading_directories($lock_name);
	if (!open LOCK, ">$lock_name") {
		$cmd->error_string = "can't lock";
		print STDERR "unable to create $lock_name ($!)\n";
		return 0;
	}
	$result = print LOCK $cmd->{new_sha1}."\n";
	close LOCK;
	if (!$result) {
		unlink ($lock_name);
		$cmd->{error_string} = "can't write";
		print STDERR "unable to write $lock_name\n";
		return 0;
	}
	if (verify_old_ref($cmd->{ref_name}, $cmd->{old_sha1}) < 0) {
		unlink ($lock_name);
		$cmd->{error_string} = "raced";
		print STDERR "$cmd->{ref_name} changed during push\n";
		return 0;
	}
	if (!rename($lock_name, $cmd->{ref_name})) {
		unlink ($lock_name);
		$cmd->{error_string} = "can't rename";
		print STDERR "unable to replace $cmd->{ref_name}\n";
		return 0;
	} else {
		print STDERR "$cmd->{ref_name}: $cmd->{old_sha1} -> $cmd->{new_sha1}\n";
		return 0;
	}
}

sub execute_commands {
	foreach $cmd (@commands) {
		update $cmd;
	}
	#run_update_post_hook
}

sub report {
	my ($status) = @_;

	packet_write (1, $status ? "unpack $status\n" : "unpack ok\n");
	foreach $cmd (@commands) {
		if (${$cmd}{'error_string'}) {
			packet_write (1, "ng ".${$cmd}{'ref_name'}." ".${$cmd}{'error_string'}."\n");
		} else {
			packet_write (1, "ok ".${$cmd}{'ref_name'}."\n");
		}
	}
	packet_flush (1);
}

sub enter_repo {
	my ($path,$strict) = @_;
	my ($used_path, $validate_path);

	return 0 if !defined ($path);

	if (!$strict) {
		$path =~ s/^~/$ENV{"HOME"}/e;
		foreach $suffix ('.git/.git','/.git','.git','') {
			if ( -d $path.$suffix ) {
				$path .= $suffix;
				last;
			}
		}
	}

	chdir $path or return 0;

	if (-d "objects" && -d "refs" && !validate_symref("HEAD")) {
		$ENV{"GIT_DIR"} = ".";
		setup_git_env;
		prepare_packed_git;
		check_repository_format;
		return $path;
	}
	0;
}

sub update_info_refs {
	my $sha1;

	my $ref_file = "$git_dir/info/refs";
	safe_create_leading_directories($ref_file);
	if (!open REFINFO, ">$ref_file+") {
		print STDERR "unable to update $ref_file+\n";
		return 0;
	}
	my @path = ("refs");
	while ($#path >= 0) {
		my $path = shift @path;
		opendir(DIR,"$git_dir/$path") || next;
		foreach $dir (readdir(DIR)) {
			next if ($dir =~ /^\./ || length($dir) > 255 || $dir =~ /\.lock$/);
			if (-d "$git_dir/$path/$dir") {
				push @path, "$path/$dir";
				next;
			}
			if (read_ref("$git_dir/$path/$dir",\$sha1) < 0) {
				print STDERR "$path/$dir points nowhere!\n";
				next;
			}
			if (!has_sha1_file($sha1)) {
				print STDERR "$path/$dir does not point to a valid commit object!\n";
				next;
			}
			print REFINFO "$sha1	$path/$dir\n";
			my ($buffer, $type, $tag_sha1);
			$tag_sha1 = $sha1;
			while (1) {
				$buffer = read_sha1_file($tag_sha1, \$type);
				last if ($type != $PACK_TYPE{OBJ_TAG});
				$tag_sha1 = $1 if $buffer =~ m/^object ([0-9a-fA-F]{40})/;
			} 
			print REFINFO "$tag_sha1	$path/$dir^{}\n"
				unless $tag_sha1 eq $sha1;
		}
		closedir DIR;
	}
	close REFINFO;
	rename "$ref_file+", $ref_file;
	0;
}

sub update_info_packs {
	my ($force) = @_;

	$outfile = "$git_object_dir/info/packs";

	safe_create_leading_directories($outfile);

	if (!open REFINFO, ">$outfile+") {
		print STDERR "Cannot write to $outfile+\n";
		return 0;
	}
	while (<$git_object_dir/pack/*.pack>) {
		print REFINFO "P $1\n"
			if m,/pack-([0-9a-fA-F]{40}).pack$,;
	}
	print REFINFO "\n";
	close REFINFO;
	rename "$outfile+", "$outfile";
}

# main entry

$quiet = 1 unless -t STDERR;

$| = 1;

setup_git_env;
prepare_packed_git;

if ($0 =~ m/receive-pack(\.pl)?/) {
	foreach $arg (@ARGV) {
		usage() if $arg =~ m/^-/;
		usage() if defined($dir);
		$dir = $arg;
	}

	usage() if !defined($dir);

	enter_repo($dir, 0) or die "'$dir': unable to chdir or not a git archive\n";

	write_head_info;

	packet_flush(1);

	read_head_info;

	if ($#commands >= 0) {
		my $unpack_status = upload_pack;
		execute_commands if !$unpack_status;
		report($unpack_status) if $report_status;
	}

	update_info_refs();#if -e "$git_dir/info/refs";
	update_info_packs();# if -e "$git_object_dir/info/packs";
	exit 0;
}

if ($0 =~ m/unpack-objects(\.pl)?/) {
	$sha = process_pack;
	print STDERR "unpacked $sha\n";
	foreach $sha (sort(keys %pack_blobs)) {
		print pack("N",$pack_blobs{$sha});
		print pack("H40",$sha);
	}
	exit 0;
}

if ($0 =~ m/cat-file(.pl)?/) {
	my ($buffer,$type);
	$buffer = read_sha1_file($ARGV[0],\$type);
	print $PACK_SIG{$type}." - ".length($buffer)."\n";
	print $buffer;
	exit 0;
}

if ($0 =~ m/update-server-info(.pl)?/) {
	my $force = 0;
	foreach $arg (@ARGV) {
		if ($arg =~ m/--f(orce)?/) {
			$force = 1;
		} else {
			print STDERR "Usage: git-update-server-info [--force]\n";
			exit 0;
		}
	}
	update_info_refs($force);
	update_info_packs($force);
	unlink("$git_dir/info/rev-cache");
	exit 0;
}

if ($0 =~ /index-pack(.pl)?/) {
	$keep_packs = 1; # so it won't write anything
	$sha = process_pack();
	index_pack($sha,\%pack_blobs);
	exit 0;
}

print STDERR "Unknown command $0\n";