/[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

trunk/fetchcrl/TrustAnchor.pm revision 2188 by davidg, Sun Feb 13 18:41:25 2011 UTC nl.nikhef.pdp.fetchcrl/trunk/TrustAnchor.pm 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 121  sub loadAnchor($$) { Line 122  sub loadAnchor($$) {
122          $::log->err("File $path$basename$suffix contains a non-URL entry")          $::log->err("File $path$basename$suffix contains a non-URL entry")
123            and close CRLURL and return 0;            and close CRLURL and return 0;
124    
125        $urllist and $urllist .= "&";        $urllist and $urllist .= "\001";
126        $urllist .= $url;        $urllist .= $url;
127      }      }
128      close CRLURL;      close CRLURL;
# 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 152  sub loadAnchor($$) { Line 154  sub loadAnchor($$) {
154    
155      @{$self->{"crlurls"}} = ();      @{$self->{"crlurls"}} = ();
156      for ( my $i=0 ; defined $info->{_}{"crl_url.".$i} ; $i++ ) {      for ( my $i=0 ; defined $info->{_}{"crl_url.".$i} ; $i++ ) {
157        $info->{_}{"crl_url.".$i} =~ s/[;\s]+/&/g;        $info->{_}{"crl_url.".$i} =~ s/[;\s]+/\001/g;
158        $info->{_}{"crl_url.".$i} =~ s/^\s*([^\s]*)\s*$/$1/;        $info->{_}{"crl_url.".$i} =~ s/^\s*([^\s]*)\s*$/$1/;
159    
160        $info->{_}{"crl_url.".$i} =~ /^\w+:\/\// or        $info->{_}{"crl_url.".$i} =~ /^\w+:\/\// or
# Line 213  sub loadAnchor($$) { Line 215  sub loadAnchor($$) {
215      my $i = 0;      my $i = 0;
216      while ( defined ($::cnf->{$self->{$section}}->{"crl_url.".$i}) ) {      while ( defined ($::cnf->{$self->{$section}}->{"crl_url.".$i}) ) {
217        my $urls;        my $urls;
218        ($urls=$::cnf->{$self->{$section}}->{"crl_url.".$i} )=~s/[;\s]+/&/g;        ($urls=$::cnf->{$self->{$section}}->{"crl_url.".$i} )=~s/[;\s]+/\001/g;
219        ${$self->{"crlurls"}}[$i] = $urls;        ${$self->{"crlurls"}}[$i] = $urls;
220        $i++;        $i++;
221      }      }
222    }    }
223    
224    # templates to construct a CA name may still have other separators    # templates to construct a CA name may still have other separators
225    $self->{"catemplate"} =~ s/[;\s]+/&/g;    $self->{"catemplate"} =~ s/[;\s]+/\001/g;
226    
227    # select only http/https/ftp/file URLs    # select only http/https/ftp/file URLs
228    # also transform the URLs using the base patterns and prepend any    # also transform the URLs using the base patterns and prepend any
229    # local URL patterns (@ANCHORNAME@, @ALIAS@, and @R@)    # local URL patterns (@ANCHORNAME@, @ALIAS@, and @R@)
230    for ( my $i=0; $i <= $#{$self->{"crlurls"}} ; $i++ ) {    for ( my $i=0; $i <= $#{$self->{"crlurls"}} ; $i++ ) {
231      my $urlstring = @{$self->{"crlurls"}}[$i];      my $urlstring = @{$self->{"crlurls"}}[$i];
232      my @urls = split(/&/,$urlstring);      my @urls = split(/\001/,$urlstring);
233      $urlstring="";      $urlstring="";
234      foreach my $url ( @urls ) {      foreach my $url ( @urls ) {
235        if ( $url =~ /^(http:|https:|ftp:|file:)/ ) {        if ( $url =~ /^(http:|https:|ftp:|file:)/ ) {
236          $urlstring.="&" if $urlstring; $urlstring.=$url;          $urlstring.="\001" if $urlstring; $urlstring.=$url;
237        } else {        } else {
238          $::log->verb(0,"URL $url in $basename$suffix unsupported, ignored");          $::log->verb(0,"URL $url in $basename$suffix unsupported, ignored");
239        }        }
240      }      }
241      if ( my $purl = $self->{"prepend_url"} ) {      if ( my $purl = $self->{"prepend_url"} ) {
242        $purl =~ s/\@R\@/$i/g;        $purl =~ s/\@R\@/$i/g;
243        $urlstring = join "&" , $purl , $urlstring;        $urlstring = join "\001" , $purl , $urlstring;
244      }      }
245      if ( my $purl = $self->{"postpend_url"} ) {      if ( my $purl = $self->{"postpend_url"} ) {
246        $purl =~ s/\@R\@/$i/g;        $purl =~ s/\@R\@/$i/g;
247        $urlstring = join "&" , $urlstring, $purl;        $urlstring = join "\001" , $urlstring, $purl;
248      }      }
249      if ( ! $urlstring ) {      if ( ! $urlstring ) {
250        $::log->err("No usable CRL URLs for",$self->getAnchorName);        $::log->err("No usable CRL URLs for",$self->getAnchorName);
# 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      foreach my $catpl ( split /&/, $self->{"catemplate"} ) {  
303        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 333  sub loadState($$) { Line 355  sub loadState($$) {
355             $::cnf->{_}->{"output_der"}, $::cnf->{_}->{"output_pem"},             $::cnf->{_}->{"output_der"}, $::cnf->{_}->{"output_pem"},
356             $::cnf->{_}->{"output_nss"}, $::cnf->{_}->{"output_openssl"}) ) {             $::cnf->{_}->{"output_nss"}, $::cnf->{_}->{"output_openssl"}) ) {
357          defined $output and $output or next;          defined $output and $output or next;
358          foreach my $file (          foreach my $ref (
359                $self->{"nametemplate_der"},                $self->{"nametemplate_der"},
360                $self->{"nametemplate_pem"},                $self->{"nametemplate_pem"},
361                $self->{"alias"}.".r\@R\@",                $self->{"alias"}.".r\@R\@",
362                $self->{"anchorname"}.".r\@R\@",                $self->{"anchorname"}.".r\@R\@",
363              ) {              ) {
364            next unless $file;            next unless $ref;
365              my $file = $ref; # copy, not to change original
366            $file =~ s/\@R\@/$i/g;            $file =~ s/\@R\@/$i/g;
367            $file = join "/", $output, $file;            $file = join "/", $output, $file;
368            next if ! -e $file;            next if ! -e $file;
# Line 412  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 432  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 462  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 {
502      local $SIG{ALRM}=sub{die "timed out after ".$self->{"httptimeout"}."s\n";};      local $SIG{ALRM}=sub{die "timed out after ".$self->{"httptimeout"}."s\n";};
503      alarm $self->{"httptimeout"};      alarm $self->{"httptimeout"};
504        $ua->parse_head(0);
505      $response = $ua->get($url);      $response = $ua->get($url);
506      alarm 0;      alarm 0;
507    };    };
# Line 545  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 562  sub retrieve($) { Line 599  sub retrieve($) {
599          "sourceurl" => $self->{"crl"}[$i]{"state"}{"sourceurl"} || "null:"          "sourceurl" => $self->{"crl"}[$i]{"state"}{"sourceurl"} || "null:"
600        );        );
601      } else {      } else {
602        foreach my $url ( split(/&/,$self->{"crlurls"}[$i]) ) {        foreach my $url ( split(/\001/,$self->{"crlurls"}[$i]) ) {
603          # of these, the first one wins          # of these, the first one wins
604          $url =~ /^(http:|https:|ftp:)/ and          $url =~ /^(http:|https:|ftp:)/ and
605            ($result,%response) = $self->retrieveHTTP($i,$url);            ($result,%response) = $self->retrieveHTTP($i,$url);
# Line 592  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 699  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 711  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.2188  
changed lines
  Added in v.3107

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