From: Tomas Doran Date: Wed, 25 Nov 2009 20:07:42 +0000 (+0000) Subject: Fix broken tests for patch as file handle X-Git-Tag: 0.000000_01~1^2~9 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=5156786ba3c8b10e1f7dac9dc652c0e557f9aa12;p=catagits%2FGitalist.git Fix broken tests for patch as file handle --- diff --git a/lib/Gitalist/Git/Util.pm b/lib/Gitalist/Git/Util.pm index 966c144..8b17e69 100644 --- a/lib/Gitalist/Git/Util.pm +++ b/lib/Gitalist/Git/Util.pm @@ -57,7 +57,7 @@ EOR '>pipe', $out, '2>pipe', $err or die "cmd returned *?"; - return ($out, $err); + return $out; } method run_cmd_list (@args) { diff --git a/lib/gitweb.pm b/lib/gitweb.pm deleted file mode 100755 index 9e689d1..0000000 --- a/lib/gitweb.pm +++ /dev/null @@ -1,6013 +0,0 @@ -#!/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 -package gitweb; - -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); -use FindBin; -binmode STDOUT, ':utf8'; - -BEGIN { - CGI->compile(); -} - -use vars qw( - $cgi $version $my_url $my_uri $base_url $path_info $GIT $projectroot - $project_maxdepth $home_link $home_link_str $site_header - $home_text $site_footer @stylesheets - $logo_url $logo_label $logo_url $logo_label $projects_list - $projects_list_description_width $default_projects_order - $export_ok $export_auth_hook $strict_export @git_base_url_list - $default_blob_plain_mimetype $default_text_plain_charset - $mimetypes_file $fallback_encoding @diff_opts $prevent_xss - %known_snapshot_formats %known_snapshot_format_aliases %feature - $GITWEB_CONFIG $GITWEB_CONFIG $GITWEB_CONFIG_SYSTEM $git_version - %input_params @cgi_param_mapping %cgi_param_mapping %actions - %allowed_options $action $project $file_name $file_parent $hash - $hash_parent $hash_base @extra_options $hash_parent_base $page - $searchtype $search_use_regexp $searchtext $search_regexp $git_dir - @snapshot_fmts - - $c -); - -sub main { - our $c = shift; - - our $cgi = new CGI; - our $version = "1.6.3.3"; - our $my_url = $cgi->url(); - our $my_uri = $cgi->url(-absolute => 1); - - # 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) { - 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 - # this can just be "git" if your webserver has a sensible PATH - our $GIT = `which git`; - chomp($GIT); - - # absolute fs-path which will be prepended to the project path - #our $projectroot = "/pub/scm"; - - # 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 = "Project Gitalist"; - - # filename of html text to include at top of each page - our $site_header = ""; - # html text to include at home page - our $home_text = "indextext.html"; - # filename of html text to include at bottom of each page - our $site_footer = ""; - - # URI of stylesheets - our @stylesheets = ("gitweb.css"); - - # 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"; - - # source of projects list - our $projectroot = our $projects_list = $c->config->{projectroot}; - - # the width (in characters) of the projects list "Description" column - our $projects_list_description_width = 25; - - # 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 = ""; - - # show repository only if this subroutine returns true - # when given the path to the project, for example: - # sub { return -e "$_[0]/git-daemon-export-ok"; } - our $export_auth_hook = undef; - - # only allow viewing of repositories also shown on the overview page - our $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 '' } (""); - - # 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; - - # assume this charset if line contains non-UTF-8 characters; - # it should be valid encoding (see Encoding::Supported(3pm) for list), - # for which encoding all byte sequences are valid, for example - # 'iso-8859-1' aka 'latin1' (it is decoded without checking, so it - # could be even 'utf-8' for the old behavior) - our $fallback_encoding = 'latin1'; - - # 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' (which implies '-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 - - # 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 => { - # 'display' => display name, - # 'type' => mime type, - # 'suffix' => filename suffix, - # 'format' => --format for git-archive, - # 'compressor' => [compressor command and arguments] - # (array reference, optional)} - # - 'tgz' => { - 'display' => 'tar.gz', - 'type' => 'application/x-gzip', - 'suffix' => '.tar.gz', - 'format' => 'tar', - 'compressor' => ['gzip']}, - - 'tbz2' => { - 'display' => 'tar.bz2', - 'type' => 'application/x-bzip2', - 'suffix' => '.tar.bz2', - 'format' => 'tar', - 'compressor' => ['bzip2']}, - - 'zip' => { - 'display' => 'zip', - 'type' => 'application/x-zip', - 'suffix' => '.zip', - 'format' => 'zip'}, - ); - - # Aliases so we understand old gitweb.snapshot values in repository - # configuration. - our %known_snapshot_format_aliases = ( - 'gzip' => 'tgz', - 'bzip2' => 'tbz2', - - # backward compatibility: legacy gitweb config support - 'x-gzip' => undef, 'gz' => undef, - 'x-bzip2' => undef, 'bz2' => undef, - 'x-zip' => undef, '' => undef, - ); - - my $feature_bool = sub { - my $key = shift; - my ($val) = git_get_project_config($key, '--bool'); - - if (!defined $val) { - return ($_[0]); - } elsif ($val eq 'true') { - return (1); - } elsif ($val eq 'false') { - return (0); - } - }; - - my $feature_snapshot = sub { - my (@fmts) = @_; - - my ($val) = git_get_project_config('snapshot'); - - if ($val) { - @fmts = ($val eq 'none' ? () : split /\s*[,\s]\s*/, $val); - } - - return @fmts; - }; - - my $feature_patches = sub { - my @val = (git_get_project_config('patches', '--int')); - - if (@val) { - return @val; - } - - return ($_[0]); - }; - - - # 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 - # - # if there is no 'sub' key (no feature-sub), then feature cannot be - # overriden - # - # use gitweb_get_feature() to retrieve the value - # (an array) or 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' => sub { &$feature_bool('blame', @_) }, - 'override' => 0, - 'default' => [0]}, - - # Enable the 'snapshot' link, providing a compressed archive of any - # tree. This can potentially generate high traffic if you have large - # project. - - # Value is a list of formats defined in %known_snapshot_formats that - # you wish to offer. - # To disable system wide have in $GITWEB_CONFIG - # $feature{'snapshot'}{'default'} = []; - # To have project specific config enable override in $GITWEB_CONFIG - # $feature{'snapshot'}{'override'} = 1; - # and in project config, a comma-separated list of formats or "none" - # to disable. Example: gitweb.snapshot = tbz2,zip; - 'snapshot' => { - 'sub' => $feature_snapshot, - 'override' => 0, - 'default' => ['tgz']}, - - # Enable text search, which will list the commits which match author, - # committer or commit text to a given string. Enabled by default. - # Project specific override is not supported. - 'search' => { - 'override' => 0, - 'default' => [1]}, - - # Enable grep search, which will list the files in currently selected - # tree containing the given string. Enabled by default. This can be - # potentially CPU-intensive, of course. - - # To enable system wide have in $GITWEB_CONFIG - # $feature{'grep'}{'default'} = [1]; - # To have project specific config enable override in $GITWEB_CONFIG - # $feature{'grep'}{'override'} = 1; - # and in project config gitweb.grep = 0|1; - 'grep' => { - 'sub' => sub { &$feature_bool('grep', @_) }, - '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' => sub { &$feature_bool('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]}, - - # Insert custom links to the action bar of all project pages. - # This enables you mainly to link to third-party scripts integrating - # into gitweb; e.g. git-browser for graphical history representation - # or custom web-based repository administration interface. - - # The 'default' value consists of a list of triplets in the form - # (label, link, position) where position is the label after which - # to insert the link and link is a format string where %n expands - # to the project name, %f to the project path within the filesystem, - # %h to the current hash (h gitweb parameter) and %b to the current - # hash base (hb gitweb parameter); %% expands to %. - - # To enable system wide have in $GITWEB_CONFIG e.g. - # $feature{'actions'}{'default'} = [('graphiclog', - # '/git-browser/by-commit.html?r=%n', 'summary')]; - # Project specific override is not supported. - 'actions' => { - 'override' => 0, - 'default' => []}, - - # Allow gitweb scan project content tags described in ctags/ - # of project repository, and display the popular Web 2.0-ish - # "tag cloud" near the project list. Note that this is something - # COMPLETELY different from the normal Git tags. - - # gitweb by itself can show existing tags, but it does not handle - # tagging itself; you need an external application for that. - # For an example script, check Girocco's cgi/tagproj.cgi. - # You may want to install the HTML::TagCloud Perl module to get - # a pretty tag cloud instead of just a list of tags. - - # To enable system wide have in $GITWEB_CONFIG - # $feature{'ctags'}{'default'} = ['path_to_tag_script']; - # Project specific override is not supported. - 'ctags' => { - 'override' => 0, - 'default' => [0]}, - - # The maximum number of patches in a patchset generated in patch - # view. Set this to 0 or undef to disable patch view, or to a - # negative number to remove any limit. - - # To disable system wide have in $GITWEB_CONFIG - # $feature{'patches'}{'default'} = [0]; - # To have project specific config enable override in $GITWEB_CONFIG - # $feature{'patches'}{'override'} = 1; - # and in project config gitweb.patches = 0|n; - # where n is the maximum number of patches allowed in a patchset. - 'patches' => { - 'sub' => $feature_patches, - 'override' => 0, - 'default' => [16]}, - ); - - our $GITWEB_CONFIG = $ENV{'GITWEB_CONFIG'} || "gitweb_config.perl"; - if (-e $GITWEB_CONFIG) { - do $GITWEB_CONFIG; - } else { - our $GITWEB_CONFIG_SYSTEM = $ENV{'GITWEB_CONFIG_SYSTEM'} || "$FindBin::Bin/../gitweb.conf"; - do $GITWEB_CONFIG_SYSTEM if -e $GITWEB_CONFIG_SYSTEM; - } - - # version of the core git binary - our $git_version = qx("$GIT" --version) =~ m/git version (.*)$/ ? $1 : "unknown"; - - # ====================================================================== - # input validation and dispatch - - # input parameters can be collected from a variety of sources (presently, CGI - # and PATH_INFO), so we define an %input_params hash that collects them all - # together during validation: this allows subsequent uses (e.g. href()) to be - # agnostic of the parameter origin - - our %input_params = (); - - # input parameters are stored with the long parameter name as key. This will - # also be used in the href subroutine to convert parameters to their CGI - # equivalent, and since the href() usage is the most frequent one, we store - # the name -> CGI key mapping here, instead of the reverse. - # - # XXX: Warning: If you touch this, check the search form for updating, - # too. - - our @cgi_param_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", - snapshot_format => "sf", - extra_options => "opt", - search_use_regexp => "sr", - ); - our %cgi_param_mapping = @cgi_param_mapping; - - # we will also need to know the possible actions, for validation - our %actions = ( - "blame" => \&git_blame, - "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, - "patch" => \&git_patch, - "patches" => \&git_patches, - "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, - ); - - # finally, we have the hash of allowed extra_options for the commands that - # allow them - our %allowed_options = ( - "--no-merges" => [ qw(rss atom log shortlog history) ], - ); - - # fill %input_params with the CGI parameters. All values except for 'opt' - # should be single values, but opt can be an array. We should probably - # build an array of parameters that can be multi-valued, but since for the time - # being it's only this one, we just single it out - while (my ($name, $symbol) = each %cgi_param_mapping) { - if ($symbol eq 'opt') { - $input_params{$name} = [ $c->req->param($symbol) ]; - } else { - $input_params{$name} = $c->req->param($symbol); - } - } - - # now read PATH_INFO and update the parameter list for missing parameters - my $evaluate_path_info = sub { - return if defined $input_params{'project'}; - return if !$path_info; - $path_info =~ s,^/+,,; - return if !$path_info; - - # find which part of PATH_INFO is project - my $project = $path_info; - $project =~ s,/+$,,; - while ($project && !check_head_link("$projectroot/$project")) { - $project =~ s,/*[^/]*$,,; - } - return unless $project; - $input_params{'project'} = $project; - - # do not change any parameters if an action is given using the query string - return if $input_params{'action'}; - $path_info =~ s,^\Q$project\E/*,,; - - # next, check if we have an action - my $action = $path_info; - $action =~ s,/.*$,,; - if (exists $actions{$action}) { - $path_info =~ s,^$action/*,,; - $input_params{'action'} = $action; - } - - # list of actions that want hash_base instead of hash, but can have no - # pathname (f) parameter - my @wants_base = ( - 'tree', - 'history', - ); - - # we want to catch - # [$hash_parent_base[:$file_parent]..]$hash_parent[:$file_name] - my ($parentrefname, $parentpathname, $refname, $pathname) = - ($path_info =~ /^(?:(.+?)(?::(.+))?\.\.)?(.+?)(?::(.+))?$/); - - # first, analyze the 'current' part - if (defined $pathname) { - # we got "branch:filename" or "branch:dir/" - # we could use git_get_type(branch:pathname), but: - # - it needs $git_dir - # - it does a git() call - # - the convention of terminating directories with a slash - # makes it superfluous - # - embedding the action in the PATH_INFO would make it even - # more superfluous - $pathname =~ s,^/+,,; - if (!$pathname || substr($pathname, -1) eq "/") { - $input_params{'action'} ||= "tree"; - $pathname =~ s,/$,,; - } else { - # the default action depends on whether we had parent info - # or not - if ($parentrefname) { - $input_params{'action'} ||= "blobdiff_plain"; - } else { - $input_params{'action'} ||= "blob_plain"; - } - } - $input_params{'hash_base'} ||= $refname; - $input_params{'file_name'} ||= $pathname; - } elsif (defined $refname) { - # we got "branch". In this case we have to choose if we have to - # set hash or hash_base. - # - # Most of the actions without a pathname only want hash to be - # set, except for the ones specified in @wants_base that want - # hash_base instead. It should also be noted that hand-crafted - # links having 'history' as an action and no pathname or hash - # set will fail, but that happens regardless of PATH_INFO. - $input_params{'action'} ||= "shortlog"; - if (grep { $_ eq $input_params{'action'} } @wants_base) { - $input_params{'hash_base'} ||= $refname; - } else { - $input_params{'hash'} ||= $refname; - } - } - - # next, handle the 'parent' part, if present - if (defined $parentrefname) { - # a missing pathspec defaults to the 'current' filename, allowing e.g. - # someproject/blobdiff/oldrev..newrev:/filename - if ($parentpathname) { - $parentpathname =~ s,^/+,,; - $parentpathname =~ s,/$,,; - $input_params{'file_parent'} ||= $parentpathname; - } else { - $input_params{'file_parent'} ||= $input_params{'file_name'}; - } - # we assume that hash_parent_base is wanted if a path was specified, - # or if the action wants hash_base instead of hash - if (defined $input_params{'file_parent'} || - grep { $_ eq $input_params{'action'} } @wants_base) { - $input_params{'hash_parent_base'} ||= $parentrefname; - } else { - $input_params{'hash_parent'} ||= $parentrefname; - } - } - - # for the snapshot action, we allow URLs in the form - # $project/snapshot/$hash.ext - # where .ext determines the snapshot and gets removed from the - # passed $refname to provide the $hash. - # - # To be able to tell that $refname includes the format extension, we - # require the following two conditions to be satisfied: - # - the hash input parameter MUST have been set from the $refname part - # of the URL (i.e. they must be equal) - # - the snapshot format MUST NOT have been defined already (e.g. from - # CGI parameter sf) - # It's also useless to try any matching unless $refname has a dot, - # so we check for that too - if (defined $input_params{'action'} && - $input_params{'action'} eq 'snapshot' && - defined $refname && index($refname, '.') != -1 && - $refname eq $input_params{'hash'} && - !defined $input_params{'snapshot_format'}) { - # We loop over the known snapshot formats, checking for - # 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) { - my $hash = $refname; - my $sfx; - $hash =~ s/(\Q$opt->{'suffix'}\E|\Q.$fmt\E)$//; - next unless $sfx = $1; - # a valid suffix was found, so set the snapshot format - # and reset the hash parameter - $input_params{'snapshot_format'} = $fmt; - $input_params{'hash'} = $hash; - # we also set the format suffix to the one requested - # in the URL: this way a request for e.g. .tgz returns - # a .tgz instead of a .tar.gz - $known_snapshot_formats{$fmt}{'suffix'} = $sfx; - last; - } - } - }; - - &$evaluate_path_info(); - - gitweb_validate_setup(); - - return $actions{$action}; -} - -sub gitweb_validate_setup { - our $action = $input_params{'action'}; - if (defined $action) { - if (!validate_action($action)) { - die_error(400, "Invalid action parameter"); - } - } - - # parameters which are pathnames - our $project = $input_params{'project'}; - if (defined $project) { - if (!validate_project($project)) { - undef $project; - die_error(404, "No such project"); - } - } - - our $file_name = $input_params{'file_name'}; - if (defined $file_name) { - if (!validate_pathname($file_name)) { - die_error(400, "Invalid file parameter"); - } - } - - our $file_parent = $input_params{'file_parent'}; - if (defined $file_parent) { - if (!validate_pathname($file_parent)) { - die_error(400, "Invalid file parent parameter"); - } - } - - # parameters which are refnames - our $hash = $input_params{'hash'}; - if (defined $hash) { - if (!validate_refname($hash)) { - die_error(400, "Invalid hash parameter"); - } - } - - our $hash_parent = $input_params{'hash_parent'}; - if (defined $hash_parent) { - if (!validate_refname($hash_parent)) { - die_error(400, "Invalid hash parent parameter"); - } - } - - our $hash_base = $input_params{'hash_base'}; - if (defined $hash_base) { - if (!validate_refname($hash_base)) { - die_error(400, "Invalid hash base parameter"); - } - } - - our @extra_options = @{$input_params{'extra_options'}}; - # @extra_options is always defined, since it can only be (currently) set from - # CGI, and $c->req->param() returns the empty array in array context if the param - # is not set - foreach my $opt (@extra_options) { - if (not exists $allowed_options{$opt}) { - die_error(400, "Invalid option parameter"); - } - if (not grep(/^$action$/, @{$allowed_options{$opt}})) { - die_error(400, "Invalid option parameter for this action"); - } - } - - our $hash_parent_base = $input_params{'hash_parent_base'}; - if (defined $hash_parent_base) { - if (!validate_refname($hash_parent_base)) { - die_error(400, "Invalid hash parent base parameter"); - } - } - - # other parameters - our $page = $input_params{'page'}; - if (defined $page) { - if ($page =~ m/[^0-9]/) { - die_error(400, "Invalid page parameter"); - } - } - - our $searchtype = $input_params{'searchtype'}; - if (defined $searchtype) { - if ($searchtype =~ m/[^a-z]/) { - die_error(400, "Invalid searchtype parameter"); - } - } - - our $search_use_regexp = $input_params{'search_use_regexp'}; - - our $searchtext = $input_params{'searchtext'}; - our $search_regexp; - if (defined $searchtext) { - if (length($searchtext) < 2) { - die_error(403, "At least two characters are required for search parameter"); - } - $search_regexp = $search_use_regexp ? $searchtext : quotemeta $searchtext; - } - - # path to the current git repository - our $git_dir; - $git_dir = "$projectroot/$project" if $project; - - # process alternate names for backward compatibility - # filter out unsupported (unknown) snapshot formats - my $filter_snapshot_fmts = sub { - my @fmts = @_; - - @fmts = map { - exists $known_snapshot_format_aliases{$_} ? - $known_snapshot_format_aliases{$_} : $_} @fmts; - @fmts = grep(exists $known_snapshot_formats{$_}, @fmts); - - }; - # list of supported snapshot formats - our @snapshot_fmts = gitweb_get_feature('snapshot'); - @snapshot_fmts = &$filter_snapshot_fmts(@snapshot_fmts); - - # dispatch - 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(400, "Unknown action"); - } - if ($action !~ m/^(opml|project_list|project_index)$/ && - !$project) { - die_error(400, "Project needed"); - } -} - -sub gitweb_get_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); -} - -# A wrapper to check if a given feature is enabled. -# With this, you can say -# -# my $bool_feat = gitweb_check_feature('bool_feat'); -# gitweb_check_feature('bool_feat') or somecode; -# -# instead of -# -# my ($bool_feat) = gitweb_get_feature('bool_feat'); -# (gitweb_get_feature('bool_feat'))[0] or somecode; -# -sub gitweb_check_feature { - return (gitweb_get_feature(@_))[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") && - (!$export_auth_hook || $export_auth_hook->($dir))); -} - - -## ====================================================================== -## action links - -sub href (%) { - my %params = @_; - # default is to use -absolute url() i.e. $my_uri - my $href = $params{-full} ? $my_url : $my_uri; - - $params{'project'} = $project unless exists $params{'project'}; - - if ($params{-replay}) { - while (my ($name, $symbol) = each %cgi_param_mapping) { - if (!exists $params{$name}) { - $params{$name} = $input_params{$name}; - } - } - } - - my $use_pathinfo = gitweb_check_feature('pathinfo'); - if ($use_pathinfo and defined $params{'project'}) { - # try to put as many parameters as possible in PATH_INFO: - # - project name - # - action - # - hash_parent or hash_parent_base:/file_parent - # - hash or hash_base:/filename - # - the snapshot_format as an appropriate suffix - - # When the script is the root DirectoryIndex for the domain, - # $href here would be something like http://gitweb.example.com/ - # Thus, we strip any trailing / from $href, to spare us double - # slashes in the final URL - $href =~ s,/$,,; - - # Then add the project name, if present - $href .= "/".esc_url($params{'project'}); - delete $params{'project'}; - - # since we destructively absorb parameters, we keep this - # boolean that remembers if we're handling a snapshot - my $is_snapshot = $params{'action'} eq 'snapshot'; - - # Summary just uses the project path URL, any other action is - # added to the URL - if (defined $params{'action'}) { - $href .= "/".esc_url($params{'action'}) unless $params{'action'} eq 'summary'; - delete $params{'action'}; - } - - # Next, we put hash_parent_base:/file_parent..hash_base:/file_name, - # stripping nonexistent or useless pieces - $href .= "/" if ($params{'hash_base'} || $params{'hash_parent_base'} - || $params{'hash_parent'} || $params{'hash'}); - if (defined $params{'hash_base'}) { - if (defined $params{'hash_parent_base'}) { - $href .= esc_url($params{'hash_parent_base'}); - # skip the file_parent if it's the same as the file_name - delete $params{'file_parent'} if $params{'file_parent'} eq $params{'file_name'}; - if (defined $params{'file_parent'} && $params{'file_parent'} !~ /\.\./) { - $href .= ":/".esc_url($params{'file_parent'}); - delete $params{'file_parent'}; - } - $href .= ".."; - delete $params{'hash_parent'}; - delete $params{'hash_parent_base'}; - } elsif (defined $params{'hash_parent'}) { - $href .= esc_url($params{'hash_parent'}). ".."; - delete $params{'hash_parent'}; - } - - $href .= esc_url($params{'hash_base'}); - if (defined $params{'file_name'} && $params{'file_name'} !~ /\.\./) { - $href .= ":/".esc_url($params{'file_name'}); - delete $params{'file_name'}; - } - delete $params{'hash'}; - delete $params{'hash_base'}; - } elsif (defined $params{'hash'}) { - $href .= esc_url($params{'hash'}); - delete $params{'hash'}; - } - - # If the action was a snapshot, we can absorb the - # snapshot_format parameter too - if ($is_snapshot) { - my $fmt = $params{'snapshot_format'}; - # snapshot_format should always be defined when href() - # is called, but just in case some code forgets, we - # fall back to the default - $fmt ||= $snapshot_fmts[0]; - $href .= $known_snapshot_formats{$fmt}{'suffix'}; - delete $params{'snapshot_format'}; - } - } - - # now encode the parameters explicitly - my @result = (); - for (my $i = 0; $i < @cgi_param_mapping; $i += 2) { - my ($name, $symbol) = ($cgi_param_mapping[$i], $cgi_param_mapping[$i+1]); - if (defined $params{$name}) { - if (ref($params{$name}) eq "ARRAY") { - foreach my $par (@{$params{$name}}) { - push @result, $symbol . "=" . esc_param($par); - } - } else { - push @result, $symbol . "=" . esc_param($params{$name}); - } - } - } - $href .= "?" . join(';', @result) if scalar @result; - - return $href; -} - - -## ====================================================================== -## validation, quoting/unquoting and escaping - -sub validate_action { - my $input = shift || return undef; - return undef unless exists $actions{$input}; - return $input; -} - -sub validate_project { - my $input = shift || return undef; - if (!validate_pathname($input) || - !(-d "$projectroot/$input") || - !check_export_ok("$projectroot/$input") || - ($strict_export && !project_in_list($input))) { - return undef; - } else { - return $input; - } -} - -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 = to_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 = to_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 %opts = @_; - 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('\%2x', ord($cntrl)) ); - if ($opts{-nohtml}) { - return $chr; - } else { - return "$chr"; - } -} - -# Alternatively use unicode control pictures codepoints, -# Unicode "printable representation" (PR) -sub quot_upr { - my $cntrl = shift; - my %opts = @_; - - my $chr = sprintf('&#%04d;', 0x2400+ord($cntrl)); - if ($opts{-nohtml}) { - return $chr; - } else { - 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); -} - -# decode sequences of octets in utf8 into Perl's internal form, -# which is utf-8 with utf8 flag set if needed. gitweb writes out -# in utf-8 thanks to "binmode STDOUT, ':utf8'" at beginning -sub to_utf8 { - my $str = shift; - if (utf8::valid($str)) { - utf8::decode($str); - return $str; - } else { - return decode($fallback_encoding, $str, Encode::FB_DEFAULT); - } -} - -## ---------------------------------------------------------------------- -## HTML aware string manipulation - -# Try to chop given string on a word boundary between position -# $len and $len+$add_len. If there is no word boundary there, -# chop at $len+$add_len. Do not chop if chopped part plus ellipsis -# (marking chopped part) would be longer than given string. -sub chop_str { - my $str = shift; - my $len = shift; - my $add_len = shift || 10; - my $where = shift || 'right'; # 'left' | 'center' | 'right' - - # Make sure perl knows it is utf8 encoded so we don't - # cut in the middle of a utf8 multibyte char. - $str = to_utf8($str); - - # 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 - # remove chopped character entities entirely - - # when chopping in the middle, distribute $len into left and right part - # return early if chopping wouldn't make string shorter - if ($where eq 'center') { - return $str if ($len + 5 >= length($str)); # filler is length 5 - $len = int($len/2); - } else { - return $str if ($len + 4 >= length($str)); # filler is length 4 - } - - # regexps: ending and beginning with word part up to $add_len - my $endre = qr/.{$len}\w{0,$add_len}/; - my $begre = qr/\w{0,$add_len}.{$len}/; - - if ($where eq 'left') { - $str =~ m/^(.*?)($begre)$/; - my ($lead, $body) = ($1, $2); - if (length($lead) > 4) { - $body =~ s/^[^;]*;// if ($lead =~ m/&[^;]*$/); - $lead = " ..."; - } - return "$lead$body"; - - } elsif ($where eq 'center') { - $str =~ m/^($endre)(.*)$/; - my ($left, $str) = ($1, $2); - $str =~ m/^(.*?)($begre)$/; - my ($mid, $right) = ($1, $2); - if (length($mid) > 5) { - $left =~ s/&[^;]*$//; - $right =~ s/^[^;]*;// if ($mid =~ m/&[^;]*$/); - $mid = " ... "; - } - return "$left$mid$right"; - - } else { - $str =~ m/^($endre)(.*)$/; - my $body = $1; - my $tail = $2; - if (length($tail) > 4) { - $body =~ s/&[^;]*$//; - $tail = "... "; - } - return "$body$tail"; - } -} - -# takes the same arguments as chop_str, but also wraps a around the -# result with a title attribute if it does get chopped. Additionally, the -# string is HTML-escaped. -sub chop_and_escape_str { - my ($str) = @_; - - my $chopped = chop_str(@_); - if ($chopped eq $str) { - return esc_html($chopped); - } else { - $str =~ s/([[:cntrl:]])/?/g; - return $cgi->span({-title=>$str}, esc_html($chopped)); - } -} - -## ---------------------------------------------------------------------- -## functions returning short strings - -# CSS class for given age value (in seconds) -sub age_class { - my $age = shift; - - if (!defined $age) { - return "noage"; - } elsif ($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; -} - -use constant { - S_IFINVALID => 0030000, - S_IFGITLINK => 0160000, -}; - -# submodule/subproject, a commit object reference -sub S_ISGITLINK($) { - my $mode = shift; - - return (($mode & S_IFMT) == S_IFGITLINK) -} - -# convert file mode in octal to symbolic file mode string -sub mode_str { - my $mode = oct shift; - - if (S_ISGITLINK($mode)) { - return 'm---------'; - } elsif (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_ISGITLINK($mode)) { - return "submodule"; - } elsif (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_ISGITLINK($mode)) { - return "submodule"; - } elsif (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); - $line =~ s{\b([0-9a-fA-F]{8,40})\b}{ - $cgi->a({-href => href(action=>"object", hash=>$1), - -class => "text"}, $1); - }eg; - - return $line; -} - -# format marker of refs pointing to given object - -# the destination action is chosen based on object type and current context: -# - for annotated tags, we choose the tag view unless it's the current view -# already, in which case we go to shortlog view -# - for other refs, we keep the current view if we're in history, shortlog or -# log view, and select shortlog otherwise -sub format_ref_marker { - my ($refs, $id) = @_; - my $markers = ''; - - if (defined $refs->{$id}) { - foreach my $ref (@{$refs->{$id}}) { - # this code exploits the fact that non-lightweight tags are the - # only indirect objects, and that they are the only objects for which - # we want to use tag instead of shortlog as action - my ($type, $name) = qw(); - my $indirect = ($ref =~ s/\^\{\}$//); - # e.g. tags/v2.6.11 or heads/next - if ($ref =~ m!^(.*?)s?/(.*)$!) { - $type = $1; - $name = $2; - } else { - $type = "ref"; - $name = $ref; - } - - my $class = $type; - $class .= " indirect" if $indirect; - - my $dest_action = "shortlog"; - - if ($indirect) { - $dest_action = "tag" unless $action eq "tag"; - } elsif ($action =~ /^(history|(short)?log)$/) { - $dest_action = $action; - } - - my $dest = ""; - $dest .= "refs/" unless $ref =~ m!^refs/!; - $dest .= $ref; - - my $link = $cgi->a({ - -href => href( - action=>$dest_action, - hash=>$dest - )}, $name); - - $markers .= " " . - $link . ""; - } - } - - 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 => to_utf8($long)}, - esc_html($short) . $extra); - } else { - return $cgi->a({-href => $href, -class => "list subject"}, - esc_html($long) . $extra); - } -} - -# format git diff header line, i.e. "diff --(git|combined|cc) ..." -sub format_git_diff_header_line { - my $line = shift; - my $diffinfo = shift; - my ($from, $to) = @_; - - if ($diffinfo->{'nparents'}) { - # combined diff - $line =~ s!^(diff (.*?) )"?.*$!$1!; - if ($to->{'href'}) { - $line .= $cgi->a({-href => $to->{'href'}, -class => "path"}, - esc_path($to->{'file'})); - } else { # file was deleted (no href) - $line .= esc_path($to->{'file'}); - } - } else { - # "ordinary" diff - $line =~ s!^(diff (.*?) )"?a/.*$!$1!; - if ($from->{'href'}) { - $line .= $cgi->a({-href => $from->{'href'}, -class => "path"}, - 'a/' . esc_path($from->{'file'})); - } else { # file was added (no href) - $line .= 'a/' . esc_path($from->{'file'}); - } - $line .= ' '; - if ($to->{'href'}) { - $line .= $cgi->a({-href => $to->{'href'}, -class => "path"}, - 'b/' . esc_path($to->{'file'})); - } else { # file was deleted - $line .= 'b/' . esc_path($to->{'file'}); - } - } - - return "
$line
\n"; -} - -# format extended diff header line, before patch itself -sub format_extended_diff_header_line { - my $line = shift; - my $diffinfo = shift; - my ($from, $to) = @_; - - # match - if ($line =~ s!^((copy|rename) from ).*$!$1! && $from->{'href'}) { - $line .= $cgi->a({-href=>$from->{'href'}, -class=>"path"}, - esc_path($from->{'file'})); - } - if ($line =~ s!^((copy|rename) to ).*$!$1! && $to->{'href'}) { - $line .= $cgi->a({-href=>$to->{'href'}, -class=>"path"}, - esc_path($to->{'file'})); - } - # match single - if ($line =~ m/\s(\d{6})$/) { - $line .= ' (' . - file_type_long($1) . - ')'; - } - # match - if ($line =~ m/^index [0-9a-fA-F]{40},[0-9a-fA-F]{40}/) { - # can match only for combined diff - $line = 'index '; - for (my $i = 0; $i < $diffinfo->{'nparents'}; $i++) { - if ($from->{'href'}[$i]) { - $line .= $cgi->a({-href=>$from->{'href'}[$i], - -class=>"hash"}, - substr($diffinfo->{'from_id'}[$i],0,7)); - } else { - $line .= '0' x 7; - } - # separator - $line .= ',' if ($i < $diffinfo->{'nparents'} - 1); - } - $line .= '..'; - if ($to->{'href'}) { - $line .= $cgi->a({-href=>$to->{'href'}, -class=>"hash"}, - substr($diffinfo->{'to_id'},0,7)); - } else { - $line .= '0' x 7; - } - - } elsif ($line =~ m/^index [0-9a-fA-F]{40}..[0-9a-fA-F]{40}/) { - # can match only for ordinary diff - my ($from_link, $to_link); - if ($from->{'href'}) { - $from_link = $cgi->a({-href=>$from->{'href'}, -class=>"hash"}, - substr($diffinfo->{'from_id'},0,7)); - } else { - $from_link = '0' x 7; - } - if ($to->{'href'}) { - $to_link = $cgi->a({-href=>$to->{'href'}, -class=>"hash"}, - substr($diffinfo->{'to_id'},0,7)); - } else { - $to_link = '0' x 7; - } - my ($from_id, $to_id) = ($diffinfo->{'from_id'}, $diffinfo->{'to_id'}); - $line =~ s!$from_id\.\.$to_id!$from_link..$to_link!; - } - - return $line . "
\n"; -} - -# format from-file/to-file diff header -sub format_diff_from_to_header { - my ($from_line, $to_line, $diffinfo, $from, $to, @parents) = @_; - my $line; - my $result = ''; - - $line = $from_line; - #assert($line =~ m/^---/) if DEBUG; - # no extra formatting for "^--- /dev/null" - if (! $diffinfo->{'nparents'}) { - # ordinary (single parent) diff - if ($line =~ m!^--- "?a/!) { - if ($from->{'href'}) { - $line = '--- a/' . - $cgi->a({-href=>$from->{'href'}, -class=>"path"}, - esc_path($from->{'file'})); - } else { - $line = '--- a/' . - esc_path($from->{'file'}); - } - } - $result .= qq!
$line
\n!; - - } else { - # combined diff (merge commit) - for (my $i = 0; $i < $diffinfo->{'nparents'}; $i++) { - if ($from->{'href'}[$i]) { - $line = '--- ' . - $cgi->a({-href=>href(action=>"blobdiff", - hash_parent=>$diffinfo->{'from_id'}[$i], - hash_parent_base=>$parents[$i], - file_parent=>$from->{'file'}[$i], - hash=>$diffinfo->{'to_id'}, - hash_base=>$hash, - file_name=>$to->{'file'}), - -class=>"path", - -title=>"diff" . ($i+1)}, - $i+1) . - '/' . - $cgi->a({-href=>$from->{'href'}[$i], -class=>"path"}, - esc_path($from->{'file'}[$i])); - } else { - $line = '--- /dev/null'; - } - $result .= qq!
$line
\n!; - } - } - - $line = $to_line; - #assert($line =~ m/^\+\+\+/) if DEBUG; - # no extra formatting for "^+++ /dev/null" - if ($line =~ m!^\+\+\+ "?b/!) { - if ($to->{'href'}) { - $line = '+++ b/' . - $cgi->a({-href=>$to->{'href'}, -class=>"path"}, - esc_path($to->{'file'})); - } else { - $line = '+++ b/' . - esc_path($to->{'file'}); - } - } - $result .= qq!
$line
\n!; - - return $result; -} - -# create note for patch simplified by combined diff -sub format_diff_cc_simplified { - my ($diffinfo, @parents) = @_; - my $result = ''; - - $result .= "
" . - "diff --cc "; - if (!is_deleted($diffinfo)) { - $result .= $cgi->a({-href => href(action=>"blob", - hash_base=>$hash, - hash=>$diffinfo->{'to_id'}, - file_name=>$diffinfo->{'to_file'}), - -class => "path"}, - esc_path($diffinfo->{'to_file'})); - } else { - $result .= esc_path($diffinfo->{'to_file'}); - } - $result .= "
\n" . # class="diff header" - "
" . - "Simple merge" . - "
\n"; # class="diff nodifferences" - - return $result; -} - -# format patch (diff) line (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"; -} - -# Generates undef or something like "_snapshot_" or "snapshot (_tbz2_ _zip_)", -# linked. Pass the hash of the tree/commit to snapshot. -sub format_snapshot_links { - my ($hash) = @_; - my $num_fmts = @snapshot_fmts; - if ($num_fmts > 1) { - # A parenthesized list of links bearing format names. - # e.g. "snapshot (_tar.gz_ _zip_)" - return "snapshot (" . join(' ', map - $cgi->a({ - -href => href( - action=>"snapshot", - hash=>$hash, - snapshot_format=>$_ - ) - }, $known_snapshot_formats{$_}{'display'}) - , @snapshot_fmts) . ")"; - } elsif ($num_fmts == 1) { - # A single "snapshot" link whose tooltip bears the format name. - # i.e. "_snapshot_" - my ($fmt) = @snapshot_fmts; - return - $cgi->a({ - -href => href( - action=>"snapshot", - hash=>$hash, - snapshot_format=>$fmt - ), - -title => "in format: $known_snapshot_formats{$fmt}{'display'}" - }, "snapshot"); - } else { # $num_fmts == 0 - return undef; - } -} - -## ...................................................................... -## functions returning values to be passed, perhaps after some -## transformation, to other functions; e.g. returning arguments to href() - -# returns hash to be passed to href to generate gitweb URL -# in -title key it returns description of link -sub get_feed_info { - my $format = shift || 'Atom'; - my %res = (action => lc($format)); - - # feed links are possible only for project views - return unless (defined $project); - # some views should link to OPML, or to generic project feed, - # or don't have specific feed yet (so they should use generic) - return if ($action =~ /^(?:tags|heads|forks|tag|search)$/x); - - my $branch; - # branches refs uses 'refs/heads/' prefix (fullname) to differentiate - # from tag links; this also makes possible to detect branch links - if ((defined $hash_base && $hash_base =~ m!^refs/heads/(.*)$!) || - (defined $hash && $hash =~ m!^refs/heads/(.*)$!)) { - $branch = $1; - } - # find log type for feed description (title) - my $type = 'log'; - if (defined $file_name) { - $type = "history of $file_name"; - $type .= "/" if ($action eq 'tree'); - $type .= " on '$branch'" if (defined $branch); - } else { - $type = "log of $branch" if (defined $branch); - } - - $res{-title} = $type; - $res{'hash'} = (defined $branch ? "refs/heads/$branch" : undef); - $res{'file_name'} = $file_name; - - return %res; -} - -## ---------------------------------------------------------------------- -## 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; -} - -# quote the given arguments for passing them to the shell -# quote_command("command", "arg 1", "arg with ' and ! characters") -# => "'command' 'arg 1' 'arg with '\'' and '\!' characters'" -# Try to avoid using this function wherever possible. -sub quote_command { - return join(' ', - map( { my $a = $_; $a =~ s/(['!])/'\\$1'/g; "'$a'" } @_ )); -} - -# 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; -} - -# repository configuration -our $config_file = ''; -our %config; - -# store multiple values for single key as anonymous array reference -# single values stored directly in the hash, not as [ ] -sub hash_set_multi { - my ($hash, $key, $value) = @_; - - if (!exists $hash->{$key}) { - $hash->{$key} = $value; - } elsif (!ref $hash->{$key}) { - $hash->{$key} = [ $hash->{$key}, $value ]; - } else { - push @{$hash->{$key}}, $value; - } -} - -# return hash of git project configuration -# optionally limited to some section, e.g. 'gitweb' -sub git_parse_project_config { - my $section_regexp = shift; - my %config; - - local $/ = "\0"; - - open my $fh, "-|", git_cmd(), "config", '-z', '-l', - or return; - - while (my $keyval = <$fh>) { - chomp $keyval; - my ($key, $value) = split(/\n/, $keyval, 2); - - hash_set_multi(\%config, $key, $value) - if (!defined $section_regexp || $key =~ /^(?:$section_regexp)\./o); - } - close $fh; - - return %config; -} - -# 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 (($val =~ /^\d+$/ && $val) || # section.key = 1 - ($val =~ /^(?:true|yes)$/i)); # section.key = true -} - -# convert config value to simple decimal number -# an optional value suffix of 'k', 'm', or 'g' will cause the value -# to be multiplied by 1024, 1048576, or 1073741824 -sub config_to_int { - my $val = shift; - - # strip leading and trailing whitespace - $val =~ s/^\s+//; - $val =~ s/\s+$//; - - if (my ($num, $unit) = ($val =~ /^([0-9]*)([kmg])$/i)) { - $unit = lc($unit); - # unknown unit is treated as 1 - return $num * ($unit eq 'g' ? 1073741824 : - $unit eq 'm' ? 1048576 : - $unit eq 'k' ? 1024 : 1); - } - return $val; -} - -# convert config value to array reference, if needed -sub config_to_multi { - my $val = shift; - - return ref($val) ? $val : (defined($val) ? [ $val ] : []); -} - -sub git_get_project_config { - my ($key, $type) = @_; - - # key sanity check - return unless ($key); - $key =~ s/^gitweb\.//; - return if ($key =~ m/\W/); - - # type sanity check - if (defined $type) { - $type =~ s/^--//; - $type = undef - unless ($type eq 'bool' || $type eq 'int'); - } - - # get config - if (!defined $config_file || - $config_file ne "$git_dir/config") { - %config = git_parse_project_config('gitweb'); - $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"}; - } elsif ($type eq 'bool') { - # backward compatibility: 'git config --bool' returns true/false - return config_to_bool($config{"gitweb.$key"}) ? 'true' : 'false'; - } elsif ($type eq 'int') { - return config_to_int($config{"gitweb.$key"}); - } - return $config{"gitweb.$key"}; -} - -# 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(500, "Open git-ls-tree failed"); - my $line = <$fd>; - close $fd or return undef; - - if (!defined $line) { - # there is no tree or hash given by $path at $base - 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; - - $git_dir = "$projectroot/$path"; - open my $fd, "$git_dir/description" - or return git_get_project_config('description'); - my $descr = <$fd>; - close $fd; - if (defined $descr) { - chomp $descr; - } - return $descr; -} - -sub git_get_project_ctags { - my $path = shift; - 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 = ; - chomp $val; - close CT; - my $ctag = $_; $ctag =~ s#.*/##; - $ctags->{$ctag} = $val; - } - closedir D; - $ctags; -} - -sub git_populate_project_tagcloud { - my $ctags = shift; - - # First, merge different-cased tags; tags vote on casing - my %ctags_lc; - foreach (keys %$ctags) { - $ctags_lc{lc $_}->{count} += $ctags->{$_}; - if (not $ctags_lc{lc $_}->{topcount} - or $ctags_lc{lc $_}->{topcount} < $ctags->{$_}) { - $ctags_lc{lc $_}->{topcount} = $ctags->{$_}; - $ctags_lc{lc $_}->{topname} = $_; - } - } - - my $cloud; - if (eval { require HTML::TagCloud; 1; }) { - $cloud = HTML::TagCloud->new; - foreach (sort keys %ctags_lc) { - # Pad the title with spaces so that the cloud looks - # less crammed. - my $title = $ctags_lc{$_}->{topname}; - $title =~ s/ / /g; - $title =~ s/^/ /g; - $title =~ s/$/ /g; - $cloud->add($title, $home_link."?by_tag=".$_, $ctags_lc{$_}->{count}); - } - } else { - $cloud = \%ctags_lc; - } - $cloud; -} - -sub git_show_project_tagcloud { - my ($cloud, $count) = @_; - #print STDERR ref($cloud)."..\n"; - if (ref $cloud eq 'HTML::TagCloud') { - return $cloud->html_and_css($count); - } else { - my @tags = sort { $cloud->{$a}->{count} <=> $cloud->{$b}->{count} } keys %$cloud; - return '

' . join (', ', map { - "$cloud->{$_}->{topname}" - } splice(@tags, 0, $count)) . '

'; - } -} - -sub git_get_project_url_list { - my $path = shift; - - $git_dir = "$projectroot/$path"; - 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')); - my @git_project_url_list = map { chomp; $_ } <$fd>; - close $fd; - - return wantarray ? @git_project_url_list : \@git_project_url_list; -} - -our $gitweb_project_owner = undef; -sub git_get_project_list_from_file { - - return if (defined $gitweb_project_owner); - - $gitweb_project_owner = {}; - # 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); - $gitweb_project_owner->{$pr} = to_utf8($ow); - } - close $fd; - } -} - -sub git_get_project_owner { - my $project = shift; - my $owner; - - return undef unless $project; - $git_dir = "$projectroot/$project"; - - if (!defined $gitweb_project_owner) { - git_get_project_list_from_file(); - } - - if (exists $gitweb_project_owner->{$project}) { - $owner = $gitweb_project_owner->{$project}; - } - if (!defined $owner){ - $owner = git_get_project_config('owner'); - } - if (!defined $owner) { - $owner = get_file_owner("$git_dir"); - } - - 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 (defined $most_recent && - $most_recent =~ / (\d+) [-+][01]\d\d\d$/) { - my $timestamp = $1; - my $age = time - $timestamp; - return ($age, age_string($age)); - } - return (undef, undef); -} - -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, 1+$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' - - if (! @commit_lines) { - return; - } - - 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 (! defined $co{'title'} || $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(500, "Open git-rev-list failed"); - %co = parse_commit_text(<$fd>, 1); - close $fd; - - return %co; -} - -sub parse_commits { - my ($commit_id, $maxcount, $skip, $filename, @args) = @_; - my @cos; - - $maxcount ||= 1; - $skip ||= 0; - - local $/ = "\0"; - - open my $fd, "-|", git_cmd(), "rev-list", - "--header", - @args, - ("--max-count=" . $maxcount), - ("--skip=" . $skip), - @extra_options, - $commit_id, - "--", - ($filename ? ($filename) : ()) - or die_error(500, "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 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{'from_file'} = $res{'to_file'} = $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; -} - -# wrapper: return parsed line of git-diff-tree "raw" output -# (the argument might be raw line, or parsed info) -sub parsed_difftree_line { - my $line_or_ref = shift; - - if (ref($line_or_ref) eq "HASH") { - # pre-parsed (or generated by hand) - return $line_or_ref; - } else { - return parse_difftree_raw_line($line_or_ref); - } -} - -# 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; -} - -# generates _two_ hashes, references to which are passed as 2 and 3 argument -sub parse_from_to_diffinfo { - my ($diffinfo, $from, $to, @parents) = @_; - - if ($diffinfo->{'nparents'}) { - # combined diff - $from->{'file'} = []; - $from->{'href'} = []; - fill_from_file_info($diffinfo, @parents) - unless exists $diffinfo->{'from_file'}; - for (my $i = 0; $i < $diffinfo->{'nparents'}; $i++) { - $from->{'file'}[$i] = - defined $diffinfo->{'from_file'}[$i] ? - $diffinfo->{'from_file'}[$i] : - $diffinfo->{'to_file'}; - if ($diffinfo->{'status'}[$i] ne "A") { # not new (added) file - $from->{'href'}[$i] = href(action=>"blob", - hash_base=>$parents[$i], - hash=>$diffinfo->{'from_id'}[$i], - file_name=>$from->{'file'}[$i]); - } else { - $from->{'href'}[$i] = undef; - } - } - } else { - # ordinary (not combined) diff - $from->{'file'} = $diffinfo->{'from_file'}; - if ($diffinfo->{'status'} ne "A") { # not new (added) file - $from->{'href'} = href(action=>"blob", hash_base=>$hash_parent, - hash=>$diffinfo->{'from_id'}, - file_name=>$from->{'file'}); - } else { - delete $from->{'href'}; - } - } - - $to->{'file'} = $diffinfo->{'to_file'}; - if (!is_deleted($diffinfo)) { # file exists in result - $to->{'href'} = href(action=>"blob", hash_base=>$hash, - hash=>$diffinfo->{'to_id'}, - file_name=>$to->{'file'}); - } else { - delete $to->{'href'}; - } -} - -## ...................................................................... -## 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]+) (.*)$/); - $ref_item{'fullname'} = $name; - $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]+) (.*)$/); - $ref_item{'fullname'} = $name; - $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 to_utf8($owner); -} - -# assume that file exists -sub insert_file { - my $filename = shift; - - open my $fd, '<', $filename; - return join '', map to_utf8($_), <$fd>; -} - -## ...................................................................... -## 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'; - } 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'; - } -} - -sub blob_contenttype { - my ($fd, $file_name, $type) = @_; - - $type ||= blob_mimetype($fd, $file_name); - if ($type eq 'text/plain' && defined $default_text_plain_charset) { - $type .= "; charset=$default_text_plain_charset"; - } - - return $type; -} - -# die_error(, ) -# Example: die_error(404, 'Hash not found') -# By convention, use the following status codes (as defined in RFC 2616): -# 400: Invalid or missing CGI parameters, or -# requested object exists but has wrong type. -# 403: Requested feature (like "pickaxe" or "snapshot") not enabled on -# this server or project. -# 404: Requested object/revision/project doesn't exist. -# 500: The server isn't configured properly, or -# an internal error occurred (e.g. failed assertions caused by bugs), or -# an unknown error occurred (e.g. the git binary died unexpectedly). -sub die_error { - my $status = shift || 500; - my $error = shift || "Internal server error"; - - my %http_responses = (400 => '400 Bad Request', - 403 => '403 Forbidden', - 404 => '404 Not Found', - 500 => '500 Internal Server Error'); - $c->response->status($http_responses{$status}); - - $c->stash->{content} = < -

- $status - $error -
- -EOF - die bless { $status => $http_responses{$status}, err => $error }; -} - -## ---------------------------------------------------------------------- -## 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; - - my @actions = gitweb_get_feature('actions'); - my %repl = ( - '%' => '%', - 'n' => $project, # project name - 'f' => $git_dir, # project path within filesystem - 'h' => $treehead || '', # current hash ('h' parameter) - 'b' => $treebase || '', # hash base ('hb' parameter) - ); - while (@actions) { - my ($label, $link, $pos) = splice(@actions,0,3); - # insert - @navs = map { $_ eq $pos ? ($_, $label) : $_ } @navs; - # munch munch - $link =~ s/%([%nfhb])/$repl{$1}/g; - $arg{$label}{'_href'} = $link; - } - - $c->stash->{page_nav} = 1; - $c->stash->{nav_links} = - (join " | ", - map { $_ eq $current ? - $_ : $cgi->a({-href => ($arg{$_}{_href} ? $arg{$_}{_href} : href(%{$arg{$_}}))}, "$_") - } @navs); - $c->stash->{extra} = $extra; -} - -sub format_paging_nav { - my ($action, $hash, $head, $page, $has_next_link) = @_; - 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(-replay=>1, page=>$page-1), - -accesskey => "p", -title => "Alt-p"}, "prev"); - } else { - $paging_nav .= " ⋅ prev"; - } - - if ($has_next_link) { - $paging_nav .= " ⋅ " . - $cgi->a({-href => href(-replay=>1, 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 q[
], - $cgi->a({-href => href(%args), -class => "title"}, - $title ? $title : $action), - q[
]; -} - -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'}, to_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"; - } else { - # unknown object: we can only present history for it - # (this includes 'commit' object, i.e. submodule support) - print "" . - esc_path($t->{'name'}) . - "\n"; - print ""; - 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 - -# get pre-image filenames for merge (combined) diff -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; -} - -# is current raw difftree line of file deletion -sub is_deleted { - my $diffinfo = shift; - - return $diffinfo->{'to_id'} eq ('0' x 40); -} - -# does patch correspond to [previous] difftree raw line -# $diffinfo - hashref of parsed raw diff format -# $patchinfo - hashref of parsed patch diff format -# (the same keys as in $diffinfo) -sub is_patch_split { - my ($diffinfo, $patchinfo) = @_; - - return defined $diffinfo && defined $patchinfo - && $diffinfo->{'to_file'} eq $patchinfo->{'to_file'}; -} - - -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"; - - # header only for combined diff in 'commitdiff' view - my $has_header = @$difftree && @parents > 1 && $action eq 'commitdiff'; - if ($has_header) { - # table header - print "\n" . - "\n"; # filename, patchN link - for (my $i = 0; $i < @parents; $i++) { - my $par = $parents[$i]; - print "\n"; - } - print "\n\n"; - } - - my $alternate = 1; - my $patchno = 0; - foreach my $line (@{$difftree}) { - my $diff = parsed_difftree_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 (!is_deleted($diff)) { - # 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; - for (my $i = 0; $i < $diff->{'nparents'}; $i++) { - my $hash_parent = $parents[$i]; - my $from_hash = $diff->{'from_id'}[$i]; - my $from_path = $diff->{'from_file'}[$i]; - my $status = $diff->{'status'}[$i]; - - $has_history ||= ($status ne 'A'); - $not_deleted ||= ($status ne 'D'); - - if ($status eq 'A') { - print "\n"; - } elsif ($status eq 'D') { - print "\n"; - } else { - if ($diff->{'to_id'} eq $from_hash) { - print "\n"; - } - } - - print "\n"; - - print "\n"; - next; # instead of 'else' clause, to avoid extra indent - } - # else ordinary diff - - my ($to_mode_oct, $to_mode_str, $to_file_type); - my ($from_mode_oct, $from_mode_str, $from_file_type); - if ($diff->{'to_mode'} ne ('0' x 6)) { - $to_mode_oct = oct $diff->{'to_mode'}; - if (S_ISREG($to_mode_oct)) { # only for regular file - $to_mode_str = sprintf("%04o", $to_mode_oct & 0777); # permission bits - } - $to_file_type = file_type($diff->{'to_mode'}); - } - if ($diff->{'from_mode'} ne ('0' x 6)) { - $from_mode_oct = oct $diff->{'from_mode'}; - if (S_ISREG($to_mode_oct)) { # only for regular file - $from_mode_str = sprintf("%04o", $from_mode_oct & 0777); # permission bits - } - $from_file_type = file_type($diff->{'from_mode'}); - } - - if ($diff->{'status'} eq "A") { # created - my $mode_chng = "[new $to_file_type"; - $mode_chng .= " with mode: $to_mode_str" if $to_mode_str; - $mode_chng .= "]"; - print "\n"; - print "\n"; - print "\n"; - - } elsif ($diff->{'status'} eq "D") { # deleted - my $mode_chng = "[deleted $from_file_type]"; - print "\n"; - print "\n"; - print "\n"; - - } elsif ($diff->{'status'} eq "M" || $diff->{'status'} eq "T") { # modified, or type changed - my $mode_chnge = ""; - if ($diff->{'from_mode'} != $diff->{'to_mode'}) { - $mode_chnge = "[changed"; - if ($from_file_type ne $to_file_type) { - $mode_chnge .= " from $from_file_type to $to_file_type"; - } - if (($from_mode_oct & 0777) != ($to_mode_oct & 0777)) { - if ($from_mode_str && $to_mode_str) { - $mode_chnge .= " mode: $from_mode_str->$to_mode_str"; - } elsif ($to_mode_str) { - $mode_chnge .= " mode: $to_mode_str"; - } - } - $mode_chnge .= "]\n"; - } - print "\n"; - print "\n"; - print "\n"; - - } elsif ($diff->{'status'} eq "R" || $diff->{'status'} eq "C") { # renamed or copied - my %status_name = ('R' => 'moved', 'C' => 'copied'); - my $nstatus = $status_name{$diff->{'status'}}; - my $mode_chng = ""; - if ($diff->{'from_mode'} != $diff->{'to_mode'}) { - # mode also for directories, so we cannot use $to_mode_str - $mode_chng = sprintf(", mode: %04o", $to_mode_oct & 0777); - } - print "\n" . - "\n" . - "\n"; - - } # we should not encounter Unmerged (U) or Unknown (X) status - print "\n"; - } - print "" if $has_header; - print "
" . - $cgi->a({-href => href(action=>"commitdiff", - hash=>$hash, hash_parent=>$par), - -title => 'commitdiff to parent number ' . - ($i+1) . ': ' . substr($par,0,7)}, - $i+1) . - " 
" . - $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") . - " | " . - " | " . - $cgi->a({-href => href(action=>"blob", - hash_base=>$hash, - hash=>$from_hash, - file_name=>$from_path)}, - "blob" . ($i+1)) . - " | "; - } else { - print ""; - } - print $cgi->a({-href => href(action=>"blobdiff", - hash=>$diff->{'to_id'}, - hash_parent=>$from_hash, - hash_base=>$hash, - hash_parent_base=>$hash_parent, - file_name=>$diff->{'to_file'}, - file_parent=>$from_path)}, - "diff" . ($i+1)) . - " | "; - if ($not_deleted) { - print $cgi->a({-href => href(action=>"blob", - hash=>$diff->{'to_id'}, - file_name=>$diff->{'to_file'}, - hash_base=>$hash)}, - "blob"); - print " | " if ($has_history); - } - if ($has_history) { - print $cgi->a({-href => href(action=>"history", - file_name=>$diff->{'to_file'}, - hash_base=>$hash)}, - "history"); - } - print "
"; - print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'}, - hash_base=>$hash, file_name=>$diff->{'file'}), - -class => "list"}, esc_path($diff->{'file'})); - print "$mode_chng"; - if ($action eq 'commitdiff') { - # link to patch - $patchno++; - print $cgi->a({-href => "#patch$patchno"}, "patch"); - print " | "; - } - print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'}, - hash_base=>$hash, file_name=>$diff->{'file'})}, - "blob"); - print ""; - print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'from_id'}, - hash_base=>$parent, file_name=>$diff->{'file'}), - -class => "list"}, esc_path($diff->{'file'})); - print "$mode_chng"; - if ($action eq 'commitdiff') { - # link to patch - $patchno++; - print $cgi->a({-href => "#patch$patchno"}, "patch"); - print " | "; - } - print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'from_id'}, - hash_base=>$parent, file_name=>$diff->{'file'})}, - "blob") . " | "; - if ($have_blame) { - print $cgi->a({-href => href(action=>"blame", hash_base=>$parent, - file_name=>$diff->{'file'})}, - "blame") . " | "; - } - print $cgi->a({-href => href(action=>"history", hash_base=>$parent, - file_name=>$diff->{'file'})}, - "history"); - print ""; - print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'}, - hash_base=>$hash, file_name=>$diff->{'file'}), - -class => "list"}, esc_path($diff->{'file'})); - print "$mode_chnge"; - if ($action eq 'commitdiff') { - # link to patch - $patchno++; - print $cgi->a({-href => "#patch$patchno"}, "patch") . - " | "; - } elsif ($diff->{'to_id'} ne $diff->{'from_id'}) { - # "commit" view and modified file (not onlu mode changed) - print $cgi->a({-href => href(action=>"blobdiff", - hash=>$diff->{'to_id'}, hash_parent=>$diff->{'from_id'}, - hash_base=>$hash, hash_parent_base=>$parent, - file_name=>$diff->{'file'})}, - "diff") . - " | "; - } - print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'}, - hash_base=>$hash, file_name=>$diff->{'file'})}, - "blob") . " | "; - if ($have_blame) { - print $cgi->a({-href => href(action=>"blame", hash_base=>$hash, - file_name=>$diff->{'file'})}, - "blame") . " | "; - } - print $cgi->a({-href => href(action=>"history", hash_base=>$hash, - file_name=>$diff->{'file'})}, - "history"); - print "" . - $cgi->a({-href => href(action=>"blob", hash_base=>$hash, - hash=>$diff->{'to_id'}, file_name=>$diff->{'to_file'}), - -class => "list"}, esc_path($diff->{'to_file'})) . "[$nstatus from " . - $cgi->a({-href => href(action=>"blob", hash_base=>$parent, - hash=>$diff->{'from_id'}, file_name=>$diff->{'from_file'}), - -class => "list"}, esc_path($diff->{'from_file'})) . - " with " . (int $diff->{'similarity'}) . "% similarity$mode_chng]"; - if ($action eq 'commitdiff') { - # link to patch - $patchno++; - print $cgi->a({-href => "#patch$patchno"}, "patch") . - " | "; - } elsif ($diff->{'to_id'} ne $diff->{'from_id'}) { - # "commit" view and modified file (not only pure rename or copy) - print $cgi->a({-href => href(action=>"blobdiff", - hash=>$diff->{'to_id'}, hash_parent=>$diff->{'from_id'}, - hash_base=>$hash, hash_parent_base=>$parent, - file_name=>$diff->{'to_file'}, file_parent=>$diff->{'from_file'})}, - "diff") . - " | "; - } - print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'}, - hash_base=>$parent, file_name=>$diff->{'to_file'})}, - "blob") . " | "; - if ($have_blame) { - print $cgi->a({-href => href(action=>"blame", hash_base=>$hash, - file_name=>$diff->{'to_file'})}, - "blame") . " | "; - } - print $cgi->a({-href => href(action=>"history", hash_base=>$hash, - file_name=>$diff->{'to_file'})}, - "history"); - print "
\n"; -} - -sub git_patchset_body { - my ($fd, $difftree, $hash, @hash_parents) = @_; - my ($hash_parent) = $hash_parents[0]; - - my $is_combined = (@hash_parents > 1); - my $patch_idx = 0; - my $patch_number = 0; - my $patch_line; - my $diffinfo; - my $to_name; - my (%from, %to); - - print "
\n"; - - # skip to first patch - while ($patch_line = <$fd>) { - chomp $patch_line; - - last if ($patch_line =~ m/^diff /); - } - - PATCH: - while ($patch_line) { - - # parse "git diff" header line - if ($patch_line =~ m/^diff --git (\"(?:[^\\\"]*(?:\\.[^\\\"]*)*)\"|[^ "]*) (.*)$/) { - # $1 is from_name, which we do not use - $to_name = unquote($2); - $to_name =~ s!^b/!!; - } elsif ($patch_line =~ m/^diff --(cc|combined) ("?.*"?)$/) { - # $1 is 'cc' or 'combined', which we do not use - $to_name = unquote($2); - } else { - $to_name = undef; - } - - # check if current patch belong to current raw line - # and parse raw git-diff line if needed - if (is_patch_split($diffinfo, { 'to_file' => $to_name })) { - # this is continuation of a split patch - print "
\n"; - } else { - # advance raw git-diff output if needed - $patch_idx++ if defined $diffinfo; - - # read and prepare patch information - $diffinfo = parsed_difftree_line($difftree->[$patch_idx]); - - # compact combined diff output can have some patches skipped - # find which patch (using pathname of result) we are at now; - if ($is_combined) { - while ($to_name ne $diffinfo->{'to_file'}) { - print "
\n" . - format_diff_cc_simplified($diffinfo, @hash_parents) . - "
\n"; # class="patch" - - $patch_idx++; - $patch_number++; - - last if $patch_idx > $#$difftree; - $diffinfo = parsed_difftree_line($difftree->[$patch_idx]); - } - } - - # modifies %from, %to hashes - parse_from_to_diffinfo($diffinfo, \%from, \%to, @hash_parents); - - # this is first patch for raw difftree line with $patch_idx index - # we index @$difftree array from 0, but number patches from 1 - print "
\n"; - } - - # git diff header - #assert($patch_line =~ m/^diff /) if DEBUG; - #assert($patch_line !~ m!$/$!) if DEBUG; # is chomp-ed - $patch_number++; - # print "git diff" header - print format_git_diff_header_line($patch_line, $diffinfo, - \%from, \%to); - - # print extended diff header - print "
\n"; - EXTENDED_HEADER: - while ($patch_line = <$fd>) { - chomp $patch_line; - - last EXTENDED_HEADER if ($patch_line =~ m/^--- |^diff /); - - print format_extended_diff_header_line($patch_line, $diffinfo, - \%from, \%to); - } - print "
\n"; # class="diff extended_header" - - # from-file/to-file diff header - if (! $patch_line) { - print "
\n"; # class="patch" - last PATCH; - } - next PATCH if ($patch_line =~ m/^diff /); - #assert($patch_line =~ m/^---/) if DEBUG; - - my $last_patch_line = $patch_line; - $patch_line = <$fd>; - chomp $patch_line; - #assert($patch_line =~ m/^\+\+\+/) if DEBUG; - - print format_diff_from_to_header($last_patch_line, $patch_line, - $diffinfo, \%from, \%to, - @hash_parents); - - # the patch itself - LINE: - while ($patch_line = <$fd>) { - chomp $patch_line; - - next PATCH if ($patch_line =~ m/^diff /); - - print format_diff_line($patch_line, \%from, \%to); - } - - } continue { - print "
\n"; # class="patch" - } - - # for compact combined (--cc) format, with chunk and patch simpliciaction - # patchset might be empty, but there might be unprocessed raw lines - for (++$patch_idx if $patch_number > 0; - $patch_idx < @$difftree; - ++$patch_idx) { - # read and prepare patch information - $diffinfo = parsed_difftree_line($difftree->[$patch_idx]); - - # generate anchor for "patch" links in difftree / whatchanged part - print "
\n" . - format_diff_cc_simplified($diffinfo, @hash_parents) . - "
\n"; # class="patch" - - $patch_number++; - } - - if ($patch_number == 0) { - if (@hash_parents > 1) { - print "
Trivial merge
\n"; - } else { - print "
No differences found
\n"; - } - } - - print "
\n"; # class="patchset" -} - -# . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . - -# fills project list info (age, description, owner, forks) for each -# project in the list, removing invalid projects from returned list -# NOTE: modifies $projlist, but does not remove entries from it -sub fill_project_list_info { - my ($projlist, $check_forks) = @_; - my @projects; - - my $show_ctags = gitweb_check_feature('ctags'); - PROJECT: - foreach my $pr (@$projlist) { - my (@activity) = git_get_last_activity($pr->{'path'}); - unless (@activity) { - next PROJECT; - } - ($pr->{'age'}, $pr->{'age_string'}) = @activity; - if (!defined $pr->{'descr'}) { - my $descr = git_get_project_description($pr->{'path'}) || ""; - $descr = to_utf8($descr); - $pr->{'descr_long'} = $descr; - $pr->{'descr'} = chop_str($descr, $projects_list_description_width, 5); - } - if (!defined $pr->{'owner'}) { - $pr->{'owner'} = git_get_project_owner("$pr->{'path'}") || ""; - } - if ($check_forks) { - my $pname = $pr->{'path'}; - if (($pname =~ s/\.git$//) && - ($pname !~ /\/$/) && - (-d "$projectroot/$pname")) { - $pr->{'forks'} = "-d $projectroot/$pname"; - } else { - $pr->{'forks'} = 0; - } - } - $show_ctags and $pr->{'ctags'} = git_get_project_ctags($pr->{'path'}); - push @projects, $pr; - } - - return @projects; -} - -# print 'sort by' element, generating 'sort by $name' replay link -# if that order is not selected -sub print_sort_th { - my ($name, $order, $header) = @_; - $header ||= ucfirst($name); - - if ($order eq $name) { - print "$header\n"; - } else { - print "" . - $cgi->a({-href => href(-replay=>1, order=>$name), - -class => "header"}, $header) . - "\n"; - } -} - -sub git_project_list_body { - # actually uses global variable $project - my ($projlist, $order, $from, $to, $extra, $no_header) = @_; - - my $check_forks = gitweb_check_feature('forks'); - my @projects = fill_project_list_info($projlist, $check_forks); - - $order ||= $default_projects_order; - $from = 0 unless defined $from; - $to = $#projects if (!defined $to || $#projects < $to); - - my %order_info = ( - project => { key => 'path', type => 'str' }, - descr => { key => 'descr_long', type => 'str' }, - owner => { key => 'owner', type => 'str' }, - age => { key => 'age', type => 'num' } - ); - my $oi = $order_info{$order}; - if ($oi->{'type'} eq 'str') { - @projects = sort {$a->{$oi->{'key'}} cmp $b->{$oi->{'key'}}} @projects; - } else { - @projects = sort {$a->{$oi->{'key'}} <=> $b->{$oi->{'key'}}} @projects; - } - - my $show_ctags = gitweb_check_feature('ctags'); - if ($show_ctags) { - my %ctags; - foreach my $p (@projects) { - foreach my $ct (keys %{$p->{'ctags'}}) { - $ctags{$ct} += $p->{'ctags'}->{$ct}; - } - } - my $cloud = git_populate_project_tagcloud(\%ctags); - print git_show_project_tagcloud($cloud, 64); - } - - print "\n"; - unless ($no_header) { - print "\n"; - if ($check_forks) { - print "\n"; - } - print_sort_th('project', $order, 'Project'); - print_sort_th('descr', $order, 'Description'); - print_sort_th('owner', $order, 'Owner'); - print_sort_th('age', $order, 'Last Change'); - print "\n" . # for links - "\n"; - } - my $alternate = 1; - my $tagfilter = $c->req->param('by_tag'); - for (my $i = $from; $i <= $to; $i++) { - my $pr = $projects[$i]; - - next if $tagfilter and $show_ctags and not grep { lc $_ eq lc $tagfilter } keys %{$pr->{'ctags'}}; - next if $searchtext and not $pr->{'path'} =~ /$searchtext/ - and not $pr->{'descr_long'} =~ /$searchtext/; - # Weed out forks or non-matching entries of search - if ($check_forks) { - my $forkbase = $project; $forkbase ||= ''; $forkbase =~ s#\.git$#/#; - $forkbase="^$forkbase" if $forkbase; - next if not $searchtext and not $tagfilter and $show_ctags - and $pr->{'path'} =~ m#$forkbase.*/.*#; # regexp-safe - } - - if ($alternate) { - print "\n"; - } else { - print "\n"; - } - $alternate ^= 1; - if ($check_forks) { - print "\n"; - } - print "\n" . - "\n" . - "\n"; - print "\n" . - "\n" . - "\n"; - } - if (defined $extra) { - print "\n"; - if ($check_forks) { - print "\n"; - } - print "\n" . - "\n"; - } - print "
"; - if ($pr->{'forks'}) { - print "\n"; - print $cgi->a({-href => href(project=>$pr->{'path'}, action=>"forks")}, "+"); - } - print "" . $cgi->a({-href => href(project=>$pr->{'path'}, action=>"summary"), - -class => "list"}, esc_html($pr->{'path'})) . "" . $cgi->a({-href => href(project=>$pr->{'path'}, action=>"summary"), - -class => "list", -title => $pr->{'descr_long'}}, - esc_html($pr->{'descr'})) . "" . chop_and_escape_str($pr->{'owner'}, 15) . "{'age'}) . "\">" . - (defined $pr->{'age_string'} ? $pr->{'age_string'} : "No commits") . "" . - $cgi->a({-href => href(project=>$pr->{'path'}, action=>"summary")}, "summary") . " | " . - $cgi->a({-href => href(project=>$pr->{'path'}, action=>"shortlog")}, "shortlog") . " | " . - $cgi->a({-href => href(project=>$pr->{'path'}, action=>"log")}, "log") . " | " . - $cgi->a({-href => href(project=>$pr->{'path'}, action=>"tree")}, "tree") . - ($pr->{'forks'} ? " | " . $cgi->a({-href => href(project=>$pr->{'path'}, action=>"forks")}, "forks") : '') . - "
$extra
\n"; -} - -sub git_shortlog_body { - # uses global variable $project - my ($commitlist, $from, $to, $refs, $extra) = @_; - - $from = 0 unless defined $from; - $to = $#{$commitlist} if (!defined $to || $#{$commitlist} < $to); - - print "\n"; - my $alternate = 1; - for (my $i = $from; $i <= $to; $i++) { - my %co = %{$commitlist->[$i]}; - my $commit = $co{'id'}; - my $ref = format_ref_marker($refs, $commit); - if ($alternate) { - print "\n"; - } else { - print "\n"; - } - $alternate ^= 1; - my $author = chop_and_escape_str($co{'author_name'}, 10); - # git_summary() used print "\n" . - print "\n" . - "\n" . - "\n" . - "\n" . - "\n"; - } - if (defined $extra) { - print "\n" . - "\n" . - "\n"; - } - print "
$co{'age_string'}$co{'age_string_date'}" . $author . ""; - print format_subject_html($co{'title'}, $co{'title_short'}, - href(action=>"commit", hash=>$commit), $ref); - print "" . - $cgi->a({-href => href(action=>"commit", hash=>$commit)}, "commit") . " | " . - $cgi->a({-href => href(action=>"commitdiff", hash=>$commit)}, "commitdiff") . " | " . - $cgi->a({-href => href(action=>"tree", hash=>$commit, hash_base=>$commit)}, "tree"); - my $snapshot_links = format_snapshot_links($commit); - if (defined $snapshot_links) { - print " | " . $snapshot_links; - } - print "
$extra
\n"; -} - -sub git_history_body { - # Warning: assumes constant type (blob or tree) during history - my ($commitlist, $from, $to, $refs, $hash_base, $ftype, $extra) = @_; - - $from = 0 unless defined $from; - $to = $#{$commitlist} unless (defined $to && $to <= $#{$commitlist}); - - print "\n"; - my $alternate = 1; - for (my $i = $from; $i <= $to; $i++) { - my %co = %{$commitlist->[$i]}; - if (!%co) { - next; - } - my $commit = $co{'id'}; - - my $ref = format_ref_marker($refs, $commit); - - if ($alternate) { - print "\n"; - } else { - print "\n"; - } - $alternate ^= 1; - # shortlog uses chop_str($co{'author_name'}, 10) - my $author = chop_and_escape_str($co{'author_name'}, 15, 3); - print "\n" . - "\n" . - "\n" . - "\n" . - "\n"; - } - if (defined $extra) { - print "\n" . - "\n" . - "\n"; - } - print "
$co{'age_string_date'}" . $author . ""; - # originally git_history used chop_str($co{'title'}, 50) - print format_subject_html($co{'title'}, $co{'title_short'}, - href(action=>"commit", hash=>$commit), $ref); - print "" . - $cgi->a({-href => href(action=>$ftype, hash_base=>$commit, file_name=>$file_name)}, $ftype) . " | " . - $cgi->a({-href => href(action=>"commitdiff", hash=>$commit)}, "commitdiff"); - - if ($ftype eq 'blob') { - my $blob_current = git_get_hash_by_path($hash_base, $file_name); - my $blob_parent = git_get_hash_by_path($commit, $file_name); - if (defined $blob_current && defined $blob_parent && - $blob_current ne $blob_parent) { - print " | " . - $cgi->a({-href => href(action=>"blobdiff", - hash=>$blob_current, hash_parent=>$blob_parent, - hash_base=>$hash_base, hash_parent_base=>$commit, - file_name=>$file_name)}, - "diff to current"); - } - } - print "
$extra
\n"; -} - -sub git_tags_body { - # uses global variable $project - my ($taglist, $from, $to, $extra) = @_; - $from = 0 unless defined $from; - $to = $#{$taglist} if (!defined $to || $#{$taglist} < $to); - - print "\n"; - my $alternate = 1; - for (my $i = $from; $i <= $to; $i++) { - my $entry = $taglist->[$i]; - my %tag = %$entry; - my $comment = $tag{'subject'}; - my $comment_short; - if (defined $comment) { - $comment_short = chop_str($comment, 30, 5); - } - if ($alternate) { - print "\n"; - } else { - print "\n"; - } - $alternate ^= 1; - if (defined $tag{'age'}) { - print "\n"; - } else { - print "\n"; - } - print "\n" . - "\n" . - "\n" . - "\n" . - ""; - } - if (defined $extra) { - print "\n" . - "\n" . - "\n"; - } - print "
$tag{'age'}" . - $cgi->a({-href => href(action=>$tag{'reftype'}, hash=>$tag{'refid'}), - -class => "list name"}, esc_html($tag{'name'})) . - ""; - if (defined $comment) { - print format_subject_html($comment, $comment_short, - href(action=>"tag", hash=>$tag{'id'})); - } - print ""; - if ($tag{'type'} eq "tag") { - print $cgi->a({-href => href(action=>"tag", hash=>$tag{'id'})}, "tag"); - } else { - print " "; - } - print "" . " | " . - $cgi->a({-href => href(action=>$tag{'reftype'}, hash=>$tag{'refid'})}, $tag{'reftype'}); - if ($tag{'reftype'} eq "commit") { - print " | " . $cgi->a({-href => href(action=>"shortlog", hash=>$tag{'fullname'})}, "shortlog") . - " | " . $cgi->a({-href => href(action=>"log", hash=>$tag{'fullname'})}, "log"); - } elsif ($tag{'reftype'} eq "blob") { - print " | " . $cgi->a({-href => href(action=>"blob_plain", hash=>$tag{'refid'})}, "raw"); - } - print "
$extra
\n"; -} - -sub git_heads_body { - # uses global variable $project - my ($headlist, $head, $from, $to, $extra) = @_; - $from = 0 unless defined $from; - $to = $#{$headlist} if (!defined $to || $#{$headlist} < $to); - - print "\n"; - my $alternate = 1; - for (my $i = $from; $i <= $to; $i++) { - my $entry = $headlist->[$i]; - my %ref = %$entry; - my $curr = $ref{'id'} eq $head; - if ($alternate) { - print "\n"; - } else { - print "\n"; - } - $alternate ^= 1; - print "\n" . - ($curr ? "\n" . - "\n" . - ""; - } - if (defined $extra) { - print "\n" . - "\n" . - "\n"; - } - print "
$ref{'age'}" : "") . - $cgi->a({-href => href(action=>"shortlog", hash=>$ref{'fullname'}), - -class => "list name"},esc_html($ref{'name'})) . - "" . - $cgi->a({-href => href(action=>"shortlog", hash=>$ref{'fullname'})}, "shortlog") . " | " . - $cgi->a({-href => href(action=>"log", hash=>$ref{'fullname'})}, "log") . " | " . - $cgi->a({-href => href(action=>"tree", hash=>$ref{'fullname'}, hash_base=>$ref{'name'})}, "tree") . - "
$extra
\n"; -} - -sub git_search_grep_body { - my ($commitlist, $from, $to, $extra) = @_; - $from = 0 unless defined $from; - $to = $#{$commitlist} if (!defined $to || $#{$commitlist} < $to); - - print "\n"; - my $alternate = 1; - for (my $i = $from; $i <= $to; $i++) { - my %co = %{$commitlist->[$i]}; - if (!%co) { - next; - } - my $commit = $co{'id'}; - if ($alternate) { - print "\n"; - } else { - print "\n"; - } - $alternate ^= 1; - my $author = chop_and_escape_str($co{'author_name'}, 15, 5); - print "\n" . - "\n" . - "\n" . - "\n" . - "\n"; - } - if (defined $extra) { - print "\n" . - "\n" . - "\n"; - } - print "
$co{'age_string_date'}" . $author . "" . - $cgi->a({-href => href(action=>"commit", hash=>$co{'id'}), - -class => "list subject"}, - chop_and_escape_str($co{'title'}, 50) . "
"); - my $comment = $co{'comment'}; - foreach my $line (@$comment) { - if ($line =~ m/^(.*?)($search_regexp)(.*)$/i) { - my ($lead, $match, $trail) = ($1, $2, $3); - $match = chop_str($match, 70, 5, 'center'); - my $contextlen = int((80 - length($match))/2); - $contextlen = 30 if ($contextlen > 30); - $lead = chop_str($lead, $contextlen, 10, 'left'); - $trail = chop_str($trail, $contextlen, 10, 'right'); - - $lead = esc_html($lead); - $match = esc_html($match); - $trail = esc_html($trail); - - print "$lead$match$trail
"; - } - } - print "		" . - $cgi->a({-href => href(action=>"commit", hash=>$co{'id'})}, "commit") . - " | " . - $cgi->a({-href => href(action=>"commitdiff", hash=>$co{'id'})}, "commitdiff") . - " | " . - $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'}, hash_base=>$co{'id'})}, "tree"); - print "
$extra
\n"; -} - -## ====================================================================== -## ====================================================================== -## actions - -sub git_project_list { - my $order = $input_params{'order'}; - if (defined $order && $order !~ m/none|project|descr|owner|age/) { - die_error(400, "Unknown order parameter"); - } - - my @list = git_get_projects_list(); - if (!@list) { - die_error(404, "No projects found"); - } - - if (-f $home_text) { - print "
\n"; - print insert_file($home_text); - print "
\n"; - } - print $cgi->startform(-method => "get") . - "

Search:\n" . - $cgi->textfield(-name => "s", -value => $searchtext) . "\n" . - "

" . - $cgi->end_form() . "\n"; - git_project_list_body(\@list, $order); -} - -sub git_forks { - my $order = $input_params{'order'}; - if (defined $order && $order !~ m/none|project|descr|owner|age/) { - die_error(400, "Unknown order parameter"); - } - - my @list = git_get_projects_list($project); - if (!@list) { - die_error(404, "No forks found"); - } - - git_print_page_nav('',''); - git_print_header_div('summary', "$project forks"); - git_project_list_body(\@list, $order); -} - -sub git_project_index { - my @projects = git_get_projects_list($project); - - print $cgi->header( - -type => 'text/plain', - -charset => 'utf-8', - -content_disposition => 'inline; filename="index.aux"'); - - foreach my $pr (@projects) { - if (!exists $pr->{'owner'}) { - $pr->{'owner'} = git_get_project_owner("$pr->{'path'}"); - } - - my ($path, $owner) = ($pr->{'path'}, $pr->{'owner'}); - # quote as in CGI::Util::encode, but keep the slash, and use '+' for ' ' - $path =~ s/([^a-zA-Z0-9_.\-\/ ])/sprintf("%%%02X", ord($1))/eg; - $owner =~ s/([^a-zA-Z0-9_.\-\/ ])/sprintf("%%%02X", ord($1))/eg; - $path =~ s/ /\+/g; - $owner =~ s/ /\+/g; - - print "$path $owner\n"; - } -} - -sub git_summary { - my $descr = git_get_project_description($project) || "none"; - my %co = parse_commit("HEAD"); - my %cd = %co ? parse_date($co{'committer_epoch'}, $co{'committer_tz'}) : (); - my $head = $co{'id'}; - - my $owner = git_get_project_owner($project); - - my $refs = git_get_references(); - # These get_*_list functions return one more to allow us to see if - # there are more ... - my @taglist = git_get_tags_list(16); - my @headlist = git_get_heads_list(16); - my @forklist; - my $check_forks = gitweb_check_feature('forks'); - - if ($check_forks) { - @forklist = git_get_projects_list($project); - } - - git_print_page_nav('summary','', $head); - - print "
 
\n"; - print "\n" . - "\n" . - "\n"; - if (defined $cd{'rfc2822'}) { - print "\n"; - } - - # use per project git URL list in $projectroot/$project/cloneurl - # or make project git URL from git base URL and project name - my $url_tag = "URL"; - my @url_list = git_get_project_url_list($project); - @url_list = map { "$_/$project" } @git_base_url_list unless @url_list; - foreach my $git_url (@url_list) { - next unless $git_url; - print "\n"; - $url_tag = ""; - } - - # Tag cloud - my $show_ctags = gitweb_check_feature('ctags'); - if ($show_ctags) { - my $ctags = git_get_project_ctags($project); - my $cloud = git_populate_project_tagcloud($ctags); - print "\n\n"; - } - - print "
description" . esc_html($descr) . "
owner" . esc_html($owner) . "
last change$cd{'rfc2822'}
$url_tag$git_url
Content tags:
"; - print "		" unless %$ctags; - print "
Add:
"; - print "		" if %$ctags; - print git_show_project_tagcloud($cloud, 48); - print "
\n"; - - # 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 "
readme
\n" . - "
\n"; - print insert_file("$projectroot/$project/README.html"); - print "\n
\n"; # class="readme" - } - - # we need to request one more than 16 (0..15) to check if - # those 16 are all - my @commitlist = $head ? parse_commits($head, 17) : (); - if (@commitlist) { - git_print_header_div('shortlog'); - git_shortlog_body(\@commitlist, 0, 15, $refs, - $#commitlist <= 15 ? undef : - $cgi->a({-href => href(action=>"shortlog")}, "...")); - } - - if (@taglist) { - git_print_header_div('tags'); - git_tags_body(\@taglist, 0, 15, - $#taglist <= 15 ? undef : - $cgi->a({-href => href(action=>"tags")}, "...")); - } - - if (@headlist) { - git_print_header_div('heads'); - git_heads_body(\@headlist, $head, 0, 15, - $#headlist <= 15 ? undef : - $cgi->a({-href => href(action=>"heads")}, "...")); - } - - if (@forklist) { - git_print_header_div('forks'); - git_project_list_body(\@forklist, 'age', 0, 15, - $#forklist <= 15 ? undef : - $cgi->a({-href => href(action=>"forks")}, "..."), - 'no_header'); - } - -} - -sub git_tag { - my $head = git_get_head_hash($project); - git_print_page_nav('','', $head,undef,$head); - my %tag = parse_tag($hash); - - if (! %tag) { - die_error(404, "Unknown tag object"); - } - - git_print_header_div('commit', esc_html($tag{'name'}), $hash); - print "
\n" . - "\n" . - "\n" . - "\n" . - "\n" . - "\n" . - "\n"; - if (defined($tag{'author'})) { - my %ad = parse_date($tag{'epoch'}, $tag{'tz'}); - print "\n"; - print "\n"; - } - print "
object" . $cgi->a({-class => "list", -href => href(action=>$tag{'type'}, hash=>$tag{'object'})}, - $tag{'object'}) . "" . $cgi->a({-href => href(action=>$tag{'type'}, hash=>$tag{'object'})}, - $tag{'type'}) . "
author" . esc_html($tag{'author'}) . "
" . $ad{'rfc2822'} . - sprintf(" (%02d:%02d %s)", $ad{'hour_local'}, $ad{'minute_local'}, $ad{'tz_local'}) . - "
\n\n" . - "
\n"; - print "
"; - my $comment = $tag{'comment'}; - foreach my $line (@$comment) { - chomp $line; - print esc_html($line, -nbsp=>1) . "
\n"; - } - print "
\n"; -} - -sub git_blame { - # permissions - gitweb_check_feature('blame') - or die_error(403, "Blame view not allowed"); - - # error checking - die_error(400, "No file name given") unless $file_name; - $hash_base ||= git_get_head_hash($project); - die_error(404, "Couldn't find base commit") unless $hash_base; - my %co = parse_commit($hash_base) - or die_error(404, "Commit not found"); - my $ftype = "blob"; - if (!defined $hash) { - $hash = git_get_hash_by_path($hash_base, $file_name, "blob") - or die_error(404, "Error looking up file"); - } else { - $ftype = git_get_type($hash); - if ($ftype !~ "blob") { - die_error(400, "Object is not a blob - $hash"); - } - } - - # run git-blame --porcelain - open my $fd, "-|", git_cmd(), "blame", '-p', - $hash_base, '--', $file_name - or die_error(500, "Open git-blame failed"); - - # page header - my $formats_nav = - $cgi->a({-href => href(action=>"blob", -replay=>1)}, - "blob") . - " | " . - $cgi->a({-href => href(action=>"history", -replay=>1)}, - "history") . - " | " . - $cgi->a({-href => href(action=>"blame", file_name=>$file_name)}, - "HEAD"); - git_print_page_nav('','', $hash_base,$co{'tree'},$hash_base, $formats_nav); - git_print_header_div('commit', esc_html($co{'title'}), $hash_base); - git_print_page_path($file_name, $ftype, $hash_base); - - # page body - my @rev_color = qw(light2 dark2); - my $num_colors = scalar(@rev_color); - my $current_color = 0; - my %metainfo = (); - - print < - - -HTML - LINE: - while (my $line = <$fd>) { - chomp $line; - # the header: [] - # no for subsequent lines in group of lines - my ($full_rev, $orig_lineno, $lineno, $group_size) = - ($line =~ /^([0-9a-f]{40}) (\d+) (\d+)(?: (\d+))?$/); - if (!exists $metainfo{$full_rev}) { - $metainfo{$full_rev} = {}; - } - my $meta = $metainfo{$full_rev}; - my $data; - while ($data = <$fd>) { - chomp $data; - last if ($data =~ s/^\t//); # contents of line - if ($data =~ /^(\S+) (.*)$/) { - $meta->{$1} = $2; - } - } - my $short_rev = substr($full_rev, 0, 8); - my $author = $meta->{'author'}; - my %date = - parse_date($meta->{'author-time'}, $meta->{'author-tz'}); - my $date = $date{'iso-tz'}; - if ($group_size) { - $current_color = ($current_color + 1) % $num_colors; - } - print "\n"; - if ($group_size) { - print "\n"; - } - my $parent_commit; - if (!exists $meta->{'parent'}) { - open (my $dd, "-|", git_cmd(), "rev-parse", "$full_rev^") - or die_error(500, "Open git-rev-parse failed"); - $parent_commit = <$dd>; - close $dd; - chomp($parent_commit); - $meta->{'parent'} = $parent_commit; - } else { - $parent_commit = $meta->{'parent'}; - } - my $blamed = href(action => 'blame', - file_name => $meta->{'filename'}, - hash_base => $parent_commit); - print ""; - print "\n"; - print "\n"; - } - print "
CommitLineData
1); - print ">"; - print $cgi->a({-href => href(action=>"commit", - hash=>$full_rev, - file_name=>$file_name)}, - esc_html($short_rev)); - print ""; - print $cgi->a({ -href => "$blamed#l$orig_lineno", - -class => "linenr" }, - esc_html($lineno)); - print "" . esc_html($data) . "
\n"; - print ""; - close $fd - or print "Reading blob failed\n"; - - # page footer -} - -sub git_tags { - my $head = git_get_head_hash($project); - git_print_page_nav('','', $head,undef,$head); - git_print_header_div('summary', $project); - - my @tagslist = git_get_tags_list(); - if (@tagslist) { - git_tags_body(\@tagslist); - } -} - -sub git_heads { - my $head = git_get_head_hash($project); - git_print_page_nav('','', $head,undef,$head); - git_print_header_div('summary', $project); - - my @headslist = git_get_heads_list(); - if (@headslist) { - git_heads_body(\@headslist, $head); - } -} - -sub git_blob_plain { - my $type = shift; - my $expires; - - if (!defined $hash) { - if (defined $file_name) { - my $base = $hash_base || git_get_head_hash($project); - $hash = git_get_hash_by_path($base, $file_name, "blob") - or die_error(404, "Cannot find file"); - } else { - die_error(400, "No file name defined"); - } - } elsif ($hash =~ m/^[0-9a-fA-F]{40}$/) { - # blobs defined by non-textual hash id's can be cached - $expires = "+1d"; - } - - open my $fd, "-|", git_cmd(), "cat-file", "blob", $hash - or die_error(500, "Open git-cat-file blob '$hash' failed"); - - # content-type (can include charset) - $type = blob_contenttype($fd, $file_name, $type); - - # "save as" filename, even when no $file_name is given - my $save_as = "$hash"; - if (defined $file_name) { - $save_as = $file_name; - } elsif ($type =~ m/^text\//) { - $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 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 => - ($sandbox ? 'attachment' : 'inline') - . '; filename="' . $save_as . '"'); - undef $/; - binmode STDOUT, ':raw'; - print <$fd>; - binmode STDOUT, ':utf8'; # as set at the beginning of gitweb.cgi - $/ = "\n"; - close $fd; -} - -sub git_blob { - my $expires; - - if (!defined $hash) { - if (defined $file_name) { - my $base = $hash_base || git_get_head_hash($project); - $hash = git_get_hash_by_path($base, $file_name, "blob") - or die_error(404, "Cannot find file"); - } else { - die_error(400, "No file name defined"); - } - } elsif ($hash =~ m/^[0-9a-fA-F]{40}$/) { - # blobs defined by non-textual hash id's can be cached - $expires = "+1d"; - } - - my $have_blame = gitweb_check_feature('blame'); - open my $fd, "-|", git_cmd(), "cat-file", "blob", $hash - or die_error(500, "Couldn't cat $file_name, $hash"); - my $mimetype = blob_mimetype($fd, $file_name); - if ($mimetype !~ m!^(?:text/|image/(?:gif|png|jpeg)$)! && -B $fd) { - close $fd; - return git_blob_plain($mimetype); - } - # we can have blame only for text/* mimetype - $have_blame &&= ($mimetype =~ m!^text/!); - - my $formats_nav = ''; - if (defined $hash_base && (my %co = parse_commit($hash_base))) { - if (defined $file_name) { - if ($have_blame) { - $formats_nav .= - $cgi->a({-href => href(action=>"blame", hash => $hash, -replay=>1)}, - "blame") . - " | "; - } - $formats_nav .= - $cgi->a({-href => href(action=>"history", -replay=>1)}, - "history") . - " | " . - $cgi->a({-href => href(action=>"blob_plain", -replay=>1)}, - "raw") . - " | " . - $cgi->a({-href => href(action=>"blob", - hash_base=>"HEAD", file_name=>$file_name)}, - "HEAD"); - } else { - $formats_nav .= - $cgi->a({-href => href(action=>"blob_plain", -replay=>1)}, - "raw"); - } - git_print_page_nav('','', $hash_base,$co{'tree'},$hash_base, $formats_nav); - git_print_header_div('commit', esc_html($co{'title'}), $hash_base); - } else { - print "
\n" . - "

\n" . - "
$hash
\n"; - } - git_print_page_path($file_name, "blob", $hash_base); - print "
\n"; - if ($mimetype =~ m!^image/!) { - print qq!$file_name$hash, - hash_base=>$hash_base, file_name=>$file_name) . - qq!" />\n!; - } else { - my $nr; - while (my $line = <$fd>) { - chomp $line; - $nr++; - $line = untabify($line); - printf "
%4i %s
\n", - $nr, $nr, $nr, esc_html($line, -nbsp=>1); - } - } - close $fd - or print "Reading blob failed.\n"; - print "
"; -} - -sub git_tree { - if (!defined $hash_base) { - $hash_base = "HEAD"; - } - if (!defined $hash) { - if (defined $file_name) { - $hash = git_get_hash_by_path($hash_base, $file_name, "tree"); - } else { - $hash = $hash_base; - } - } - 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 $refs = git_get_references(); - my $ref = format_ref_marker($refs, $hash_base); - my $basedir = ''; - my $have_blame = gitweb_check_feature('blame'); - if (defined $hash_base && (my %co = parse_commit($hash_base))) { - my @views_nav = (); - if (defined $file_name) { - push @views_nav, - $cgi->a({-href => href(action=>"history", -replay=>1)}, - "history"), - $cgi->a({-href => href(action=>"tree", - hash_base=>"HEAD", file_name=>$file_name)}, - "HEAD"), - } - my $snapshot_links = format_snapshot_links($hash); - if (defined $snapshot_links) { - # FIXME: Should be available when we have no hash base as well. - push @views_nav, $snapshot_links; - } - git_print_page_nav('tree','', $hash_base, undef, undef, join(' | ', @views_nav)); - git_print_header_div('commit', esc_html($co{'title'}) . $ref, $hash_base); - } else { - undef $hash_base; - print "
\n"; - print "

\n"; - print "
$hash
\n"; - } - if (defined $file_name) { - $basedir = $file_name; - if ($basedir ne '' && substr($basedir, -1) ne '/') { - $basedir .= '/'; - } - git_print_page_path($file_name, 'tree', $hash_base); - } - print "
\n"; - print "\n"; - my $alternate = 1; - # '..' (top directory) link if possible - if (defined $hash_base && - defined $file_name && $file_name =~ m![^/]+$!) { - if ($alternate) { - print "\n"; - } else { - print "\n"; - } - $alternate ^= 1; - - my $up = $file_name; - $up =~ s!/?[^/]+$!!; - undef $up unless $up; - # based on git_print_tree_entry - print '\n"; - print '\n"; - print "\n"; - - print "\n"; - } - foreach my $line (@entries) { - my %t = parse_ls_tree_line($line, -z => 1); - - if ($alternate) { - print "\n"; - } else { - print "\n"; - } - $alternate ^= 1; - - git_print_tree_entry(\%t, $basedir, $hash_base, $have_blame); - - print "\n"; - } - print "
' . mode_str('040000') . "'; - print $cgi->a({-href => href(action=>"tree", hash_base=>$hash_base, - file_name=>$up)}, - ".."); - print "
\n" . - "
"; -} - -sub git_snapshot { - my $format = $input_params{'snapshot_format'}; - if (!@snapshot_fmts) { - die_error(403, "Snapshots not allowed"); - } - # default to first supported snapshot format - $format ||= $snapshot_fmts[0]; - if ($format !~ m/^[a-z0-9]+$/) { - die_error(400, "Invalid snapshot format parameter"); - } elsif (!exists($known_snapshot_formats{$format})) { - die_error(400, "Unknown snapshot format"); - } elsif (!grep($_ eq $format, @snapshot_fmts)) { - die_error(403, "Unsupported snapshot format"); - } - - if (!defined $hash) { - $hash = git_get_head_hash($project); - } - - my $name = $project; - $name =~ s,([^/])/*\.git$,$1,; - $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 = quote_command( - git_cmd(), 'archive', - "--format=$known_snapshot_formats{$format}{'format'}", - "--prefix=$name/", $hash); - if (exists $known_snapshot_formats{$format}{'compressor'}) { - $cmd .= ' | ' . quote_command(@{$known_snapshot_formats{$format}{'compressor'}}); - } - - print $cgi->header( - -type => $known_snapshot_formats{$format}{'type'}, - -content_disposition => 'inline; filename="' . "$filename" . '"', - -status => '200 OK'); - - open my $fd, "-|", $cmd - or die_error(500, "Execute git-archive failed"); - binmode STDOUT, ':raw'; - print <$fd>; - binmode STDOUT, ':utf8'; # as set at the beginning of gitweb.cgi - close $fd; -} - -sub git_log { - my $head = git_get_head_hash($project); - if (!defined $hash) { - $hash = $head; - } - if (!defined $page) { - $page = 0; - } - my $refs = git_get_references(); - - my @commitlist = parse_commits($hash, 101, (100 * $page)); - - my $paging_nav = format_paging_nav('log', $hash, $head, $page, $#commitlist >= 100); - - my ($patch_max) = gitweb_get_feature('patches'); - if ($patch_max) { - if ($patch_max < 0 || @commitlist <= $patch_max) { - $paging_nav .= " ⋅ " . - $cgi->a({-href => href(action=>"patches", -replay=>1)}, - "patches"); - } - } - - git_print_page_nav('log','', $hash,undef,undef, $paging_nav); - - if (!@commitlist) { - my %co = parse_commit($hash); - - git_print_header_div('summary', $project); - print "
Last change $co{'age_string'}.

\n"; - } - my $to = ($#commitlist >= 99) ? (99) : ($#commitlist); - for (my $i = 0; $i <= $to; $i++) { - my %co = %{$commitlist[$i]}; - next if !%co; - my $commit = $co{'id'}; - my $ref = format_ref_marker($refs, $commit); - my %ad = parse_date($co{'author_epoch'}); - git_print_header_div('commit', - "$co{'age_string'}" . - esc_html($co{'title'}) . $ref, - $commit); - print "
\n" . - "
\n" . - $cgi->a({-href => href(action=>"commit", hash=>$commit)}, "commit") . - " | " . - $cgi->a({-href => href(action=>"commitdiff", hash=>$commit)}, "commitdiff") . - " | " . - $cgi->a({-href => href(action=>"tree", hash=>$commit, hash_base=>$commit)}, "tree") . - "
\n" . - "
\n" . - "" . esc_html($co{'author_name'}) . " [$ad{'rfc2822'}]
\n" . - "
\n"; - - print "
\n"; - git_print_log($co{'comment'}, -final_empty_line=> 1); - print "
\n"; - } - if ($#commitlist >= 100) { - print "
\n"; - print $cgi->a({-href => href(-replay=>1, page=>$page+1), - -accesskey => "n", -title => "Alt-n"}, "next"); - print "
\n"; - } -} - -sub git_commit { - $hash ||= $hash_base || "HEAD"; - my %co = parse_commit($hash) - or die_error(404, "Unknown commit object"); - my %ad = parse_date($co{'author_epoch'}, $co{'author_tz'}); - my %cd = parse_date($co{'committer_epoch'}, $co{'committer_tz'}); - - my $parent = $co{'parent'}; - my $parents = $co{'parents'}; # listref - - # we need to prepare $formats_nav before any parameter munging - my $formats_nav; - if (!defined $parent) { - # --root commitdiff - $formats_nav .= '(initial)'; - } elsif (@$parents == 1) { - # single parent commit - $formats_nav .= - '(parent: ' . - $cgi->a({-href => href(action=>"commit", - hash=>$parent)}, - esc_html(substr($parent, 0, 7))) . - ')'; - } else { - # merge commit - $formats_nav .= - '(merge: ' . - join(' ', map { - $cgi->a({-href => href(action=>"commit", - hash=>$_)}, - esc_html(substr($_, 0, 7))); - } @$parents ) . - ')'; - } - if (gitweb_check_feature('patches')) { - $formats_nav .= " | " . - $cgi->a({-href => href(action=>"patch", -replay=>1)}, - "patch"); - } - - if (!defined $parent) { - $parent = "--root"; - } - my @difftree; - open my $fd, "-|", git_cmd(), "diff-tree", '-r', "--no-commit-id", - @diff_opts, - (@$parents <= 1 ? $parent : '-c'), - $hash, "--" - or die_error(500, "Open git-diff-tree failed"); - @difftree = map { chomp; $_ } <$fd>; - close $fd or die_error(404, "Reading git-diff-tree failed"); - - # non-textual hash id's can be cached - my $expires; - if ($hash =~ m/^[0-9a-fA-F]{40}$/) { - $expires = "+1d"; - } - my $refs = git_get_references(); - my $ref = format_ref_marker($refs, $co{'id'}); - - git_print_page_nav('commit', '', - $hash, $co{'tree'}, $hash, - $formats_nav); - - if (defined $co{'parent'}) { - git_print_header_div('commitdiff', esc_html($co{'title'}) . $ref, $hash); - } else { - git_print_header_div('tree', esc_html($co{'title'}) . $ref, $co{'tree'}, $hash); - } - print "
\n" . - "\n"; - print "\n". - "" . - "" . - "\n"; - print "\n"; - print "\n"; - print "\n"; - print "" . - "" . - "" . - "" . - "\n"; - - foreach my $par (@$parents) { - print "" . - "" . - "" . - "" . - "\n"; - } - print "
author" . esc_html($co{'author'}) . "
$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 "
committer" . esc_html($co{'committer'}) . "
$cd{'rfc2822'}" . - sprintf(" (%02d:%02d %s)", $cd{'hour_local'}, $cd{'minute_local'}, $cd{'tz_local'}) . - "
commit$co{'id'}
tree" . - $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'}, hash_base=>$hash), - class => "list"}, $co{'tree'}) . - "" . - $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'}, hash_base=>$hash)}, - "tree"); - my $snapshot_links = format_snapshot_links($hash); - if (defined $snapshot_links) { - print " | " . $snapshot_links; - } - print "
parent" . - $cgi->a({-href => href(action=>"commit", hash=>$par), - class => "list"}, $par) . - "" . - $cgi->a({-href => href(action=>"commit", hash=>$par)}, "commit") . - " | " . - $cgi->a({-href => href(action=>"commitdiff", hash=>$hash, hash_parent=>$par)}, "diff") . - "
". - "
\n"; - - print "
\n"; - git_print_log($co{'comment'}); - print "
\n"; - - git_difftree_body(\@difftree, $hash, @$parents); - -} - -sub git_object { - # object is defined by: - # - hash or hash_base alone - # - hash_base and file_name - my $type; - - # - hash or hash_base alone - if ($hash || ($hash_base && !defined $file_name)) { - my $object_id = $hash || $hash_base; - - open my $fd, "-|", quote_command( - git_cmd(), 'cat-file', '-t', $object_id) . ' 2> /dev/null' - or die_error(404, "Object does not exist"); - $type = <$fd>; - chomp $type; - close $fd - or die_error(404, "Object does not exist"); - - # - hash_base and file_name - } elsif ($hash_base && defined $file_name) { - $file_name =~ s,/+$,,; - - system(git_cmd(), "cat-file", '-e', $hash_base) == 0 - or die_error(404, "Base object does not exist"); - - # here errors should not hapen - open my $fd, "-|", git_cmd(), "ls-tree", $hash_base, "--", $file_name - or die_error(500, "Open git-ls-tree failed"); - my $line = <$fd>; - close $fd; - - #'100644 blob 0fa3f3a66fb6a137f6ec2c19351ed4d807070ffa panic.c' - unless ($line && $line =~ m/^([0-9]+) (.+) ([0-9a-fA-F]{40})\t/) { - die_error(404, "File or directory for given base does not exist"); - } - $type = $2; - $hash = $3; - } else { - die_error(400, "Not enough information to find object"); - } - - print $cgi->redirect(-uri => href(action=>$type, -full=>1, - hash=>$hash, hash_base=>$hash_base, - file_name=>$file_name), - -status => '302 Found'); -} - -sub git_blobdiff { - my $format = shift || 'html'; - - my $fd; - my @difftree; - my %diffinfo; - my $expires; - - # preparing $fd and %diffinfo for git_patchset_body - # new style URI - if (defined $hash_base && defined $hash_parent_base) { - if (defined $file_name) { - # read raw output - open $fd, "-|", git_cmd(), "diff-tree", '-r', @diff_opts, - $hash_parent_base, $hash_base, - "--", (defined $file_parent ? $file_parent : ()), $file_name - or die_error(500, "Open git-diff-tree failed"); - @difftree = map { chomp; $_ } <$fd>; - close $fd - or die_error(404, "Reading git-diff-tree failed"); - @difftree - or die_error(404, "Blob diff not found"); - - } elsif (defined $hash && - $hash =~ /[0-9a-fA-F]{40}/) { - # try to find filename from $hash - - # read filtered raw output - open $fd, "-|", git_cmd(), "diff-tree", '-r', @diff_opts, - $hash_parent_base, $hash_base, "--" - or die_error(500, "Open git-diff-tree failed"); - @difftree = - # ':100644 100644 03b21826... 3b93d5e7... M ls-files.c' - # $hash == to_id - grep { /^:[0-7]{6} [0-7]{6} [0-9a-fA-F]{40} $hash/ } - map { chomp; $_ } <$fd>; - close $fd - or die_error(404, "Reading git-diff-tree failed"); - @difftree - or die_error(404, "Blob diff not found"); - - } else { - die_error(400, "Missing one of the blob diff parameters"); - } - - if (@difftree > 1) { - die_error(400, "Ambiguous blob diff specification"); - } - - %diffinfo = parse_difftree_raw_line($difftree[0]); - $file_parent ||= $diffinfo{'from_file'} || $file_name; - $file_name ||= $diffinfo{'to_file'}; - - $hash_parent ||= $diffinfo{'from_id'}; - $hash ||= $diffinfo{'to_id'}; - - # non-textual hash id's can be cached - if ($hash_base =~ m/^[0-9a-fA-F]{40}$/ && - $hash_parent_base =~ m/^[0-9a-fA-F]{40}$/) { - $expires = '+1d'; - } - - # open patch output - open $fd, "-|", git_cmd(), "diff-tree", '-r', @diff_opts, - '-p', ($format eq 'html' ? "--full-index" : ()), - $hash_parent_base, $hash_base, - "--", (defined $file_parent ? $file_parent : ()), $file_name - or die_error(500, "Open git-diff-tree failed"); - } - - # old/legacy style URI -- not generated anymore since 1.4.3. - if (!%diffinfo) { - die_error('404 Not Found', "Missing one of the blob diff parameters") - } - - # header - if ($format eq 'html') { - my $formats_nav = - $cgi->a({-href => href(action=>"blobdiff_plain", -replay=>1)}, - "raw"); - if (defined $hash_base && (my %co = parse_commit($hash_base))) { - git_print_page_nav('','', $hash_base,$co{'tree'},$hash_base, $formats_nav); - git_print_header_div('commit', esc_html($co{'title'}), $hash_base); - } else { - print "

$formats_nav
\n"; - print "
$hash vs $hash_parent
\n"; - } - if (defined $file_name) { - git_print_page_path($file_name, "blob", $hash_base); - } else { - print "
\n"; - } - - } elsif ($format eq 'plain') { - print $cgi->header( - -type => 'text/plain', - -charset => 'utf-8', - -expires => $expires, - -content_disposition => 'inline; filename="' . "$file_name" . '.patch"'); - - print "X-Git-Url: " . $cgi->self_url() . "\n\n"; - - } else { - die_error(400, "Unknown blobdiff format"); - } - - # patch - if ($format eq 'html') { - print "
\n"; - - git_patchset_body($fd, [ \%diffinfo ], $hash_base, $hash_parent_base); - close $fd; - - print "
\n"; # class="page_body" - - } else { - while (my $line = <$fd>) { - $line =~ s!a/($hash|$hash_parent)!'a/'.esc_path($diffinfo{'from_file'})!eg; - $line =~ s!b/($hash|$hash_parent)!'b/'.esc_path($diffinfo{'to_file'})!eg; - - print $line; - - last if $line =~ m!^\+\+\+!; - } - local $/ = undef; - print <$fd>; - close $fd; - } -} - -sub git_blobdiff_plain { - git_blobdiff('plain'); -} - -sub git_commitdiff { - my %params = @_; - my $format = $params{-format} || 'html'; - - my ($patch_max) = gitweb_get_feature('patches'); - if ($format eq 'patch') { - die_error(403, "Patch view not allowed") unless $patch_max; - } - - $hash ||= $hash_base || "HEAD"; - my %co = parse_commit($hash) - or die_error(404, "Unknown commit object"); - - # choose format for commitdiff for merge - if (! defined $hash_parent && @{$co{'parents'}} > 1) { - $hash_parent = '--cc'; - } - # we need to prepare $formats_nav before almost any parameter munging - my $formats_nav; - if ($format eq 'html') { - $formats_nav = - $cgi->a({-href => href(action=>"commitdiff_plain", -replay=>1)}, - "raw"); - if ($patch_max) { - $formats_nav .= " | " . - $cgi->a({-href => href(action=>"patch", -replay=>1)}, - "patch"); - } - - if (defined $hash_parent && - $hash_parent ne '-c' && $hash_parent ne '--cc') { - # commitdiff with two commits given - my $hash_parent_short = $hash_parent; - if ($hash_parent =~ m/^[0-9a-fA-F]{40}$/) { - $hash_parent_short = substr($hash_parent, 0, 7); - } - $formats_nav .= - ' (from'; - for (my $i = 0; $i < @{$co{'parents'}}; $i++) { - if ($co{'parents'}[$i] eq $hash_parent) { - $formats_nav .= ' parent ' . ($i+1); - last; - } - } - $formats_nav .= ': ' . - $cgi->a({-href => href(action=>"commitdiff", - hash=>$hash_parent)}, - esc_html($hash_parent_short)) . - ')'; - } elsif (!$co{'parent'}) { - # --root commitdiff - $formats_nav .= ' (initial)'; - } elsif (scalar @{$co{'parents'}} == 1) { - # single parent commit - $formats_nav .= - ' (parent: ' . - $cgi->a({-href => href(action=>"commitdiff", - hash=>$co{'parent'})}, - esc_html(substr($co{'parent'}, 0, 7))) . - ')'; - } else { - # merge commit - if ($hash_parent eq '--cc') { - $formats_nav .= ' | ' . - $cgi->a({-href => href(action=>"commitdiff", - hash=>$hash, hash_parent=>'-c')}, - 'combined'); - } else { # $hash_parent eq '-c' - $formats_nav .= ' | ' . - $cgi->a({-href => href(action=>"commitdiff", - hash=>$hash, hash_parent=>'--cc')}, - 'compact'); - } - $formats_nav .= - ' (merge: ' . - join(' ', map { - $cgi->a({-href => href(action=>"commitdiff", - hash=>$_)}, - esc_html(substr($_, 0, 7))); - } @{$co{'parents'}} ) . - ')'; - } - } - - my $hash_parent_param = $hash_parent; - if (!defined $hash_parent_param) { - # --cc for multiple parents, --root for parentless - $hash_parent_param = - @{$co{'parents'}} > 1 ? '--cc' : $co{'parent'} || '--root'; - } - - # read commitdiff - my $fd; - my @difftree; - if ($format eq 'html') { - open $fd, "-|", git_cmd(), "diff-tree", '-r', @diff_opts, - "--no-commit-id", "--patch-with-raw", "--full-index", - $hash_parent_param, $hash, "--" - or die_error(500, "Open git-diff-tree failed"); - - while (my $line = <$fd>) { - chomp $line; - # empty line ends raw part of diff-tree output - last unless $line; - push @difftree, scalar parse_difftree_raw_line($line); - } - - } elsif ($format eq 'plain') { - open $fd, "-|", git_cmd(), "diff-tree", '-r', @diff_opts, - '-p', $hash_parent_param, $hash, "--" - or die_error(500, "Open git-diff-tree failed"); - } elsif ($format eq 'patch') { - # For commit ranges, we limit the output to the number of - # patches specified in the 'patches' feature. - # For single commits, we limit the output to a single patch, - # diverging from the git-format-patch default. - my @commit_spec = (); - if ($hash_parent) { - if ($patch_max > 0) { - push @commit_spec, "-$patch_max"; - } - push @commit_spec, '-n', "$hash_parent..$hash"; - } else { - if ($params{-single}) { - push @commit_spec, '-1'; - } else { - if ($patch_max > 0) { - push @commit_spec, "-$patch_max"; - } - push @commit_spec, "-n"; - } - push @commit_spec, '--root', $hash; - } - open $fd, "-|", git_cmd(), "format-patch", '--encoding=utf8', - '--stdout', @commit_spec - or die_error(500, "Open git-format-patch failed"); - } else { - die_error(400, "Unknown commitdiff format"); - } - - # non-textual hash id's can be cached - my $expires; - if ($hash =~ m/^[0-9a-fA-F]{40}$/) { - $expires = "+1d"; - } - - # write commit message - if ($format eq 'html') { - my $refs = git_get_references(); - my $ref = format_ref_marker($refs, $co{'id'}); - - git_print_page_nav('commitdiff','', $hash,$co{'tree'},$hash, $formats_nav); - git_print_header_div('commit', esc_html($co{'title'}) . $ref, $hash); - git_print_authorship(\%co); - print "
\n"; - if (@{$co{'comment'}} > 1) { - print "
\n"; - git_print_log($co{'comment'}, -final_empty_line=> 1, -remove_title => 1); - print "
\n"; # class="log" - } - - } elsif ($format eq 'plain') { - my $refs = git_get_references("tags"); - my $tagname = git_get_rev_name_tags($hash); - my $filename = basename($project) . "-$hash.patch"; - - print $cgi->header( - -type => 'text/plain', - -charset => 'utf-8', - -expires => $expires, - -content_disposition => 'inline; filename="' . "$filename" . '"'); - my %ad = parse_date($co{'author_epoch'}, $co{'author_tz'}); - print "From: " . to_utf8($co{'author'}) . "\n"; - print "Date: $ad{'rfc2822'} ($ad{'tz_local'})\n"; - print "Subject: " . to_utf8($co{'title'}) . "\n"; - - print "X-Git-Tag: $tagname\n" if $tagname; - print "X-Git-Url: " . $cgi->self_url() . "\n\n"; - - foreach my $line (@{$co{'comment'}}) { - print to_utf8($line) . "\n"; - } - print "---\n\n"; - } elsif ($format eq 'patch') { - my $filename = basename($project) . "-$hash.patch"; - - print $cgi->header( - -type => 'text/plain', - -charset => 'utf-8', - -expires => $expires, - -content_disposition => 'inline; filename="' . "$filename" . '"'); - } - - # write patch - if ($format eq 'html') { - my $use_parents = !defined $hash_parent || - $hash_parent eq '-c' || $hash_parent eq '--cc'; - git_difftree_body(\@difftree, $hash, - $use_parents ? @{$co{'parents'}} : $hash_parent); - print "
\n"; - - git_patchset_body($fd, \@difftree, $hash, - $use_parents ? @{$co{'parents'}} : $hash_parent); - close $fd; - print "
\n"; # class="page_body" - - } elsif ($format eq 'plain') { - local $/ = undef; - print <$fd>; - close $fd - or print "Reading git-diff-tree failed\n"; - } elsif ($format eq 'patch') { - local $/ = undef; - print <$fd>; - close $fd - or print "Reading git-format-patch failed\n"; - } -} - -sub git_commitdiff_plain { - git_commitdiff(-format => 'plain'); -} - -# format-patch-style patches -sub git_patch { - git_commitdiff(-format => 'patch', -single=> 1); -} - -sub git_patches { - git_commitdiff(-format => 'patch'); -} - -sub git_history { - if (!defined $hash_base) { - $hash_base = git_get_head_hash($project); - } - if (!defined $page) { - $page = 0; - } - my $ftype; - my %co = parse_commit($hash_base) - or die_error(404, "Unknown commit object"); - - my $refs = git_get_references(); - my $limit = sprintf("--max-count=%i", (100 * ($page+1))); - - my @commitlist = parse_commits($hash_base, 101, (100 * $page), - $file_name, "--full-history") - or die_error(404, "No such file or directory on given branch"); - - if (!defined $hash && defined $file_name) { - # some commits could have deleted file in question, - # and not have it in tree, but one of them has to have it - for (my $i = 0; $i <= @commitlist; $i++) { - $hash = git_get_hash_by_path($commitlist[$i]{'id'}, $file_name); - last if defined $hash; - } - } - if (defined $hash) { - $ftype = git_get_type($hash); - } - if (!defined $ftype) { - die_error(500, "Unknown type of object"); - } - - my $paging_nav = ''; - if ($page > 0) { - $paging_nav .= - $cgi->a({-href => href(action=>"history", hash=>$hash, hash_base=>$hash_base, - file_name=>$file_name)}, - "first"); - $paging_nav .= " ⋅ " . - $cgi->a({-href => href(-replay=>1, page=>$page-1), - -accesskey => "p", -title => "Alt-p"}, "prev"); - } else { - $paging_nav .= "first"; - $paging_nav .= " ⋅ prev"; - } - my $next_link = ''; - if ($#commitlist >= 100) { - $next_link = - $cgi->a({-href => href(-replay=>1, page=>$page+1), - -accesskey => "n", -title => "Alt-n"}, "next"); - $paging_nav .= " ⋅ $next_link"; - } else { - $paging_nav .= " ⋅ next"; - } - - git_print_page_nav('history','', $hash_base,$co{'tree'},$hash_base, $paging_nav); - git_print_header_div('commit', esc_html($co{'title'}), $hash_base); - git_print_page_path($file_name, $ftype, $hash_base); - - git_history_body(\@commitlist, 0, 99, - $refs, $hash_base, $ftype, $next_link); - -} - -sub git_search { - gitweb_check_feature('search') or die_error(403, "Search is disabled"); - if (!defined $searchtext) { - die_error(400, "Text field is empty"); - } - if (!defined $hash) { - $hash = git_get_head_hash($project); - } - my %co = parse_commit($hash); - if (!%co) { - die_error(404, "Unknown commit object"); - } - if (!defined $page) { - $page = 0; - } - - $searchtype ||= 'commit'; - if ($searchtype eq 'pickaxe') { - # pickaxe may take all resources of your box and run for several minutes - # with every query - so decide by yourself how public you make this feature - gitweb_check_feature('pickaxe') - or die_error(403, "Pickaxe is disabled"); - } - if ($searchtype eq 'grep') { - gitweb_check_feature('grep') - or die_error(403, "Grep is disabled"); - } - - - if ($searchtype eq 'commit' or $searchtype eq 'author' or $searchtype eq 'committer') { - my $greptype; - if ($searchtype eq 'commit') { - $greptype = "--grep="; - } elsif ($searchtype eq 'author') { - $greptype = "--author="; - } elsif ($searchtype eq 'committer') { - $greptype = "--committer="; - } - $greptype .= $searchtext; - my @commitlist = parse_commits($hash, 101, (100 * $page), undef, - $greptype, '--regexp-ignore-case', - $search_use_regexp ? '--extended-regexp' : '--fixed-strings'); - - my $paging_nav = ''; - if ($page > 0) { - $paging_nav .= - $cgi->a({-href => href(action=>"search", hash=>$hash, - searchtext=>$searchtext, - searchtype=>$searchtype)}, - "first"); - $paging_nav .= " ⋅ " . - $cgi->a({-href => href(-replay=>1, page=>$page-1), - -accesskey => "p", -title => "Alt-p"}, "prev"); - } else { - $paging_nav .= "first"; - $paging_nav .= " ⋅ prev"; - } - my $next_link = ''; - if ($#commitlist >= 100) { - $next_link = - $cgi->a({-href => href(-replay=>1, page=>$page+1), - -accesskey => "n", -title => "Alt-n"}, "next"); - $paging_nav .= " ⋅ $next_link"; - } else { - $paging_nav .= " ⋅ next"; - } - - if ($#commitlist >= 100) { - } - - git_print_page_nav('','', $hash,$co{'tree'},$hash, $paging_nav); - git_print_header_div('commit', esc_html($co{'title'}), $hash); - git_search_grep_body(\@commitlist, 0, 99, $next_link); - } - - if ($searchtype eq 'pickaxe') { - git_print_page_nav('','', $hash,$co{'tree'},$hash); - git_print_header_div('commit', esc_html($co{'title'}), $hash); - - print "\n"; - my $alternate = 1; - $/ = "\n"; - open my $fd, '-|', git_cmd(), '--no-pager', 'log', @diff_opts, - '--pretty=format:%H', '--no-abbrev', '--raw', "-S$searchtext", - ($search_use_regexp ? '--pickaxe-regex' : ()); - undef %co; - my @files; - while (my $line = <$fd>) { - chomp $line; - next unless $line; - - my %set = parse_difftree_raw_line($line); - if (defined $set{'commit'}) { - # finish previous commit - if (%co) { - print "\n" . - "\n" . - "\n"; - } - - if ($alternate) { - print "\n"; - } else { - print "\n"; - } - $alternate ^= 1; - %co = parse_commit($set{'commit'}); - my $author = chop_and_escape_str($co{'author_name'}, 15, 5); - print "\n" . - "\n" . - "\n" . - "\n" . - "\n"; - } - - print "
" . - $cgi->a({-href => href(action=>"commit", hash=>$co{'id'})}, "commit") . - " | " . - $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'}, hash_base=>$co{'id'})}, "tree"); - print "
$co{'age_string_date'}$author" . - $cgi->a({-href => href(action=>"commit", hash=>$co{'id'}), - -class => "list subject"}, - chop_and_escape_str($co{'title'}, 50) . "
"); - } elsif (defined $set{'to_id'}) { - next if ($set{'to_id'} =~ m/^0{40}$/); - - print $cgi->a({-href => href(action=>"blob", hash_base=>$co{'id'}, - hash=>$set{'to_id'}, file_name=>$set{'to_file'}), - -class => "list"}, - "" . esc_path($set{'file'}) . "") . - "
\n"; - } - } - close $fd; - - # finish last commit (warning: repetition!) - if (%co) { - print "		" . - $cgi->a({-href => href(action=>"commit", hash=>$co{'id'})}, "commit") . - " | " . - $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'}, hash_base=>$co{'id'})}, "tree"); - print "
\n"; - } - - if ($searchtype eq 'grep') { - git_print_page_nav('','', $hash,$co{'tree'},$hash); - git_print_header_div('commit', esc_html($co{'title'}), $hash); - - print "\n"; - my $alternate = 1; - my $matches = 0; - $/ = "\n"; - open my $fd, "-|", git_cmd(), 'grep', '-n', - $search_use_regexp ? ('-E', '-i') : '-F', - $searchtext, $co{'tree'}; - my $lastfile = ''; - while (my $line = <$fd>) { - chomp $line; - my ($file, $lno, $ltext, $binary); - last if ($matches++ > 1000); - if ($line =~ /^Binary file (.+) matches$/) { - $file = $1; - $binary = 1; - } else { - (undef, $file, $lno, $ltext) = split(/:/, $line, 4); - } - if ($file ne $lastfile) { - $lastfile and print "\n"; - if ($alternate++) { - print "\n"; - } else { - print "\n"; - } - print "\n"; - if ($matches > 1000) { - print "
Too many matches, listing trimmed
\n"; - } - } else { - print "
No matches found
\n"; - } - close $fd; - - print "
". - $cgi->a({-href => href(action=>"blob", hash=>$co{'hash'}, - file_name=>"$file"), - -class => "list"}, esc_path($file)); - print "\n"; - $lastfile = $file; - } - if ($binary) { - print "
Binary file
\n"; - } else { - $ltext = untabify($ltext); - if ($ltext =~ m/^(.*)($search_regexp)(.*)$/i) { - $ltext = esc_html($1, -nbsp=>1); - $ltext .= ''; - $ltext .= esc_html($2, -nbsp=>1); - $ltext .= ''; - $ltext .= esc_html($3, -nbsp=>1); - } else { - $ltext = esc_html($ltext, -nbsp=>1); - } - print "
" . - $cgi->a({-href => href(action=>"blob", hash=>$co{'hash'}, - file_name=>"$file").'#l'.$lno, - -class => "linenr"}, sprintf('%4i', $lno)) - . ' ' . $ltext . "
\n"; - } - } - if ($lastfile) { - print "
\n"; - } -} - -sub git_search_help { - git_print_page_nav('','', $hash,$hash,$hash); - print <Pattern is by default a normal string that is matched precisely (but without -regard to case, except in the case of pickaxe). However, when you check the re checkbox, -the pattern entered is recognized as the POSIX extended -regular expression (also case -insensitive).

-
-
commit
-
The commit messages and authorship information will be scanned for the given pattern.
-EOT - my $have_grep = gitweb_check_feature('grep'); - if ($have_grep) { - print <grep -
All files in the currently selected tree (HEAD unless you are explicitly browsing - a different one) are searched for the given pattern. On large trees, this search can take -a while and put some strain on the server, so please use it with some consideration. Note that -due to git-grep peculiarity, currently if regexp mode is turned off, the matches are -case-sensitive.
-EOT - } - print <author -
Name and e-mail of the change author and date of birth of the patch will be scanned for the given pattern.
-
committer
-
Name and e-mail of the committer and date of commit will be scanned for the given pattern.
-EOT - my $have_pickaxe = gitweb_check_feature('pickaxe'); - if ($have_pickaxe) { - print <pickaxe -
All commits that caused the string to appear or disappear from any file (changes that -added, removed or "modified" the string) will be listed. This search can take a while and -takes a lot of strain on the server, so please use it wisely. Note that since you may be -interested even in changes just changing the case as well, this search is case sensitive.
-EOT - } - print "
\n"; -} - -sub git_shortlog { - my $head = git_get_head_hash($project); - if (!defined $hash) { - $hash = $head; - } - if (!defined $page) { - $page = 0; - } - my $refs = git_get_references(); - - my $commit_hash = $hash; - if (defined $hash_parent) { - $commit_hash = "$hash_parent..$hash"; - } - my @commitlist = parse_commits($commit_hash, 101, (100 * $page)); - - my $paging_nav = format_paging_nav('shortlog', $hash, $head, $page, $#commitlist >= 100); - my $next_link = ''; - if ($#commitlist >= 100) { - $next_link = - $cgi->a({-href => href(-replay=>1, page=>$page+1), - -accesskey => "n", -title => "Alt-n"}, "next"); - } - my $patch_max = gitweb_check_feature('patches'); - if ($patch_max) { - if ($patch_max < 0 || @commitlist <= $patch_max) { - $paging_nav .= " ⋅ " . - $cgi->a({-href => href(action=>"patches", -replay=>1)}, - "patches"); - } - } - - git_print_page_nav('shortlog','', $hash,$hash,$hash, $paging_nav); - git_print_header_div('summary', $project); - - git_shortlog_body(\@commitlist, 0, 99, $refs, $next_link); - -} - -## ...................................................................... -## feeds (RSS, Atom; OPML) - -# XXX This does header stuff which may not play nice with Catalyst, so likely -# broken in some/many ways. -sub git_feed { - my $format = shift || 'atom'; - my $have_blame = gitweb_check_feature('blame'); - - # Atom: http://www.atomenabled.org/developers/syndication/ - # RSS: http://www.notestips.com/80256B3A007F2692/1/NAMO5P9UPQ - if ($format ne 'rss' && $format ne 'atom') { - die_error(400, "Unknown web feed format"); - } - - # log/feed of current (HEAD) branch, log of given branch, history of file/directory - my $head = $hash || 'HEAD'; - my @commitlist = parse_commits($head, 150, 0, $file_name); - - my %latest_commit; - my %latest_date; - my $content_type = "application/$format+xml"; - if (defined $cgi->http('HTTP_ACCEPT') && - $cgi->Accept('text/xml') > $cgi->Accept($content_type)) { - # browser (feed reader) prefers text/xml - $content_type = 'text/xml'; - } - if (defined($commitlist[0])) { - %latest_commit = %{$commitlist[0]}; - my $latest_epoch = $latest_commit{'committer_epoch'}; - %latest_date = parse_date($latest_epoch); - my $if_modified = $cgi->http('IF_MODIFIED_SINCE'); - if (defined $if_modified) { - my $since; - if (eval { require HTTP::Date; 1; }) { - $since = HTTP::Date::str2time($if_modified); - } elsif (eval { require Time::ParseDate; 1; }) { - $since = Time::ParseDate::parsedate($if_modified, GMT => 1); - } - if (defined $since && $latest_epoch <= $since) { - print $cgi->header( - -type => $content_type, - -charset => 'utf-8', - -last_modified => $latest_date{'rfc2822'}, - -status => '304 Not Modified'); - return; - } - } - print $cgi->header( - -type => $content_type, - -charset => 'utf-8', - -last_modified => $latest_date{'rfc2822'}); - } else { - print $cgi->header( - -type => $content_type, - -charset => 'utf-8'); - } - - # Optimization: skip generating the body if client asks only - # for Last-Modified date. - return if ($cgi->request_method() eq 'HEAD'); - - # header variables - my $title = $c->config->{sitename} . " - $project/$action"; - my $feed_type = 'log'; - if (defined $hash) { - $title .= " - '$hash'"; - $feed_type = 'branch log'; - if (defined $file_name) { - $title .= " :: $file_name"; - $feed_type = 'history'; - } - } elsif (defined $file_name) { - $title .= " - $file_name"; - $feed_type = 'history'; - } - $title .= " $feed_type"; - my $descr = git_get_project_description($project); - if (defined $descr) { - $descr = esc_html($descr); - } else { - $descr = "$project " . - ($format eq 'rss' ? 'RSS' : 'Atom') . - " feed"; - } - my $owner = git_get_project_owner($project); - $owner = esc_html($owner); - - #header - my $alt_url; - if (defined $file_name) { - $alt_url = href(-full=>1, action=>"history", hash=>$hash, file_name=>$file_name); - } elsif (defined $hash) { - $alt_url = href(-full=>1, action=>"log", hash=>$hash); - } else { - $alt_url = href(-full=>1, action=>"summary"); - } - print qq!\n!; - if ($format eq 'rss') { - print < - -XML - print "$title\n" . - "$alt_url\n" . - "$descr\n" . - "en\n" . - # project owner is responsible for 'editorial' content - "$owner\n"; - if ($c->config->{logo} || $c->config->{favicon}) { - # prefer the logo to the favicon, since RSS - # doesn't allow both - my $img = esc_url($c->config->{logo} || $c->config->{favicon}); - print "\n" . - "$img\n" . - "$title\n" . - "$alt_url\n" . - "\n"; - } - if (%latest_date) { - print "$latest_date{'rfc2822'}\n"; - print "$latest_date{'rfc2822'}\n"; - } - print "gitweb v.$version/$git_version\n"; - } elsif ($format eq 'atom') { - print < -XML - print "$title\n" . - "$descr\n" . - '' . "\n" . - '' . "\n" . - "" . href(-full=>1) . "\n" . - # use project owner for feed author - "$owner\n"; - if ($c->config->{favicon}) { - print "" . esc_url($c->config->{favicon}) . "\n"; - } - if (defined $logo_url) { - # not twice as wide as tall: 72 x 27 pixels - print "" . esc_url($c->config->{logo}) . "\n"; - } - if (! %latest_date) { - # dummy date to keep the feed valid until commits trickle in: - print "1970-01-01T00:00:00Z\n"; - } else { - print "$latest_date{'iso-8601'}\n"; - } - print "gitweb\n"; - } - - # contents - for (my $i = 0; $i <= $#commitlist; $i++) { - my %co = %{$commitlist[$i]}; - my $commit = $co{'id'}; - # we read 150, we always show 30 and the ones more recent than 48 hours - if (($i >= 20) && ((time - $co{'author_epoch'}) > 48*60*60)) { - last; - } - my %cd = parse_date($co{'author_epoch'}); - - # get list of changed files - open my $fd, "-|", git_cmd(), "diff-tree", '-r', @diff_opts, - $co{'parent'} || "--root", - $co{'id'}, "--", (defined $file_name ? $file_name : ()) - or next; - my @difftree = map { chomp; $_ } <$fd>; - close $fd - or next; - - # print element (entry, item) - my $co_url = href(-full=>1, action=>"commitdiff", hash=>$commit); - if ($format eq 'rss') { - print "\n" . - "" . esc_html($co{'title'}) . "\n" . - "" . esc_html($co{'author'}) . "\n" . - "$cd{'rfc2822'}\n" . - "$co_url\n" . - "$co_url\n" . - "" . esc_html($co{'title'}) . "\n" . - "" . - "\n" . - "" . esc_html($co{'title'}) . "\n" . - "$cd{'iso-8601'}\n" . - "\n" . - " " . esc_html($co{'author_name'}) . "\n"; - if ($co{'author_email'}) { - print " " . esc_html($co{'author_email'}) . "\n"; - } - print "\n" . - # use committer for contributor - "\n" . - " " . esc_html($co{'committer_name'}) . "\n"; - if ($co{'committer_email'}) { - print " " . esc_html($co{'committer_email'}) . "\n"; - } - print "\n" . - "$cd{'iso-8601'}\n" . - "\n" . - "$co_url\n" . - "\n" . - "
\n"; - } - my $comment = $co{'comment'}; - print "
\n";
-		foreach my $line (@$comment) {
-			$line = esc_html($line);
-			print "$line\n";
-		}
-		print "
    \n"; - foreach my $difftree_line (@difftree) { - my %difftree = parse_difftree_raw_line($difftree_line); - next if !$difftree{'from_id'}; - - my $file = $difftree{'file'} || $difftree{'to_file'}; - - print "
  • " . - "[" . - $cgi->a({-href => href(-full=>1, action=>"blobdiff", - hash=>$difftree{'to_id'}, hash_parent=>$difftree{'from_id'}, - hash_base=>$co{'id'}, hash_parent_base=>$co{'parent'}, - file_name=>$file, file_parent=>$difftree{'from_file'}), - -title => "diff"}, 'D'); - if ($have_blame) { - print $cgi->a({-href => href(-full=>1, action=>"blame", - file_name=>$file, hash_base=>$commit), - -title => "blame"}, 'B'); - } - # if this is not a feed of a file history - if (!defined $file_name || $file_name ne $file) { - print $cgi->a({-href => href(-full=>1, action=>"history", - file_name=>$file, hash=>$commit), - -title => "history"}, 'H'); - } - $file = esc_path($file); - print "] ". - "$file
    • \n"; - } - if ($format eq 'rss') { - print "
]]>\n" . - "\n" . - "\n"; - } elsif ($format eq 'atom') { - print "\n
\n" . - "\n" . - "\n"; - } - } - - # end of feed - if ($format eq 'rss') { - print "\n\n"; - } elsif ($format eq 'atom') { - print "\n"; - } -} - -sub git_rss { - git_feed('rss'); -} - -sub git_atom { - git_feed('atom'); -} - -sub git_opml { - my @list = git_get_projects_list(); - - print $cgi->header( - -type => 'text/xml', - -charset => 'utf-8', - -content_disposition => 'inline; filename="opml.xml"'); - - my $sitename = $c->config->{sitename}; - print < - - - $sitename OPML Export - - - -XML - - foreach my $pr (@list) { - my %proj = %$pr; - my $head = git_get_head_hash($proj{'path'}); - if (!defined $head) { - next; - } - $git_dir = "$projectroot/$proj{'path'}"; - my %co = parse_commit($head); - if (!%co) { - next; - } - - my $path = esc_html(chop_str($proj{'path'}, 25, 5)); - my $rss = href('project' => $proj{'path'}, 'action' => 'rss', -full => 1); - my $html = href('project' => $proj{'path'}, 'action' => 'summary', -full => 1); - print "\n"; - } - print < - - -XML -} - -1; diff --git a/t/02git_object.t b/t/02git_object.t index 4ce679c..3a1ad62 100644 --- a/t/02git_object.t +++ b/t/02git_object.t @@ -1,7 +1,7 @@ use strict; use warnings; use FindBin qw/$Bin/; -use Test::More qw/no_plan/; +use Test::More; use Test::Exception; use Data::Dumper; @@ -78,7 +78,8 @@ is($patch->{diff}, '--- a/file1 ', 'patch->{diff} is correct'); is($patch->{dst}, '5716ca5987cbf97d6bb54920bea6adde242d87e6', 'patch->{dst} is correct'); -ok(index($commit_obj->get_patch, 'From 3f7567c7bdf7e7ebf410926493b92d398333116e Mon Sep 17 00:00:00 2001 +ok(index(do { local $/; my $fh = $commit_obj->get_patch; <$fh> }, +'From 3f7567c7bdf7e7ebf410926493b92d398333116e Mon Sep 17 00:00:00 2001 From: Florian Ragwitz Date: Tue, 6 Mar 2007 20:39:45 +0100 Subject: [PATCH] bar @@ -96,4 +97,8 @@ index 257cc56..5716ca5 100644 +bar --') == 0, 'commit_obj->get_patch can return a patch'); -like($commit_obj->get_patch(undef, 3), qr!PATCH 2/2!, 'commit_obj->get_patch can return a patchset'); +like(do { local $/; my $fh = $commit_obj->get_patch(undef, 3); <$fh> }, + qr!PATCH 2/2!, 'commit_obj->get_patch can return a patchset'); + +done_testing; +