From: Mark Wooding <mdw@distorted.org.uk>
Date: Mon, 27 Jun 2016 16:50:00 +0000 (+0100)
Subject: lib/Odin.pm: Provide substitutions on mail recipient addresses.
X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~mdw/git/odin-cgi/commitdiff_plain/fd83afba2d3ebb14bbacdef2802bc5d415ea3705

lib/Odin.pm: Provide substitutions on mail recipient addresses.

The most useful thing is `%l' to include the original Odin local-part in
the forwarded address.  For completeness, we also have `%d' which is the
default domain-part.
---

diff --git a/lib/Odin.pm b/lib/Odin.pm
index a575e83..90f1dc1 100644
--- a/lib/Odin.pm
+++ b/lib/Odin.pm
@@ -574,7 +574,7 @@ sub gen_redir_name ($$) {
 sub qualify_recip ($) {
   my ($r) = @_;
 
-  return $r =~ /\@/ || !defined $MAIL_QUALDOM ? $r : "$r\@$MAIL_QUALDOM";
+  return $r =~ /\@/ || !defined $MAIL_QUALDOM ? $r : "$r\@\%d";
 }
 
 sub check_fixup_redir ($) {
@@ -586,6 +586,13 @@ sub check_fixup_redir ($) {
   }
 }
 
+sub subst_recip ($$) {
+  my ($l, $r) = @_;
+  my %d = ('%' => '%', 'l' => $l, 'd' => $MAIL_QUALDOM);
+  $r =~ s{%([%a-z])}{$d{$1} // fail "undefined substitution `\%$1'"}eg;
+  return $r;
+}
+
 sub new_redir ($$\%;$) {
   my ($dom, $gen, $r, $n) = @_;
   my $db = open_db;
@@ -600,7 +607,7 @@ sub new_redir ($$\%;$) {
       insert_record $db, "odin_mailredir",
 	lpart => $l, dom => $dom, st => 'live',
 	owner => $WHO, creator => $WHO,
-	recip => $r->{recip} // qualify_recip $Odin::WHO,
+	recip => subst_recip($l, $r->{recip} // qualify_recip $Odin::WHO),
 	expire => $r->{expire} // -1,
 	comment => $r->{comment} // "";
       push @l, $l;
@@ -688,7 +695,8 @@ sub modify_redir ($\%@) {
 	  WHERE lpart = ? AND dom = ? AND owner = ?", undef,
 	 $l, $dom, $WHO);
       if (!defined $recip) { Odin::fail "unknown local part `$l'"; }
-      elsif ($recip eq "") { $r{recip} //= qualify_recip $WHO; }
+      elsif ($recip eq "" || defined $r{recip})
+	{ $r{recip} = subst_recip $l, $r{recip} // qualify_recip $WHO; }
       if ($st ne "live") { $r{st} = "live"; $r{expire} //= -1; }
       my @var = ();
       my @val = ();