Viktor Dukhovni:
> On Tue, Apr 07, 2020 at 11:46:33AM +0200, Michael Storz wrote:
> 
> > > I should perhaps mention that the "tlstype.pl" Perl script does not
> > > handle TLS connection re-use.  I've not looked at what it would take
> > > to do that.
> > 
> > And it does not work for mixed-case hostnames:
> > 
> > - TLS connection established to lower-case-hostname
> > - relay=mixed-case-hostname
> 
> Ah, thanks. Easily enough corrected, by wrapping Perl values in
> lc($value).  If you fix this and more issues, feel free to put it up on
> github somewhere...  I am not planning to become a "maintainer" of this
> off-the-cuff script.

Attached are an updated script, and a diff.

        Wietse
#! /usr/bin/env perl

use strict;
use warnings;

local $/ = "\n\n";

while (<>) {
    my $qid;
    my %tls;
    my $smtp;
    foreach my $line (split("\n")) {
        if ($line =~ m{ postfix(?:\S*?)/qmgr\[\d+\]: (\w+): from=<.*>, 
size=\d+, nrcpt=\d+ [(]queue active[)]$}) {
            $qid //= $1;
            next;
        }
        if ($line =~ m{ postfix(?:\S*?)/smtp\[(\d+)\]: (\S+) TLS connection 
established to (\S+): (.*)}) {
            $tls{$1}->{lc($3)} = [$2, $4];
            next;
        }
        if ($line =~ m{.*? postfix(?:\S*?)/smtp\[(\d+)\]: (\w+): (to=.*), 
relay=(\S+), (delay=\S+, delays=\S+, dsn=2\.\S+, status=sent .*)}) {
            next unless $qid eq $2;
            if (defined($tls{$1}->{lc($4)}) && ($tls{$1}->{lc($4)}->[2] //= $5) 
eq $5) {
                printf "qid=%s, relay=%s, %s -> %s %s\n", $qid, lc($4), $3, 
@{$tls{$1}->{lc($4)}}[0..1];
            } else {
                delete $tls{$1};
                printf "qid=%s, relay=%s, %s -> cleartext\n", $qid, lc($4), $3;
            }
        }
    }
}
--- tlstype.pl-posted   2020-04-07 18:13:50.000000000 -0400
+++ tlstype.pl  2020-04-07 18:59:44.000000000 -0400
@@ -15,16 +15,16 @@
            next;
        }
        if ($line =~ m{ postfix(?:\S*?)/smtp\[(\d+)\]: (\S+) TLS connection 
established to (\S+): (.*)}) {
-           $tls{$1}->{$3} = [$2, $4];
+           $tls{$1}->{lc($3)} = [$2, $4];
            next;
        }
        if ($line =~ m{.*? postfix(?:\S*?)/smtp\[(\d+)\]: (\w+): (to=.*), 
relay=(\S+), (delay=\S+, delays=\S+, dsn=2\.\S+, status=sent .*)}) {
            next unless $qid eq $2;
-           if (defined($tls{$1}->{$4}) && ($tls{$1}->{$4}->[2] //= $5) eq $5) {
-               printf "qid=%s, relay=%s, %s -> %s %s\n", $qid, $4, $3, 
@{$tls{$1}->{$4}}[0..1];
+           if (defined($tls{$1}->{lc($4)}) && ($tls{$1}->{lc($4)}->[2] //= $5) 
eq $5) {
+               printf "qid=%s, relay=%s, %s -> %s %s\n", $qid, lc($4), $3, 
@{$tls{$1}->{lc($4)}}[0..1];
            } else {
                delete $tls{$1};
-               printf "qid=%s, relay=%s, %s -> cleartext\n", $qid, $4, $3;
+               printf "qid=%s, relay=%s, %s -> cleartext\n", $qid, lc($4), $3;
            }
        }
     }

Reply via email to