11
11
use warnings;
12
12
use CGI qw( :standard :escapeHTML -nosticky) ;
13
13
use CGI::Util qw( unescape) ;
14
- use CGI::Carp qw( fatalsToBrowser) ;
14
+ use CGI::Carp qw( fatalsToBrowser set_message ) ;
15
15
use Encode;
16
16
use Fcntl ' :mode' ;
17
17
use File::Find qw( ) ;
@@ -952,6 +952,21 @@ sub evaluate_path_info {
952
952
$git_avatar = ' ' ;
953
953
}
954
954
955
+ # custom error handler: 'die <message>' is Internal Server Error
956
+ sub handle_errors_html {
957
+ my $msg = shift ; # it is already HTML escaped
958
+
959
+ # to avoid infinite loop where error occurs in die_error,
960
+ # change handler to default handler, disabling handle_errors_html
961
+ set_message(" Error occured when inside die_error:\n $msg " );
962
+
963
+ # you cannot jump out of die_error when called as error handler;
964
+ # the subroutine set via CGI::Carp::set_message is called _after_
965
+ # HTTP headers are already written, so it cannot write them itself
966
+ die_error(undef , undef , $msg , -error_handler => 1, -no_http_header => 1);
967
+ }
968
+ set_message(\&handle_errors_html);
969
+
955
970
# dispatch
956
971
if (!defined $action ) {
957
972
if (defined $hash ) {
@@ -972,11 +987,16 @@ sub evaluate_path_info {
972
987
die_error(400, " Project needed" );
973
988
}
974
989
$actions {$action }-> ();
975
- exit ;
990
+ DONE_GITWEB:
991
+ 1;
976
992
977
993
# # ======================================================================
978
994
# # action links
979
995
996
+ # possible values of extra options
997
+ # -full => 0|1 - use absolute/full URL ($my_uri/$my_url as base)
998
+ # -replay => 1 - start from a current view (replay with modifications)
999
+ # -path_info => 0|1 - don't use/use path_info URL (if possible)
980
1000
sub href {
981
1001
my %params = @_ ;
982
1002
# default is to use -absolute url() i.e. $my_uri
@@ -993,7 +1013,8 @@ sub href {
993
1013
}
994
1014
995
1015
my $use_pathinfo = gitweb_check_feature(' pathinfo' );
996
- if ($use_pathinfo and defined $params {' project' }) {
1016
+ if (defined $params {' project' } &&
1017
+ (exists $params {-path_info} ? $params {-path_info} : $use_pathinfo )) {
997
1018
# try to put as many parameters as possible in PATH_INFO:
998
1019
# - project name
999
1020
# - action
@@ -3161,23 +3182,30 @@ sub blob_contenttype {
3161
3182
# # ======================================================================
3162
3183
# # functions printing HTML: header, footer, error page
3163
3184
3185
+ sub get_page_title {
3186
+ my $title = to_utf8($site_name );
3187
+
3188
+ return $title unless (defined $project );
3189
+ $title .= " - " . to_utf8($project );
3190
+
3191
+ return $title unless (defined $action );
3192
+ $title .= " /$action " ; # $action is US-ASCII (7bit ASCII)
3193
+
3194
+ return $title unless (defined $file_name );
3195
+ $title .= " - " . esc_path($file_name );
3196
+ if ($action eq " tree" && $file_name !~ m | /$ | ) {
3197
+ $title .= " /" ;
3198
+ }
3199
+
3200
+ return $title ;
3201
+ }
3202
+
3164
3203
sub git_header_html {
3165
3204
my $status = shift || " 200 OK" ;
3166
3205
my $expires = shift ;
3206
+ my %opts = @_ ;
3167
3207
3168
- my $title = " $site_name " ;
3169
- if (defined $project ) {
3170
- $title .= " - " . to_utf8($project );
3171
- if (defined $action ) {
3172
- $title .= " /$action " ;
3173
- if (defined $file_name ) {
3174
- $title .= " - " . esc_path($file_name );
3175
- if ($action eq " tree" && $file_name !~ m | /$ | ) {
3176
- $title .= " /" ;
3177
- }
3178
- }
3179
- }
3180
- }
3208
+ my $title = get_page_title();
3181
3209
my $content_type ;
3182
3210
# require explicit support from the UA if we are to send the page as
3183
3211
# 'application/xhtml+xml', otherwise send it as plain old 'text/html'.
@@ -3191,7 +3219,8 @@ sub git_header_html {
3191
3219
$content_type = ' text/html' ;
3192
3220
}
3193
3221
print $cgi -> header(-type => $content_type , -charset => ' utf-8' ,
3194
- -status => $status , -expires => $expires );
3222
+ -status => $status , -expires => $expires )
3223
+ unless ($opts {' -no_http_headers' });
3195
3224
my $mod_perl_version = $ENV {' MOD_PERL' } ? " $ENV {'MOD_PERL'}" : ' ' ;
3196
3225
print <<EOF ;
3197
3226
<?xml version="1.0" encoding="utf-8"?>
@@ -3408,6 +3437,7 @@ sub die_error {
3408
3437
my $status = shift || 500;
3409
3438
my $error = esc_html(shift ) || " Internal Server Error" ;
3410
3439
my $extra = shift ;
3440
+ my %opts = @_ ;
3411
3441
3412
3442
my %http_responses = (
3413
3443
400 => ' 400 Bad Request' ,
@@ -3416,7 +3446,7 @@ sub die_error {
3416
3446
500 => ' 500 Internal Server Error' ,
3417
3447
503 => ' 503 Service Unavailable' ,
3418
3448
);
3419
- git_header_html($http_responses {$status });
3449
+ git_header_html($http_responses {$status }, undef , %opts );
3420
3450
print <<EOF ;
3421
3451
<div class="page_body">
3422
3452
<br /><br />
@@ -3430,7 +3460,8 @@ sub die_error {
3430
3460
print " </div>\n " ;
3431
3461
3432
3462
git_footer_html();
3433
- exit ;
3463
+ goto DONE_GITWEB
3464
+ unless ($opts {' -error_handler' });
3434
3465
}
3435
3466
3436
3467
# # ----------------------------------------------------------------------
0 commit comments