diff options
Diffstat (limited to 'cert_valid.pl')
-rwxr-xr-x | cert_valid.pl | 210 |
1 files changed, 210 insertions, 0 deletions
diff --git a/cert_valid.pl b/cert_valid.pl new file mode 100755 index 0000000..41a1984 --- /dev/null +++ b/cert_valid.pl | |||
@@ -0,0 +1,210 @@ | |||
1 | #!/usr/bin/perl -w | ||
2 | # | ||
3 | # A dummy SSL certificate validator helper that | ||
4 | # echos back all the SSL errors sent by Squid. | ||
5 | # | ||
6 | |||
7 | use warnings; | ||
8 | use strict; | ||
9 | use Getopt::Long; | ||
10 | use Pod::Usage; | ||
11 | use Crypt::OpenSSL::X509; | ||
12 | use FileHandle; | ||
13 | use POSIX qw(strftime); | ||
14 | |||
15 | my $debug = 0; | ||
16 | my $help = 0; | ||
17 | |||
18 | =pod | ||
19 | |||
20 | =head1 NAME | ||
21 | |||
22 | cert_valid.pl - A fake cert validation helper for Squid | ||
23 | |||
24 | =head1 SYNOPSIS | ||
25 | |||
26 | cert_valid.pl [-d | --debug] [-h | --help] | ||
27 | |||
28 | =over 8 | ||
29 | |||
30 | =item B<-h | --help> | ||
31 | |||
32 | brief help message | ||
33 | |||
34 | =item B<-d | --debug> | ||
35 | |||
36 | enable debug messages to stderr | ||
37 | |||
38 | =back | ||
39 | |||
40 | =head1 DESCRIPTION | ||
41 | |||
42 | Retrieves the SSL certificate error list from squid and echo back without any change. | ||
43 | |||
44 | =head1 COPYRIGHT | ||
45 | |||
46 | (C) 2012 The Measurement Factory, Author: Tsantilas Christos | ||
47 | |||
48 | This program is free software. You may redistribute copies of it under the | ||
49 | terms of the GNU General Public License version 2, or (at your opinion) any | ||
50 | later version. | ||
51 | |||
52 | =cut | ||
53 | |||
54 | GetOptions( | ||
55 | 'help' => \$help, | ||
56 | 'debug' => \$debug, | ||
57 | ) or pod2usage(1); | ||
58 | |||
59 | pod2usage(1) if ($help); | ||
60 | |||
61 | $|=1; | ||
62 | while (<>) { | ||
63 | my $first_line = $_; | ||
64 | my @line_args = split; | ||
65 | |||
66 | if ($first_line =~ /^\s*$/) { | ||
67 | next; | ||
68 | } | ||
69 | |||
70 | my $response; | ||
71 | my $haserror = 0; | ||
72 | my $channelId = $line_args[0]; | ||
73 | my $code = $line_args[1]; | ||
74 | my $bodylen = $line_args[2]; | ||
75 | my $body = $line_args[3] . "\n"; | ||
76 | if ($channelId !~ /\d+/) { | ||
77 | $response = $channelId." BH message=\"This helper is concurrent and requires the concurrency option to be specified.\"\1"; | ||
78 | } elsif ($bodylen !~ /\d+/) { | ||
79 | $response = $channelId." BH message=\"cert validator request syntax error \" \1"; | ||
80 | } else { | ||
81 | my $readlen = length($body); | ||
82 | my %certs = (); | ||
83 | my %errors = (); | ||
84 | my @responseErrors = (); | ||
85 | |||
86 | while($readlen < $bodylen) { | ||
87 | my $t = <>; | ||
88 | if (defined $t) { | ||
89 | $body = $body . $t; | ||
90 | $readlen = length($body); | ||
91 | } | ||
92 | } | ||
93 | |||
94 | print(STDERR logPrefix()."GOT ". "Code=".$code." $bodylen \n") if ($debug); #.$body; | ||
95 | my $hostname; | ||
96 | parseRequest($body, \$hostname, \%errors, \%certs); | ||
97 | print(STDERR logPrefix()."Parse result: \n") if ($debug); | ||
98 | print(STDERR logPrefix()."\tFOUND host:".$hostname."\n") if ($debug); | ||
99 | print(STDERR logPrefix()."\tFOUND ERRORS:") if ($debug); | ||
100 | foreach my $err (keys %errors) { | ||
101 | print(STDERR logPrefix().$errors{$err}{"name"}."/".$errors{$err}{"cert"}." ,") if ($debug); | ||
102 | } | ||
103 | print(STDERR "\n") if ($debug); | ||
104 | foreach my $key (keys %certs) { | ||
105 | ## Use "perldoc Crypt::OpenSSL::X509" for X509 available methods. | ||
106 | print(STDERR logPrefix()."\tFOUND cert ".$key.": ".$certs{$key}->subject() . "\n") if ($debug); | ||
107 | } | ||
108 | |||
109 | #got the peer certificate ID. Assume that the peer certificate is the first one. | ||
110 | my $peerCertId = (keys %certs)[0]; | ||
111 | |||
112 | # Echo back the errors: fill the responseErrors array with the errors we read. | ||
113 | foreach my $err (keys %errors) { | ||
114 | $haserror = 1; | ||
115 | appendError (\@responseErrors, | ||
116 | $errors{$err}{"name"}, #The error name | ||
117 | "Checked by Cert Validator", # An error reason | ||
118 | $errors{$err}{"cert"} # The cert ID. We are always filling with the peer certificate. | ||
119 | ); | ||
120 | } | ||
121 | |||
122 | $response = createResponse(\@responseErrors); | ||
123 | my $len = length($response); | ||
124 | if ($haserror) { | ||
125 | $response = $channelId." ERR ".$len." ".$response."\1"; | ||
126 | } else { | ||
127 | $response = $channelId." OK ".$len." ".$response."\1"; | ||
128 | } | ||
129 | } | ||
130 | |||
131 | print $response; | ||
132 | print(STDERR logPrefix().">> ".$response."\n") if ($debug); | ||
133 | } | ||
134 | |||
135 | sub trim | ||
136 | { | ||
137 | my $s = shift; | ||
138 | $s =~ s/^\s+//; | ||
139 | $s =~ s/\s+$//; | ||
140 | return $s; | ||
141 | } | ||
142 | |||
143 | sub appendError | ||
144 | { | ||
145 | my ($errorArrays) = shift; | ||
146 | my($errorName) = shift; | ||
147 | my($errorReason) = shift; | ||
148 | my($errorCert) = shift; | ||
149 | push @$errorArrays, { "error_name" => $errorName, "error_reason" => $errorReason, "error_cert" => $errorCert}; | ||
150 | } | ||
151 | |||
152 | sub createResponse | ||
153 | { | ||
154 | my ($responseErrors) = shift; | ||
155 | my $response=""; | ||
156 | my $i = 0; | ||
157 | foreach my $err (@$responseErrors) { | ||
158 | $response=$response."error_name_".$i."=".$err->{"error_name"}."\n". | ||
159 | "error_reason_".$i."=".$err->{"error_reason"}."\n". | ||
160 | "error_cert_".$i."=".$err->{"error_cert"}."\n"; | ||
161 | $i++; | ||
162 | } | ||
163 | return $response; | ||
164 | } | ||
165 | |||
166 | sub parseRequest | ||
167 | { | ||
168 | my($request)=shift; | ||
169 | my $hostname = shift; | ||
170 | my $errors = shift; | ||
171 | my $certs = shift; | ||
172 | while ($request !~ /^\s*$/) { | ||
173 | $request = trim($request); | ||
174 | if ($request =~ /^host=/) { | ||
175 | my($vallen) = index($request, "\n"); | ||
176 | my $host = substr($request, 5, $vallen - 5); | ||
177 | $$hostname = $host; | ||
178 | $request =~ s/^host=.*$//m; | ||
179 | } | ||
180 | if ($request =~ /^cert_(\d+)=/) { | ||
181 | my $certId = "cert_".$1; | ||
182 | my($vallen) = index($request, "-----END CERTIFICATE-----") + length("-----END CERTIFICATE-----"); | ||
183 | my $x509 = Crypt::OpenSSL::X509->new_from_string(substr($request, index($request, "-----BEGIN"))); | ||
184 | $certs->{$certId} = $x509; | ||
185 | $request = substr($request, $vallen); | ||
186 | } | ||
187 | elsif ($request =~ /^error_name_(\d+)=(.*)$/m) { | ||
188 | my $errorId = $1; | ||
189 | my $errorName = $2; | ||
190 | $request =~ s/^error_name_\d+=.*$//m; | ||
191 | $errors->{$errorId}{"name"} = $errorName; | ||
192 | } | ||
193 | elsif ($request =~ /^error_cert_(\d+)=(.*)$/m) { | ||
194 | my $errorId = $1; | ||
195 | my $certId = $2; | ||
196 | $request =~ s/^error_cert_\d+=.*$//m; | ||
197 | $errors->{$errorId}{"cert"} = $certId; | ||
198 | } | ||
199 | else { | ||
200 | print(STDERR logPrefix()."ParseError on \"".$request."\"\n") if ($debug); | ||
201 | $request = "";# finish processing.... | ||
202 | } | ||
203 | } | ||
204 | } | ||
205 | |||
206 | |||
207 | sub logPrefix | ||
208 | { | ||
209 | return strftime("%Y/%m/%d %H:%M:%S.0", localtime)." ".$0." ".$$." | " ; | ||
210 | } | ||