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. . . .
--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)