[RFC/PATCH] gitweb: Use list form of 'open "-|"' pipeline

[RFC/PATCH] gitweb: Use list form of 'open "-|"' pipeline

[Jakub Narebski]

Add output_pipeline subroutine, which allows to use list form of
pipeline; instead of
  open my $fh, "-|", "cmd_1 option | cmd_2 argument"
we can now write
  my $fh = output_pipeline(['cmd_1', 'option'], ['cmd_2', 'argument']);
which allows to avoid troubles with shell quoting, and avoid spawning
shell.  Code is based on snippet http://www.perlmonks.org/?node_id=246397
simplified a bit.

It is then used in git_snapshot subroutine, where we sometimes open
pipeline from git-archive to compressor.

While at it, ensure that snapshot saved as <basename>.<suffix>
uncompresses to <basename>/

NOTE: this commit prepares way for adding syntax highlighting support
using external filter (external tool), like GNU Source-highlight or
Andre Simon's Highlight.

Signed-off-by: Jakub Narebski <jnareb@gmail.com>
---
This patch is an RFC, and doesn't really meant to be applied.
I'd like opinion on this code from resident Perl experts.  It
should work, though; it was rudimentarly tested.

 gitweb/gitweb.perl |   52 ++++++++++++++++++++++++++++++++++++++++------------
 1 files changed, 40 insertions(+), 12 deletions(-)

diff --git a/gitweb/gitweb.perl b/gitweb/gitweb.perl
index a5df2fe..ba97a7b 100755
--- a/gitweb/gitweb.perl
+++ b/gitweb/gitweb.perl
@@ -1455,6 +1455,35 @@ sub git_cmd_str {
 	return join(' ', git_cmd());
 }
 
+# my $fh = output_pipeline(['cmd_1', 'option'], ['cmd_2', 'argument']);
+# is equivalent to (is the "list form" of) the following
+# open my $fh, "-|", "cmd_1 option | cmd_2 argument"
+#
+# Based on http://www.perlmonks.org/?node_id=246397
+#
+sub output_pipeline {
+	my @commands_list = @_;
+	exit unless @commands_list;
+
+	my $pid = open(my $fh, "-|");
+	#die "Couldn't fork: $!" unless defined $pid;
+
+	if ($pid) { # parent
+		return $fh;
+	}
+
+	# child
+ COMMAND:
+	while (my $command = pop @commands_list) {
+		my $pid = @commands_list ? open(STDIN, "-|") : -1;
+		#die "Couldn't fork: $!" unless defined $pid;
+
+		next COMMAND unless ($pid); # parent
+		exec @$command;             # child
+		#die "Couldn't exec \"@$command\": $!";
+	}
+}
+
 # get HEAD ref of given project as hash
 sub git_get_head_hash {
 	my $project = shift;
@@ -4545,27 +4574,26 @@ sub git_snapshot {
 		$hash = git_get_head_hash($project);
 	}
 
-	my $git_command = git_cmd_str();
 	my $name = $project;
-	$name =~ s,([^/])/*\.git$,$1,;
+	$name =~ s,([^/])/*\.git$,$1,; # strip '.git' or '/.git'
 	$name = basename($name);
-	my $filename = to_utf8($name);
-	$name =~ s/\047/\047\\\047\047/g;
-	my $cmd;
-	$filename .= "-$hash$known_snapshot_formats{$format}{'suffix'}";
-	$cmd = "$git_command archive " .
-		"--format=$known_snapshot_formats{$format}{'format'} " .
-		"--prefix=\'$name\'/ $hash";
+	$name = to_utf8($name);  # or only for filename, not prefix?
+	$name .= "-$hash";
+
+	my @cmds = ([git_cmd(), "archive",
+		"--format=$known_snapshot_formats{$format}{'format'}",
+		"--prefix=$name/", $hash]);
 	if (exists $known_snapshot_formats{$format}{'compressor'}) {
-		$cmd .= ' | ' . join ' ', @{$known_snapshot_formats{$format}{'compressor'}};
+		push @cmds, $known_snapshot_formats{$format}{'compressor'};
 	}
 
 	print $cgi->header(
 		-type => $known_snapshot_formats{$format}{'type'},
-		-content_disposition => 'inline; filename="' . "$filename" . '"',
+		-content_disposition => 'inline; filename="' .
+			"$filename$known_snapshot_formats{$format}{'suffix'}" . '"',
 		-status => '200 OK');
 
-	open my $fd, "-|", $cmd
+	my $fd = output_pipeline(@cmds)
 		or die_error(undef, "Execute git-archive failed");
 	binmode STDOUT, ':raw';
 	print <$fd>;

Re: [RFC/PATCH] gitweb: Use list form of 'open "-|"' pipeline

[Charles Bailey]

On Sat, Mar 08, 2008 at 05:57:20PM +0100, Jakub Narebski wrote:
> Add output_pipeline subroutine, which allows to use list form of
> pipeline; instead of
>   open my $fh, "-|", "cmd_1 option | cmd_2 argument"
> we can now write
>   my $fh = output_pipeline(['cmd_1', 'option'], ['cmd_2', 'argument']);
> which allows to avoid troubles with shell quoting, and avoid spawning
> shell.  Code is based on snippet http://www.perlmonks.org/?node_id=246397
> simplified a bit.
> 

I'm not a perl open expert, and I don't know if gitweb has other
issues on windows anyway, but the list time I experimented with it
neither the open( FHAND, "-|" ) trick, not the list form of open in
combination with the "-|" mode worked at all on windows.

Charles.

Re: [RFC/PATCH] gitweb: Use list form of 'open "-|"' pipeline

[Jakub Narebski]

On Sat, 8 Mar 2008, Charles Bailey wrote:
> On Sat, Mar 08, 2008 at 05:57:20PM +0100, Jakub Narebski wrote:

>> Add output_pipeline subroutine, which allows to use list form of
>> pipeline; instead of
>>
>>   open my $fh, "-|", "cmd_1 option | cmd_2 argument"
>>
>> we can now write
>>
>>   my $fh = output_pipeline(['cmd_1', 'option'], ['cmd_2', 'argument']);
>>
>> which allows to avoid troubles with shell quoting, and avoid spawning
>> shell.  Code is based on snippet http://www.perlmonks.org/?node_id=246397
>> simplified a bit.
> 
> I'm not a Perl open expert, and I don't know if gitweb has other
> issues on windows anyway, but the list time I experimented with it
> neither the open( FHAND, "-|" ) trick, not the list form of open in
> combination with the "-|" mode worked at all on windows.

First, gitweb is git web interface; I don't know if anybody tried for
example to run gitweb on Windows, be it from Apache or from IIS.

Second, it probably depends on the flavour (distribution) of Perl
used. ActiveState Perl requires some horrible workarounds[*1*], I don't
know what about MSys / MinGW Perl, Cygwin Perl, or Vanilla / Strawberry
Perl.


[*1*] Git.pm, Perl interface to the Git, includes workaround for
ActiveState Perl sheningans; gitweb currently doesn't use Git.pm
(Git.pm would need some extensions), but perhaps it should. On the
other hand it would make installation slightly more complicated.

-- 
Jakub Narebski
Poland

Re: [RFC/PATCH] gitweb: Use list form of 'open "-|"' pipeline

[Frank Lichtenheld]

On Sat, Mar 08, 2008 at 05:57:20PM +0100, Jakub Narebski wrote:
> diff --git a/gitweb/gitweb.perl b/gitweb/gitweb.perl
> index a5df2fe..ba97a7b 100755
> --- a/gitweb/gitweb.perl
> +++ b/gitweb/gitweb.perl
> @@ -1455,6 +1455,35 @@ sub git_cmd_str {
>  	return join(' ', git_cmd());
>  }
>  
> +# my $fh = output_pipeline(['cmd_1', 'option'], ['cmd_2', 'argument']);
> +# is equivalent to (is the "list form" of) the following
> +# open my $fh, "-|", "cmd_1 option | cmd_2 argument"
> +#
> +# Based on http://www.perlmonks.org/?node_id=246397

It might be worthwile to look into how e.g. IPC::Run does this.

> +sub output_pipeline {
> +	my @commands_list = @_;
> +	exit unless @commands_list;
> +
> +	my $pid = open(my $fh, "-|");
> +	#die "Couldn't fork: $!" unless defined $pid;

Why are all the die's commented out?

> +	if ($pid) { # parent
> +		return $fh;
> +	}
> +
> +	# child
> + COMMAND:
> +	while (my $command = pop @commands_list) {
> +		my $pid = @commands_list ? open(STDIN, "-|") : -1;
> +		#die "Couldn't fork: $!" unless defined $pid;
> +
> +		next COMMAND unless ($pid); # parent
> +		exec @$command;             # child

The "parent" and "child" comments here are wrong, which was really
really confusing...

This should probably be "new child" instead of "parent" and
"old child" instead of "child".

Thw whole concept of processing the array backwards might be shorter,
I personally find it somewhat confusing though.

What happens to all these child processes anyway if one of them fails to
exec?

> +		#die "Couldn't exec \"@$command\": $!";
> +	}
> +}
> +
>  # get HEAD ref of given project as hash
>  sub git_get_head_hash {
>  	my $project = shift;
> @@ -4545,27 +4574,26 @@ sub git_snapshot {
>  		$hash = git_get_head_hash($project);
>  	}
>  
> -	my $git_command = git_cmd_str();
>  	my $name = $project;
> -	$name =~ s,([^/])/*\.git$,$1,;
> +	$name =~ s,([^/])/*\.git$,$1,; # strip '.git' or '/.git'
>  	$name = basename($name);
> -	my $filename = to_utf8($name);
> -	$name =~ s/\047/\047\\\047\047/g;
> -	my $cmd;
> -	$filename .= "-$hash$known_snapshot_formats{$format}{'suffix'}";
> -	$cmd = "$git_command archive " .
> -		"--format=$known_snapshot_formats{$format}{'format'} " .
> -		"--prefix=\'$name\'/ $hash";
> +	$name = to_utf8($name);  # or only for filename, not prefix?
> +	$name .= "-$hash";
> +
> +	my @cmds = ([git_cmd(), "archive",
> +		"--format=$known_snapshot_formats{$format}{'format'}",
> +		"--prefix=$name/", $hash]);
>  	if (exists $known_snapshot_formats{$format}{'compressor'}) {
> -		$cmd .= ' | ' . join ' ', @{$known_snapshot_formats{$format}{'compressor'}};
> +		push @cmds, $known_snapshot_formats{$format}{'compressor'};
>  	}
>  
>  	print $cgi->header(
>  		-type => $known_snapshot_formats{$format}{'type'},
> -		-content_disposition => 'inline; filename="' . "$filename" . '"',
> +		-content_disposition => 'inline; filename="' .
> +			"$filename$known_snapshot_formats{$format}{'suffix'}" . '"',

Huh, that compiles? Where is $filename defined now at all?

>  		-status => '200 OK');
>  
> -	open my $fd, "-|", $cmd
> +	my $fd = output_pipeline(@cmds)
>  		or die_error(undef, "Execute git-archive failed");
>  	binmode STDOUT, ':raw';
>  	print <$fd>;

Gruesse,
-- 
Frank Lichtenheld <frank@lichtenheld.de>
www: http://www.djpig.de/

Re: [RFC/PATCH] gitweb: Use list form of 'open "-|"' pipeline

[Jakub Narebski]

Thanks a lot for reviewing this patch!

On Tue, 11 March 2008, Frank Lichtenheld wrote:
> On Sat, Mar 08, 2008 at 05:57:20PM +0100, Jakub Narebski wrote:
>>
>> diff --git a/gitweb/gitweb.perl b/gitweb/gitweb.perl
>> index a5df2fe..ba97a7b 100755
>> --- a/gitweb/gitweb.perl
>> +++ b/gitweb/gitweb.perl
>> @@ -1455,6 +1455,35 @@ sub git_cmd_str {
>>  	return join(' ', git_cmd());
>>  }
>>  
>> +# my $fh = output_pipeline(['cmd_1', 'option'], ['cmd_2', 'argument']);
>> +# is equivalent to (is the "list form" of) the following
>> +# open my $fh, "-|", "cmd_1 option | cmd_2 argument"
>> +#
>> +# Based on http://www.perlmonks.org/?node_id=246397

Note that this patch is a bit "cargo cult" (copy'n'paste) programming...
 
> It might be worthwile to look into how e.g. IPC::Run does this.

Thanks for the pointer. I look at it.

IPC::Run isn't installed by default with Perl, like Encode, Fcntl,
File::Find and File::Basename, or reasonable to be required to be
installed to run server side app like CGI, so we cannot use it
directly, as we cannot require for gitweb user to have it installed.

Additionally while in some parts IPC::Run API is nice and well
thought (composing pipeline), some of it would make it hard to use
in gitweb. For example I could not find how to direct pipeline
output to filehandle instead of to scalar or opened file. While
for currently the only pipeline in gitweb, namely generating
(externally) compressed snapshot IPC::Run API would be enough,
for syntax highlighting with its line-by-line pipeline output
parsing it would be, I think, a bit cumbersome.

It would be nice if parts of IPC::Run made it into Git.pm...
then we could just use it in gitweb.

>> +sub output_pipeline {
>> +	my @commands_list = @_;
>> +	exit unless @commands_list;
>> +
>> +	my $pid = open(my $fh, "-|");
>> +	#die "Couldn't fork: $!" unless defined $pid;
> 
> Why are all the die's commented out?

The goal is to have gitweb deal with errors gracefully. It should
generate some kind of '503 Server Error' page, instead of dieing
without output, or what would be even worse, in the middle of output.

I haven't examined how it should be writen for this RFC patch, so
I have commented out 'die' just in case. In the final version (if it
will be decided to go this route) it should be cleaned out.

>> +	if ($pid) { # parent
>> +		return $fh;
>> +	}
>> +
>> +	# child
>> + COMMAND:
>> +	while (my $command = pop @commands_list) {
>> +		my $pid = @commands_list ? open(STDIN, "-|") : -1;
>> +		#die "Couldn't fork: $!" unless defined $pid;
>> +
>> +		next COMMAND unless ($pid); # parent
>> +		exec @$command;             # child
> 
> The "parent" and "child" comments here are wrong, which was really
> really confusing...

I'm sorry. My mistake.

> This should probably be "new child" instead of "parent" and
> "old child" instead of "child".

I think those comments could be simply removed, as they are, I guess,
equivalent to

   count++;  /* increment counter */

in C/C++.

> Thw whole concept of processing the array backwards might be shorter,
> I personally find it somewhat confusing though.

I'm not sure if it is not the only possible way, as the (first) parent,
I think, has to return filehandle. But I might be mistaken.

> What happens to all these child processes anyway if one of them fails to
> exec?

Original snippet returned in addition to filehandle also list of pids.
Perhaps I have oversimplified this snipped... or it was to simple to
begin with.

>> +		#die "Couldn't exec \"@$command\": $!";
>> +	}
>> +}
>> +
>>  # get HEAD ref of given project as hash
>>  sub git_get_head_hash {
>>  	my $project = shift;
>> @@ -4545,27 +4574,26 @@ sub git_snapshot {
>>  		$hash = git_get_head_hash($project);
>>  	}
>>  
>> -	my $git_command = git_cmd_str();
>>  	my $name = $project;
>> -	$name =~ s,([^/])/*\.git$,$1,;
>> +	$name =~ s,([^/])/*\.git$,$1,; # strip '.git' or '/.git'
>>  	$name = basename($name);
>> -	my $filename = to_utf8($name);
>> -	$name =~ s/\047/\047\\\047\047/g;
>> -	my $cmd;
>> -	$filename .= "-$hash$known_snapshot_formats{$format}{'suffix'}";
>> -	$cmd = "$git_command archive " .
>> -		"--format=$known_snapshot_formats{$format}{'format'} " .
>> -		"--prefix=\'$name\'/ $hash";
>> +	$name = to_utf8($name);  # or only for filename, not prefix?
>> +	$name .= "-$hash";
>> +
>> +	my @cmds = ([git_cmd(), "archive",
>> +		"--format=$known_snapshot_formats{$format}{'format'}",
>> +		"--prefix=$name/", $hash]);
>>  	if (exists $known_snapshot_formats{$format}{'compressor'}) {
>> -		$cmd .= ' | ' . join ' ', @{$known_snapshot_formats{$format}{'compressor'}};
>> +		push @cmds, $known_snapshot_formats{$format}{'compressor'};
>>  	}
>>  
>>  	print $cgi->header(
>>  		-type => $known_snapshot_formats{$format}{'type'},
>> -		-content_disposition => 'inline; filename="' . "$filename" . '"',
>> +		-content_disposition => 'inline; filename="' .
>> +			"$filename$known_snapshot_formats{$format}{'suffix'}" . '"',
> 
> Huh, that compiles? Where is $filename defined now at all?

I'm very sorry. This was my quick improving code just before sending
this patch... forgetting to test after "obvously correct" (not!) changes.

By the way, this change to have <filename>.<suffix> snapshot extract to
<filename>/ directory is independent on the "list form of pipeline"
changes and should probably be sent as separate patch.


Once again, thanks for reviewing and commenting on this RFC patch.
I'm just not a Perl hacker...
-- 
Jakub Narebski
Poland

Re: [RFC/PATCH] gitweb: Use list form of 'open "-|"' pipeline

[Frank Lichtenheld]

On Tue, Mar 11, 2008 at 06:30:57PM +0100, Jakub Narebski wrote:
> On Tue, 11 March 2008, Frank Lichtenheld wrote:
> > On Sat, Mar 08, 2008 at 05:57:20PM +0100, Jakub Narebski wrote:
> >>
> >> diff --git a/gitweb/gitweb.perl b/gitweb/gitweb.perl
> >> index a5df2fe..ba97a7b 100755
> >> --- a/gitweb/gitweb.perl
> >> +++ b/gitweb/gitweb.perl
> >> @@ -1455,6 +1455,35 @@ sub git_cmd_str {
> >>  	return join(' ', git_cmd());
> >>  }
> >>  
> >> +# my $fh = output_pipeline(['cmd_1', 'option'], ['cmd_2', 'argument']);
> >> +# is equivalent to (is the "list form" of) the following
> >> +# open my $fh, "-|", "cmd_1 option | cmd_2 argument"
> >> +#
> >> +# Based on http://www.perlmonks.org/?node_id=246397
> 
> Note that this patch is a bit "cargo cult" (copy'n'paste) programming...
>  
> > It might be worthwile to look into how e.g. IPC::Run does this.
> 
> Thanks for the pointer. I look at it.

After taking a look at the IPC::Run code myself I'm not really sure it
is really "worthwile", as I put it, to try to understand that.

Creating a less flexible solution that is readable might be better.

> >> +sub output_pipeline {
> >> +	my @commands_list = @_;
> >> +	exit unless @commands_list;
> >> +
> >> +	my $pid = open(my $fh, "-|");
> >> +	#die "Couldn't fork: $!" unless defined $pid;
> > 
> > Why are all the die's commented out?
> 
> The goal is to have gitweb deal with errors gracefully. It should
> generate some kind of '503 Server Error' page, instead of dieing
> without output, or what would be even worse, in the middle of output.
> 
> I haven't examined how it should be writen for this RFC patch, so
> I have commented out 'die' just in case. In the final version (if it
> will be decided to go this route) it should be cleaned out.

Ok, I guessed as much, but wanted to make sure ;)

> > Thw whole concept of processing the array backwards might be shorter,
> > I personally find it somewhat confusing though.
> 
> I'm not sure if it is not the only possible way, as the (first) parent,
> I think, has to return filehandle. But I might be mistaken.
> 
> > What happens to all these child processes anyway if one of them fails to
> > exec?
> 
> Original snippet returned in addition to filehandle also list of pids.
> Perhaps I have oversimplified this snipped... or it was to simple to
> begin with.

I'm not really convinced yet that dealing with a shell is much worse
than dealing with IPC ;)

Jokes aside, my idea for implementing something like this would be to
use explicit pipe()'s and fork()'s instead of the open() magic. With
better control over the filehandles and pids you might be able to build
a more robust solution.

Gruesse,
-- 
Frank Lichtenheld <frank@lichtenheld.de>
www: http://www.djpig.de/

Re: [RFC/PATCH] gitweb: Use list form of 'open "-|"' pipeline

[Jay Soffian]

On Tue, Mar 11, 2008 at 2:59 PM, Frank Lichtenheld <frank@lichtenheld.de> wrote:
>  After taking a look at the IPC::Run code myself I'm not really sure it
>  is really "worthwile", as I put it, to try to understand that.
>
>  Creating a less flexible solution that is readable might be better.

"man perlipc" - search for "Safe Pipe Opens".

j.