File Coverage

blib/lib/Plack/Middleware/ClientCert.pm

Criterion	Covered	Total	%
statement	33	35	94.2
branch	5	6	83.3
condition	3	7	42.8
subroutine	5	5	100.0
pod	1	2	50.0
total	47	55	85.4

package Plack::Middleware::ClientCert;
use strict;
use warnings;

use parent qw(Plack::Middleware);

our $VERSION = '0.100';

sub client_cert
 {
  my ($env) = @_;
  my %cert = ();
  my $prefix = 'client_';

  my $ssl_env = "SSL_CLIENT_S_DN";

  my $dn = $env->{ CERT_SUBJECT } || $env->{ $ssl_env } || '';

  #
  # If headers are passed in by a proxy, they are prefixed by HTTP_
  #
  if (!$dn && $env->{ "HTTP_$ssl_env" }) {
    $ssl_env = "HTTP_$ssl_env";
    $dn = $env->{ $ssl_env };
   }

  #
  # Apache on Linux does the parsing for us.  The parts to the DN are
  # all in SSL_CLIENT_S_DN_xx
  #
  my @keys = grep s/^${ssl_env}_(.*)/$1/, (keys %{ $env });
  if (@keys) {
    for my $key (@keys) {
      $env->{ $prefix . lc( $key ) } = $env->{ "${ssl_env}_${key}" };
     }
   }
  #
  # The DN can be delimited by commas or slashes (/).  Assume commas unless
  # the very first character is a slash.
  #
  elsif ($dn =~ /^\//) {
    # Iterate through the DN while there are still 'field=value' pairs
    while ($dn =~ /=/) {
      #
      # Match the leading slash, then the field name, equals sign,
      # and value.  Finally, match the next slash seperator or the
      # end of the line.
      #
      $dn =~ s/^\/(.*?)=(.*?)(\/|$)/$3/;
      $env->{ $prefix . lc( $1 ) } = $2;
     }
   }
  else {
    # Iterate through the DN while there are still 'field=value' pairs
    while ($dn =~ /=/) {
      #
      # The first match is the field.   Then match 0 or 1 quotation mark(s).
      # The third match is the value.  Match the closed quote (or nothing).
      # Finally, match the comma seperator and blank space, or the end
      #
      $dn =~ s/^(.*?)=(\"*)(.*?)\2(,\s*|$)//;
      $env->{ $prefix . lc( $1 ) } = $3;
     }
   }

  # Add serial number if appropriate
  my $serial_key = $ssl_env;
  $serial_key =~ s/S_DN/M_SERIAL/;

  $env->{ "${prefix}serial" } = $env->{ $serial_key } || '';

  return;

 } # End of client_cert()

sub call {
    my($self, $env) = @_;

    client_cert( $env );

    return $self->app->($env);
}

1;

__END__