sub parse_authres()

in lib/Mail/SpamAssassin/Plugin/AuthRes.pm [377:597]

• 193 lines of code
• 46 McCabe index (conditional complexity)

sub parse_authres {
  my ($self, $pms, $hdrname, $hdr) = @_;

  dbg("authres: parsing $hdrname: $hdr");

  my $authserv;
  my $version = 1;
  my @methods;
  my $arc_index;

  local $_ = $hdr;

  if ($hdrname =~ /^ARC-/i) {
    if (!/\Gi\b/gcs) {
      die("missing arc index: $hdr");
    }
    skip_cfws();
    if (!/\G=/gcs) {
      die("invalid arc index: ".substr($_, pos())."\n");
    }
    skip_cfws();
    if (!/\G(\d+)/gcs) {
      die("invalid arc index: ".substr($_, pos())."\n");
    }
    $arc_index = $1;
    if ($arc_index < 1 || $arc_index > 50) {
      die("invalid arc index: $arc_index\n");
    }
    skip_cfws();
    if (!/\G;/gcs) {
      die("missing delimiter: ".substr($_, pos())."\n");
    }
    skip_cfws();
  }

  # authserv-id
  if (!/\G($TOKEN)/gcs) {
    die("invalid authserv: ".substr($_, pos())."\n");
  }
  $authserv = lc($1);

  # some invalid headers start with spf=foo etc, missing authserv-id
  if (/\G=/gcs) {
    die("missing authserv: $hdr\n");
  }

  if (%{$pms->{conf}->{authres_trusted_authserv}}) {
    if (!$pms->{conf}->{authres_trusted_authserv}->{$authserv}) {
      die("authserv not trusted: $authserv\n");
    }
  }
  if ($pms->{conf}->{authres_ignored_authserv}->{$authserv}) {
    die("ignored authserv: $authserv\n");
  }

  # skip authserv version
  skip_cfws();
  if (/\G\d+/gcs) {
    skip_cfws();
  }

  if (!/\G;/gcs) {
    die("missing delimiter: ".substr($_, pos())."\n");
  }
  skip_cfws();

  while (pos() < length()) {
    my ($method, $result);
    my $reason = '';
    my $props = {};

    # some silly generators add duplicate authserv-id; here
    if (/\G\Q${authserv}\E\s*;/gcs) {
      skip_cfws();
    }

    # skip none method
    if (/\Gnone\b/igcs) {
      die("method none\n");
    }

    # method / version = result
    if (!/\G([\w-]+)/gcs) {
      die("invalid method: ".substr($_, pos())."\n");
    }
    $method = lc($1);
    if (!exists $method_result{$method}) {
      die("unknown method: $method: $hdr\n");
    }
    skip_cfws();
    if (/\G\//gcs) {
      skip_cfws();
      if (!/\G\d+/gcs) {
        die("invalid $method version: ".substr($_, pos())."\n");
      }
      $version = $1;
      skip_cfws();
    }
    if (!/\G=/gcs) {
      die("missing result for $method: ".substr($_, pos())."\n");
    }
    skip_cfws();
    if (!/\G(\w+)/gcs) {
      die("invalid result for $method: ".substr($_, pos())."\n");
    }
    $result = $1;
    if (!exists $method_result{$method}{$result}) {
      die("unknown result for $method: $result\n");
    }
    skip_cfws();

    # reason = value
    if (/\Greason\b/igcs) {
      skip_cfws();
      if (!/\G=/gcs) {
        die("invalid reason: ".substr($_, pos())."\n");
      }
      skip_cfws();
      if (!/\G$QUOTED_STRING|($TOKEN)/gcs) {
        die("invalid reason: ".substr($_, pos())."\n");
      }
      $reason = defined $1 ? $1 : $2;
      skip_cfws();
    }

    # action = value (some microsoft ARC stuff?)
    if (/\Gaction\b/igcs) {
      skip_cfws();
      if (!/\G=/gcs) {
        die("invalid action: ".substr($_, pos())."\n");
      }
      skip_cfws();
      if (!/\G$QUOTED_STRING|$TOKEN/gcs) {
        die("invalid action: ".substr($_, pos())."\n");
      }
      skip_cfws();
    }

    # ptype.property = value
    while (pos() < length()) {
      my ($ptype, $property, $value);

      # no props?
      if (/\G(?:;|$)/gcs) {
        skip_cfws();
        last;
      }

      # ptype
      if (!/\G([\w-]+)/gcs) {
        die("invalid ptype: ".substr($_,pos())."\n");
      }
      $ptype = lc($1);
      if (!exists $method_ptype_prop{$method}{$ptype}) {
        die("unknown ptype: $method/$ptype\n");
      }
      skip_cfws();

      # dot
      if (!/\G\./gcs) {
        die("missing property: ".substr($_, pos())."\n");
      }
      skip_cfws();

      # property
      if (!/\G([\w-]+)/gcs) {
        die("invalid property: ".substr($_, pos())."\n");
      }
      $property = lc($1);
      if (!exists $method_ptype_prop{$method}{$ptype}{$property} &&
          !exists $method_ptype_prop{$method}{$ptype}{'*'}) {
        die("unknown property for $method/$ptype: $property\n");
      }
      skip_cfws();

      # =
      if (!/\G=/gcs) {
        die("missing property value: ".substr($_, pos())."\n");
      }
      skip_cfws();

      # value:
      # The grammar is ( value / [ [ local-part ] "@" ] domain-name )
      # where value := token / quoted-string
      # and local-part := dot-atom / quoted-string / obs-local-part
      if (!/\G$QUOTED_STRING|($ATOM(?:\.$ATOM)*|$TOKEN)(?=(?:[\s;]|$))/gcs) {
        die("invalid $method/$ptype.$property value: ".substr($_, pos())."\n");
      }
      $value = defined $1 ? $1 : $2;
      skip_cfws();

      $props->{$ptype}->{$property} = $value;

      if (/\G(?:;|$)/gcs) {
        skip_cfws();
        last;
      }
    }

    push @methods, [$method, {
        'authserv' => $authserv,
        'version' => $version,
        'result' => $result,
        'reason' => $reason,
        'properties' => $props,
        'arc_index' => $arc_index,
        }];
  }

  # paranoid check..
  if (pos() < length()) {
    die("parse ended prematurely? ".substr($_, pos())."\n");
  }

  # Pushed to pms only if header parsed completely
  foreach my $marr (@methods) {
    push @{$pms->{authres_parsed}->{$marr->[0]}}, $marr->[1];
  }

  return 1;
}