[thirdparty/git.git] / t / t0021 / rot13-filter.pl

#
# Example implementation for the Git filter protocol version 2
# See Documentation/gitattributes.txt, section "Filter Protocol"
#
# The first argument defines a debug log file that the script write to.
# All remaining arguments define a list of supported protocol
# capabilities ("clean", "smudge", etc).
#
# This implementation supports special test cases:
# (1) If data with the pathname "clean-write-fail.r" is processed with
#     a "clean" operation then the write operation will die.
# (2) If data with the pathname "smudge-write-fail.r" is processed with
#     a "smudge" operation then the write operation will die.
# (3) If data with the pathname "error.r" is processed with any
#     operation then the filter signals that it cannot or does not want
#     to process the file.
# (4) If data with the pathname "abort.r" is processed with any
#     operation then the filter signals that it cannot or does not want
#     to process the file and any file after that is processed with the
#     same command.
# (5) If data with a pathname that is a key in the DELAY hash is
#     requested (e.g. "test-delay10.a") then the filter responds with
#     a "delay" status and sets the "requested" field in the DELAY hash.
#     The filter will signal the availability of this object after
#     "count" (field in DELAY hash) "list_available_blobs" commands.
# (6) If data with the pathname "missing-delay.a" is processed that the
#     filter will drop the path from the "list_available_blobs" response.
# (7) If data with the pathname "invalid-delay.a" is processed that the
#     filter will add the path "unfiltered" which was not delayed before
#     to the "list_available_blobs" response.
#

use strict;
use warnings;
use IO::File;

my $MAX_PACKET_CONTENT_SIZE = 65516;
my $log_file                = shift @ARGV;
my @capabilities            = @ARGV;

open my $debug, ">>", $log_file or die "cannot open log file: $!";

my %DELAY = (
	'test-delay10.a' => { "requested" => 0, "count" => 1 },
	'test-delay11.a' => { "requested" => 0, "count" => 1 },
	'test-delay20.a' => { "requested" => 0, "count" => 2 },
	'test-delay10.b' => { "requested" => 0, "count" => 1 },
	'missing-delay.a' => { "requested" => 0, "count" => 1 },
	'invalid-delay.a' => { "requested" => 0, "count" => 1 },
);

sub rot13 {
	my $str = shift;
	$str =~ y/A-Za-z/N-ZA-Mn-za-m/;
	return $str;
}

sub packet_compare_lists {
	my ($expect, @result) = @_;
	my $ix;
	if (scalar @$expect != scalar @result) {
		return undef;
	}
	for ($ix = 0; $ix < $#result; $ix++) {
		if ($expect->[$ix] ne $result[$ix]) {
			return undef;
		}
	}
	return 1;
}

sub packet_bin_read {
	my $buffer;
	my $bytes_read = read STDIN, $buffer, 4;
	if ( $bytes_read == 0 ) {
		# EOF - Git stopped talking to us!
		return ( -1, "" );
	} elsif ( $bytes_read != 4 ) {
		die "invalid packet: '$buffer'";
	}
	my $pkt_size = hex($buffer);
	if ( $pkt_size == 0 ) {
		return ( 1, "" );
	} elsif ( $pkt_size > 4 ) {
		my $content_size = $pkt_size - 4;
		$bytes_read = read STDIN, $buffer, $content_size;
		if ( $bytes_read != $content_size ) {
			die "invalid packet ($content_size bytes expected; $bytes_read bytes read)";
		}
		return ( 0, $buffer );
	} else {
		die "invalid packet size: $pkt_size";
	}
}

sub remove_final_lf_or_die {
	my $buf = shift;
	unless ( $buf =~ s/\n$// ) {
		die "A non-binary line MUST be terminated by an LF.\n"
		    . "Received: '$buf'";
	}
	return $buf;
}

sub packet_txt_read {
	my ( $res, $buf ) = packet_bin_read();
	unless ( $res == -1 or $buf eq '' ) {
		$buf = remove_final_lf_or_die($buf);
	}
	return ( $res, $buf );
}

sub packet_required_key_val_read {
	my ( $key ) = @_;
	my ( $res, $buf ) = packet_txt_read();
	unless ( $res == -1 or ( $buf =~ s/^$key=// and $buf ne '' ) ) {
		die "bad $key: '$buf'";
	}
	return ( $res, $buf );
}

sub packet_bin_write {
	my $buf = shift;
	print STDOUT sprintf( "%04x", length($buf) + 4 );
	print STDOUT $buf;
	STDOUT->flush();
}

sub packet_txt_write {
	packet_bin_write( $_[0] . "\n" );
}

sub packet_flush {
	print STDOUT sprintf( "%04x", 0 );
	STDOUT->flush();
}

sub packet_initialize {
	my ($name, $version) = @_;

	packet_compare_lists([0, $name . "-client"], packet_txt_read()) ||
		die "bad initialize";
	packet_compare_lists([0, "version=" . $version], packet_txt_read()) ||
		die "bad version";
	packet_compare_lists([1, ""], packet_bin_read()) ||
		die "bad version end";

	packet_txt_write( $name . "-server" );
	packet_txt_write( "version=" . $version );
	packet_flush();
}

sub packet_read_capabilities {
	my @cap;
	while (1) {
		my ( $res, $buf ) = packet_bin_read();
		if ( $res == -1 ) {
			die "unexpected EOF when reading capabilities";
		}
		return ( $res, @cap ) if ( $res != 0 );
		$buf = remove_final_lf_or_die($buf);
		unless ( $buf =~ s/capability=// ) {
			die "bad capability buf: '$buf'";
		}
		push @cap, $buf;
	}
}

# Read remote capabilities and check them against capabilities we require
sub packet_read_and_check_capabilities {
	my @required_caps = @_;
	my ($res, @remote_caps) = packet_read_capabilities();
	my %remote_caps = map { $_ => 1 } @remote_caps;
	foreach (@required_caps) {
		unless (exists($remote_caps{$_})) {
			die "required '$_' capability not available from remote" ;
		}
	}
	return %remote_caps;
}

# Check our capabilities we want to advertise against the remote ones
# and then advertise our capabilities
sub packet_check_and_write_capabilities {
	my ($remote_caps, @our_caps) = @_;
	foreach (@our_caps) {
		unless (exists($remote_caps->{$_})) {
			die "our capability '$_' is not available from remote"
		}
		packet_txt_write( "capability=" . $_ );
	}
	packet_flush();
}

print $debug "START\n";
$debug->flush();

packet_initialize("git-filter", 2);

my %remote_caps = packet_read_and_check_capabilities("clean", "smudge", "delay");
packet_check_and_write_capabilities(\%remote_caps, @capabilities);

print $debug "init handshake complete\n";
$debug->flush();

while (1) {
	my ( $res, $command ) = packet_required_key_val_read("command");
	if ( $res == -1 ) {
		print $debug "STOP\n";
		exit();
	}
	print $debug "IN: $command";
	$debug->flush();

	if ( $command eq "list_available_blobs" ) {
		# Flush
		packet_compare_lists([1, ""], packet_bin_read()) ||
			die "bad list_available_blobs end";

		foreach my $pathname ( sort keys %DELAY ) {
			if ( $DELAY{$pathname}{"requested"} >= 1 ) {
				$DELAY{$pathname}{"count"} = $DELAY{$pathname}{"count"} - 1;
				if ( $pathname eq "invalid-delay.a" ) {
					# Send Git a pathname that was not delayed earlier
					packet_txt_write("pathname=unfiltered");
				}
				if ( $pathname eq "missing-delay.a" ) {
					# Do not signal Git that this file is available
				} elsif ( $DELAY{$pathname}{"count"} == 0 ) {
					print $debug " $pathname";
					packet_txt_write("pathname=$pathname");
				}
			}
		}

		packet_flush();

		print $debug " [OK]\n";
		$debug->flush();
		packet_txt_write("status=success");
		packet_flush();
	} else {
		my ( $res, $pathname ) = packet_required_key_val_read("pathname");
		if ( $res == -1 ) {
			die "unexpected EOF while expecting pathname";
		}
		print $debug " $pathname";
		$debug->flush();

		# Read until flush
		my ( $done, $buffer ) = packet_txt_read();
		while ( $buffer ne '' ) {
			if ( $buffer eq "can-delay=1" ) {
				if ( exists $DELAY{$pathname} and $DELAY{$pathname}{"requested"} == 0 ) {
					$DELAY{$pathname}{"requested"} = 1;
				}
			} else {
				die "Unknown message '$buffer'";
			}

			( $done, $buffer ) = packet_txt_read();
		}
		if ( $done == -1 ) {
			die "unexpected EOF after pathname '$pathname'";
		}

		my $input = "";
		{
			binmode(STDIN);
			my $buffer;
			my $done = 0;
			while ( !$done ) {
				( $done, $buffer ) = packet_bin_read();
				$input .= $buffer;
			}
			if ( $done == -1 ) {
				die "unexpected EOF while reading input for '$pathname'";
			}			
			print $debug " " . length($input) . " [OK] -- ";
			$debug->flush();
		}

		my $output;
		if ( exists $DELAY{$pathname} and exists $DELAY{$pathname}{"output"} ) {
			$output = $DELAY{$pathname}{"output"}
		} elsif ( $pathname eq "error.r" or $pathname eq "abort.r" ) {
			$output = "";
		} elsif ( $command eq "clean" and grep( /^clean$/, @capabilities ) ) {
			$output = rot13($input);
		} elsif ( $command eq "smudge" and grep( /^smudge$/, @capabilities ) ) {
			$output = rot13($input);
		} else {
			die "bad command '$command'";
		}

		if ( $pathname eq "error.r" ) {
			print $debug "[ERROR]\n";
			$debug->flush();
			packet_txt_write("status=error");
			packet_flush();
		} elsif ( $pathname eq "abort.r" ) {
			print $debug "[ABORT]\n";
			$debug->flush();
			packet_txt_write("status=abort");
			packet_flush();
		} elsif ( $command eq "smudge" and
			exists $DELAY{$pathname} and
			$DELAY{$pathname}{"requested"} == 1 ) {
			print $debug "[DELAYED]\n";
			$debug->flush();
			packet_txt_write("status=delayed");
			packet_flush();
			$DELAY{$pathname}{"requested"} = 2;
			$DELAY{$pathname}{"output"} = $output;
		} else {
			packet_txt_write("status=success");
			packet_flush();

			if ( $pathname eq "${command}-write-fail.r" ) {
				print $debug "[WRITE FAIL]\n";
				$debug->flush();
				die "${command} write error";
			}

			print $debug "OUT: " . length($output) . " ";
			$debug->flush();

			while ( length($output) > 0 ) {
				my $packet = substr( $output, 0, $MAX_PACKET_CONTENT_SIZE );
				packet_bin_write($packet);
				# dots represent the number of packets
				print $debug ".";
				if ( length($output) > $MAX_PACKET_CONTENT_SIZE ) {
					$output = substr( $output, $MAX_PACKET_CONTENT_SIZE );
				} else {
					$output = "";
				}
			}
			packet_flush();
			print $debug " [OK]\n";
			$debug->flush();
			packet_flush();
		}
	}
}
Commit	Line	Data
edcc8581 LS	1	#
	2	# Example implementation for the Git filter protocol version 2
	3	# See Documentation/gitattributes.txt, section "Filter Protocol"
	4	#
e1ec4721 LS	5	# The first argument defines a debug log file that the script write to.
	6	# All remaining arguments define a list of supported protocol
	7	# capabilities ("clean", "smudge", etc).
edcc8581 LS	8	#
	9	# This implementation supports special test cases:
	10	# (1) If data with the pathname "clean-write-fail.r" is processed with
	11	# a "clean" operation then the write operation will die.
	12	# (2) If data with the pathname "smudge-write-fail.r" is processed with
	13	# a "smudge" operation then the write operation will die.
	14	# (3) If data with the pathname "error.r" is processed with any
	15	# operation then the filter signals that it cannot or does not want
	16	# to process the file.
	17	# (4) If data with the pathname "abort.r" is processed with any
	18	# operation then the filter signals that it cannot or does not want
	19	# to process the file and any file after that is processed with the
	20	# same command.
2841e8f8 LS	21	# (5) If data with a pathname that is a key in the DELAY hash is
	22	# requested (e.g. "test-delay10.a") then the filter responds with
	23	# a "delay" status and sets the "requested" field in the DELAY hash.
	24	# The filter will signal the availability of this object after
	25	# "count" (field in DELAY hash) "list_available_blobs" commands.
	26	# (6) If data with the pathname "missing-delay.a" is processed that the
	27	# filter will drop the path from the "list_available_blobs" response.
	28	# (7) If data with the pathname "invalid-delay.a" is processed that the
	29	# filter will add the path "unfiltered" which was not delayed before
	30	# to the "list_available_blobs" response.
edcc8581 LS	31	#
	32
	33	use strict;
	34	use warnings;
4821494e	35	use IO::File;
edcc8581 LS	36
edcc8581 LS	37	my $MAX_PACKET_CONTENT_SIZE = 65516;
e1ec4721	38	my $log_file = shift @ARGV;
edcc8581 LS	39	my @capabilities = @ARGV;
edcc8581 LS	40
e1ec4721	41	open my $debug, ">>", $log_file or die "cannot open log file: $!";
edcc8581	42
2841e8f8 LS	43	my %DELAY = (
	44	'test-delay10.a' => { "requested" => 0, "count" => 1 },
	45	'test-delay11.a' => { "requested" => 0, "count" => 1 },
	46	'test-delay20.a' => { "requested" => 0, "count" => 2 },
	47	'test-delay10.b' => { "requested" => 0, "count" => 1 },
	48	'missing-delay.a' => { "requested" => 0, "count" => 1 },
	49	'invalid-delay.a' => { "requested" => 0, "count" => 1 },
	50	);
	51
edcc8581 LS	52	sub rot13 {
	53	my $str = shift;
	54	$str =~ y/A-Za-z/N-ZA-Mn-za-m/;
	55	return $str;
	56	}
	57
0a268826 CC	58	sub packet_compare_lists {
	59	my ($expect, @result) = @_;
	60	my $ix;
	61	if (scalar @$expect != scalar @result) {
	62	return undef;
	63	}
	64	for ($ix = 0; $ix < $#result; $ix++) {
	65	if ($expect->[$ix] ne $result[$ix]) {
	66	return undef;
	67	}
	68	}
	69	return 1;
	70	}
	71
edcc8581 LS	72	sub packet_bin_read {
	73	my $buffer;
	74	my $bytes_read = read STDIN, $buffer, 4;
	75	if ( $bytes_read == 0 ) {
	76	# EOF - Git stopped talking to us!
2c9ea595	77	return ( -1, "" );
ed17d262	78	} elsif ( $bytes_read != 4 ) {
edcc8581 LS	79	die "invalid packet: '$buffer'";
	80	}
	81	my $pkt_size = hex($buffer);
	82	if ( $pkt_size == 0 ) {
	83	return ( 1, "" );
ed17d262	84	} elsif ( $pkt_size > 4 ) {
edcc8581 LS	85	my $content_size = $pkt_size - 4;
	86	$bytes_read = read STDIN, $buffer, $content_size;
	87	if ( $bytes_read != $content_size ) {
	88	die "invalid packet ($content_size bytes expected; $bytes_read bytes read)";
	89	}
	90	return ( 0, $buffer );
ed17d262	91	} else {
edcc8581 LS	92	die "invalid packet size: $pkt_size";
	93	}
	94	}
	95
4a9ef1bb CC	96	sub remove_final_lf_or_die {
	97	my $buf = shift;
	98	unless ( $buf =~ s/\n$// ) {
00df039f CC	99	die "A non-binary line MUST be terminated by an LF.\n"
00df039f CC	100	. "Received: '$buf'";
edcc8581	101	}
4a9ef1bb CC	102	return $buf;
	103	}
	104
	105	sub packet_txt_read {
	106	my ( $res, $buf ) = packet_bin_read();
	107	unless ( $res == -1 or $buf eq '' ) {
	108	$buf = remove_final_lf_or_die($buf);
	109	}
edcc8581 LS	110	return ( $res, $buf );
	111	}
	112
2c9ea595 CC	113	sub packet_required_key_val_read {
	114	my ( $key ) = @_;
	115	my ( $res, $buf ) = packet_txt_read();
	116	unless ( $res == -1 or ( $buf =~ s/^$key=// and $buf ne '' ) ) {
	117	die "bad $key: '$buf'";
	118	}
	119	return ( $res, $buf );
	120	}
	121
edcc8581 LS	122	sub packet_bin_write {
	123	my $buf = shift;
	124	print STDOUT sprintf( "%04x", length($buf) + 4 );
	125	print STDOUT $buf;
	126	STDOUT->flush();
	127	}
	128
	129	sub packet_txt_write {
	130	packet_bin_write( $_[0] . "\n" );
	131	}
	132
	133	sub packet_flush {
	134	print STDOUT sprintf( "%04x", 0 );
	135	STDOUT->flush();
	136	}
	137
25cbfe34 CC	138	sub packet_initialize {
	139	my ($name, $version) = @_;
	140
	141	packet_compare_lists([0, $name . "-client"], packet_txt_read()) \|\|
	142	die "bad initialize";
	143	packet_compare_lists([0, "version=" . $version], packet_txt_read()) \|\|
	144	die "bad version";
	145	packet_compare_lists([1, ""], packet_bin_read()) \|\|
	146	die "bad version end";
	147
	148	packet_txt_write( $name . "-server" );
	149	packet_txt_write( "version=" . $version );
	150	packet_flush();
	151	}
	152
f11c8ce1 CC	153	sub packet_read_capabilities {
	154	my @cap;
	155	while (1) {
	156	my ( $res, $buf ) = packet_bin_read();
	157	if ( $res == -1 ) {
	158	die "unexpected EOF when reading capabilities";
	159	}
	160	return ( $res, @cap ) if ( $res != 0 );
	161	$buf = remove_final_lf_or_die($buf);
	162	unless ( $buf =~ s/capability=// ) {
	163	die "bad capability buf: '$buf'";
	164	}
	165	push @cap, $buf;
	166	}
	167	}
	168
	169	# Read remote capabilities and check them against capabilities we require
	170	sub packet_read_and_check_capabilities {
	171	my @required_caps = @_;
	172	my ($res, @remote_caps) = packet_read_capabilities();
	173	my %remote_caps = map { $_ => 1 } @remote_caps;
	174	foreach (@required_caps) {
	175	unless (exists($remote_caps{$_})) {
	176	die "required '$_' capability not available from remote" ;
	177	}
	178	}
	179	return %remote_caps;
	180	}
	181
	182	# Check our capabilities we want to advertise against the remote ones
	183	# and then advertise our capabilities
	184	sub packet_check_and_write_capabilities {
	185	my ($remote_caps, @our_caps) = @_;
	186	foreach (@our_caps) {
	187	unless (exists($remote_caps->{$_})) {
	188	die "our capability '$_' is not available from remote"
	189	}
	190	packet_txt_write( "capability=" . $_ );
	191	}
	192	packet_flush();
	193	}
	194
edcc8581 LS	195	print $debug "START\n";
	196	$debug->flush();
	197
25cbfe34	198	packet_initialize("git-filter", 2);
edcc8581	199
f11c8ce1 CC	200	my %remote_caps = packet_read_and_check_capabilities("clean", "smudge", "delay");
	201	packet_check_and_write_capabilities(\%remote_caps, @capabilities);
	202
edcc8581 LS	203	print $debug "init handshake complete\n";
	204	$debug->flush();
	205
	206	while (1) {
2c9ea595 CC	207	my ( $res, $command ) = packet_required_key_val_read("command");
	208	if ( $res == -1 ) {
	209	print $debug "STOP\n";
	210	exit();
	211	}
edcc8581 LS	212	print $debug "IN: $command";
	213	$debug->flush();
	214
2841e8f8 LS	215	if ( $command eq "list_available_blobs" ) {
2841e8f8 LS	216	# Flush
2c9ea595 CC	217	packet_compare_lists([1, ""], packet_bin_read()) \|\|
2c9ea595 CC	218	die "bad list_available_blobs end";
c6b0831c	219
2841e8f8 LS	220	foreach my $pathname ( sort keys %DELAY ) {
	221	if ( $DELAY{$pathname}{"requested"} >= 1 ) {
	222	$DELAY{$pathname}{"count"} = $DELAY{$pathname}{"count"} - 1;
	223	if ( $pathname eq "invalid-delay.a" ) {
	224	# Send Git a pathname that was not delayed earlier
	225	packet_txt_write("pathname=unfiltered");
	226	}
	227	if ( $pathname eq "missing-delay.a" ) {
	228	# Do not signal Git that this file is available
	229	} elsif ( $DELAY{$pathname}{"count"} == 0 ) {
	230	print $debug " $pathname";
	231	packet_txt_write("pathname=$pathname");
	232	}
	233	}
edcc8581	234	}
edcc8581	235
edcc8581	236	packet_flush();
2841e8f8 LS	237
2841e8f8 LS	238	print $debug " [OK]\n";
edcc8581	239	$debug->flush();
2841e8f8	240	packet_txt_write("status=success");
edcc8581	241	packet_flush();
ed17d262	242	} else {
2c9ea595 CC	243	my ( $res, $pathname ) = packet_required_key_val_read("pathname");
	244	if ( $res == -1 ) {
	245	die "unexpected EOF while expecting pathname";
	246	}
2841e8f8 LS	247	print $debug " $pathname";
	248	$debug->flush();
	249
2841e8f8 LS	250	# Read until flush
	251	my ( $done, $buffer ) = packet_txt_read();
	252	while ( $buffer ne '' ) {
	253	if ( $buffer eq "can-delay=1" ) {
	254	if ( exists $DELAY{$pathname} and $DELAY{$pathname}{"requested"} == 0 ) {
	255	$DELAY{$pathname}{"requested"} = 1;
	256	}
	257	} else {
	258	die "Unknown message '$buffer'";
	259	}
edcc8581	260
2841e8f8 LS	261	( $done, $buffer ) = packet_txt_read();
2841e8f8 LS	262	}
2c9ea595 CC	263	if ( $done == -1 ) {
	264	die "unexpected EOF after pathname '$pathname'";
	265	}
2841e8f8 LS	266
	267	my $input = "";
	268	{
	269	binmode(STDIN);
	270	my $buffer;
	271	my $done = 0;
	272	while ( !$done ) {
	273	( $done, $buffer ) = packet_bin_read();
	274	$input .= $buffer;
	275	}
2c9ea595 CC	276	if ( $done == -1 ) {
	277	die "unexpected EOF while reading input for '$pathname'";
	278	}
2841e8f8	279	print $debug " " . length($input) . " [OK] -- ";
edcc8581	280	$debug->flush();
edcc8581 LS	281	}
edcc8581 LS	282
2841e8f8 LS	283	my $output;
	284	if ( exists $DELAY{$pathname} and exists $DELAY{$pathname}{"output"} ) {
	285	$output = $DELAY{$pathname}{"output"}
ed17d262	286	} elsif ( $pathname eq "error.r" or $pathname eq "abort.r" ) {
2841e8f8	287	$output = "";
ed17d262	288	} elsif ( $command eq "clean" and grep( /^clean$/, @capabilities ) ) {
2841e8f8	289	$output = rot13($input);
ed17d262	290	} elsif ( $command eq "smudge" and grep( /^smudge$/, @capabilities ) ) {
2841e8f8	291	$output = rot13($input);
ed17d262	292	} else {
2841e8f8 LS	293	die "bad command '$command'";
	294	}
	295
	296	if ( $pathname eq "error.r" ) {
	297	print $debug "[ERROR]\n";
	298	$debug->flush();
	299	packet_txt_write("status=error");
	300	packet_flush();
ed17d262	301	} elsif ( $pathname eq "abort.r" ) {
2841e8f8 LS	302	print $debug "[ABORT]\n";
	303	$debug->flush();
	304	packet_txt_write("status=abort");
	305	packet_flush();
ed17d262	306	} elsif ( $command eq "smudge" and
2841e8f8	307	exists $DELAY{$pathname} and
ed17d262	308	$DELAY{$pathname}{"requested"} == 1 ) {
2841e8f8 LS	309	print $debug "[DELAYED]\n";
	310	$debug->flush();
	311	packet_txt_write("status=delayed");
	312	packet_flush();
	313	$DELAY{$pathname}{"requested"} = 2;
	314	$DELAY{$pathname}{"output"} = $output;
ed17d262	315	} else {
2841e8f8 LS	316	packet_txt_write("status=success");
2841e8f8 LS	317	packet_flush();
17573334	318
2841e8f8 LS	319	if ( $pathname eq "${command}-write-fail.r" ) {
	320	print $debug "[WRITE FAIL]\n";
	321	$debug->flush();
	322	die "${command} write error";
edcc8581	323	}
2841e8f8 LS	324
	325	print $debug "OUT: " . length($output) . " ";
	326	$debug->flush();
	327
	328	while ( length($output) > 0 ) {
	329	my $packet = substr( $output, 0, $MAX_PACKET_CONTENT_SIZE );
	330	packet_bin_write($packet);
	331	# dots represent the number of packets
	332	print $debug ".";
	333	if ( length($output) > $MAX_PACKET_CONTENT_SIZE ) {
	334	$output = substr( $output, $MAX_PACKET_CONTENT_SIZE );
ed17d262	335	} else {
2841e8f8 LS	336	$output = "";
2841e8f8 LS	337	}
edcc8581	338	}
2841e8f8 LS	339	packet_flush();
	340	print $debug " [OK]\n";
	341	$debug->flush();
	342	packet_flush();
edcc8581	343	}
edcc8581 LS	344	}
edcc8581 LS	345	}