summaryrefslogtreecommitdiffstats
path: root/util
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--util/.gitignore2
-rw-r--r--util/README40
-rwxr-xr-xutil/chunking_fixqueue_finalnewlines.pl160
-rwxr-xr-xutil/cramtest.pl60
-rw-r--r--util/gen_pkcs3.c268
-rwxr-xr-xutil/logargs.sh26
-rwxr-xr-xutil/mkcdb.pl93
-rwxr-xr-xutil/ocsp_fetch.pl84
-rw-r--r--util/proxy_protocol_client.pl251
-rw-r--r--util/ratelimit.pl159
-rwxr-xr-xutil/renew-opendmarc-tlds.sh128
-rwxr-xr-xutil/unknownuser.sh32
12 files changed, 1303 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..2fe9a6c
--- /dev/null
+++ b/util/gen_pkcs3.c
@@ -0,0 +1,268 @@
+/* Copyright (C) 2012,2016 Phil Pennock.
+ * Copyright (c) The Exim Maintainers 2021
+ * 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
+
+
+
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-04 17:43:24 +0000