On 1/11/25 11:00, Andreas S. Kerber wrote:
> Would you mind sharing this 'perlsrs' file? I can't seem to find it
> and I'd like to take a look.

Not at all.

It's actually multiple files.

- perlsrs-old.m4 - the original version I found and started with
- perlsrs.m4 - a test modification of perlsrs-old.m4 to use socketmap
- socketmap.m4 - a version of (socketmap) perlsrs.m4 I used for a while
- envfrom2srs.pl - script to convert from SRS form to raw form
- srs2envto.pl - script to convert from raw form to SRS form
- socketmapd*.pl - socketmap of above Perl to avoid startup delay

I only used the socketmap version on one system for a few years before
giving up on it b/c I'd forget to start the socketmap daemon when the
system would reboot (patching / etc.).

I've never had any noticeable performance problems with the
perlsrs-old.m4 / envfrom2srs.pl / srs2envto.pl versions and they just
work without needing to remember start anything.

N.B. you need to change the $secret and $fwdomain. $secret is data
meant to prevent others from predicting your SRS values. $fwdomain is
mean to be the domain that you forward emailas; I use the hosts FQDN.

I save these files in the /etc/mail/srs directory.

I create a sym-link to the m4 files from where Sendmail / m4 looks for
hacks (/usr/share/sendmail-cf/hack on my system).

Then I include the following at the end of my sendmail.mc file:

HACK(`perlsrs-old')dnl

The premise behind the m4 is to check to see if the envelope from is in
class w, and if not, apply SRS to the envelope.

It's been a long time since I looked at this and I just confirmed that
it is still working.

--8<--perlsrs-old.m4--8<--
divert(-1)

# Copyright (c) 2004 by Mark Kramer <admin@asarian-host.net>
# All rights reserved.
# Copyright (c) 1988, 1993
# The Regents of the University of California. All rights reserved.
# # By using this file, you agree to the terms and conditions set
# forth in the LICENSE file which can be found at the top level of
# the sendmail distribution.
# #

divert(0)

VERSIONID(`$Id: perlsrs.m4,v 1.2 2004/04/01 20:37:09 mkramer Exp $')

ifdef(`_MAILER_DEFINED_',,`errprint(`*** WARNING: MAILER() should be
before HACK(perlsrs)')')

LOCAL_CONFIG

# Forward SRS program map

Kenvfrom2srs program /etc/mail/srs/envfrom2srs.pl

# Reverse SRS program map

Ksrs2envto program /etc/mail/srs/srs2envto.pl

# SRS regex map

Kis_srs regex ^<?SRS[01][=+-].*

MAILER_DEFINITIONS

SEnvFromSMTP
R$*@$=w$* $@ $1@$2$3 Don't SRS
rewrite local (class w) sending domains.
R$* $: $(envfrom2srs $1 $) SRS rewrite
non-local (!class w) sending domains.

LOCAL_RULESETS

###################################################################
### Local SRS Macros ###
###################################################################

SIsSRS
R$* $: $(is_srs $1 $)
R$@ $@ YES
R$* $@ NO

SReverseSrs
R$* $: $1 $>IsSRS $1
R$* NO $@ $1
R$* YES $@ $(srs2envto $1 $)

LOCAL_RULE_0

# Do we need to reverse SRS address?

R$* $: $>ReverseSrs $1
-->8--perlsrs-old.m4-->8--

--8<--perlsrs.m4--8<--
divert(-1)

# Copyright (c) 2004 by Mark Kramer <admin@asarian-host.net>
# All rights reserved.
# Copyright (c) 1988, 1993
# The Regents of the University of California. All rights reserved.
# # By using this file, you agree to the terms and conditions set
# forth in the LICENSE file which can be found at the top level of
# the sendmail distribution.
# #

divert(0)

VERSIONID(`$Id: 8.13.perlsrs.m4,v 1.0 2004/08/21 13:15:43 mkramer Exp $')

ifdef(`_MAILER_DEFINED_',,`errprint(`*** WARNING: MAILER() should be
before HACK(perlsrs)')')

LOCAL_CONFIG

# SRS socket maps

Kreverse_srs socket local:/var/run/socketmapd.sock
Kmake_srs socket local:/var/run/socketmapd.sock

# SRS regex map

Kis_srs regex ^<?SRS[01][=+-].*

MAILER_DEFINITIONS

SEnvFromSMTP
R$* $: $(make_srs $1 $)

LOCAL_RULESETS

###################################################################
### Local SRS Macros ###
###################################################################

SIsSrs
R$* $: $(is_srs $1 $)
R$@ $@ YES
R$* $@ NO

SReverseSrs
R$* $: $1 $>IsSrs $1
R$* NO $@ $1
R$* YES $@ $(reverse_srs $1 $)

LOCAL_RULE_0

# Do we need to reverse SRS address?

R$* $: $>ReverseSrs $1
-->8--perlsrs.m4-->8--

--8<--socketmap.m4--8<--
divert(-1)

# Copyright (c) 2004 by Mark Kramer <admin@asarian-host.net>
# All rights reserved.
# Copyright (c) 1988, 1993
# The Regents of the University of California. All rights reserved.
# # By using this file, you agree to the terms and conditions set
# forth in the LICENSE file which can be found at the top level of
# the sendmail distribution.
# #

divert(0)

VERSIONID(`$Id: socketmap.m4,v 1.0 2004/11/09 13:15:43 mkramer Exp $')

ifdef(`_MAILER_DEFINED_',,`errprint(`*** WARNING: MAILER() should be
before HACK(socketmap)')')

LOCAL_CONFIG

# SRS socket maps

Kreverse_srs socket local:/var/run/socketmapd.sock
Kmake_srs socket local:/var/run/socketmapd.sock

# SRS regex map

Kis_srs regex ^<?SRS[01][-+=].*

MAILER_DEFINITIONS

SEnvFromSMTP
R$*@$=w$* $@ $1@$2$3 Don't SRS rewrite local (class
w) sending domains.
R$* $: $(make_srs $1 $) SRS rewrite non-local (!class w)
sending domains.

LOCAL_RULESETS

###################################################################
### Local SRS Macros ###
###################################################################

SIsSrs
R$* $: $(is_srs $1 $)
R$@ $@ YES
R$* $@ NO

SReverseSrs
R$* $: $1 $>IsSrs $1
R$* NO $@ $1
R$* YES $@ $(reverse_srs $1 $)

LOCAL_RULE_0

# Do we need to reverse SRS address?

R$* $: $>ReverseSrs $1
-->8--socketmap.m4-->8--

--8<--envfrom2srs.pl--8<--
#!/usr/bin/perl
# # Sendmail "program" map script to rewrite envelope-from
# address to SRS0 address. Called from macro EnvFromSMTP.
# # Code by Mark Kramer <admin@asarian-host.net>
# # Version 0.30
# # Last revision: March 24, 2004
# # Licensed under GPL
# # For detailed installation notes, read:
# # http://asarian-host.net/srs/sendmailsrs.htm
# # See also: http://www.anarres.org/projects/srs/
# http://spf.pobox.com/
# # This version requires at least Sendmail 8.12.10 + Mail::SRS 0.30

use Mail::SRS;
use strict;

# No funny business in our output, please

close (STDERR);

my $old_address = $ARGV[0];
my $secret = 'REDACTED';
my ($new_address, $use_address);
my $fwdomain = 'REDACTED';
my $srs = new Mail::SRS (Secret => $secret, HashLength => 8,
AlwaysRewrite => 1);

###
open(my $fh, '>>', '/tmp/mylog.txt');
print $fh "$old_address\n";
close $fh;
###

# Our original envelope-from may look funny on entry
# of this Ruleset:
# # admin<@asarian-host.net.>
# # We need to preprocess it some:

($use_address = $old_address) =~ s/[<>]//g;
$use_address =~ s/\.$//g;

# Here, at EnvFromSMTP, we do not loop our address through an
# extra IsSrs macro: we want SRS1 forwarding functionality!
# (relaying reversed third-party SRS1 addresses is a
# different story, though; but here we just allow for SRS0
# addresses to be promoted to SRS1 ones).
# # Ok, first check whether we already have a signed SRS address;
# if so, just return the old address: we do not want to double-sign
# by accident! (Non-locally generated SRS0 addresses, by nature
# of the protocol, will not 'eval'; so, they will simply become
# SRS1 addresses. Thus, only locally generated SRS0 addresses are
# exempted from double-signing.)
# # Else, gimme a valid SRS signed address, munge it back the way
# sendmail wants it at this point; or just return the old address,
# in case nothing went.

if (eval {$new_address = $srs -> reverse ($use_address)}) {
print "$old_address\n";
} elsif (eval {$new_address = $srs -> forward ($use_address, $fwdomain)}) {
$new_address .= '.>';
$new_address =~ s/\@/<@/;
print "$new_address\n";
} else {
print "$old_address\n";
}

exit 0;
-->8--envfrom2srs.pl-->8--

--8<--srs2envto.pl--8<--
#!/usr/bin/perl
# # Sendmail "program" map script to revert SRS0 or SRS1 address
# back to regular recipient. Called from macro ParseLocal.
# # Code by Mark Kramer <admin@asarian-host.net>
# # Version 0.30
# # Last revision: March 24, 2004
# # Licensed under GPL
# # For detailed installation notes, read:
# # http://asarian-host.net/srs/sendmailsrs.htm
# # See also: http://www.anarres.org/projects/srs/
# http://spf.pobox.com/
# # This version requires at least Sendmail 8.12.10 + Mail::SRS 0.30

use Mail::SRS;
use strict;

# No funny business in our output, please

close (STDERR);

my $old_address = $ARGV[0];
my $secret = 'REDACTED';
my $use_address;
my $srs = new Mail::SRS (Secret => $secret, HashLength => 8,
AlwaysRewrite => 1);

# Munge ParseLocal recipient in the same manner as required
# in EnvFromSMTP.

($use_address = $old_address) =~ s/[<>]//g;
$use_address =~ s/\.$//g;

# Just try and reverse the address. If we succeed, return this
# new address; else, return the old address (quoted if it was
# a piped alias).
# # We do an exhaustive while loop, so that SRS1 address may
# become SRS0, which, in turn, may become reverted to
# a local recipient.
# # Mail:SRS, as of 0.30, is now case-insensitive. Added the
# /i switch to accomodate for the change.

if ($use_address =~ /^SRS[01][=+-]/i) {
$use_address = $_ while (eval {$_ = $srs -> reverse ($use_address)});
$use_address .= '.>';
$use_address =~ s/\@/<@/;
print "$use_address\n";
} elsif ($use_address =~ /^\|/) {
print "\"$old_address\"\n";
} else {
print "$old_address\n";
}

exit 0;
-->8--srs2envto.pl-->8--

--8<--socketmapd.0.31.pl--8<--
#!/usr/bin/perl

# Sendmail "socket" map script to perform SRS functions.
# # Code by Mark Kramer <admin@asarian-host.net>
# # Version 0.31
# # Last revision: November 2, 2004
# # With thanks to Jim Allen for pointing out a missing
# "while (!eof($client))" loop, causing BROKEN PIPE errors
# on concurrent connections.
# # Licensed under GPL
# # For detailed installation notes, read:
# # http://asarian-host.net/srs/sendmailsrs.htm
# # See also: http://www.anarres.org/projects/srs/
# http://spf.pobox.com/
# # This version requires at least Sendmail 8.13.0 + Mail::SRS 0.30

use IO::Socket;
use POSIX qw (:sys_wait_h);
use Sys::Syslog qw (:DEFAULT setlogsock);
use Mail::SRS;
use strict;

my ($user, $login, $pass, $uid, $gid, $data, $socket_map, $old_address,
$new_address, $use_address, $client, $sock);
my $secret = 'REDACTED';
my $fwdomain = 'REDACTED';
my $srs = new Mail::SRS (Secret => $secret, MaxAge => 8, HashLength =>
8, AlwaysRewrite => 1);

sub write_syslog {
setlogsock ('unix');
openlog ('socketmapd', 'pid,cons', 'lpr') or exit 1;
syslog ('info', @_);
closelog ();
}

sub log_error_and_exit {
write_syslog (@_);
exit 1;
}

sub netstringRead {
my $sock = shift;
my $saveSeparator = $/;
$/ = ':';
my $dataLength = <$sock>;
write_syslog ("WARNING: cannot read netstring length") unless
defined ($dataLength);
chomp ($dataLength);
my $data;
if ($sock -> read ($data, $dataLength) == $dataLength) {
($sock -> getc () eq ',') or write_syslog ("WARNING: data
misses closing ,");
} else {
write_syslog ("WARNING: received only " . length ($data) . " of
$dataLength bytes");
}
$/ = $saveSeparator;
return $data;
}

sub netstringWrite {
my $sock = shift;
my $data = "OK " . shift;
write_syslog ("WARNING: $@") if (not eval {print $sock length
($data) . ':' . $data . ','});
}

sub handleChildConnection {
my $client = shift;
while (not eval {eof ($client)}) {
if (eval {$data = netstringRead ($client)}) {
if ($data =~ /^(\S+) (\S+)$/) {
$socket_map = $1;
$old_address = $2;
($use_address = $old_address) =~ s/[<>]//g;
$use_address =~ s/\.$//g;
if ($socket_map eq 'reverse_srs') {
if ($use_address =~ /^SRS[01][-+=]/i) {
$use_address = $_ while (eval {$_ = $srs ->
reverse ($use_address)});
$use_address .= '.>';
$use_address =~ s/\@/<@/;
netstringWrite ($client, $use_address);
} elsif ($use_address =~ /^\|/) {
netstringWrite ($client, "\"$old_address\"");
} else {
netstringWrite ($client, $old_address);
}
} elsif ($socket_map eq 'make_srs') {
if (eval {$new_address = $srs -> reverse
($use_address)}) {
netstringWrite ($client, $old_address);
} elsif (eval {$new_address = $srs -> forward
($use_address, $fwdomain)}) {
$new_address .= '.>';
$new_address =~ s/\@/<@/;
netstringWrite ($client, $new_address);
} else {
netstringWrite ($client, $old_address);
}
} else {
write_syslog ("WARNING: unknown socketmap,
'$socket_map'");
}
} else {
write_syslog ("WARNING: incomplete data, '$data'");
}
} else {
write_syslog ("WARNING: unable to read from client");
}
}
}

if (not $user = lc ($ARGV[0])) {
print STDERR "Missing user\n";
print STDERR "Usage: $0 <user to run as>\n";
exit 1;
} elsif ($>) {
print STDERR "You need to start socketmapd as root!\n";
exit 1;
} else {
($login, $pass, $uid, $gid) = getpwnam ($user);
if (not defined ($uid)) {
log_error_and_exit ("$user is not a valid user on this system!");
} elsif (not $uid) {
log_error_and_exit ("You cannot run socketmapd as root!");
}
}

open (STDIN, '/dev/null');
open (STDOUT, '>/dev/null');
open (STDERR, '>&STDOUT');

umask (0027);

unlink ('/var/run/socketmapd.pid');
unlink ('/var/run/socketmapd.sock');

if ($_ = fork ()) {
open (USERLOG, ">".'/var/run/socketmapd.pid') or exit 1;
flock (USERLOG, 2);
seek (USERLOG, 0, 0);
print USERLOG " $_";
close (USERLOG);
exit 0;
}

POSIX::setsid () || exit 1;

if (not (eval {$sock = new IO::Socket::UNIX (
Listen => SOMAXCONN,
Type => SOCK_STREAM,
Local => '/var/run/socketmapd.sock')})) {
log_error_and_exit ("ERROR: Unable to create UNIX domain socket!");
}

chown $uid, $gid, '/var/run/socketmapd.sock';

$0 = 'socketmapd';

$) = $gid;
$( = $gid;
$> = $uid;
$< = $uid;

write_syslog ("Dropped privileges on socketmap daemon");

while (eval {$client = $sock -> accept ()}) {
if (fork) {
eval {$client -> close ()};
wait;
} elsif (fork) {
exit 0;
} else {
eval {$sock -> close ()};
eval {handleChildConnection ($client)};
eval {$client -> close ()};
exit 0;
}
}

write_syslog ("Unsuccessful exit from the socketmap daemon: $!");

eval {$sock -> close ()};

exit 0;
-->8--socketmapd.0.31.pl-->8--

--
Grant. . . .