/[pdpsoft]/nl.nikhef.pdp.fetchcrl/trunk/TrustAnchor.pm
ViewVC logotype

Diff of /nl.nikhef.pdp.fetchcrl/trunk/TrustAnchor.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 2305 by davidg, Sun Jun 12 20:59:58 2011 UTC revision 3107 by davidg, Fri Sep 9 15:32:11 2016 UTC
# Line 112  sub loadAnchor($$) { Line 112  sub loadAnchor($$) {
112      @{$self->{"crlurls"}} = ();      @{$self->{"crlurls"}} = ();
113      open CRLURL,"$path$basename$suffix" or      open CRLURL,"$path$basename$suffix" or
114        $::log->err("Error reading crl_url $path$basename$suffix: $!") and return 0;        $::log->err("Error reading crl_url $path$basename$suffix: $!") and return 0;
115        $self->{"filename"} = "$path$basename$suffix";
116      my $urllist;      my $urllist;
117      while (<CRLURL>) {      while (<CRLURL>) {
118        /^\s*([^#\n]+).*$/ and my $url = $1 or next;        /^\s*([^#\n]+).*$/ and my $url = $1 or next;
# Line 134  sub loadAnchor($$) { Line 135  sub loadAnchor($$) {
135      $info->read( $path . $basename . $suffix ) or      $info->read( $path . $basename . $suffix ) or
136        $::log->err("Error reading info $path$basename$suffix", $info->errstr)        $::log->err("Error reading info $path$basename$suffix", $info->errstr)
137          and return 0;          and return 0;
138        $self->{"filename"} = "$path$basename$suffix";
139    
140      $info->{_}->{"crl_url"} and $info->{_}->{"crl_url.0"} and      $info->{_}->{"crl_url"} and $info->{_}->{"crl_url.0"} and
141        $::log->err("Invalid info for $basename: crl_url and .0 duplicate") and        $::log->err("Invalid info for $basename: crl_url and .0 duplicate") and
# Line 265  sub printAnchorName($) { Line 267  sub printAnchorName($) {
267    print "" . ($self->{"anchorname"} || "undefined") ."\n";    print "" . ($self->{"anchorname"} || "undefined") ."\n";
268  }  }
269    
270    sub displayAnchorName($) {
271      my $self = shift;
272      return ($self->{"anchorname"} || "undefined");
273    }
274    
275  sub loadCAfiles($) {  sub loadCAfiles($) {
276    my $self         = shift;    my $self         = shift;
277    my $idx = 0;    my $idx = 0;
# Line 276  sub loadCAfiles($) { Line 283  sub loadCAfiles($) {
283      $::log->err("CA directory",$cadir,"does not exist") and      $::log->err("CA directory",$cadir,"does not exist") and
284      return 0;      return 0;
285    
286      # add @HASH@ support, inducing a file read and fork, only if really needed
287      my $crlhash;
288      if ( $self->{"catemplate"} =~ /\@HASH\@/ ) {
289        $self->{"crl"}[0]{"data"} ne "" or
290          $::log->err("CA name template contains HASH, but no CRL ".
291                      "could be loaded in time for ".$self->displayAnchorName) and
292          return 0;
293        my $probecrl = CRL->new(undef,$self->{"crl"}[0]{"data"});
294        $crlhash = $probecrl->getAttribute("hash");
295        $::log->verb(3,"Inferred CA template HASH ".($crlhash?$crlhash:"failed").
296                       " for ".$self->displayAnchorName);
297      }
298    
299    @{$self->{"cafile"}} = ();    @{$self->{"cafile"}} = ();
300    do {    do {
301      my $cafile;      my $cafile;
302    
303      foreach my $catpl ( split /\001/, $self->{"catemplate"} ) {      foreach my $catpl ( split /\001/, $self->{"catemplate"} ) {
304        $catpl =~ s/\@R\@/$idx/g;        $catpl =~ s/\@R\@/$idx/g;
305          $catpl =~ s/\@HASH\@/$crlhash/g;
306        -e $cadir.'/'.$catpl and        -e $cadir.'/'.$catpl and
307          $cafile = $cadir.'/'.$catpl and last;          $cafile = $cadir.'/'.$catpl and last;
308      }      }
# Line 413  sub retrieveHTTP($$) { Line 435  sub retrieveHTTP($$) {
435        $ua->proxy("http", $self->{"http_proxy"});        $ua->proxy("http", $self->{"http_proxy"});
436      }      }
437    }    }
438      # set request cache control if specified as valid in config
439      if ( defined $::cnf->{_}->{cache_control_request} ) {
440        $::log->verb(5,"Setting request cache-control to ".
441                       $::cnf->{_}->{cache_control_request});
442        if ( $::cnf->{_}->{cache_control_request} =~ /^\d+$/ ) {
443          $ua->default_header('Cache-control' =>
444                              "max-age=".$::cnf->{_}->{cache_control_request} );
445        } else {
446          die "Request cache control is invalid (not a number)\n";
447        }
448      }
449    
450    # see with a HEAD request if we can get by with old data    # see with a HEAD request if we can get by with old data
451    # but to assess that we need Last-Modified from the previous request    # but to assess that we need Last-Modified from the previous request
# Line 433  sub retrieveHTTP($$) { Line 465  sub retrieveHTTP($$) {
465      };      };
466      alarm 0; # make sure the alarm stops ticking, regardless of the eval      alarm 0; # make sure the alarm stops ticking, regardless of the eval
467    
468      if ( $@ ) {      if ( $@ ) { # died, alarm hit: server bad, so try next URL
469        $::log->verb(2,"HEAD error $url:", $@);        $::log->verb(2,"HEAD error $url:", $@);
470        return undef;        return undef;
471      }      }
472    
473      # try get if head fails anyway      # try using cached data if it is fresh
474      if ( ( ! $@ ) and      if ( ( ! $@ ) and
475            $response->is_success and            $response->is_success and
476           $response->header("Last-Modified") ) {           $response->header("Last-Modified") ) {
# Line 463  sub retrieveHTTP($$) { Line 495  sub retrieveHTTP($$) {
495      }      }
496    }    }
497    
498    # try get if head fails anyway    # try get if head fails, there was no cache, cache disabled or invalidated
499    
500    my $response;    my $response;
501    eval {    eval {
# Line 547  sub retrieve($) { Line 579  sub retrieve($) {
579      # be used for all (like  Last-Modified, and cache control data)      # be used for all (like  Last-Modified, and cache control data)
580    
581      # if we have a cached piece of fresh data, return that one      # if we have a cached piece of fresh data, return that one
582        # and make sure the nextupdate in the CRL itself outlives claimed freshness
583      if ( !$self->{"nocache"} and      if ( !$self->{"nocache"} and
584            ($self->{"crl"}[$i]{"state"}{"freshuntil"} || 0) > time and            ($self->{"crl"}[$i]{"state"}{"freshuntil"} || 0) > time and
585            ($self->{"crl"}[$i]{"state"}{"nextupdate"} || time) >= time and            ($self->{"crl"}[$i]{"state"}{"nextupdate"} || time) >= time and
586              ($self->{"crl"}[$i]{"state"}{"nextupdate"} || 0) >=
587                  ($self->{"crl"}[$i]{"state"}{"freshuntil"} || 0) and
588            $self->{"crl"}[$i]{"state"}{"b64data"} ) {            $self->{"crl"}[$i]{"state"}{"b64data"} ) {
589        $::log->verb(3,"Using cached content for",$self->{"alias"},"index",$i);        $::log->verb(3,"Using cached content for",$self->{"alias"},"index",$i);
590        $::log->verb(4,"Content dated",        $::log->verb(4,"Content dated",
# Line 594  sub retrieve($) { Line 629  sub retrieve($) {
629                           time )/3600).                           time )/3600).
630                       " left of ".$self->{"agingtolerance"}."h, retry later.");                       " left of ".$self->{"agingtolerance"}."h, retry later.");
631           } else {           } else {
632          $::log->err("CRL retrieval for",          $::log->retr_err("CRL retrieval for",
633                       $self->{"alias"},($i?"[$i] ":"")."failed.",                       $self->{"alias"},($i?"[$i] ":"")."failed.",
634                       $self->{"agingtolerance"}."h grace expired.",                       $self->{"agingtolerance"}."h grace expired.",
635                       "CRL not updated");                       "CRL not updated");
636           }           }
637        } else { # direct errors, no tolerance anymore        } else { # direct errors, no tolerance anymore
638          $::log->err("CRL retrieval for",          $::log->retr_err("CRL retrieval for",
639                       $self->{"alias"},($i?"[$i] ":"")."failed,",                       $self->{"alias"},($i?"[$i] ":"")."failed,",
640                       "CRL not updated");                       "CRL not updated");
641        }        }
# Line 701  sub verifyAndConvertCRLs($) { Line 736  sub verifyAndConvertCRLs($) {
736      }      }
737    
738      $#verifyMessages >= 0 and do {      $#verifyMessages >= 0 and do {
739        $::log->err("CRL verification failed for",$self->{"anchorname"}."/$i",        $::log->retr_err("CRL verification failed for",$self->{"anchorname"}."/$i",
740                    "(".$self->{"alias"}.")");                    "(".$self->{"alias"}.")");
741        foreach my $m ( @verifyMessages ) {        foreach my $m ( @verifyMessages ) {
742          $::log->verb(0,$self->{"anchorname"}."/$i:",$m);          $::log->verb(0,$self->{"anchorname"}."/$i:",$m);
# Line 713  sub verifyAndConvertCRLs($) { Line 748  sub verifyAndConvertCRLs($) {
748      foreach my $key ( qw/ lastupdate nextupdate sha1fp issuer / ) {      foreach my $key ( qw/ lastupdate nextupdate sha1fp issuer / ) {
749        $self->{"crl"}[$i]{"state"}{$key} = $crl->getAttribute($key) || "";        $self->{"crl"}[$i]{"state"}{$key} = $crl->getAttribute($key) || "";
750      }      }
751    
752    
753        # issue a low-level warning in case the cache control headers from
754        # the CA (or its CDN) are bugus, i.e. the CRL wille expire before the
755        # cache does. Don't log at warning, since the site cannot fix this
756        if ( defined ($self->{"crl"}[$i]{"state"}{"freshuntil"}) and
757             ( $self->{"crl"}[$i]{"state"}{"freshuntil"} >
758               ( $self->{"crl"}[$i]{"state"}{"nextupdate"} +
759                 $::cnf->{_}->{expirestolerance} )
760             )
761          ) {
762          $::log->verb(1,"Cache control headers for CA ".$self->{"alias"}." at ".
763            "URL ".$self->{"crl"}[$i]{"state"}{"sourceurl"}." have apparent ".
764            "freshness ".sprintf("%.1f",($self->{"crl"}[$i]{"state"}{"freshuntil"}-
765                                 $self->{"crl"}[$i]{"state"}{"nextupdate"})/3600).
766            "hrs beyond CRL expiration nextUpdate. Reset freshness from ".
767            gmtime($self->{"crl"}[$i]{"state"}{"freshuntil"})." UTC to ".
768            $::cnf->{_}->{expirestolerance}." second before nextUpdate at ".
769            gmtime($self->{"crl"}[$i]{"state"}{"nextupdate"})." UTC.");
770          $self->{"crl"}[$i]{"state"}{"freshuntil"} =
771            $self->{"crl"}[$i]{"state"}{"nextupdate"} -
772            $::cnf->{_}->{expirestolerance};
773        }
774    
775        # limit maximum freshness period to compensate for CAs that overdo it
776        if ( defined ($self->{"crl"}[$i]{"state"}{"freshuntil"}) and
777             $self->{"crl"}[$i]{"state"}{"freshuntil"} >
778               (time + $::cnf->{_}->{maxcachetime}) ) {
779          $self->{"crl"}[$i]{"state"}{"freshuntil"} =
780            time+$::cnf->{_}->{maxcachetime};
781          $::log->verb(1,"Cache state freshness expiry for CA ".$self->{"alias"}.
782                       " reset to at most ".
783                       sprintf("%.1f",$::cnf->{_}->{maxcachetime}/3600.).
784                       "hrs beyond current time (".
785                       gmtime($self->{"crl"}[$i]{"state"}{"freshuntil"})." UTC)");
786        }
787    
788    }    }
789    return 1;    return 1;
790  }  }

Legend:
Removed from v.2305  
changed lines
  Added in v.3107

grid.support@nikhef.nl
ViewVC Help
Powered by ViewVC 1.1.28