diff options
Diffstat (limited to '')
| -rw-r--r-- | util/.gitignore | 2 | ||||
| -rw-r--r-- | util/README | 40 | ||||
| -rwxr-xr-x | util/chunking_fixqueue_finalnewlines.pl | 160 | ||||
| -rwxr-xr-x | util/cramtest.pl | 60 | ||||
| -rw-r--r-- | util/gen_pkcs3.c | 267 | ||||
| -rwxr-xr-x | util/logargs.sh | 26 | ||||
| -rwxr-xr-x | util/mkcdb.pl | 93 | ||||
| -rwxr-xr-x | util/ocsp_fetch.pl | 84 | ||||
| -rw-r--r-- | util/proxy_protocol_client.pl | 251 | ||||
| -rw-r--r-- | util/ratelimit.pl | 159 | ||||
| -rwxr-xr-x | util/renew-opendmarc-tlds.sh | 128 | ||||
| -rwxr-xr-x | util/unknownuser.sh | 32 |
12 files changed, 1302 insertions, 0 deletions
diff --git a/util/.gitignore b/util/.gitignore new file mode 100644 index 0000000..5d49724 --- /dev/null +++ b/util/.gitignore @@ -0,0 +1,2 @@ +# Compiled programs: +gen_pkcs3 diff --git a/util/README b/util/README new file mode 100644 index 0000000..bff3378 --- /dev/null +++ b/util/README @@ -0,0 +1,40 @@ +The "util" directory in the Exim distribution +--------------------------------------------- + +This directory contains some small scripts that people have contributed which +may be useful to others. They are probably not usable immediately without at +least some minor editing. Take them as starting points. + +cramtest.pl +----------- + +A Perl script to help with debugging CRAM-MD5 authentication. + +logargs.sh +---------- + +A shell script to interpose between a caller and Exim, to find out what command +line arguments it is trying to use. + +mkcdb.pl +-------- + +A Perl script for a converting flat file into a format that is suitable for +processing by cdbmake into a cdb file. It has some advantages over the +cdbmake-12 awk script. + +ratelimit.pl +------------ + +A Perl script for computing peak sending rates from a log file. This is for +use with the ratelimit ACL condition, so that you can get some idea of what a +reasonable limit would be before deploying the feature. + +unknownuser.sh +-------------- + +This is historical, dating to the time when people tried to send back a helpful +message when an incoming message's recipient was unknown. It recalls a +different age... + +==== diff --git a/util/chunking_fixqueue_finalnewlines.pl b/util/chunking_fixqueue_finalnewlines.pl new file mode 100755 index 0000000..5dddfa5 --- /dev/null +++ b/util/chunking_fixqueue_finalnewlines.pl @@ -0,0 +1,160 @@ +#!/usr/bin/env perl + +use warnings; +use strict; +BEGIN { pop @INC if $INC[-1] eq '.' }; + +use Fcntl qw(:DEFAULT :flock :seek); +use File::Find; +use File::Spec; + +use constant MIN_AGE => 60; # seconds +my $exim = exists $ENV{'EXIM_BINARY'} ? $ENV{'EXIM_BINARY'} : 'exim'; + +my %known_okay = map {$_=>1} qw( linux darwin freebsd ); +unless (exists $known_okay{$^O}) { + warn "for ease, this perl uses flock, not fcntl, assuming they're the same\n"; + warn "this is not known by this author to be the case on $^O\n"; + warn "please investigate and either add to allowed-list in script, or rewrite\n"; + die "bailing out"; + + # Another approach to rewriting script: stop all exim receivers and + # queue-runners, prevent them from starting, then add your OS to the list and + # run, even though the locking type is wrong, relying upon not actually + # contending. +} + +my $spool_dir = `$exim -n -bP spool_directory`; +chomp $spool_dir; + +chdir(File::Spec->catfile($spool_dir, 'input')) + or die "chdir($spool_dir/input) failed: $!\n"; + +my $exim_msgid_r = qr/(?:[0-9A-Za-z]{6}-[0-9A-Za-z]{6}-[0-9A-Za-z]{2})/; +my $spool_dfile_r = qr/^(($exim_msgid_r)-D)\z/o; + +sub fh_ends_newline { + my ($fh, $dfn, $verbose) = @_; + seek($fh, -1, 2) or do { warn "seek(file($dfn)) failed: $!\n"; return -1 }; + my $count = read $fh, my $ch, 1; + if ($count == -1) { warn "failed to read last byte of $dfn\n"; return -1 }; + if ($count == 0) { warn "file shrunk by one?? problem with $dfn\n"; return -1 }; + if ($ch eq "\n") { print "okay!\n" if $verbose; return 1 } + print "PROBLEM: $dfn missing final newline (got $ch)\n" if $verbose; + return 0; +} + + +sub each_found_file { + return unless $_ =~ $spool_dfile_r; + my ($msgid, $dfn) = ($2, $1); + + # We should have already upgraded Exim before invoking us, thus any spool + # files will be old and we can reduce spending time trying to lock files + # still being written to, etc. + my @st = lstat($dfn) or return; + if ($^T - $st[9] < MIN_AGE) { return }; + -f "./${msgid}-H" || return; + + print "consider: $dfn\n"; + open(my $fh, '+<:raw', $dfn) or do { + warn "open($dfn) failed: $!\n"; + return; + }; + # return with a lexical FH in modern Perl should guarantee close, AIUI + + # we do our first check without a lock, so that we can scan past messages + # being handled by Exim quickly, and only lock up on those which Exim is + # trying and failing to deliver. However, since Exim will be hung on remote + # hosts, this is likely. Thus best to kill queue-runners first. + + return if fh_ends_newline($fh, $dfn, 0); # also returns on error + print "Problem? $msgid probably missing newline, locking to be sure ...\n"; + flock($fh, LOCK_EX) or do { warn "flock(file($dfn)) failed: $!\n"; return }; + return if fh_ends_newline($fh, $dfn, 1); # also returns on error + + fixup_message($msgid, $dfn, $fh); + + close($fh) or warn "close($dfn) failed: $!\n"; +}; + +sub fixup_message { + my ($msgid, $dfn, $fh) = @_; + # we can't freeze the message, our lock stops that, which is good! + + seek($fh, 0, 2) or do { warn "seek(file($dfn)) failed: $!\n"; return -1 }; + + my $r = inc_message_header_linecount($msgid); + if ($r < 0) { + warn "failed to fix message headers in ${msgid}-H so not editing message\n"; + return; + } + + print {$fh} "\n"; + + print "${msgid}: added newline\n"; +}; + +sub inc_message_header_linecount { + my ($msgid) = @_; + my $name_in = "${msgid}-H"; + my $name_out = "${msgid}-chunkfix"; + + open(my $in, '<:perlio', $name_in) or do { warn "open(${name_in}) failed: $!\n"; return -1 }; + open(my $out, '>:perlio', $name_out) or do { warn "write-open(${name_out}) failed: $!\n"; return -1 }; + my $seen = 0; + my $lc; + foreach (<$in>) { + if ($seen) { + print {$out} $_; + next; + } + if (/^(-body_linecount\s+)(\d+)(\s*)$/) { + $lc = $2 + 1; + print {$out} "${1}${lc}${3}"; + $seen = 1; + next; + } + print {$out} $_; + } + close($in) or do { + warn "read-close(${msgid}-H) failed, assuming incomplete: $!\n"; + close($out); + unlink $name_out; + return -1; + }; + close($out) or do { + warn "write-close(${msgid}-chunkfix) failed, aborting: $!\n"; + unlink $name_out; + return -1; + }; + + my @target = stat($name_in) or do { warn "stat($name_in) failed: $!\n"; unlink $name_out; return -1 }; + my @created = stat($name_out) or do { warn "stat($name_out) failed: $!\n"; unlink $name_out; return -1 }; + # 4=uid, 5=gid, 2=mode + if (($created[5] != $target[5]) or ($created[4] != $target[4])) { + chown $target[4], $target[5], $name_out or do { + warn "chown($name_out) failed: $!\n"; + unlink $name_out; + return -1; + }; + } + if (($created[2]&07777) != ($target[2]&0x7777)) { + chmod $target[2]&0x7777, $name_out or do { + warn "chmod($name_out) failed: $!\n"; + unlink $name_out; + return -1; + }; + } + + rename $name_out, $name_in or do { + warn "rename '${msgid}-chunkfix' -> '${msgid}-H' failed: $!\n"; + unlink $name_out; + return -1; + }; + + print "${msgid}: linecount set to $lc\n"; + return 1; +} + +find({wanted => \&each_found_file}, '.'); diff --git a/util/cramtest.pl b/util/cramtest.pl new file mode 100755 index 0000000..48f989a --- /dev/null +++ b/util/cramtest.pl @@ -0,0 +1,60 @@ +#!/usr/bin/perl + +# This script is contributed by Vadim Vygonets to aid in debugging CRAM-MD5 +# authentication. + +# A patch was contributed by Jon Warbrick to upgrade it to use the Digest::MD5 +# module instead of the deprecated MD5 module. + +# The script prompts for three data values: a user name, a password, and the +# challenge as sent out by an SMTP server. The challenge is a base-64 string. +# It should be copied (cut-and-pasted) literally as the third data item. The +# output of the program is the base-64 string that is to be returned as the +# response to the challenge. Using the example in RFC 2195: +# +# User: tim +# Password: tanstaaftanstaaf +# Challenge: PDE4OTYuNjk3MTcwOTUyQHBvc3RvZmZpY2UucmVzdG9uLm1jaS5uZXQ+ +# dGltIGI5MTNhNjAyYzdlZGE3YTQ5NWI0ZTZlNzMzNGQzODkw +# +# The last line is what you you would send back to the server. + + +# Copyright (c) 2002 +# Vadim Vygonets <vadik-exim@vygo.net>. All rights reserved. +# Public domain is OK with me. + +BEGIN { pop @INC if $INC[-1] eq '.' }; + +use MIME::Base64; +use Digest::MD5; + +print "User: "; +chop($user = <>); +print "Password: "; +chop($passwd = <>); +print "Challenge: "; +chop($chal = <>); +$chal =~ s/^334 //; + +$context = new Digest::MD5; +if (length($passwd) > 64) { + $context->add($passwd); + $passwd = $context->digest(); + $context->reset(); +} + +@passwd = unpack("C*", pack("a64", $passwd)); +for ($i = 0; $i < 64; $i++) { + $pass_ipad[$i] = $passwd[$i] ^ 0x36; + $pass_opad[$i] = $passwd[$i] ^ 0x5C; +} +$context->add(pack("C64", @pass_ipad), decode_base64($chal)); +$digest = $context->digest(); +$context->reset(); +$context->add(pack("C64", @pass_opad), $digest); +$digest = $context->digest(); + +print encode_base64($user . " " . unpack("H*", $digest)); + +# End diff --git a/util/gen_pkcs3.c b/util/gen_pkcs3.c new file mode 100644 index 0000000..5c4e429 --- /dev/null +++ b/util/gen_pkcs3.c @@ -0,0 +1,267 @@ +/* Copyright (C) 2012,2016 Phil Pennock. + * This is distributed as part of Exim and licensed under the GPL. + * See the file "NOTICE" for more details. + */ + +/* Build with: + * c99 $(pkg-config --cflags openssl) gen_pkcs3.c $(pkg-config --libs openssl) + */ + +/* + * Rationale: + * The Diffie-Hellman primes which are embedded into Exim as named primes for + * the tls_dhparam option are in the std-crypto.c file. The source for those + * comes from various RFCs, where they are given in hexadecimal form. + * + * This tool provides convenient conversion, to reduce the risk of human + * error in transcription. + */ + +#include <ctype.h> +#include <errno.h> +#include <stdbool.h> +#include <stdio.h> +#include <stdlib.h> +#include <string.h> +#include <unistd.h> + +#include <openssl/bio.h> +#include <openssl/bn.h> +#include <openssl/dh.h> +#include <openssl/err.h> +#include <openssl/pem.h> + +extern const char *__progname; + + +void __attribute__((__noreturn__)) __attribute__((__format__(printf, 1, 2))) +die(const char *fmt, ...) +{ + va_list ap; + + fflush(NULL); + fprintf(stderr, "%s: ", __progname); + va_start(ap, fmt); + vfprintf(stderr, fmt, ap); + va_end(ap); + fprintf(stderr, "\n"); + fflush(stderr); + exit(1); +} + + +void __attribute__((__noreturn__)) +die_openssl_err(const char *msg) +{ + char err_string[250]; + + ERR_error_string_n(ERR_get_error(), err_string, sizeof(err_string)); + die("%s: %s", msg, err_string); +} + + +static BIGNUM * +bn_from_text(const char *text) +{ + BIGNUM *b; + char *p, *spaceless; + const char *q, *end; + size_t len; + int rc; + + len = strlen(text); + spaceless = malloc(len + 1); + if (!spaceless) + die("malloc(%zu) failed: %s", len + 1, strerror(errno)); + + for (p = spaceless, q = text, end = text + len; + q < end; + ++q) { + if (!isspace(*q)) + *p++ = *q; + } + len = p - spaceless; + *p++ = '\0'; + + b = NULL; + rc = BN_hex2bn(&b, spaceless); + + if (rc != (int)len) + die("BN_hex2bn did not convert entire input; took %d of %zu bytes", + rc, len); + + return b; +} + + +static void +our_dh_check(DH *dh) +{ + int rc, errflags = 0; + + rc = DH_check(dh, &errflags); + if (!rc) die_openssl_err("DH_check() could not be performed");; + + /* We ignore DH_UNABLE_TO_CHECK_GENERATOR because some of the invocations + * deliberately provide generators other than 2 or 5. */ + + if (errflags & DH_CHECK_P_NOT_SAFE_PRIME) + die("DH_check(): p not a safe prime"); + if (errflags & DH_NOT_SUITABLE_GENERATOR) + die("DH_check(): g not suitable as generator"); +} + + +static void +emit_c_format_dh(FILE *stream, DH *dh) +{ + BIO *bio; + long length; + char *data, *end, *p, *nl; + + bio = BIO_new(BIO_s_mem()); + PEM_write_bio_DHparams(bio, dh); + length = BIO_get_mem_data(bio, &data); + if (!length) + die("no data in memory BIO to format for printing"); + if (length < 0) + die("grr, negative length memory not supported"); + end = data + length; + + for (p = data; p < end; /**/) { + nl = strchr(p, '\n'); + if (!nl) { + fprintf(stream, "\"%s\\n\"\n/* missing final newline */\n", p); + break; + } + *nl = '\0'; + fprintf(stream, "\"%s\\n\"%s\n", p, (nl == end - 1 ? ";" : "")); + p = nl + 1; + } +} + + +void __attribute__((__noreturn__)) +usage(FILE *stream, int exitcode) +{ + fprintf(stream, "Usage: %s [-CPcst] <dh_p> <dh_g> [<dh_q>]\n" +"Both dh_p and dh_g should be hex strings representing the numbers\n" +"The same applies to the optional dh_q (prime-order subgroup).\n" +"They may contain whitespace.\n" +"Older values, dh_g is often just '2', not a long string.\n" +"\n" +" -C show C string form of PEM result\n" +" -P do not show PEM\n" +" -c run OpenSSL DH_check() on the DH object\n" +" -s show the parsed p and g\n" +" -t show text form of certificate\n" + + , __progname); + exit(exitcode); +} + + +int +main(int argc, char *argv[]) +{ + BIGNUM *p, *g, *q; + DH *dh; + int ch; + bool perform_dh_check = false; + bool show_c_form = false; + bool show_numbers = false; + bool show_pem = true; + bool show_text = false; + bool given_q = false; + + while ((ch = getopt(argc, argv, "CPcsth")) != -1) { + switch (ch) { + case 'C': + show_c_form = true; + break; + case 'P': + show_pem = false; + break; + case 'c': + perform_dh_check = true; + break; + case 's': + show_numbers = true; + break; + case 't': + show_text = true; + break; + + case 'h': + usage(stdout, 0); + case '?': + die("Unknown option or missing argument -%c", optopt); + default: + die("Unhandled option -%c", ch); + } + } + + optind -= 1; + argc -= optind; + argv += optind; + + if ((argc < 3) || (argc > 4)) { + fprintf(stderr, "argc: %d\n", argc); + usage(stderr, 1); + } + + // If we use DH_set0_pqg instead of setting dh fields directly; the q value + // is optional and may be NULL. + // Just blank them all. + p = g = q = NULL; + + p = bn_from_text(argv[1]); + g = bn_from_text(argv[2]); + if (argc >= 4) { + q = bn_from_text(argv[3]); + given_q = true; + } + + if (show_numbers) { + printf("p = "); + BN_print_fp(stdout, p); + printf("\ng = "); + BN_print_fp(stdout, g); + if (given_q) { + printf("\nq = "); + BN_print_fp(stdout, q); + } + printf("\n"); + } + + dh = DH_new(); + // The documented method for setting q appeared in OpenSSL 1.1.0. +#if OPENSSL_VERSION_NUMBER >= 0x1010000f + // NULL okay for q; yes, the optional value is in the middle. + if (DH_set0_pqg(dh, p, q, g) != 1) { + die_openssl_err("initialising DH pqg values failed"); + } +#else + dh->p = p; + dh->g = g; + if (given_q) { + dh->q = q; + } +#endif + + if (perform_dh_check) + our_dh_check(dh); + + if (show_text) + DHparams_print_fp(stdout, dh); + + if (show_pem) { + if (show_c_form) + emit_c_format_dh(stdout, dh); + else + PEM_write_DHparams(stdout, dh); + } + + DH_free(dh); /* should free p,g (& q if non-NULL) too */ + return 0; +} diff --git a/util/logargs.sh b/util/logargs.sh new file mode 100755 index 0000000..87369a6 --- /dev/null +++ b/util/logargs.sh @@ -0,0 +1,26 @@ +#! /bin/sh + +# This script can be interposed between a calling program and another +# program, in order to log the arguments which are being used. This can +# be helpful in finding out what is going on if some program is calling +# Exim with arguments it doesn't understand. + +# Set this to the the path of the program that must ultimately be called. + +CALL=exim + +# Set this to the name of the file where the data is to be logged. The +# script writes on the end of it. It must be accessible to the user who +# runs the script. + +LOGFILE=/home/ph10/tmp/zz + +# The arguments are copied to the log file + +echo $@ >>$LOGFILE + +# The real program is now called + +exec $CALL $@ + +# End diff --git a/util/mkcdb.pl b/util/mkcdb.pl new file mode 100755 index 0000000..691849d --- /dev/null +++ b/util/mkcdb.pl @@ -0,0 +1,93 @@ +#!/usr/bin/perl -wT +# +# Create cdb file from flat alias file. DPC: 15/10/98. +# Args: source (may be relative or absolute) +# target (may be relative or absolute. Default = source) +# Generates: target.cdb +# target.tmp +# +# Little Perl script to convert flat file into CDB file. Two advantages over +# cdbmake-12 awk script that is distributed with CDB: +# 1) Handles 'dpc22:dpc22@hermes' as well as 'dpc22 dpc22@hermes' +# 2) Perl works with arbitrary length strings: awk chokes at 1,024 chars +# +# Cambridge: hermes/src/admin/mkcdb,v 1.9 2005/02/15 18:14:12 fanf2 Exp + +use strict; + +BEGIN { pop @INC if $INC[-1] eq '.' }; +$ENV{'PATH'} = ""; +umask(022); + +my $CDB = '/opt/cdb/bin/cdbmake'; + +my $prog = $0; +$prog =~ s|(.*/)?([^/]+)|$2|; + +my $source; +my $target; +if (@ARGV == 1) { + $source = shift(@ARGV); + $target = $source; +} elsif (@ARGV == 2) { + $source = shift(@ARGV); + $target = shift(@ARGV); +} else { + die("$prog: usage: <source> [<target>]\n"); +} +# trust the invoker ?! +$source =~ /(.*)/; +$source = $1; +$target =~ /(.*)/; +$target = $1; + +open(SOURCE, "< ${source}") + or die("$prog: open < $source: $!\n"); + +open(PIPE, "| $CDB $target.cdb $target.tmp") + or die("$prog: open | $CDB $target: $!\n"); + +sub add_item ($$) { + my $key = shift; + my $val = shift; + printf PIPE ("+%d,%d:%s->%s\n", length($key), length($val), $key, $val); +} + +sub add_line ($) { + my $line = shift; + if ($line =~ /^([^\s:]+)\s*:\s*(.*)$/s) { # key : values + add_item($1,$2); + return; + } + if ($line =~ /^(\S+)\s+(.*)$/s) { # key: values + add_item($1,$2); + return; + } + if ($line =~ /^(\S+)$/s) { # key (empty value) + add_item($1,''); + return; + } + warn "$prog: unrecognized item: $line"; +} + +my $data; +while(<SOURCE>) { + next if /^#/ or /^\s*$/; + m/^(\s*)(\S.*)\s+$/s; + if (length($1) == 0) { + add_line($data) if defined $data; + $data = $2; + } else { + $data .= " $2"; + } +} +add_line($data) if defined $data; +print PIPE "\n"; + +close(SOURCE) + or die("$prog: close < $source: $!\n"); +close(PIPE) + or die($! ? "$prog: close | $CDB $target: $!\n" + : "$prog: close | $CDB $target: exited $?\n"); + +exit 0; diff --git a/util/ocsp_fetch.pl b/util/ocsp_fetch.pl new file mode 100755 index 0000000..08ca4cb --- /dev/null +++ b/util/ocsp_fetch.pl @@ -0,0 +1,84 @@ +#!/usr/bin/perl +# Copyright (C) 2012 Wizards Internet Ltd +# License GPLv2: GNU GPL version 2 <http://www.gnu.org/licenses/old-licenses/gpl-2.0.html> +use strict; +BEGIN { pop @INC if $INC[-1] eq '.' }; +use Getopt::Std; +$Getopt::Std::STANDARD_HELP_VERSION=1; +use IO::Handle; +use Date::Parse; +my ($o,$i,$s,$f,$t,$u,$VERSION); +$VERSION='1.0'; +$o={'m'=>10}; +getopts("c:i:u:a:o:m:fv",$o); +usage('No issuer specified') if ! $o->{'i'} && ! -f $o->{'i'}; +usage('No certificate specified') if ! $o->{'c'} && ! -f $o->{'c'}; +usage('No CA chain specified') if ! $o->{'a'} && ! -f $o->{'a'}; +usage('No OCSP file specified') if ! $o->{'o'}; +usage('No URL specified') if ! $o->{'u'}; +$o->{'t'}=$o->{'o'}.'.tmp'; + +# check if we need to +if ( $o->{'f'} + || ! -f $o->{'o'} + || ( -M $o->{'o'} > 0 ) + ) +{ + $i = new IO::Handle; + open( $i, "openssl ocsp -issuer $o->{'i'} -cert $o->{'c'} -url $o->{'u'} -CAfile $o->{'a'} -respout $o->{'t'} 2>/dev/null |" ) || die 'Unable to execute ocsp command'; + $s = <$i> || die 'Unable to read status'; + $f = <$i> || die 'Unable to read update time'; + $t = <$i> || die 'Unable to read next update time'; + close $i; + # Status ok ? + chomp($s); + chomp($f); + chomp($t); + $s =~ s/[^:]*: //; + $f =~ s/[^:]*: //; + $t =~ s/[^:]*: //; + $t = str2time($t); + die "OCSP status is $s" if $s ne 'good'; + warn "Next Update $t" if $o->{'v'}; + # response is good, adjust mod time and move into place. + $u = $t - $o->{'m'} * (($t - time)/100); + utime $u,$u,$o->{'t'}; + rename $o->{'t'},$o->{'o'}; +} +exit; + +sub +usage +{ + my $m = shift; + print STDERR "$m\n" if $m; + HELP_MESSAGE(\*STDERR); + die; +} +sub +HELP_MESSAGE +{ + my $h = shift; + print $h <<EOF +Usage: $0 -i issuer -c certificate -u ocsp_url -a ca_certs -o response [-v] [-f] + +For a certificate "www.example.com.pem" + signed by "signing.example.net.pem" + signed by root CA "ca.example.net.pem" + with OCSP server http://ocsp.example.net/ + +Ensure there is a file with the signing chain + + cat ca.example.net.pem signing.example.net.pem >chain.pem + +The update procedure would be + + ocsp_fetch -i signing.example.net.pem \ + -c www.example.com.pem \ + -u http://ocsp.example.net/ \ + -a chain.pem \ + -o www.example.com.ocsp.der +EOF +} +# vi: aw ai sw=4 +# End of File diff --git a/util/proxy_protocol_client.pl b/util/proxy_protocol_client.pl new file mode 100644 index 0000000..67a171d --- /dev/null +++ b/util/proxy_protocol_client.pl @@ -0,0 +1,251 @@ +#!/usr/bin/perl +# +# Copyright (C) 2014 Todd Lyons +# License GPLv2: GNU GPL version 2 +# <http://www.gnu.org/licenses/old-licenses/gpl-2.0.html> +# +# This script emulates a proxy which uses Proxy Protocol to communicate +# to a backend server. It should be run from an IP which is configured +# to be a Proxy Protocol connection (or not, if you are testing error +# scenarios) because Proxy Protocol specs require not to fall back to a +# non-proxied mode. +# +# The script is interactive, so when you run it, you are expected to +# perform whatever conversation is required for the protocol being +# tested. It uses STDIN/STDOUT, so you can also pipe output to/from the +# script. It was originally written to test Exim's Proxy Protocol +# code, and it could be tested like this: +# +# swaks --pipe 'perl proxy_protocol_client.pl --server-ip +# host.internal.lan' --from user@example.com --to user@example.net +# +use strict; +use warnings; +BEGIN { pop @INC if $INC[-1] eq '.' }; +use IO::Select; +use IO::Socket; +use Getopt::Long; +use Data::Dumper; + +my %opts; +GetOptions( \%opts, + 'help', + '6|ipv6', + 'dest-ip:s', + 'dest-port:i', + 'source-ip:s', + 'source-port:i', + 'server-ip:s', + 'server-port:i', + 'version:i' +); +&usage() if ($opts{help} || !$opts{'server-ip'}); + +my ($dest_ip,$source_ip,$dest_port,$source_port); +my %socket_map; +my $status_line = "Testing Proxy Protocol Version " . + ($opts{version} ? $opts{version} : '2') . + ":\n"; + +# All ip's and ports are in network byte order in version 2 mode, but are +# simple strings when in version 1 mode. The binary_pack_*() functions +# return the required data for the Proxy Protocol version being used. + +# Use provided source or fall back to www.mrball.net +$source_ip = $opts{'source-ip'} ? binary_pack_ip($opts{'source-ip'}) : + $opts{6} ? + binary_pack_ip("2001:470:d:367::50") : + binary_pack_ip("208.89.139.252"); +$source_port = $opts{'source-port'} ? + binary_pack_port($opts{'source-port'}) : + binary_pack_port(43118); + +$status_line .= "-> " if (!$opts{version} || $opts{version} == 2); + +# Use provided dest or fall back to mail.exim.org +$dest_ip = $opts{'dest-ip'} ? binary_pack_ip($opts{'dest-ip'}) : + $opts{6} ? + binary_pack_ip("2001:630:212:8:204:23ff:fed6:b664") : + binary_pack_ip("131.111.8.192"); +$dest_port = $opts{'dest-port'} ? + binary_pack_port($opts{'dest-port'}) : + binary_pack_port(25); + +# The IP and port of the Proxy Protocol backend real server being tested, +# don't binary pack it. +my $server_ip = $opts{'server-ip'}; +my $server_port = $opts{'server-port'} ? $opts{'server-port'} : 25; + +my $s = IO::Select->new(); # for socket polling + +sub generate_preamble { + my @preamble; + if (!$opts{version} || $opts{version} == 2) { + @preamble = ( + "\x0D\x0A\x0D\x0A\x00\x0D\x0A\x51\x55\x49\x54\x0A", # 12 byte v2 header + "\x21", # top 4 bits declares v2 + # bottom 4 bits is command + $opts{6} ? "\x21" : "\x11", # inet6/4 and TCP (stream) + $opts{6} ? "\x00\x24" : "\x00\x0b", # 36 bytes / 12 bytes + $source_ip, + $dest_ip, + $source_port, + $dest_port + ); + } + else { + @preamble = ( + "PROXY", " ", # Request proxy mode + $opts{6} ? "TCP6" : "TCP4", " ", # inet6/4 and TCP (stream) + $source_ip, " ", + $dest_ip, " ", + $source_port, " ", + $dest_port, + "\x0d\x0a" + ); + $status_line .= join "", @preamble; + } + print "\n", $status_line, "\n"; + print "\n" if (!$opts{version} || $opts{version} == 2); + return @preamble; +} + +sub binary_pack_port { + my $port = shift(); + if ($opts{version} && $opts{version} == 1) { + return $port + if ($port && $port =~ /^\d+$/ && $port > 0 && $port < 65536); + die "Not a valid port: $port"; + } + $status_line .= $port." "; + $port = pack "S", $port; + return $port; +} + +sub binary_pack_ip { + my $ip = shift(); + if ( $ip =~ m/\./ && !$opts{6}) { + if (IP4_valid($ip)) { + return $ip if ($opts{version} && $opts{version} == 1); + $status_line .= $ip.":"; + $ip = pack "C*", split /\./, $ip; + } + else { die "Invalid IPv4: $ip"; } + } + elsif ($ip =~ m/:/ && $opts{6}) { + $ip = pad_ipv6($ip); + if (IP6_valid($ip)) { + return $ip if ($opts{version} && $opts{version} == 1); + $status_line .= $ip.":"; + $ip = pack "S>*", map hex, split /:/, $ip; + } + else { die "Invalid IPv6: $ip"; } + } + else { die "Mismatching IP families passed: $ip"; } + return $ip; +} + +sub pad_ipv6 { + my $ip = shift(); + my @ip = split /:/, $ip; + my $segments = scalar @ip; + return $ip if ($segments == 8); + $ip = ""; + for (my $count=1; $count <= $segments; $count++) { + my $block = $ip[$count-1]; + if ($block) { + $ip .= $block; + $ip .= ":" unless $count == $segments; + } + elsif ($count == 1) { + # Somebody passed us ::1, fix it, but it's not really valid + $ip = "0:"; + } + else { + $ip .= join ":", map "0", 0..(8-$segments); + $ip .= ":"; + } + } + return $ip; +} + +sub IP6_valid { + my $ip = shift; + $ip = lc($ip); + return 0 unless ($ip =~ /^[0-9a-f:]+$/); + my @ip = split /:/, $ip; + return 0 if (scalar @ip != 8); + return 1; +} + +sub IP4_valid { + my $ip = shift; + $ip =~ /^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/; + foreach ($1,$2,$3,$4){ + if ($_ <256 && $_ >0) {next;} + return 0; + } + return 1; +} + +sub go_interactive { + my $continue = 1; + while($continue) { + # Check for input on both ends, recheck every 5 sec + for my $socket ($s->can_read(5)) { + my $remote = $socket_map{$socket}; + my $buffer; + my $read = $socket->sysread($buffer, 4096); + if ($read) { + $remote->syswrite($buffer); + } + else { + $continue = 0; + } + } + } +} + +sub connect_stdin_to_proxy { + my $sock = new IO::Socket::INET( + PeerAddr => $server_ip, + PeerPort => $server_port, + Proto => 'tcp' + ); + + die "Could not create socket: $!\n" unless $sock; + # Add sockets to the Select group + $s->add(\*STDIN); + $s->add($sock); + # Tie the sockets together using this hash + $socket_map{\*STDIN} = $sock; + $socket_map{$sock} = \*STDOUT; + return $sock; +} + +sub usage { + chomp(my $prog = `basename $0`); + print <<EOF; +Usage: $prog [required] [optional] + Required: + --server-ip IP of server to test proxy configuration, + a hostname is ok, but for only this setting + Optional: + --server-port Port server is listening on (default 25) + --6 IPv6 source/dest (default IPv4), if none specified, + some default, reverse resolvable IP's are used for + the source and dest ip/port + --dest-ip Public IP of the proxy server + --dest-port Port of public IP of proxy server + --source-ip IP connecting to the proxy server + --source-port Port of IP connecting to the proxy server + --help This output +EOF + exit; +} + + +my $sock = connect_stdin_to_proxy(); +my @preamble = generate_preamble(); +print $sock @preamble; +go_interactive(); diff --git a/util/ratelimit.pl b/util/ratelimit.pl new file mode 100644 index 0000000..e212fa2 --- /dev/null +++ b/util/ratelimit.pl @@ -0,0 +1,159 @@ +#!/usr/bin/perl -wT + +use strict; + +BEGIN { pop @INC if $INC[-1] eq '.' }; + +sub usage () { + print <<END; +usage: ratelimit.pl [options] <period> <regex> <logfile> + +The aim of this script is to compute clients' peak sending rates +from an Exim log file, using the same formula as Exim's ratelimit +ACL condition. This is so that you can get an idea of a reasonable +limit setting before you deploy the restrictions. + +options: + +-d Show debugging information to stderr +-p Show progress of parse the log to stderr + +<period> The smoothing period in seconds, as defined by the + documentation for the ratelimit ACL condition. + + This script isn't perfectly accurate, because the time + stamps in Exim's log files are only accurate to a second + whereas internally Exim computes sender rates to the + accuracy of your computer's clock (typically 10ms). + +<regex> The second argument is a regular expression. + + Each line is matched against the regular expression. + Lines that do not match are ignored. The regex may + contain 0, 1, or 2 () capturing sub-expressions. + + If there are no () sub-expressions, then every line that + matches is used to compute a single rate. Its maximum + value is reported when the script finishes. + + If there is one () sub-expression, then the text matched + by the sub-expression is used to identify a rate lookup + key, similar to the lookup key used by the ratelimit + ACL condition. For example, you might write a regex + to match the client IP address, or the authenticated + username. Separate rates are computed for each different + client and the maximum rate for each client is reported + when the script finishes. + + If there are two () sub-expressions, then the text matched + by the first sub-expression is used to identify a rate + lookup key as above, and the second is used to match the + message size recorded in the log line, e.g. "S=(\\d+)". + In this case the byte rate is computed instead of the + message rate, similar to the per_byte option of the + ratelimit ACL condition. + +<logfile> The log files to be processed can be specified on the + command line after the other arguments; if no filenames + are specified the script will read from stdin. + +examples: + +./ratelimit.pl 1 ' <= .*? \[(.*?)\]' <logfile> + + Compute burst sending rate like ACL condition + ratelimit = 0 / 1s / strict / \$sender_host_address + +./ratelimit.pl 3600 '<= (.*?) ' <logfile> + + Compute sending rate like ACL condition + ratelimit = 0 / 1h / strict / \$sender_address + +END + exit 1; +} + +sub iso2unix (@) { + my ($y,$m,$d,$H,$M,$S,$zs,$zh,$zm) = @_; + use integer; + $y -= $m < 3; + $m += $m < 3 ? 10 : -2; + my $z = defined $zs ? "${zs}1" * ($zh * 60 + $zm) : 0; + my $t = $y/400 - $y/100 + $y/4 + $y*365 + + $m*367/12 + $d - 719499; + return $t * 86400 + + $H * 3600 + + $M * 60 + + $S + - $z; +} + +my $debug = 0; +my $progress = 0; +while (@ARGV && $ARGV[0] =~ /^-\w+$/) { + $debug = 1 if $ARGV[0] =~ s/(-\w*)d(\w*)/$1$2/; + $progress = 1 if $ARGV[0] =~ s/(-\w*)p(\w*)/$1$2/; + shift if $ARGV[0] eq "-"; +} + +usage if @ARGV < 2; + +my $progtime = ""; + +my $period = shift; + +my $re_txt = shift; +my $re = qr{$re_txt}o; + +my %time; +my %rate; +my %max; + +sub debug ($) { + my $key = shift; + printf STDERR "%s\t%12d %8s %5.2f %5.2f\n", + $_, $time{$key}, $key, $max{$key}, $rate{$key}; +} + +while (<>) { + next unless $_ =~ $re; + my $key = $1 || ""; + my $size = $2 || 1.0; + my $time = iso2unix + ($_ =~ m{^(\d{4})-(\d\d)-(\d\d)[ ] + (\d\d):(\d\d):(\d\d)[ ] + (?:([+-])(\d\d)(\d\d)[ ])? + }x); + if ($progress) { + my $prog_now = substr $_, 0, 14; + if ($progtime ne $prog_now) { + $progtime = $prog_now; + print STDERR "$progtime\n"; + } + } + if (not defined $time{$key}) { + $time{$key} = $time; + $rate{$key} = 0.0; + $max{$key} = 0.0; + debug $key if $debug; + next; + } + # see acl_ratelimit() for details of the following + my $interval = $time - $time{$key}; + $interval = 1e-9 if $interval <= 0.0; + my $i_over_p = $interval / $period; + my $a = exp(-$i_over_p); + $time{$key} = $time; + $rate{$key} = $size * (1.0 - $a) / $i_over_p + $a * $rate{$key}; + $max{$key} = $rate{$key} if $rate{$key} > $max{$key}; + debug $key if $debug; +} + +print map { + " " x (20 - length) . + "$_ : $max{$_}\n" +} sort { + $max{$a} <=> $max{$b} +} keys %max; + +# eof diff --git a/util/renew-opendmarc-tlds.sh b/util/renew-opendmarc-tlds.sh new file mode 100755 index 0000000..9967018 --- /dev/null +++ b/util/renew-opendmarc-tlds.sh @@ -0,0 +1,128 @@ +#!/bin/sh -eu +# +# Short version of this script: +# curl -f -o /var/cache/exim/opendmarc.tlds https://publicsuffix.org/list/public_suffix_list.dat +# but run as Exim runtime user, writing to a place it can write to, and with +# sanity checks and atomic replacement. +# +# For now, we deliberately leave the invalid file around for analysis +# with .<pid> suffix. +# +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~8< cut here >8~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +# +# Create a cron-job as the Exim run-time user to invoke this daily, with a +# single parameter, 'cron'. Eg: +# +# 3 4 * * * /usr/local/sbin/renew-opendmarc-tlds.sh cron +# +# That will, at 3 minutes past the 4th hour (in whatever timezone cron is +# running it) invoke this script with 'cron'; we will then sleep between 10 and +# 50 seconds, before continuing. +# +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~8< cut here >8~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +# +# This should be "pretty portable"; the only things it depends upon are: +# * a POSIX shell which additionally implements 'local' (dash works) +# * the 'curl' command; change the fetch_candidate() function to replace that +# * the 'stat' command, to get the size of a file; else Perl +# + change size_of() if need be; it's defined per-OS +# * the 'hexdump' command and /dev/urandom existing +# + used when invoked with 'cron', to avoid retrieving on a minute boundary +# and contending with many other automated systems. +# + with bash/zsh, can replace with: $(( 10 + ( RANDOM % 40 ) )) +# + on Debian/Ubuntu systems, hexdump is in the 'bsdmainutils' package. + +# Consider putting an email address inside the parentheses, something like +# noc@example.org or other reachable address, so that if something goes wrong +# and the server operators need to step in, they can see from logs who to +# contact instead of just blocking your IP: +readonly CurlUserAgent='renew-opendmarc-tlds/0.1 (distributed with Exim)' + +# change this to your Exim run-time user (exim -n -bP exim_user) : +readonly RuntimeUser='_exim' + +# Do not make this a directory which untrusted users can write to: +readonly StateDir='/var/cache/exim' + +readonly URL='https://publicsuffix.org/list/public_suffix_list.dat' + +readonly TargetShortFile='opendmarc.tlds' + +# When replacing, new file must be at least this percentage the size of +# the old one or it's an error: +readonly MinNewSizeRation=90 + +# Each of these regexps must be matched by the file, or it's an error: +readonly MustExistRegexps=' + ^ac\.uk$ + ^org$ + ^tech$ + ' + +# =======================8< end of configuration >8======================= + +set -eu + +readonly FullTargetPath="${StateDir}/${TargetShortFile}" +readonly WorkingFile="${FullTargetPath}.$$" + +progname="$(basename "$0")" +note() { printf >&2 '%s: %s\n' "$progname" "$*"; } +die() { note "$@"; exit 1; } + +# guard against stomping on file-permissions +[ ".$(id -un)" = ".${RuntimeUser:?}" ] || \ + die "must be invoked as ${RuntimeUser}" + +fetch_candidate() { + curl --user-agent "$CurlUserAgent" -fSs -o "${WorkingFile}" "${URL}" +} + +case $(uname -s) in +*BSD|Darwin) + size_of() { stat -f %z "$1"; } + ;; +Linux) + size_of() { stat -c %s "$1"; } + ;; +*) + # why do we live in a world where Perl is the safe portable solution + # to getting the size of a file? + size_of() { perl -le 'print((stat($ARGV[0]))[7])' -- "$1"; } + ;; +esac + +sanity_check_candidate() { + local new_size prev_size re + new_size="$(size_of "$WorkingFile")" + + for re in $MustExistRegexps; do + grep -qs "$re" -- "$WorkingFile" || \ + die "regexp $re not found in $WorkingFile" + done + + if ! prev_size="$(size_of "$FullTargetPath")"; then + note "missing previous file, can't size-compare: $FullTargetPath" + # We're sane by definition, probably initial fetch, and the + # stat failure and this note will be printed. That's fine; if + # a cron invocation is missing the file then something has gone + # badly wrong. + return 0 + fi + local ratio + ratio=$(expr $new_size \* 100 / $prev_size) + if [ $ratio -lt $MinNewSizeRation ]; then + die "New $TargetShortFile candidate only ${ratio}% size of old; $new_size vs $prev_size" + fi +} + +if [ "${1:-.}" = "cron" ]; then + shift + # Don't pull on-the-minute, wait for off-cycle-peak + sleep $(( ($(dd if=/dev/urandom bs=1 count=1 2>/dev/null | hexdump -e '1/1 "%u"') % 40) + 10)) +fi + +umask 022 +fetch_candidate +sanity_check_candidate +mv -- "$WorkingFile" "$FullTargetPath" diff --git a/util/unknownuser.sh b/util/unknownuser.sh new file mode 100755 index 0000000..fe04dc6 --- /dev/null +++ b/util/unknownuser.sh @@ -0,0 +1,32 @@ +#! /bin/sh + +# This is a sample script for demonstrating how to handle unknown users in +# a more friendly way than just returning a "user unknown" error. It can +# be called from a pipe transport set up like this: + +# unknownuser_pipe: +# driver = pipe; +# command = "/opt/exim/util/unknownuser.sh", +# ignore_status, +# return_output, +# user = nobody + +# which is specified by a smartuser director set up like this: + +# unknownuser: +# transport = unknownuser_pipe, +# no_verify, +# driver = smartuser; + +# Any output generated by this script is then returned to the sender of +# the message. You can run any commands you like at this point, for example, +# to attempt fuzzy matches on the local part of the address. Here we just +# give a bland message, demonstrating the availability of the variables +# $LOCAL_PART and $DOMAIN. + +cat <<End +"$LOCAL_PART" is not a known user mailbox in the domain "$DOMAIN". +End + + + |