X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=Debbugs%2FCGI.pm;h=9cc4d512426310e48b15f048722834ac34f7b160;hb=9ba3b5ba7379ac06399d7b296e7796b65fad6149;hp=d51b9be0a469c5503f4e3648964c36bb2bb31e27;hpb=dfffc9e4190838650697c3758a477e92f49939a3;p=debbugs.git diff --git a/Debbugs/CGI.pm b/Debbugs/CGI.pm index d51b9be..9cc4d51 100644 --- a/Debbugs/CGI.pm +++ b/Debbugs/CGI.pm @@ -34,7 +34,7 @@ None known. use warnings; use strict; use vars qw($VERSION $DEBUG %EXPORT_TAGS @EXPORT_OK @EXPORT); -use base qw(Exporter); +use Exporter qw(import); use Debbugs::URI; use HTML::Entities; @@ -50,7 +50,8 @@ use POSIX qw(ceil); use Storable qw(dclone); use List::Util qw(max); - +use File::stat; +use Digest::MD5 qw(md5_hex); use Carp; use Debbugs::Text qw(fill_in_template); @@ -77,6 +78,7 @@ BEGIN{ usertags => [qw(add_user)], misc => [qw(maint_decode)], package_search => [qw(@package_search_key_order %package_search_keys)], + cache => [qw(calculate_etag etag_does_not_match)], #status => [qw(getbugstatus)], ); @EXPORT_OK = (); @@ -161,7 +163,9 @@ sub munge_url { while (my ($key,$value) = splice @old_param,0,2) { push @new_param,($key,$value) unless exists $params{$key}; } - $new_url->query_form(@new_param,%params); + $new_url->query_form(@new_param, + map {($_,$params{$_})} + sort keys %params); return $new_url->as_string; } @@ -288,7 +292,9 @@ sub cgi_parameters { sub quitcgi { - my $msg = shift; + my ($msg, $status) = @_; + $status //= '500 Internal Server Error'; + print "Status: $status\n"; print "Content-Type: text/html\n\n"; print fill_in_template(template=>'cgi/quit', variables => {msg => $msg} @@ -618,10 +624,6 @@ sub htmlize_maintlinks { return htmlize_addresslinks($prefixfunc, \&mainturl, $maints); } - -our $_maintainer; -our $_maintainer_rev; - =head2 bug_linklist bug_linklist($separator,$class,@bugs) @@ -837,7 +839,6 @@ sub option_form{ for my $key (keys %{$param{form_option}}) { # strip out leader; shouldn't be anything here without one, # but skip stupid things anyway - my $o_key = $key; next unless $key =~ s/^\Q$form_option_leader\E//; if ($key =~ /^add_(.+)$/) { # this causes a specific parameter to be added @@ -934,6 +935,77 @@ sub maint_decode { wantarray ? @output : $output[0]; } +=head1 cache + +=head2 calculate_etags + + calculate_etags(files => [qw(list of files)],additional_data => [qw(any additional data)]); + +=cut + +sub calculate_etags { + my %param = + validate_with(params => \@_, + spec => {files => {type => ARRAYREF, + default => [], + }, + additional_data => {type => ARRAYREF, + default => [], + }, + }, + ); + my @additional_data = @{$param{additional_data}}; + for my $file (@{$param{files}}) { + my $st = stat($file) or warn "Unable to stat $file: $!"; + push @additional_data,$st->mtime; + push @additional_data,$st->size; + } + return(md5_hex(join('',sort @additional_data))); +} + +=head2 etag_does_not_match + + etag_does_not_match(cgi=>$q,files=>[qw(list of files)], + additional_data=>[qw(any additional data)]) + + +Checks to see if the CGI request contains an etag which matches the calculated +etag. + +If there wasn't an etag given, or the etag given doesn't match, return the etag. + +If the etag does match, return 0. + +=cut + +sub etag_does_not_match { + my %param = + validate_with(params => \@_, + spec => {files => {type => ARRAYREF, + default => [], + }, + additional_data => {type => ARRAYREF, + default => [], + }, + cgi => {type => OBJECT}, + }, + ); + my $submitted_etag = + $param{cgi}->http('if-none-match'); + my $etag = + calculate_etags(files=>$param{files}, + additional_data=>$param{additional_data}); + if (not defined $submitted_etag or + length($submitted_etag) != 32 + or $etag ne $submitted_etag + ) { + return $etag; + } + if ($etag eq $submitted_etag) { + return 0; + } +} + 1;