X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=Debbugs%2FCGI.pm;h=34646b81489e4ae8c4f0e5c2a54dfe55ea7b3a0a;hb=07309ad3fbc3f3d29b0da8921716392b8e593eb0;hp=d305aed7e2724261fa1c3723846bc378e0351a02;hpb=f3e9030c5d22122dc4e7a4713b1c3413592a0d02;p=debbugs.git diff --git a/Debbugs/CGI.pm b/Debbugs/CGI.pm index d305aed..34646b8 100644 --- a/Debbugs/CGI.pm +++ b/Debbugs/CGI.pm @@ -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; } @@ -196,7 +200,7 @@ width and height are passed. sub version_url{ my %params = validate_with(params => \@_, - spec => {package => {type => SCALAR, + spec => {package => {type => SCALAR|ARRAYREF, }, found => {type => ARRAYREF, default => [], @@ -400,11 +404,15 @@ sub package_links { } my @links = (); for my $type (qw(src package)) { - push @links, map {(munge_url('pkgreport.cgi?', + push @links, map {my $t_type = $type; + if ($_ =~ s/^src://) { + $t_type = 'src'; + } + (munge_url('pkgreport.cgi?', %options, - $type => $_, + $t_type => $_, ), - ($type eq 'src'?'src:':'').$_); + ($t_type eq 'src'?'src:':'').$_); } make_list($param{$type}) if exists $param{$type}; } for my $type (qw(maint owner submitter correspondent)) { @@ -536,8 +544,8 @@ the split links with commas and spaces. sub maybelink { my ($links,$regex,$join) = @_; if (not defined $regex and not defined $join) { - $links =~ s{((?:ftp|http|https)://[\S~-]+?/?)([\)\'\:\.\,]?(?:\s|\.<|$))} - {q().html_escape($1).q().$2}geimo; + $links =~ s{(.*?)((?:(?:ftp|http|https)://[\S~-]+?/?)?)([\)\'\:\.\,]?(?:\s|\.<|$))} + {html_escape($1).(length $2?q().html_escape($2).q():'').html_escape($3)}geimo; return $links; } $join = ' ' if not defined $join; @@ -930,6 +938,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;