Code

Merge branch 'sb/format-patch-parseopt' into sb/opt-filename
[git.git] / gitweb / gitweb.perl
index bec1af6b73bca92fdb0cabc45bb5e41d178b9a1d..1e7e2d8387efb810afb3b9c9d279cc59f52d932e 100755 (executable)
@@ -27,13 +27,29 @@ our $version = "++GIT_VERSION++";
 our $my_url = $cgi->url();
 our $my_uri = $cgi->url(-absolute => 1);
 
-# if we're called with PATH_INFO, we have to strip that
-# from the URL to find our real URL
-# we make $path_info global because it's also used later on
+# Base URL for relative URLs in gitweb ($logo, $favicon, ...),
+# needed and used only for URLs with nonempty PATH_INFO
+our $base_url = $my_url;
+
+# When the script is used as DirectoryIndex, the URL does not contain the name
+# of the script file itself, and $cgi->url() fails to strip PATH_INFO, so we
+# have to do it ourselves. We make $path_info global because it's also used
+# later on.
+#
+# Another issue with the script being the DirectoryIndex is that the resulting
+# $my_url data is not the full script URL: this is good, because we want
+# generated links to keep implying the script name if it wasn't explicitly
+# indicated in the URL we're handling, but it means that $my_url cannot be used
+# as base URL.
+# Therefore, if we needed to strip PATH_INFO, then we know that we have
+# to build the base URL ourselves:
 our $path_info = $ENV{"PATH_INFO"};
 if ($path_info) {
-       $my_url =~ s,\Q$path_info\E$,,;
-       $my_uri =~ s,\Q$path_info\E$,,;
+       if ($my_url =~ s,\Q$path_info\E$,, &&
+           $my_uri =~ s,\Q$path_info\E$,, &&
+           defined $ENV{'SCRIPT_NAME'}) {
+               $base_url = $cgi->url(-base => 1) . $ENV{'SCRIPT_NAME'};
+       }
 }
 
 # core git executable to use
@@ -132,6 +148,10 @@ our $fallback_encoding = 'latin1';
 # - one might want to include '-B' option, e.g. '-B', '-M'
 our @diff_opts = ('-M'); # taken from git_commit
 
+# Disables features that would allow repository owners to inject script into
+# the gitweb domain.
+our $prevent_xss = 0;
+
 # information about snapshot formats that gitweb is capable of serving
 our %known_snapshot_formats = (
        # name => {
@@ -382,13 +402,13 @@ sub feature_bool {
        my $key = shift;
        my ($val) = git_get_project_config($key, '--bool');
 
-       if ($val eq 'true') {
+       if (!defined $val) {
+               return ($_[0]);
+       } elsif ($val eq 'true') {
                return (1);
        } elsif ($val eq 'false') {
                return (0);
        }
-
-       return ($_[0]);
 }
 
 sub feature_snapshot {
@@ -438,8 +458,8 @@ sub filter_snapshot_fmts {
        @fmts = map {
                exists $known_snapshot_format_aliases{$_} ?
                       $known_snapshot_format_aliases{$_} : $_} @fmts;
-       @fmts = grep(exists $known_snapshot_formats{$_}, @fmts);
-
+       @fmts = grep {
+               exists $known_snapshot_formats{$_} } @fmts;
 }
 
 our $GITWEB_CONFIG = $ENV{'GITWEB_CONFIG'} || "++GITWEB_CONFIG++";
@@ -668,11 +688,12 @@ sub evaluate_path_info {
                # extensions. Allowed extensions are both the defined suffix
                # (which includes the initial dot already) and the snapshot
                # format key itself, with a prepended dot
-               while (my ($fmt, %opt) = each %known_snapshot_formats) {
+               while (my ($fmt, $opt) = each %known_snapshot_formats) {
                        my $hash = $refname;
-                       my $sfx;
-                       $hash =~ s/(\Q$opt{'suffix'}\E|\Q.$fmt\E)$//;
-                       next unless $sfx = $1;
+                       unless ($hash =~ s/(\Q$opt->{'suffix'}\E|\Q.$fmt\E)$//) {
+                               next;
+                       }
+                       my $sfx = $1;
                        # a valid suffix was found, so set the snapshot format
                        # and reset the hash parameter
                        $input_params{'snapshot_format'} = $fmt;
@@ -808,7 +829,7 @@ if (!defined $action) {
 if (!defined($actions{$action})) {
        die_error(400, "Unknown action");
 }
-if ($action !~ m/^(opml|project_list|project_index)$/ &&
+if ($action !~ m/^(?:opml|project_list|project_index)$/ &&
     !$project) {
        die_error(400, "Project needed");
 }
@@ -818,7 +839,7 @@ exit;
 ## ======================================================================
 ## action links
 
-sub href (%) {
+sub href {
        my %params = @_;
        # default is to use -absolute url() i.e. $my_uri
        my $href = $params{-full} ? $my_url : $my_uri;
@@ -1016,7 +1037,7 @@ sub esc_url {
 }
 
 # replace invalid utf8 character with SUBSTITUTION sequence
-sub esc_html ($;%) {
+sub esc_html {
        my $str = shift;
        my %opts = @_;
 
@@ -1215,7 +1236,7 @@ sub chop_and_escape_str {
        if ($chopped eq $str) {
                return esc_html($chopped);
        } else {
-               $str =~ s/([[:cntrl:]])/?/g;
+               $str =~ s/[[:cntrl:]]/?/g;
                return $cgi->span({-title=>$str}, esc_html($chopped));
        }
 }
@@ -1276,7 +1297,7 @@ use constant {
 };
 
 # submodule/subproject, a commit object reference
-sub S_ISGITLINK($) {
+sub S_ISGITLINK {
        my $mode = shift;
 
        return (($mode & S_IFMT) == S_IFGITLINK)
@@ -1364,13 +1385,11 @@ sub format_log_line_html {
        my $line = shift;
 
        $line = esc_html($line, -nbsp=>1);
-       if ($line =~ m/\b([0-9a-fA-F]{8,40})\b/) {
-               my $hash_text = $1;
-               my $link =
-                       $cgi->a({-href => href(action=>"object", hash=>$hash_text),
-                               -class => "text"}, $hash_text);
-               $line =~ s/$hash_text/$link/;
-       }
+       $line =~ s{\b([0-9a-fA-F]{8,40})\b}{
+               $cgi->a({-href => href(action=>"object", hash=>$1),
+                                       -class => "text"}, $1);
+       }eg;
+
        return $line;
 }
 
@@ -1440,6 +1459,7 @@ sub format_subject_html {
        $extra = '' unless defined($extra);
 
        if (length($short) < length($long)) {
+               $long =~ s/[[:cntrl:]]/?/g;
                return $cgi->a({-href => $href, -class => "list subject",
                                -title => to_utf8($long)},
                       esc_html($short) . $extra);
@@ -1820,7 +1840,7 @@ sub git_cmd {
 # Try to avoid using this function wherever possible.
 sub quote_command {
        return join(' ',
-                   map( { my $a = $_; $a =~ s/(['!])/'\\$1'/g; "'$a'" } @_ ));
+               map { my $a = $_; $a =~ s/(['!])/'\\$1'/g; "'$a'" } @_ );
 }
 
 # get HEAD ref of given project as hash
@@ -1894,18 +1914,19 @@ sub git_parse_project_config {
        return %config;
 }
 
-# convert config value to boolean, 'true' or 'false'
+# convert config value to boolean: 'true' or 'false'
 # no value, number > 0, 'true' and 'yes' values are true
 # rest of values are treated as false (never as error)
 sub config_to_bool {
        my $val = shift;
 
+       return 1 if !defined $val;             # section.key
+
        # strip leading and trailing whitespace
        $val =~ s/^\s+//;
        $val =~ s/\s+$//;
 
-       return (!defined $val ||               # section.key
-               ($val =~ /^\d+$/ && $val) ||   # section.key = 1
+       return (($val =~ /^\d+$/ && $val) ||   # section.key = 1
                ($val =~ /^(?:true|yes)$/i));  # section.key = true
 }
 
@@ -1958,6 +1979,9 @@ sub git_get_project_config {
                $config_file = "$git_dir/config";
        }
 
+       # check if config variable (key) exists
+       return unless exists $config{"gitweb.$key"};
+
        # ensure given type
        if (!defined $type) {
                return $config{"gitweb.$key"};
@@ -2028,7 +2052,7 @@ sub git_get_project_description {
        my $path = shift;
 
        $git_dir = "$projectroot/$path";
-       open my $fd, "$git_dir/description"
+       open my $fd, '<', "$git_dir/description"
                or return git_get_project_config('description');
        my $descr = <$fd>;
        close $fd;
@@ -2043,18 +2067,17 @@ sub git_get_project_ctags {
        my $ctags = {};
 
        $git_dir = "$projectroot/$path";
-       unless (opendir D, "$git_dir/ctags") {
-               return $ctags;
-       }
-       foreach (grep { -f $_ } map { "$git_dir/ctags/$_" } readdir(D)) {
-               open CT, $_ or next;
-               my $val = <CT>;
+       opendir my $dh, "$git_dir/ctags"
+               or return $ctags;
+       foreach (grep { -f $_ } map { "$git_dir/ctags/$_" } readdir($dh)) {
+               open my $ct, '<', $_ or next;
+               my $val = <$ct>;
                chomp $val;
-               close CT;
+               close $ct;
                my $ctag = $_; $ctag =~ s#.*/##;
                $ctags->{$ctag} = $val;
        }
-       closedir D;
+       closedir $dh;
        $ctags;
 }
 
@@ -2107,7 +2130,7 @@ sub git_get_project_url_list {
        my $path = shift;
 
        $git_dir = "$projectroot/$path";
-       open my $fd, "$git_dir/cloneurl"
+       open my $fd, '<', "$git_dir/cloneurl"
                or return wantarray ?
                @{ config_to_multi(git_get_project_config('url')) } :
                   config_to_multi(git_get_project_config('url'));
@@ -2165,7 +2188,7 @@ sub git_get_projects_list {
                # 'libs%2Fklibc%2Fklibc.git H.+Peter+Anvin'
                # 'linux%2Fhotplug%2Fudev.git Greg+Kroah-Hartman'
                my %paths;
-               open my ($fd), $projects_list or return;
+               open my $fd, '<', $projects_list or return;
        PROJECT:
                while (my $line = <$fd>) {
                        chomp $line;
@@ -2228,7 +2251,7 @@ sub git_get_project_list_from_file {
        # 'libs%2Fklibc%2Fklibc.git H.+Peter+Anvin'
        # 'linux%2Fhotplug%2Fudev.git Greg+Kroah-Hartman'
        if (-f $projects_list) {
-               open (my $fd , $projects_list);
+               open(my $fd, '<', $projects_list);
                while (my $line = <$fd>) {
                        chomp $line;
                        my ($pr, $ow) = split ' ', $line;
@@ -2593,7 +2616,7 @@ sub parsed_difftree_line {
 }
 
 # parse line of git-ls-tree output
-sub parse_ls_tree_line ($;%) {
+sub parse_ls_tree_line {
        my $line = shift;
        my %opts = @_;
        my %res;
@@ -2782,18 +2805,18 @@ sub mimetype_guess_file {
        -r $mimemap or return undef;
 
        my %mimemap;
-       open(MIME, $mimemap) or return undef;
-       while (<MIME>) {
+       open(my $mh, '<', $mimemap) or return undef;
+       while (<$mh>) {
                next if m/^#/; # skip comments
-               my ($mime, $exts) = split(/\t+/);
+               my ($mimetype, $exts) = split(/\t+/);
                if (defined $exts) {
                        my @exts = split(/\s+/, $exts);
                        foreach my $ext (@exts) {
-                               $mimemap{$ext} = $mime;
+                               $mimemap{$ext} = $mimetype;
                        }
                }
        }
-       close(MIME);
+       close($mh);
 
        $filename =~ /\.([^.]*)$/;
        return $mimemap{$1};
@@ -2904,7 +2927,7 @@ EOF
        # the stylesheet, favicon etc urls won't work correctly with path_info
        # unless we set the appropriate base URL
        if ($ENV{'PATH_INFO'}) {
-               print '<base href="'.esc_url($my_url).'" />\n';
+               print "<base href=\"".esc_url($base_url)."\" />\n";
        }
        # print out each stylesheet that exist, providing backwards capability
        # for those people who defined $stylesheet in a config file
@@ -3191,7 +3214,6 @@ sub git_print_header_div {
              "\n</div>\n";
 }
 
-#sub git_print_authorship (\%) {
 sub git_print_authorship {
        my $co = shift;
 
@@ -3247,8 +3269,7 @@ sub git_print_page_path {
        print "<br/></div>\n";
 }
 
-# sub git_print_log (\@;%) {
-sub git_print_log ($;%) {
+sub git_print_log {
        my $log = shift;
        my %opts = @_;
 
@@ -3306,7 +3327,7 @@ sub git_get_link_target {
        open my $fd, "-|", git_cmd(), "cat-file", "blob", $hash
                or return;
        {
-               local $/;
+               local $/ = undef;
                $link_target = <$fd>;
        }
        close $fd
@@ -3319,10 +3340,7 @@ sub git_get_link_target {
 # return target of link relative to top directory (top tree);
 # return undef if it is not possible (including absolute links).
 sub normalize_link_target {
-       my ($link_target, $basedir, $hash_base) = @_;
-
-       # we can normalize symlink target only if $hash_base is provided
-       return unless $hash_base;
+       my ($link_target, $basedir) = @_;
 
        # absolute symlinks (beginning with '/') cannot be normalized
        return if (substr($link_target, 0, 1) eq '/');
@@ -3378,7 +3396,7 @@ sub git_print_tree_entry {
                if (S_ISLNK(oct $t->{'mode'})) {
                        my $link_target = git_get_link_target($t->{'hash'});
                        if ($link_target) {
-                               my $norm_target = normalize_link_target($link_target, $basedir, $hash_base);
+                               my $norm_target = normalize_link_target($link_target, $basedir);
                                if (defined $norm_target) {
                                        print " -> " .
                                              $cgi->a({-href => href(action=>"object", hash_base=>$hash_base,
@@ -3971,7 +3989,7 @@ sub fill_project_list_info {
                            ($pname !~ /\/$/) &&
                            (-d "$projectroot/$pname")) {
                                $pr->{'forks'} = "-d $projectroot/$pname";
-                       }       else {
+                       } else {
                                $pr->{'forks'} = 0;
                        }
                }
@@ -4503,7 +4521,9 @@ sub git_summary {
 
        print "</table>\n";
 
-       if (-s "$projectroot/$project/README.html") {
+       # If XSS prevention is on, we don't include README.html.
+       # TODO: Allow a readme in some safe format.
+       if (!$prevent_xss && -s "$projectroot/$project/README.html") {
                print "<div class=\"title\">readme</div>\n" .
                      "<div class=\"readme\">\n";
                insert_file("$projectroot/$project/README.html");
@@ -4764,15 +4784,25 @@ sub git_blob_plain {
                $save_as .= '.txt';
        }
 
+       # With XSS prevention on, blobs of all types except a few known safe
+       # ones are served with "Content-Disposition: attachment" to make sure
+       # they don't run in our security domain.  For certain image types,
+       # blob view writes an <img> tag referring to blob_plain view, and we
+       # want to be sure not to break that by serving the image as an
+       # attachment (though Firefox 3 doesn't seem to care).
+       my $sandbox = $prevent_xss &&
+               $type !~ m!^(?:text/plain|image/(?:gif|png|jpeg))$!;
+
        print $cgi->header(
                -type => $type,
                -expires => $expires,
-               -content_disposition => 'inline; filename="' . $save_as . '"');
-       undef $/;
+               -content_disposition =>
+                       ($sandbox ? 'attachment' : 'inline')
+                       . '; filename="' . $save_as . '"');
+       local $/ = undef;
        binmode STDOUT, ':raw';
        print <$fd>;
        binmode STDOUT, ':utf8'; # as set at the beginning of gitweb.cgi
-       $/ = "\n";
        close $fd;
 }
 
@@ -4874,12 +4904,16 @@ sub git_tree {
                }
        }
        die_error(404, "No such tree") unless defined($hash);
-       $/ = "\0";
-       open my $fd, "-|", git_cmd(), "ls-tree", '-z', $hash
-               or die_error(500, "Open git-ls-tree failed");
-       my @entries = map { chomp; $_ } <$fd>;
-       close $fd or die_error(404, "Reading tree failed");
-       $/ = "\n";
+
+       my @entries = ();
+       {
+               local $/ = "\0";
+               open my $fd, "-|", git_cmd(), "ls-tree", '-z', $hash
+                       or die_error(500, "Open git-ls-tree failed");
+               @entries = map { chomp; $_ } <$fd>;
+               close $fd
+                       or die_error(404, "Reading tree failed");
+       }
 
        my $refs = git_get_references();
        my $ref = format_ref_marker($refs, $hash_base);
@@ -5774,7 +5808,7 @@ sub git_search {
 
                print "<table class=\"pickaxe search\">\n";
                my $alternate = 1;
-               $/ = "\n";
+               local $/ = "\n";
                open my $fd, '-|', git_cmd(), '--no-pager', 'log', @diff_opts,
                        '--pretty=format:%H', '--no-abbrev', '--raw', "-S$searchtext",
                        ($search_use_regexp ? '--pickaxe-regex' : ());
@@ -5844,7 +5878,7 @@ sub git_search {
                print "<table class=\"grep_search\">\n";
                my $alternate = 1;
                my $matches = 0;
-               $/ = "\n";
+               local $/ = "\n";
                open my $fd, "-|", git_cmd(), 'grep', '-n',
                        $search_use_regexp ? ('-E', '-i') : '-F',
                        $searchtext, $co{'tree'};
@@ -6247,7 +6281,7 @@ XML
        # end of feed
        if ($format eq 'rss') {
                print "</channel>\n</rss>\n";
-       }       elsif ($format eq 'atom') {
+       } elsif ($format eq 'atom') {
                print "</feed>\n";
        }
 }