#!/usr/bin/perl # gitweb - simple web interface to track changes in git repositories # # (C) 2005-2006, Kay Sievers # (C) 2005, Christian Gierke # # This program is licensed under the GPLv2 use strict; use warnings; use CGI qw(:standard :escapeHTML -nosticky); use CGI::Util qw(unescape); use CGI::Carp qw(fatalsToBrowser); use Encode; use Fcntl ':mode'; use File::Find qw(); use File::Basename qw(basename); binmode STDOUT, ':utf8'; BEGIN { CGI->compile() if $ENV{'MOD_PERL'}; } our $cgi = new CGI; our $version = "++GIT_VERSION++"; our $my_url = $cgi->url(); our $my_uri = $cgi->url(-absolute => 1); # core git executable to use # this can just be "git" if your webserver has a sensible PATH our $GIT = "++GIT_BINDIR++/git"; # absolute fs-path which will be prepended to the project path #our $projectroot = "/pub/scm"; our $projectroot = "++GITWEB_PROJECTROOT++"; # target of the home link on top of all pages our $home_link = $my_uri || "/"; # string of the home link on top of all pages our $home_link_str = "++GITWEB_HOME_LINK_STR++"; # name of your site or organization to appear in page titles # replace this with something more descriptive for clearer bookmarks our $site_name = "++GITWEB_SITENAME++" || ($ENV{'SERVER_NAME'} || "Untitled") . " Git"; # filename of html text to include at top of each page our $site_header = "++GITWEB_SITE_HEADER++"; # html text to include at home page our $home_text = "++GITWEB_HOMETEXT++"; # filename of html text to include at bottom of each page our $site_footer = "++GITWEB_SITE_FOOTER++"; # URI of stylesheets our @stylesheets = ("++GITWEB_CSS++"); # URI of a single stylesheet, which can be overridden in GITWEB_CONFIG. our $stylesheet = undef; # URI of GIT logo (72x27 size) our $logo = "++GITWEB_LOGO++"; # URI of GIT favicon, assumed to be image/png type our $favicon = "++GITWEB_FAVICON++"; # URI and label (title) of GIT logo link #our $logo_url = "http://www.kernel.org/pub/software/scm/git/docs/"; #our $logo_label = "git documentation"; our $logo_url = "http://git.or.cz/"; our $logo_label = "git homepage"; # source of projects list our $projects_list = "++GITWEB_LIST++"; # default order of projects list # valid values are none, project, descr, owner, and age our $default_projects_order = "project"; # show repository only if this file exists # (only effective if this variable evaluates to true) our $export_ok = "++GITWEB_EXPORT_OK++"; # only allow viewing of repositories also shown on the overview page our $strict_export = "++GITWEB_STRICT_EXPORT++"; # list of git base URLs used for URL to where fetch project from, # i.e. full URL is "$git_base_url/$project" our @git_base_url_list = grep { $_ ne '' } ("++GITWEB_BASE_URL++"); # default blob_plain mimetype and default charset for text/plain blob our $default_blob_plain_mimetype = 'text/plain'; our $default_text_plain_charset = undef; # file to use for guessing MIME types before trying /etc/mime.types # (relative to the current git repository) our $mimetypes_file = undef; # You define site-wide feature defaults here; override them with # $GITWEB_CONFIG as necessary. our %feature = ( # feature => { # 'sub' => feature-sub (subroutine), # 'override' => allow-override (boolean), # 'default' => [ default options...] (array reference)} # # if feature is overridable (it means that allow-override has true value, # then feature-sub will be called with default options as parameters; # return value of feature-sub indicates if to enable specified feature # # use gitweb_check_feature() to check if is enabled # Enable the 'blame' blob view, showing the last commit that modified # each line in the file. This can be very CPU-intensive. # To enable system wide have in $GITWEB_CONFIG # $feature{'blame'}{'default'} = [1]; # To have project specific config enable override in $GITWEB_CONFIG # $feature{'blame'}{'override'} = 1; # and in project config gitweb.blame = 0|1; 'blame' => { 'sub' => \&feature_blame, 'override' => 0, 'default' => [0]}, # Enable the 'snapshot' link, providing a compressed tarball of any # tree. This can potentially generate high traffic if you have large # project. # To disable system wide have in $GITWEB_CONFIG # $feature{'snapshot'}{'default'} = [undef]; # To have project specific config enable override in $GITWEB_CONFIG # $feature{'snapshot'}{'override'} = 1; # and in project config gitweb.snapshot = none|gzip|bzip2; 'snapshot' => { 'sub' => \&feature_snapshot, 'override' => 0, # => [content-encoding, suffix, program] 'default' => ['x-gzip', 'gz', 'gzip']}, # Enable text search, which will list the commits which match author, # committer or commit text to a given string. Enabled by default. 'search' => { 'override' => 0, 'default' => [1]}, # Enable the pickaxe search, which will list the commits that modified # a given string in a file. This can be practical and quite faster # alternative to 'blame', but still potentially CPU-intensive. # To enable system wide have in $GITWEB_CONFIG # $feature{'pickaxe'}{'default'} = [1]; # To have project specific config enable override in $GITWEB_CONFIG # $feature{'pickaxe'}{'override'} = 1; # and in project config gitweb.pickaxe = 0|1; 'pickaxe' => { 'sub' => \&feature_pickaxe, 'override' => 0, 'default' => [1]}, # Make gitweb use an alternative format of the URLs which can be # more readable and natural-looking: project name is embedded # directly in the path and the query string contains other # auxiliary information. All gitweb installations recognize # URL in either format; this configures in which formats gitweb # generates links. # To enable system wide have in $GITWEB_CONFIG # $feature{'pathinfo'}{'default'} = [1]; # Project specific override is not supported. # Note that you will need to change the default location of CSS, # favicon, logo and possibly other files to an absolute URL. Also, # if gitweb.cgi serves as your indexfile, you will need to force # $my_uri to contain the script name in your $GITWEB_CONFIG. 'pathinfo' => { 'override' => 0, 'default' => [0]}, # Make gitweb consider projects in project root subdirectories # to be forks of existing projects. Given project $projname.git, # projects matching $projname/*.git will not be shown in the main # projects list, instead a '+' mark will be added to $projname # there and a 'forks' view will be enabled for the project, listing # all the forks. If project list is taken from a file, forks have # to be listed after the main project. # To enable system wide have in $GITWEB_CONFIG # $feature{'forks'}{'default'} = [1]; # Project specific override is not supported. 'forks' => { 'override' => 0, 'default' => [0]}, ); sub gitweb_check_feature { my ($name) = @_; return unless exists $feature{$name}; my ($sub, $override, @defaults) = ( $feature{$name}{'sub'}, $feature{$name}{'override'}, @{$feature{$name}{'default'}}); if (!$override) { return @defaults; } if (!defined $sub) { warn "feature $name is not overrideable"; return @defaults; } return $sub->(@defaults); } sub feature_blame { my ($val) = git_get_project_config('blame', '--bool'); if ($val eq 'true') { return 1; } elsif ($val eq 'false') { return 0; } return $_[0]; } sub feature_snapshot { my ($ctype, $suffix, $command) = @_; my ($val) = git_get_project_config('snapshot'); if ($val eq 'gzip') { return ('x-gzip', 'gz', 'gzip'); } elsif ($val eq 'bzip2') { return ('x-bzip2', 'bz2', 'bzip2'); } elsif ($val eq 'none') { return (); } return ($ctype, $suffix, $command); } sub gitweb_have_snapshot { my ($ctype, $suffix, $command) = gitweb_check_feature('snapshot'); my $have_snapshot = (defined $ctype && defined $suffix); return $have_snapshot; } sub feature_pickaxe { my ($val) = git_get_project_config('pickaxe', '--bool'); if ($val eq 'true') { return (1); } elsif ($val eq 'false') { return (0); } return ($_[0]); } # checking HEAD file with -e is fragile if the repository was # initialized long time ago (i.e. symlink HEAD) and was pack-ref'ed # and then pruned. sub check_head_link { my ($dir) = @_; my $headfile = "$dir/HEAD"; return ((-e $headfile) || (-l $headfile && readlink($headfile) =~ /^refs\/heads\//)); } sub check_export_ok { my ($dir) = @_; return (check_head_link($dir) && (!$export_ok || -e "$dir/$export_ok")); } # rename detection options for git-diff and git-diff-tree # - default is '-M', with the cost proportional to # (number of removed files) * (number of new files). # - more costly is '-C' (or '-C', '-M'), with the cost proportional to # (number of changed files + number of removed files) * (number of new files) # - even more costly is '-C', '--find-copies-harder' with cost # (number of files in the original tree) * (number of new files) # - one might want to include '-B' option, e.g. '-B', '-M' our @diff_opts = ('-M'); # taken from git_commit our $GITWEB_CONFIG = $ENV{'GITWEB_CONFIG'} || "++GITWEB_CONFIG++"; do $GITWEB_CONFIG if -e $GITWEB_CONFIG; # version of the core git binary our $git_version = qx($GIT --version) =~ m/git version (.*)$/ ? $1 : "unknown"; $projects_list ||= $projectroot; # ====================================================================== # input validation and dispatch our $action = $cgi->param('a'); if (defined $action) { if ($action =~ m/[^0-9a-zA-Z\.\-_]/) { die_error(undef, "Invalid action parameter"); } } # parameters which are pathnames our $project = $cgi->param('p'); if (defined $project) { if (!validate_pathname($project) || !(-d "$projectroot/$project") || !check_head_link("$projectroot/$project") || ($export_ok && !(-e "$projectroot/$project/$export_ok")) || ($strict_export && !project_in_list($project))) { undef $project; die_error(undef, "No such project"); } } our $file_name = $cgi->param('f'); if (defined $file_name) { if (!validate_pathname($file_name)) { die_error(undef, "Invalid file parameter"); } } our $file_parent = $cgi->param('fp'); if (defined $file_parent) { if (!validate_pathname($file_parent)) { die_error(undef, "Invalid file parent parameter"); } } # parameters which are refnames our $hash = $cgi->param('h'); if (defined $hash) { if (!validate_refname($hash)) { die_error(undef, "Invalid hash parameter"); } } our $hash_parent = $cgi->param('hp'); if (defined $hash_parent) { if (!validate_refname($hash_parent)) { die_error(undef, "Invalid hash parent parameter"); } } our $hash_base = $cgi->param('hb'); if (defined $hash_base) { if (!validate_refname($hash_base)) { die_error(undef, "Invalid hash base parameter"); } } our $hash_parent_base = $cgi->param('hpb'); if (defined $hash_parent_base) { if (!validate_refname($hash_parent_base)) { die_error(undef, "Invalid hash parent base parameter"); } } # other parameters our $page = $cgi->param('pg'); if (defined $page) { if ($page =~ m/[^0-9]/) { die_error(undef, "Invalid page parameter"); } } our $searchtext = $cgi->param('s'); if (defined $searchtext) { if ($searchtext =~ m/[^a-zA-Z0-9_\.\/\-\+\:\@ ]/) { die_error(undef, "Invalid search parameter"); } if (length($searchtext) < 2) { die_error(undef, "At least two characters are required for search parameter"); } $searchtext = quotemeta $searchtext; } our $searchtype = $cgi->param('st'); if (defined $searchtype) { if ($searchtype =~ m/[^a-z]/) { die_error(undef, "Invalid searchtype parameter"); } } # now read PATH_INFO and use it as alternative to parameters sub evaluate_path_info { return if defined $project; my $path_info = $ENV{"PATH_INFO"}; return if !$path_info; $path_info =~ s,^/+,,; return if !$path_info; # find which part of PATH_INFO is project $project = $path_info; $project =~ s,/+$,,; while ($project && !check_head_link("$projectroot/$project")) { $project =~ s,/*[^/]*$,,; } # validate project $project = validate_pathname($project); if (!$project || ($export_ok && !-e "$projectroot/$project/$export_ok") || ($strict_export && !project_in_list($project))) { undef $project; return; } # do not change any parameters if an action is given using the query string return if $action; $path_info =~ s,^$project/*,,; my ($refname, $pathname) = split(/:/, $path_info, 2); if (defined $pathname) { # we got "project.git/branch:filename" or "project.git/branch:dir/" # we could use git_get_type(branch:pathname), but it needs $git_dir $pathname =~ s,^/+,,; if (!$pathname || substr($pathname, -1) eq "/") { $action ||= "tree"; $pathname =~ s,/$,,; } else { $action ||= "blob_plain"; } $hash_base ||= validate_refname($refname); $file_name ||= validate_pathname($pathname); } elsif (defined $refname) { # we got "project.git/branch" $action ||= "shortlog"; $hash ||= validate_refname($refname); } } evaluate_path_info(); # path to the current git repository our $git_dir; $git_dir = "$projectroot/$project" if $project; # dispatch my %actions = ( "blame" => \&git_blame2, "blobdiff" => \&git_blobdiff, "blobdiff_plain" => \&git_blobdiff_plain, "blob" => \&git_blob, "blob_plain" => \&git_blob_plain, "commitdiff" => \&git_commitdiff, "commitdiff_plain" => \&git_commitdiff_plain, "commit" => \&git_commit, "forks" => \&git_forks, "heads" => \&git_heads, "history" => \&git_history, "log" => \&git_log, "rss" => \&git_rss, "atom" => \&git_atom, "search" => \&git_search, "search_help" => \&git_search_help, "shortlog" => \&git_shortlog, "summary" => \&git_summary, "tag" => \&git_tag, "tags" => \&git_tags, "tree" => \&git_tree, "snapshot" => \&git_snapshot, "object" => \&git_object, # those below don't need $project "opml" => \&git_opml, "project_list" => \&git_project_list, "project_index" => \&git_project_index, ); if (!defined $action) { if (defined $hash) { $action = git_get_type($hash); } elsif (defined $hash_base && defined $file_name) { $action = git_get_type("$hash_base:$file_name"); } elsif (defined $project) { $action = 'summary'; } else { $action = 'project_list'; } } if (!defined($actions{$action})) { die_error(undef, "Unknown action"); } if ($action !~ m/^(opml|project_list|project_index)$/ && !$project) { die_error(undef, "Project needed"); } $actions{$action}->(); exit; ## ====================================================================== ## action links sub href(%) { my %params = @_; # default is to use -absolute url() i.e. $my_uri my $href = $params{-full} ? $my_url : $my_uri; # XXX: Warning: If you touch this, check the search form for updating, # too. my @mapping = ( project => "p", action => "a", file_name => "f", file_parent => "fp", hash => "h", hash_parent => "hp", hash_base => "hb", hash_parent_base => "hpb", page => "pg", order => "o", searchtext => "s", searchtype => "st", ); my %mapping = @mapping; $params{'project'} = $project unless exists $params{'project'}; my ($use_pathinfo) = gitweb_check_feature('pathinfo'); if ($use_pathinfo) { # use PATH_INFO for project name $href .= "/$params{'project'}" if defined $params{'project'}; delete $params{'project'}; # Summary just uses the project path URL if (defined $params{'action'} && $params{'action'} eq 'summary') { delete $params{'action'}; } } # now encode the parameters explicitly my @result = (); for (my $i = 0; $i < @mapping; $i += 2) { my ($name, $symbol) = ($mapping[$i], $mapping[$i+1]); if (defined $params{$name}) { push @result, $symbol . "=" . esc_param($params{$name}); } } $href .= "?" . join(';', @result) if scalar @result; return $href; } ## ====================================================================== ## validation, quoting/unquoting and escaping sub validate_pathname { my $input = shift || return undef; # no '.' or '..' as elements of path, i.e. no '.' nor '..' # at the beginning, at the end, and between slashes. # also this catches doubled slashes if ($input =~ m!(^|/)(|\.|\.\.)(/|$)!) { return undef; } # no null characters if ($input =~ m!\0!) { return undef; } return $input; } sub validate_refname { my $input = shift || return undef; # textual hashes are O.K. if ($input =~ m/^[0-9a-fA-F]{40}$/) { return $input; } # it must be correct pathname $input = validate_pathname($input) or return undef; # restrictions on ref name according to git-check-ref-format if ($input =~ m!(/\.|\.\.|[\000-\040\177 ~^:?*\[]|/$)!) { return undef; } return $input; } # quote unsafe chars, but keep the slash, even when it's not # correct, but quoted slashes look too horrible in bookmarks sub esc_param { my $str = shift; $str =~ s/([^A-Za-z0-9\-_.~()\/:@])/sprintf("%%%02X", ord($1))/eg; $str =~ s/\+/%2B/g; $str =~ s/ /\+/g; return $str; } # quote unsafe chars in whole URL, so some charactrs cannot be quoted sub esc_url { my $str = shift; $str =~ s/([^A-Za-z0-9\-_.~();\/;?:@&=])/sprintf("%%%02X", ord($1))/eg; $str =~ s/\+/%2B/g; $str =~ s/ /\+/g; return $str; } # replace invalid utf8 character with SUBSTITUTION sequence sub esc_html ($;%) { my $str = shift; my %opts = @_; $str = decode_utf8($str); $str = $cgi->escapeHTML($str); if ($opts{'-nbsp'}) { $str =~ s/ / /g; } $str =~ s|([[:cntrl:]])|(($1 ne "\t") ? quot_cec($1) : $1)|eg; return $str; } # quote control characters and escape filename to HTML sub esc_path { my $str = shift; my %opts = @_; $str = decode_utf8($str); $str = $cgi->escapeHTML($str); if ($opts{'-nbsp'}) { $str =~ s/ / /g; } $str =~ s|([[:cntrl:]])|quot_cec($1)|eg; return $str; } # Make control characters "printable", using character escape codes (CEC) sub quot_cec { my $cntrl = shift; my %es = ( # character escape codes, aka escape sequences "\t" => '\t', # tab (HT) "\n" => '\n', # line feed (LF) "\r" => '\r', # carrige return (CR) "\f" => '\f', # form feed (FF) "\b" => '\b', # backspace (BS) "\a" => '\a', # alarm (bell) (BEL) "\e" => '\e', # escape (ESC) "\013" => '\v', # vertical tab (VT) "\000" => '\0', # nul character (NUL) ); my $chr = ( (exists $es{$cntrl}) ? $es{$cntrl} : sprintf('\%03o', ord($cntrl)) ); return "$chr"; } # Alternatively use unicode control pictures codepoints, # Unicode "printable representation" (PR) sub quot_upr { my $cntrl = shift; my $chr = sprintf('&#%04d;', 0x2400+ord($cntrl)); return "$chr"; } # git may return quoted and escaped filenames sub unquote { my $str = shift; sub unq { my $seq = shift; my %es = ( # character escape codes, aka escape sequences 't' => "\t", # tab (HT, TAB) 'n' => "\n", # newline (NL) 'r' => "\r", # return (CR) 'f' => "\f", # form feed (FF) 'b' => "\b", # backspace (BS) 'a' => "\a", # alarm (bell) (BEL) 'e' => "\e", # escape (ESC) 'v' => "\013", # vertical tab (VT) ); if ($seq =~ m/^[0-7]{1,3}$/) { # octal char sequence return chr(oct($seq)); } elsif (exists $es{$seq}) { # C escape sequence, aka character escape code return $es{$seq} } # quoted ordinary character return $seq; } if ($str =~ m/^"(.*)"$/) { # needs unquoting $str = $1; $str =~ s/\\([^0-7]|[0-7]{1,3})/unq($1)/eg; } return $str; } # escape tabs (convert tabs to spaces) sub untabify { my $line = shift; while ((my $pos = index($line, "\t")) != -1) { if (my $count = (8 - ($pos % 8))) { my $spaces = ' ' x $count; $line =~ s/\t/$spaces/; } } return $line; } sub project_in_list { my $project = shift; my @list = git_get_projects_list(); return @list && scalar(grep { $_->{'path'} eq $project } @list); } ## ---------------------------------------------------------------------- ## HTML aware string manipulation sub chop_str { my $str = shift; my $len = shift; my $add_len = shift || 10; # allow only $len chars, but don't cut a word if it would fit in $add_len # if it doesn't fit, cut it if it's still longer than the dots we would add $str =~ m/^(.{0,$len}[^ \/\-_:\.@]{0,$add_len})(.*)/; my $body = $1; my $tail = $2; if (length($tail) > 4) { $tail = " ..."; $body =~ s/&[^;]*$//; # remove chopped character entities } return "$body$tail"; } ## ---------------------------------------------------------------------- ## functions returning short strings # CSS class for given age value (in seconds) sub age_class { my $age = shift; if ($age < 60*60*2) { return "age0"; } elsif ($age < 60*60*24*2) { return "age1"; } else { return "age2"; } } # convert age in seconds to "nn units ago" string sub age_string { my $age = shift; my $age_str; if ($age > 60*60*24*365*2) { $age_str = (int $age/60/60/24/365); $age_str .= " years ago"; } elsif ($age > 60*60*24*(365/12)*2) { $age_str = int $age/60/60/24/(365/12); $age_str .= " months ago"; } elsif ($age > 60*60*24*7*2) { $age_str = int $age/60/60/24/7; $age_str .= " weeks ago"; } elsif ($age > 60*60*24*2) { $age_str = int $age/60/60/24; $age_str .= " days ago"; } elsif ($age > 60*60*2) { $age_str = int $age/60/60; $age_str .= " hours ago"; } elsif ($age > 60*2) { $age_str = int $age/60; $age_str .= " min ago"; } elsif ($age > 2) { $age_str = int $age; $age_str .= " sec ago"; } else { $age_str .= " right now"; } return $age_str; } # convert file mode in octal to symbolic file mode string sub mode_str { my $mode = oct shift; if (S_ISDIR($mode & S_IFMT)) { return 'drwxr-xr-x'; } elsif (S_ISLNK($mode)) { return 'lrwxrwxrwx'; } elsif (S_ISREG($mode)) { # git cares only about the executable bit if ($mode & S_IXUSR) { return '-rwxr-xr-x'; } else { return '-rw-r--r--'; }; } else { return '----------'; } } # convert file mode in octal to file type string sub file_type { my $mode = shift; if ($mode !~ m/^[0-7]+$/) { return $mode; } else { $mode = oct $mode; } if (S_ISDIR($mode & S_IFMT)) { return "directory"; } elsif (S_ISLNK($mode)) { return "symlink"; } elsif (S_ISREG($mode)) { return "file"; } else { return "unknown"; } } # convert file mode in octal to file type description string sub file_type_long { my $mode = shift; if ($mode !~ m/^[0-7]+$/) { return $mode; } else { $mode = oct $mode; } if (S_ISDIR($mode & S_IFMT)) { return "directory"; } elsif (S_ISLNK($mode)) { return "symlink"; } elsif (S_ISREG($mode)) { if ($mode & S_IXUSR) { return "executable"; } else { return "file"; }; } else { return "unknown"; } } ## ---------------------------------------------------------------------- ## functions returning short HTML fragments, or transforming HTML fragments ## which don't belong to other sections # format line of commit message. sub format_log_line_html { my $line = shift; $line = esc_html($line, -nbsp=>1); if ($line =~ m/([0-9a-fA-F]{8,40})/) { my $hash_text = $1; my $link = $cgi->a({-href => href(action=>"object", hash=>$hash_text), -class => "text"}, $hash_text); $line =~ s/$hash_text/$link/; } return $line; } # format marker of refs pointing to given object sub format_ref_marker { my ($refs, $id) = @_; my $markers = ''; if (defined $refs->{$id}) { foreach my $ref (@{$refs->{$id}}) { my ($type, $name) = qw(); # e.g. tags/v2.6.11 or heads/next if ($ref =~ m!^(.*?)s?/(.*)$!) { $type = $1; $name = $2; } else { $type = "ref"; $name = $ref; } $markers .= " " . esc_html($name) . ""; } } if ($markers) { return ' '. $markers . ''; } else { return ""; } } # format, perhaps shortened and with markers, title line sub format_subject_html { my ($long, $short, $href, $extra) = @_; $extra = '' unless defined($extra); if (length($short) < length($long)) { return $cgi->a({-href => $href, -class => "list subject", -title => decode_utf8($long)}, esc_html($short) . $extra); } else { return $cgi->a({-href => $href, -class => "list subject"}, esc_html($long) . $extra); } } # format patch (diff) line (rather not to be used for diff headers) sub format_diff_line { my $line = shift; my ($from, $to) = @_; my $diff_class = ""; chomp $line; if ($from && $to && ref($from->{'href'}) eq "ARRAY") { # combined diff my $prefix = substr($line, 0, scalar @{$from->{'href'}}); if ($line =~ m/^\@{3}/) { $diff_class = " chunk_header"; } elsif ($line =~ m/^\\/) { $diff_class = " incomplete"; } elsif ($prefix =~ tr/+/+/) { $diff_class = " add"; } elsif ($prefix =~ tr/-/-/) { $diff_class = " rem"; } } else { # assume ordinary diff my $char = substr($line, 0, 1); if ($char eq '+') { $diff_class = " add"; } elsif ($char eq '-') { $diff_class = " rem"; } elsif ($char eq '@') { $diff_class = " chunk_header"; } elsif ($char eq "\\") { $diff_class = " incomplete"; } } $line = untabify($line); if ($from && $to && $line =~ m/^\@{2} /) { my ($from_text, $from_start, $from_lines, $to_text, $to_start, $to_lines, $section) = $line =~ m/^\@{2} (-(\d+)(?:,(\d+))?) (\+(\d+)(?:,(\d+))?) \@{2}(.*)$/; $from_lines = 0 unless defined $from_lines; $to_lines = 0 unless defined $to_lines; if ($from->{'href'}) { $from_text = $cgi->a({-href=>"$from->{'href'}#l$from_start", -class=>"list"}, $from_text); } if ($to->{'href'}) { $to_text = $cgi->a({-href=>"$to->{'href'}#l$to_start", -class=>"list"}, $to_text); } $line = "@@ $from_text $to_text @@" . "" . esc_html($section, -nbsp=>1) . ""; return "
$line
\n"; } elsif ($from && $to && $line =~ m/^\@{3}/) { my ($prefix, $ranges, $section) = $line =~ m/^(\@+) (.*?) \@+(.*)$/; my (@from_text, @from_start, @from_nlines, $to_text, $to_start, $to_nlines); @from_text = split(' ', $ranges); for (my $i = 0; $i < @from_text; ++$i) { ($from_start[$i], $from_nlines[$i]) = (split(',', substr($from_text[$i], 1)), 0); } $to_text = pop @from_text; $to_start = pop @from_start; $to_nlines = pop @from_nlines; $line = "$prefix "; for (my $i = 0; $i < @from_text; ++$i) { if ($from->{'href'}[$i]) { $line .= $cgi->a({-href=>"$from->{'href'}[$i]#l$from_start[$i]", -class=>"list"}, $from_text[$i]); } else { $line .= $from_text[$i]; } $line .= " "; } if ($to->{'href'}) { $line .= $cgi->a({-href=>"$to->{'href'}#l$to_start", -class=>"list"}, $to_text); } else { $line .= $to_text; } $line .= " $prefix" . "" . esc_html($section, -nbsp=>1) . ""; return "
$line
\n"; } return "
" . esc_html($line, -nbsp=>1) . "
\n"; } ## ---------------------------------------------------------------------- ## git utility subroutines, invoking git commands # returns path to the core git executable and the --git-dir parameter as list sub git_cmd { return $GIT, '--git-dir='.$git_dir; } # returns path to the core git executable and the --git-dir parameter as string sub git_cmd_str { return join(' ', git_cmd()); } # get HEAD ref of given project as hash sub git_get_head_hash { my $project = shift; my $o_git_dir = $git_dir; my $retval = undef; $git_dir = "$projectroot/$project"; if (open my $fd, "-|", git_cmd(), "rev-parse", "--verify", "HEAD") { my $head = <$fd>; close $fd; if (defined $head && $head =~ /^([0-9a-fA-F]{40})$/) { $retval = $1; } } if (defined $o_git_dir) { $git_dir = $o_git_dir; } return $retval; } # get type of given object sub git_get_type { my $hash = shift; open my $fd, "-|", git_cmd(), "cat-file", '-t', $hash or return; my $type = <$fd>; close $fd or return; chomp $type; return $type; } sub git_get_project_config { my ($key, $type) = @_; return unless ($key); $key =~ s/^gitweb\.//; return if ($key =~ m/\W/); my @x = (git_cmd(), 'config'); if (defined $type) { push @x, $type; } push @x, "--get"; push @x, "gitweb.$key"; my $val = qx(@x); chomp $val; return ($val); } # get hash of given path at given ref sub git_get_hash_by_path { my $base = shift; my $path = shift || return undef; my $type = shift; $path =~ s,/+$,,; open my $fd, "-|", git_cmd(), "ls-tree", $base, "--", $path or die_error(undef, "Open git-ls-tree failed"); my $line = <$fd>; close $fd or return undef; #'100644 blob 0fa3f3a66fb6a137f6ec2c19351ed4d807070ffa panic.c' $line =~ m/^([0-9]+) (.+) ([0-9a-fA-F]{40})\t/; if (defined $type && $type ne $2) { # type doesn't match return undef; } return $3; } # get path of entry with given hash at given tree-ish (ref) # used to get 'from' filename for combined diff (merge commit) for renames sub git_get_path_by_hash { my $base = shift || return; my $hash = shift || return; local $/ = "\0"; open my $fd, "-|", git_cmd(), "ls-tree", '-r', '-t', '-z', $base or return undef; while (my $line = <$fd>) { chomp $line; #'040000 tree 595596a6a9117ddba9fe379b6b012b558bac8423 gitweb' #'100644 blob e02e90f0429be0d2a69b76571101f20b8f75530f gitweb/README' if ($line =~ m/(?:[0-9]+) (?:.+) $hash\t(.+)$/) { close $fd; return $1; } } close $fd; return undef; } ## ...................................................................... ## git utility functions, directly accessing git repository sub git_get_project_description { my $path = shift; open my $fd, "$projectroot/$path/description" or return undef; my $descr = <$fd>; close $fd; chomp $descr; return $descr; } sub git_get_project_url_list { my $path = shift; open my $fd, "$projectroot/$path/cloneurl" or return; my @git_project_url_list = map { chomp; $_ } <$fd>; close $fd; return wantarray ? @git_project_url_list : \@git_project_url_list; } sub git_get_projects_list { my ($filter) = @_; my @list; $filter ||= ''; $filter =~ s/\.git$//; my ($check_forks) = gitweb_check_feature('forks'); if (-d $projects_list) { # search in directory my $dir = $projects_list . ($filter ? "/$filter" : ''); # remove the trailing "/" $dir =~ s!/+$!!; my $pfxlen = length("$dir"); File::Find::find({ follow_fast => 1, # follow symbolic links dangling_symlinks => 0, # ignore dangling symlinks, silently wanted => sub { # skip project-list toplevel, if we get it. return if (m!^[/.]$!); # only directories can be git repositories return unless (-d $_); my $subdir = substr($File::Find::name, $pfxlen + 1); # we check related file in $projectroot if ($check_forks and $subdir =~ m#/.#) { $File::Find::prune = 1; } elsif (check_export_ok("$projectroot/$filter/$subdir")) { push @list, { path => ($filter ? "$filter/" : '') . $subdir }; $File::Find::prune = 1; } }, }, "$dir"); } elsif (-f $projects_list) { # read from file(url-encoded): # 'git%2Fgit.git Linus+Torvalds' # 'libs%2Fklibc%2Fklibc.git H.+Peter+Anvin' # 'linux%2Fhotplug%2Fudev.git Greg+Kroah-Hartman' my %paths; open my ($fd), $projects_list or return; PROJECT: while (my $line = <$fd>) { chomp $line; my ($path, $owner) = split ' ', $line; $path = unescape($path); $owner = unescape($owner); if (!defined $path) { next; } if ($filter ne '') { # looking for forks; my $pfx = substr($path, 0, length($filter)); if ($pfx ne $filter) { next PROJECT; } my $sfx = substr($path, length($filter)); if ($sfx !~ /^\/.*\.git$/) { next PROJECT; } } elsif ($check_forks) { PATH: foreach my $filter (keys %paths) { # looking for forks; my $pfx = substr($path, 0, length($filter)); if ($pfx ne $filter) { next PATH; } my $sfx = substr($path, length($filter)); if ($sfx !~ /^\/.*\.git$/) { next PATH; } # is a fork, don't include it in # the list next PROJECT; } } if (check_export_ok("$projectroot/$path")) { my $pr = { path => $path, owner => decode_utf8($owner), }; push @list, $pr; (my $forks_path = $path) =~ s/\.git$//; $paths{$forks_path}++; } } close $fd; } return @list; } sub git_get_project_owner { my $project = shift; my $owner; return undef unless $project; # read from file (url-encoded): # 'git%2Fgit.git Linus+Torvalds' # 'libs%2Fklibc%2Fklibc.git H.+Peter+Anvin' # 'linux%2Fhotplug%2Fudev.git Greg+Kroah-Hartman' if (-f $projects_list) { open (my $fd , $projects_list); while (my $line = <$fd>) { chomp $line; my ($pr, $ow) = split ' ', $line; $pr = unescape($pr); $ow = unescape($ow); if ($pr eq $project) { $owner = decode_utf8($ow); last; } } close $fd; } if (!defined $owner) { $owner = get_file_owner("$projectroot/$project"); } return $owner; } sub git_get_last_activity { my ($path) = @_; my $fd; $git_dir = "$projectroot/$path"; open($fd, "-|", git_cmd(), 'for-each-ref', '--format=%(committer)', '--sort=-committerdate', '--count=1', 'refs/heads') or return; my $most_recent = <$fd>; close $fd or return; if ($most_recent =~ / (\d+) [-+][01]\d\d\d$/) { my $timestamp = $1; my $age = time - $timestamp; return ($age, age_string($age)); } } sub git_get_references { my $type = shift || ""; my %refs; # 5dc01c595e6c6ec9ccda4f6f69c131c0dd945f8c refs/tags/v2.6.11 # c39ae07f393806ccf406ef966e9a15afc43cc36a refs/tags/v2.6.11^{} open my $fd, "-|", git_cmd(), "show-ref", "--dereference", ($type ? ("--", "refs/$type") : ()) # use -- if $type or return; while (my $line = <$fd>) { chomp $line; if ($line =~ m!^([0-9a-fA-F]{40})\srefs/($type/?[^^]+)!) { if (defined $refs{$1}) { push @{$refs{$1}}, $2; } else { $refs{$1} = [ $2 ]; } } } close $fd or return; return \%refs; } sub git_get_rev_name_tags { my $hash = shift || return undef; open my $fd, "-|", git_cmd(), "name-rev", "--tags", $hash or return; my $name_rev = <$fd>; close $fd; if ($name_rev =~ m|^$hash tags/(.*)$|) { return $1; } else { # catches also '$hash undefined' output return undef; } } ## ---------------------------------------------------------------------- ## parse to hash functions sub parse_date { my $epoch = shift; my $tz = shift || "-0000"; my %date; my @months = ("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"); my @days = ("Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"); my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime($epoch); $date{'hour'} = $hour; $date{'minute'} = $min; $date{'mday'} = $mday; $date{'day'} = $days[$wday]; $date{'month'} = $months[$mon]; $date{'rfc2822'} = sprintf "%s, %d %s %4d %02d:%02d:%02d +0000", $days[$wday], $mday, $months[$mon], 1900+$year, $hour ,$min, $sec; $date{'mday-time'} = sprintf "%d %s %02d:%02d", $mday, $months[$mon], $hour ,$min; $date{'iso-8601'} = sprintf "%04d-%02d-%02dT%02d:%02d:%02dZ", 1900+$year, $mon, $mday, $hour ,$min, $sec; $tz =~ m/^([+\-][0-9][0-9])([0-9][0-9])$/; my $local = $epoch + ((int $1 + ($2/60)) * 3600); ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime($local); $date{'hour_local'} = $hour; $date{'minute_local'} = $min; $date{'tz_local'} = $tz; $date{'iso-tz'} = sprintf("%04d-%02d-%02d %02d:%02d:%02d %s", 1900+$year, $mon+1, $mday, $hour, $min, $sec, $tz); return %date; } sub parse_tag { my $tag_id = shift; my %tag; my @comment; open my $fd, "-|", git_cmd(), "cat-file", "tag", $tag_id or return; $tag{'id'} = $tag_id; while (my $line = <$fd>) { chomp $line; if ($line =~ m/^object ([0-9a-fA-F]{40})$/) { $tag{'object'} = $1; } elsif ($line =~ m/^type (.+)$/) { $tag{'type'} = $1; } elsif ($line =~ m/^tag (.+)$/) { $tag{'name'} = $1; } elsif ($line =~ m/^tagger (.*) ([0-9]+) (.*)$/) { $tag{'author'} = $1; $tag{'epoch'} = $2; $tag{'tz'} = $3; } elsif ($line =~ m/--BEGIN/) { push @comment, $line; last; } elsif ($line eq "") { last; } } push @comment, <$fd>; $tag{'comment'} = \@comment; close $fd or return; if (!defined $tag{'name'}) { return }; return %tag } sub parse_commit_text { my ($commit_text, $withparents) = @_; my @commit_lines = split '\n', $commit_text; my %co; pop @commit_lines; # Remove '\0' my $header = shift @commit_lines; if (!($header =~ m/^[0-9a-fA-F]{40}/)) { return; } ($co{'id'}, my @parents) = split ' ', $header; while (my $line = shift @commit_lines) { last if $line eq "\n"; if ($line =~ m/^tree ([0-9a-fA-F]{40})$/) { $co{'tree'} = $1; } elsif ((!defined $withparents) && ($line =~ m/^parent ([0-9a-fA-F]{40})$/)) { push @parents, $1; } elsif ($line =~ m/^author (.*) ([0-9]+) (.*)$/) { $co{'author'} = $1; $co{'author_epoch'} = $2; $co{'author_tz'} = $3; if ($co{'author'} =~ m/^([^<]+) <([^>]*)>/) { $co{'author_name'} = $1; $co{'author_email'} = $2; } else { $co{'author_name'} = $co{'author'}; } } elsif ($line =~ m/^committer (.*) ([0-9]+) (.*)$/) { $co{'committer'} = $1; $co{'committer_epoch'} = $2; $co{'committer_tz'} = $3; $co{'committer_name'} = $co{'committer'}; if ($co{'committer'} =~ m/^([^<]+) <([^>]*)>/) { $co{'committer_name'} = $1; $co{'committer_email'} = $2; } else { $co{'committer_name'} = $co{'committer'}; } } } if (!defined $co{'tree'}) { return; }; $co{'parents'} = \@parents; $co{'parent'} = $parents[0]; foreach my $title (@commit_lines) { $title =~ s/^ //; if ($title ne "") { $co{'title'} = chop_str($title, 80, 5); # remove leading stuff of merges to make the interesting part visible if (length($title) > 50) { $title =~ s/^Automatic //; $title =~ s/^merge (of|with) /Merge ... /i; if (length($title) > 50) { $title =~ s/(http|rsync):\/\///; } if (length($title) > 50) { $title =~ s/(master|www|rsync)\.//; } if (length($title) > 50) { $title =~ s/kernel.org:?//; } if (length($title) > 50) { $title =~ s/\/pub\/scm//; } } $co{'title_short'} = chop_str($title, 50, 5); last; } } if ($co{'title'} eq "") { $co{'title'} = $co{'title_short'} = '(no commit message)'; } # remove added spaces foreach my $line (@commit_lines) { $line =~ s/^ //; } $co{'comment'} = \@commit_lines; my $age = time - $co{'committer_epoch'}; $co{'age'} = $age; $co{'age_string'} = age_string($age); my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime($co{'committer_epoch'}); if ($age > 60*60*24*7*2) { $co{'age_string_date'} = sprintf "%4i-%02u-%02i", 1900 + $year, $mon+1, $mday; $co{'age_string_age'} = $co{'age_string'}; } else { $co{'age_string_date'} = $co{'age_string'}; $co{'age_string_age'} = sprintf "%4i-%02u-%02i", 1900 + $year, $mon+1, $mday; } return %co; } sub parse_commit { my ($commit_id) = @_; my %co; local $/ = "\0"; open my $fd, "-|", git_cmd(), "rev-list", "--parents", "--header", "--max-count=1", $commit_id, "--", or die_error(undef, "Open git-rev-list failed"); %co = parse_commit_text(<$fd>, 1); close $fd; return %co; } sub parse_commits { my ($commit_id, $maxcount, $skip, $arg, $filename) = @_; my @cos; $maxcount ||= 1; $skip ||= 0; local $/ = "\0"; open my $fd, "-|", git_cmd(), "rev-list", "--header", ($arg ? ($arg) : ()), ("--max-count=" . $maxcount), ("--skip=" . $skip), $commit_id, "--", ($filename ? ($filename) : ()) or die_error(undef, "Open git-rev-list failed"); while (my $line = <$fd>) { my %co = parse_commit_text($line); push @cos, \%co; } close $fd; return wantarray ? @cos : \@cos; } # parse ref from ref_file, given by ref_id, with given type sub parse_ref { my $ref_file = shift; my $ref_id = shift; my $type = shift || git_get_type($ref_id); my %ref_item; $ref_item{'type'} = $type; $ref_item{'id'} = $ref_id; $ref_item{'epoch'} = 0; $ref_item{'age'} = "unknown"; if ($type eq "tag") { my %tag = parse_tag($ref_id); $ref_item{'comment'} = $tag{'comment'}; if ($tag{'type'} eq "commit") { my %co = parse_commit($tag{'object'}); $ref_item{'epoch'} = $co{'committer_epoch'}; $ref_item{'age'} = $co{'age_string'}; } elsif (defined($tag{'epoch'})) { my $age = time - $tag{'epoch'}; $ref_item{'epoch'} = $tag{'epoch'}; $ref_item{'age'} = age_string($age); } $ref_item{'reftype'} = $tag{'type'}; $ref_item{'name'} = $tag{'name'}; $ref_item{'refid'} = $tag{'object'}; } elsif ($type eq "commit"){ my %co = parse_commit($ref_id); $ref_item{'reftype'} = "commit"; $ref_item{'name'} = $ref_file; $ref_item{'title'} = $co{'title'}; $ref_item{'refid'} = $ref_id; $ref_item{'epoch'} = $co{'committer_epoch'}; $ref_item{'age'} = $co{'age_string'}; } else { $ref_item{'reftype'} = $type; $ref_item{'name'} = $ref_file; $ref_item{'refid'} = $ref_id; } return %ref_item; } # parse line of git-diff-tree "raw" output sub parse_difftree_raw_line { my $line = shift; my %res; # ':100644 100644 03b218260e99b78c6df0ed378e59ed9205ccc96d 3b93d5e7cc7f7dd4ebed13a5cc1a4ad976fc94d8 M ls-files.c' # ':100644 100644 7f9281985086971d3877aca27704f2aaf9c448ce bc190ebc71bbd923f2b728e505408f5e54bd073a M rev-tree.c' if ($line =~ m/^:([0-7]{6}) ([0-7]{6}) ([0-9a-fA-F]{40}) ([0-9a-fA-F]{40}) (.)([0-9]{0,3})\t(.*)$/) { $res{'from_mode'} = $1; $res{'to_mode'} = $2; $res{'from_id'} = $3; $res{'to_id'} = $4; $res{'status'} = $5; $res{'similarity'} = $6; if ($res{'status'} eq 'R' || $res{'status'} eq 'C') { # renamed or copied ($res{'from_file'}, $res{'to_file'}) = map { unquote($_) } split("\t", $7); } else { $res{'file'} = unquote($7); } } # '::100755 100755 100755 60e79ca1b01bc8b057abe17ddab484699a7f5fdb 94067cc5f73388f33722d52ae02f44692bc07490 94067cc5f73388f33722d52ae02f44692bc07490 MR git-gui/git-gui.sh' # combined diff (for merge commit) elsif ($line =~ s/^(::+)((?:[0-7]{6} )+)((?:[0-9a-fA-F]{40} )+)([a-zA-Z]+)\t(.*)$//) { $res{'nparents'} = length($1); $res{'from_mode'} = [ split(' ', $2) ]; $res{'to_mode'} = pop @{$res{'from_mode'}}; $res{'from_id'} = [ split(' ', $3) ]; $res{'to_id'} = pop @{$res{'from_id'}}; $res{'status'} = [ split('', $4) ]; $res{'to_file'} = unquote($5); } # 'c512b523472485aef4fff9e57b229d9d243c967f' elsif ($line =~ m/^([0-9a-fA-F]{40})$/) { $res{'commit'} = $1; } return wantarray ? %res : \%res; } # parse line of git-ls-tree output sub parse_ls_tree_line ($;%) { my $line = shift; my %opts = @_; my %res; #'100644 blob 0fa3f3a66fb6a137f6ec2c19351ed4d807070ffa panic.c' $line =~ m/^([0-9]+) (.+) ([0-9a-fA-F]{40})\t(.+)$/s; $res{'mode'} = $1; $res{'type'} = $2; $res{'hash'} = $3; if ($opts{'-z'}) { $res{'name'} = $4; } else { $res{'name'} = unquote($4); } return wantarray ? %res : \%res; } ## ...................................................................... ## parse to array of hashes functions sub git_get_heads_list { my $limit = shift; my @headslist; open my $fd, '-|', git_cmd(), 'for-each-ref', ($limit ? '--count='.($limit+1) : ()), '--sort=-committerdate', '--format=%(objectname) %(refname) %(subject)%00%(committer)', 'refs/heads' or return; while (my $line = <$fd>) { my %ref_item; chomp $line; my ($refinfo, $committerinfo) = split(/\0/, $line); my ($hash, $name, $title) = split(' ', $refinfo, 3); my ($committer, $epoch, $tz) = ($committerinfo =~ /^(.*) ([0-9]+) (.*)$/); $name =~ s!^refs/heads/!!; $ref_item{'name'} = $name; $ref_item{'id'} = $hash; $ref_item{'title'} = $title || '(no commit message)'; $ref_item{'epoch'} = $epoch; if ($epoch) { $ref_item{'age'} = age_string(time - $ref_item{'epoch'}); } else { $ref_item{'age'} = "unknown"; } push @headslist, \%ref_item; } close $fd; return wantarray ? @headslist : \@headslist; } sub git_get_tags_list { my $limit = shift; my @tagslist; open my $fd, '-|', git_cmd(), 'for-each-ref', ($limit ? '--count='.($limit+1) : ()), '--sort=-creatordate', '--format=%(objectname) %(objecttype) %(refname) '. '%(*objectname) %(*objecttype) %(subject)%00%(creator)', 'refs/tags' or return; while (my $line = <$fd>) { my %ref_item; chomp $line; my ($refinfo, $creatorinfo) = split(/\0/, $line); my ($id, $type, $name, $refid, $reftype, $title) = split(' ', $refinfo, 6); my ($creator, $epoch, $tz) = ($creatorinfo =~ /^(.*) ([0-9]+) (.*)$/); $name =~ s!^refs/tags/!!; $ref_item{'type'} = $type; $ref_item{'id'} = $id; $ref_item{'name'} = $name; if ($type eq "tag") { $ref_item{'subject'} = $title; $ref_item{'reftype'} = $reftype; $ref_item{'refid'} = $refid; } else { $ref_item{'reftype'} = $type; $ref_item{'refid'} = $id; } if ($type eq "tag" || $type eq "commit") { $ref_item{'epoch'} = $epoch; if ($epoch) { $ref_item{'age'} = age_string(time - $ref_item{'epoch'}); } else { $ref_item{'age'} = "unknown"; } } push @tagslist, \%ref_item; } close $fd; return wantarray ? @tagslist : \@tagslist; } ## ---------------------------------------------------------------------- ## filesystem-related functions sub get_file_owner { my $path = shift; my ($dev, $ino, $mode, $nlink, $st_uid, $st_gid, $rdev, $size) = stat($path); my ($name, $passwd, $uid, $gid, $quota, $comment, $gcos, $dir, $shell) = getpwuid($st_uid); if (!defined $gcos) { return undef; } my $owner = $gcos; $owner =~ s/[,;].*$//; return decode_utf8($owner); } ## ...................................................................... ## mimetype related functions sub mimetype_guess_file { my $filename = shift; my $mimemap = shift; -r $mimemap or return undef; my %mimemap; open(MIME, $mimemap) or return undef; while () { next if m/^#/; # skip comments my ($mime, $exts) = split(/\t+/); if (defined $exts) { my @exts = split(/\s+/, $exts); foreach my $ext (@exts) { $mimemap{$ext} = $mime; } } } close(MIME); $filename =~ /\.([^.]*)$/; return $mimemap{$1}; } sub mimetype_guess { my $filename = shift; my $mime; $filename =~ /\./ or return undef; if ($mimetypes_file) { my $file = $mimetypes_file; if ($file !~ m!^/!) { # if it is relative path # it is relative to project $file = "$projectroot/$project/$file"; } $mime = mimetype_guess_file($filename, $file); } $mime ||= mimetype_guess_file($filename, '/etc/mime.types'); return $mime; } sub blob_mimetype { my $fd = shift; my $filename = shift; if ($filename) { my $mime = mimetype_guess($filename); $mime and return $mime; } # just in case return $default_blob_plain_mimetype unless $fd; if (-T $fd) { return 'text/plain' . ($default_text_plain_charset ? '; charset='.$default_text_plain_charset : ''); } elsif (! $filename) { return 'application/octet-stream'; } elsif ($filename =~ m/\.png$/i) { return 'image/png'; } elsif ($filename =~ m/\.gif$/i) { return 'image/gif'; } elsif ($filename =~ m/\.jpe?g$/i) { return 'image/jpeg'; } else { return 'application/octet-stream'; } } ## ====================================================================== ## functions printing HTML: header, footer, error page sub git_header_html { my $status = shift || "200 OK"; my $expires = shift; my $title = "$site_name"; if (defined $project) { $title .= " - " . decode_utf8($project); if (defined $action) { $title .= "/$action"; if (defined $file_name) { $title .= " - " . esc_path($file_name); if ($action eq "tree" && $file_name !~ m|/$|) { $title .= "/"; } } } } my $content_type; # require explicit support from the UA if we are to send the page as # 'application/xhtml+xml', otherwise send it as plain old 'text/html'. # we have to do this because MSIE sometimes globs '*/*', pretending to # support xhtml+xml but choking when it gets what it asked for. if (defined $cgi->http('HTTP_ACCEPT') && $cgi->http('HTTP_ACCEPT') =~ m/(,|;|\s|^)application\/xhtml\+xml(,|;|\s|$)/ && $cgi->Accept('application/xhtml+xml') != 0) { $content_type = 'application/xhtml+xml'; } else { $content_type = 'text/html'; } print $cgi->header(-type=>$content_type, -charset => 'utf-8', -status=> $status, -expires => $expires); my $mod_perl_version = $ENV{'MOD_PERL'} ? " $ENV{'MOD_PERL'}" : ''; print < $title EOF # print out each stylesheet that exist if (defined $stylesheet) { #provides backwards capability for those people who define style sheet in a config file print ''."\n"; } else { foreach my $stylesheet (@stylesheets) { next unless $stylesheet; print ''."\n"; } } if (defined $project) { printf(''."\n", esc_param($project), href(action=>"rss")); printf(''."\n", esc_param($project), href(action=>"atom")); } else { printf(''."\n", $site_name, href(project=>undef, action=>"project_index")); printf(''."\n", $site_name, href(project=>undef, action=>"opml")); } if (defined $favicon) { print qq(\n); } print "\n" . "\n"; if (-f $site_header) { open (my $fd, $site_header); print <$fd>; close $fd; } print "
\n" . $cgi->a({-href => esc_url($logo_url), -title => $logo_label}, qq()); print $cgi->a({-href => esc_url($home_link)}, $home_link_str) . " / "; if (defined $project) { print $cgi->a({-href => href(action=>"summary")}, esc_html($project)); if (defined $action) { print " / $action"; } print "\n"; } my ($have_search) = gitweb_check_feature('search'); if ((defined $project) && ($have_search)) { if (!defined $searchtext) { $searchtext = ""; } my $search_hash; if (defined $hash_base) { $search_hash = $hash_base; } elsif (defined $hash) { $search_hash = $hash; } else { $search_hash = "HEAD"; } $cgi->param("a", "search"); $cgi->param("h", $search_hash); $cgi->param("p", $project); print $cgi->startform(-method => "get", -action => $my_uri) . "
\n" . $cgi->hidden(-name => "p") . "\n" . $cgi->hidden(-name => "a") . "\n" . $cgi->hidden(-name => "h") . "\n" . $cgi->popup_menu(-name => 'st', -default => 'commit', -values => ['commit', 'author', 'committer', 'pickaxe']) . $cgi->sup($cgi->a({-href => href(action=>"search_help")}, "?")) . " search:\n", $cgi->textfield(-name => "s", -value => $searchtext) . "\n" . "
" . $cgi->end_form() . "\n"; } print "
\n"; } sub git_footer_html { print "
\n"; if (defined $project) { my $descr = git_get_project_description($project); if (defined $descr) { print "\n"; } print $cgi->a({-href => href(action=>"rss"), -class => "rss_logo"}, "RSS") . " "; print $cgi->a({-href => href(action=>"atom"), -class => "rss_logo"}, "Atom") . "\n"; } else { print $cgi->a({-href => href(project=>undef, action=>"opml"), -class => "rss_logo"}, "OPML") . " "; print $cgi->a({-href => href(project=>undef, action=>"project_index"), -class => "rss_logo"}, "TXT") . "\n"; } print "
\n" ; if (-f $site_footer) { open (my $fd, $site_footer); print <$fd>; close $fd; } print "\n" . ""; } sub die_error { my $status = shift || "403 Forbidden"; my $error = shift || "Malformed query, file missing or permission denied"; git_header_html($status); print <

$status - $error
EOF git_footer_html(); exit; } ## ---------------------------------------------------------------------- ## functions printing or outputting HTML: navigation sub git_print_page_nav { my ($current, $suppress, $head, $treehead, $treebase, $extra) = @_; $extra = '' if !defined $extra; # pager or formats my @navs = qw(summary shortlog log commit commitdiff tree); if ($suppress) { @navs = grep { $_ ne $suppress } @navs; } my %arg = map { $_ => {action=>$_} } @navs; if (defined $head) { for (qw(commit commitdiff)) { $arg{$_}{'hash'} = $head; } if ($current =~ m/^(tree | log | shortlog | commit | commitdiff | search)$/x) { for (qw(shortlog log)) { $arg{$_}{'hash'} = $head; } } } $arg{'tree'}{'hash'} = $treehead if defined $treehead; $arg{'tree'}{'hash_base'} = $treebase if defined $treebase; print "
\n" . (join " | ", map { $_ eq $current ? $_ : $cgi->a({-href => href(%{$arg{$_}})}, "$_") } @navs); print "
\n$extra
\n" . "
\n"; } sub format_paging_nav { my ($action, $hash, $head, $page, $nrevs) = @_; my $paging_nav; if ($hash ne $head || $page) { $paging_nav .= $cgi->a({-href => href(action=>$action)}, "HEAD"); } else { $paging_nav .= "HEAD"; } if ($page > 0) { $paging_nav .= " ⋅ " . $cgi->a({-href => href(action=>$action, hash=>$hash, page=>$page-1), -accesskey => "p", -title => "Alt-p"}, "prev"); } else { $paging_nav .= " ⋅ prev"; } if ($nrevs >= (100 * ($page+1)-1)) { $paging_nav .= " ⋅ " . $cgi->a({-href => href(action=>$action, hash=>$hash, page=>$page+1), -accesskey => "n", -title => "Alt-n"}, "next"); } else { $paging_nav .= " ⋅ next"; } return $paging_nav; } ## ...................................................................... ## functions printing or outputting HTML: div sub git_print_header_div { my ($action, $title, $hash, $hash_base) = @_; my %args = (); $args{'action'} = $action; $args{'hash'} = $hash if $hash; $args{'hash_base'} = $hash_base if $hash_base; print "
\n" . $cgi->a({-href => href(%args), -class => "title"}, $title ? $title : $action) . "\n
\n"; } #sub git_print_authorship (\%) { sub git_print_authorship { my $co = shift; my %ad = parse_date($co->{'author_epoch'}, $co->{'author_tz'}); print "
" . esc_html($co->{'author_name'}) . " [$ad{'rfc2822'}"; if ($ad{'hour_local'} < 6) { printf(" (%02d:%02d %s)", $ad{'hour_local'}, $ad{'minute_local'}, $ad{'tz_local'}); } else { printf(" (%02d:%02d %s)", $ad{'hour_local'}, $ad{'minute_local'}, $ad{'tz_local'}); } print "]
\n"; } sub git_print_page_path { my $name = shift; my $type = shift; my $hb = shift; print "
"; print $cgi->a({-href => href(action=>"tree", hash_base=>$hb), -title => 'tree root'}, decode_utf8("[$project]")); print " / "; if (defined $name) { my @dirname = split '/', $name; my $basename = pop @dirname; my $fullname = ''; foreach my $dir (@dirname) { $fullname .= ($fullname ? '/' : '') . $dir; print $cgi->a({-href => href(action=>"tree", file_name=>$fullname, hash_base=>$hb), -title => $fullname}, esc_path($dir)); print " / "; } if (defined $type && $type eq 'blob') { print $cgi->a({-href => href(action=>"blob_plain", file_name=>$file_name, hash_base=>$hb), -title => $name}, esc_path($basename)); } elsif (defined $type && $type eq 'tree') { print $cgi->a({-href => href(action=>"tree", file_name=>$file_name, hash_base=>$hb), -title => $name}, esc_path($basename)); print " / "; } else { print esc_path($basename); } } print "
\n"; } # sub git_print_log (\@;%) { sub git_print_log ($;%) { my $log = shift; my %opts = @_; if ($opts{'-remove_title'}) { # remove title, i.e. first line of log shift @$log; } # remove leading empty lines while (defined $log->[0] && $log->[0] eq "") { shift @$log; } # print log my $signoff = 0; my $empty = 0; foreach my $line (@$log) { if ($line =~ m/^ *(signed[ \-]off[ \-]by[ :]|acked[ \-]by[ :]|cc[ :])/i) { $signoff = 1; $empty = 0; if (! $opts{'-remove_signoff'}) { print "" . esc_html($line) . "
\n"; next; } else { # remove signoff lines next; } } else { $signoff = 0; } # print only one empty line # do not print empty line after signoff if ($line eq "") { next if ($empty || $signoff); $empty = 1; } else { $empty = 0; } print format_log_line_html($line) . "
\n"; } if ($opts{'-final_empty_line'}) { # end with single empty line print "
\n" unless $empty; } } # return link target (what link points to) sub git_get_link_target { my $hash = shift; my $link_target; # read link open my $fd, "-|", git_cmd(), "cat-file", "blob", $hash or return; { local $/; $link_target = <$fd>; } close $fd or return; return $link_target; } # given link target, and the directory (basedir) the link is in, # 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; # absolute symlinks (beginning with '/') cannot be normalized return if (substr($link_target, 0, 1) eq '/'); # normalize link target to path from top (root) tree (dir) my $path; if ($basedir) { $path = $basedir . '/' . $link_target; } else { # we are in top (root) tree (dir) $path = $link_target; } # remove //, /./, and /../ my @path_parts; foreach my $part (split('/', $path)) { # discard '.' and '' next if (!$part || $part eq '.'); # handle '..' if ($part eq '..') { if (@path_parts) { pop @path_parts; } else { # link leads outside repository (outside top dir) return; } } else { push @path_parts, $part; } } $path = join('/', @path_parts); return $path; } # print tree entry (row of git_tree), but without encompassing element sub git_print_tree_entry { my ($t, $basedir, $hash_base, $have_blame) = @_; my %base_key = (); $base_key{'hash_base'} = $hash_base if defined $hash_base; # The format of a table row is: mode list link. Where mode is # the mode of the entry, list is the name of the entry, an href, # and link is the action links of the entry. print "" . mode_str($t->{'mode'}) . "\n"; if ($t->{'type'} eq "blob") { print "" . $cgi->a({-href => href(action=>"blob", hash=>$t->{'hash'}, file_name=>"$basedir$t->{'name'}", %base_key), -class => "list"}, esc_path($t->{'name'})); 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); if (defined $norm_target) { print " -> " . $cgi->a({-href => href(action=>"object", hash_base=>$hash_base, file_name=>$norm_target), -title => $norm_target}, esc_path($link_target)); } else { print " -> " . esc_path($link_target); } } } print "\n"; print ""; print $cgi->a({-href => href(action=>"blob", hash=>$t->{'hash'}, file_name=>"$basedir$t->{'name'}", %base_key)}, "blob"); if ($have_blame) { print " | " . $cgi->a({-href => href(action=>"blame", hash=>$t->{'hash'}, file_name=>"$basedir$t->{'name'}", %base_key)}, "blame"); } if (defined $hash_base) { print " | " . $cgi->a({-href => href(action=>"history", hash_base=>$hash_base, hash=>$t->{'hash'}, file_name=>"$basedir$t->{'name'}")}, "history"); } print " | " . $cgi->a({-href => href(action=>"blob_plain", hash_base=>$hash_base, file_name=>"$basedir$t->{'name'}")}, "raw"); print "\n"; } elsif ($t->{'type'} eq "tree") { print ""; print $cgi->a({-href => href(action=>"tree", hash=>$t->{'hash'}, file_name=>"$basedir$t->{'name'}", %base_key)}, esc_path($t->{'name'})); print "\n"; print ""; print $cgi->a({-href => href(action=>"tree", hash=>$t->{'hash'}, file_name=>"$basedir$t->{'name'}", %base_key)}, "tree"); if (defined $hash_base) { print " | " . $cgi->a({-href => href(action=>"history", hash_base=>$hash_base, file_name=>"$basedir$t->{'name'}")}, "history"); } print "\n"; } } ## ...................................................................... ## functions printing large fragments of HTML sub fill_from_file_info { my ($diff, @parents) = @_; $diff->{'from_file'} = [ ]; $diff->{'from_file'}[$diff->{'nparents'} - 1] = undef; for (my $i = 0; $i < $diff->{'nparents'}; $i++) { if ($diff->{'status'}[$i] eq 'R' || $diff->{'status'}[$i] eq 'C') { $diff->{'from_file'}[$i] = git_get_path_by_hash($parents[$i], $diff->{'from_id'}[$i]); } } return $diff; } # parameters can be strings, or references to arrays of strings sub from_ids_eq { my ($a, $b) = @_; if (ref($a) eq "ARRAY" && ref($b) eq "ARRAY" && @$a == @$b) { for (my $i = 0; $i < @$a; ++$i) { return 0 unless ($a->[$i] eq $b->[$i]); } return 1; } elsif (!ref($a) && !ref($b)) { return $a eq $b; } else { return 0; } } sub git_difftree_body { my ($difftree, $hash, @parents) = @_; my ($parent) = $parents[0]; my ($have_blame) = gitweb_check_feature('blame'); print "
\n"; if ($#{$difftree} > 10) { print(($#{$difftree} + 1) . " files changed:\n"); } print "
\n"; print " 1 ? "combined " : "") . "diff_tree\">\n"; my $alternate = 1; my $patchno = 0; foreach my $line (@{$difftree}) { my $diff; if (ref($line) eq "HASH") { # pre-parsed (or generated by hand) $diff = $line; } else { $diff = parse_difftree_raw_line($line); } if ($alternate) { print "\n"; } else { print "\n"; } $alternate ^= 1; if (exists $diff->{'nparents'}) { # combined diff fill_from_file_info($diff, @parents) unless exists $diff->{'from_file'}; if ($diff->{'to_id'} ne ('0' x 40)) { # file exists in the result (child) commit print "\n"; } else { print "\n"; } if ($action eq 'commitdiff') { # link to patch $patchno++; print "\n"; } my $has_history = 0; my $not_deleted = 0; f
" . $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'}, file_name=>$diff->{'to_file'}, hash_base=>$hash), -class => "list"}, esc_path($diff->{'to_file'})) . "" . esc_path($diff->{'to_file'}) . "" . $cgi->a({-href => "#patch$patchno"}, "patch") . " | " . "