Source Format Enforcement (#1234)

[thirdparty/squid.git] / src / security / cert_validators / fake / security_fake_certverify.pl.in

#!@PERL@

use warnings;
use strict;
use Getopt::Long;
use Pod::Usage;
use Crypt::OpenSSL::X509;
use FileHandle;
use POSIX qw(strftime);

my $debug = 0;
my $help = 0;

=pod

=head1 NAME

security_fake_certverify - A fake cert validation helper for Squid

=head1 SYNOPSIS

security_fake_certverify [-d | --debug] [-h | --help]

=head1 DESCRIPTION

Retrieves the SSL certificate error list from Squid and echo back without any change.

=head1 OPTIONS

=over 8

=item  B<-h | --help>

brief help message

=item B<-d | --debug>

enable debug messages to stderr

=back

=head1 AUTHOR

This program and documentation was written by
I<Christos Tsantilas <chtsanti@users.sourceforge.net>>

=head1 COPYRIGHT

 * Copyright (C) 1996-2023 The Squid Software Foundation and contributors
 *
 * Squid software is distributed under GPLv2+ license and includes
 * contributions from numerous individuals and organizations.
 * Please see the COPYING and CONTRIBUTORS files for details.

(C) 2012 The Measurement Factory, Author: Tsantilas Christos

This program is free software. You may redistribute copies of it under the
terms of the GNU General Public License version 2, or (at your opinion) any
later version.

=head1 QUESTIONS

Questions on the usage of this program can be sent to the I<Squid Users mailing list <squid-users@lists.squid-cache.org>>

=head1 REPORTING BUGS

Bug reports need to be made in English.
See http://wiki.squid-cache.org/SquidFaq/BugReporting for details of what you need to include with your bug report.

Report bugs or bug fixes using http://bugs.squid-cache.org/

Report serious security bugs to I<Squid Bugs <squid-bugs@lists.squid-cache.org>>

Report ideas for new improvements to the I<Squid Developers mailing list <squid-dev@lists.squid-cache.org>>

=head1 SEE ALSO

squid (8), GPL (7),

The Squid FAQ wiki http://wiki.squid-cache.org/SquidFaq

The Squid Configuration Manual http://www.squid-cache.org/Doc/config/

=cut

GetOptions(
    'help' => \$help,
    'debug' => \$debug,
    ) or pod2usage(1);

pod2usage(1) if ($help);

$|=1;
while (<>) {
    my $first_line = $_;
    my @line_args = split;

    if ($first_line =~ /^\s*$/) {
        next;
    }

    my $response;
    my $haserror = 0;
    my $channelId = $line_args[0];
    my $code = $line_args[1];
    my $bodylen = $line_args[2];
    my $body = $line_args[3] . "\n";
    if ($channelId !~ /\d+/) {
        $response = $channelId." BH message=\"This helper is  concurrent and requires the concurrency option to be specified.\"\1";
    } elsif ($bodylen !~ /\d+/) {
        $response = $channelId." BH message=\"cert validator request syntax error \" \1";
    } else {
        my $readlen = length($body);
        my %certs = ();
        my %errors = ();
        my @responseErrors = ();

        while($readlen < $bodylen) {
            my $t = <>;
            if (defined $t) {
                $body  = $body . $t;
                $readlen = length($body);
            }
        }

        print(STDERR logPrefix()."GOT ". "Code=".$code." $bodylen \n") if ($debug); #.$body;
        my $hostname;
        my $sslVersion = "-";
        my $sslCipher = "-";
        parseRequest($body, \$hostname, \$sslVersion, \$sslCipher, \%errors, \%certs);
        print(STDERR logPrefix()."Parse result: \n") if ($debug);
        print(STDERR logPrefix()."\tFOUND host:".$hostname."\n") if ($debug);
        print(STDERR logPrefix()."\tFOUND ssl version:".$sslVersion."\n") if ($debug);
        print(STDERR logPrefix()."\tFOUND ssl cipher:".$sslCipher."\n") if ($debug);
        print(STDERR logPrefix()."\tFOUND ERRORS:") if ($debug);
        foreach my $err (keys %errors) {
            print(STDERR logPrefix().$errors{$err}{"name"}."/".$errors{$err}{"cert"}." ,")  if ($debug);
        }
        print(STDERR "\n") if ($debug);
        foreach my $key (keys %certs) {
            ## Use "perldoc Crypt::OpenSSL::X509" for X509 available methods.
            print(STDERR logPrefix()."\tFOUND cert ".$key.": ".$certs{$key}->subject() . "\n") if ($debug);
        }

#got the peer certificate ID. Assume that the peer certificate is the first one.
        my $peerCertId = (keys %certs)[0];

 # Echo back the errors: fill the responseErrors array  with the errors we read.
        foreach my $err (keys %errors) {
            $haserror = 1;
            appendError (\@responseErrors,
                $errors{$err}{"name"}, #The error name
                "Checked by Cert Validator", # An error reason
                $errors{$err}{"cert"} # The cert ID. We are always filling with the peer certificate.
                );
        }

        $response = createResponse(\@responseErrors);
        my $len = length($response);
        if ($haserror) {
            $response = $channelId." ERR ".$len." ".$response."\1";
        } else {
            $response = $channelId." OK ".$len." ".$response."\1";
        }
    }

    print $response;
    print(STDERR logPrefix().">> ".$response."\n") if ($debug);
}

sub trim
{
    my $s = shift;
    $s =~ s/^\s+//;
    $s =~ s/\s+$//;
    return $s;
}

sub appendError
{
    my ($errorArrays) = shift;
    my($errorName) = shift;
    my($errorReason) = shift;
    my($errorCert) = shift;
    push @$errorArrays, { "error_name" => $errorName, "error_reason" => $errorReason, "error_cert" => $errorCert};
}

sub createResponse
{
    my ($responseErrors) = shift;
    my $response="";
    my $i = 0;
    foreach my $err (@$responseErrors) {
        $response=$response."error_name_".$i."=".$err->{"error_name"}."\n".
            "error_reason_".$i."=".$err->{"error_reason"}."\n".
            "error_cert_".$i."=".$err->{"error_cert"}."\n";
        $i++;
    }
    return $response;
}

sub parseRequest
{
    my($request)=shift;
    my $hostname = shift;
    my $sslVersion = shift;
    my $sslCipher = shift;
    my $errors = shift;
    my $certs = shift;
    while ($request !~ /^\s*$/) {
        $request = trim($request);
        if ($request =~ /^host=/) {
            my($vallen) = index($request, "\n");
            my $host = substr($request, 5, $vallen - 5);
            $$hostname = $host;
            $request =~ s/^host=.*$//m;
        }
        if ($request =~ s/^proto_version=(.*?)$//m) {
            $$sslVersion = $1;
        }
        if ($request =~ s/^cipher=(.*?)$//m) {
            $$sslCipher = $1;
        }
        if ($request =~ /^cert_(\d+)=/) {
            my $certId = "cert_".$1;
            my($vallen) = index($request, "-----END CERTIFICATE-----") + length("-----END CERTIFICATE-----");
            my $x509 = Crypt::OpenSSL::X509->new_from_string(substr($request, index($request, "-----BEGIN")));
            $certs->{$certId} = $x509;
            $request = substr($request, $vallen);
        }
        elsif ($request =~ /^error_name_(\d+)=(.*)$/m) {
            my $errorId = $1;
            my $errorName = $2;
            $request =~ s/^error_name_\d+=.*$//m;
            $errors->{$errorId}{"name"} = $errorName;
        }
        elsif ($request =~ /^error_cert_(\d+)=(.*)$/m) {
            my $errorId = $1;
            my $certId = $2;
            $request =~ s/^error_cert_\d+=.*$//m;
            $errors->{$errorId}{"cert"} = $certId;
        }
        else {
            print(STDERR logPrefix()."ParseError on \"".$request."\"\n") if ($debug);
            $request = "";# finish processing....
        }
    }
}


sub logPrefix
{
    return strftime("%Y/%m/%d %H:%M:%S.0", localtime)." ".$0." ".$$." | " ;
}